YAP 7.1.0
e.c
1/*************************************************************************
2 * *
3 * YAP Prolog *
4 * *
5 * Yap Prolog was developed at NCCUP - Universidade do Porto *
6 * *
7 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8 * *
9 **************************************************************************
10 * *
11 * File: exec.c *
12 * Last rev: 8/2/88 *
13 * mods: *
14 * comments: Execute Prolog code *
15 * *
16
17 *************************************************************************/
18#ifdef SCCS
19static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
20#endif
21
22#include "absmi.h"
23
24#include "amidefs.h"
25
26#include "attvar.h"
27#include "cut_c.h"
28#include "yapio.h"
29#include "heapgc.h"
30
31static bool CallPredicate(PredEntry *, choiceptr, yamop *CACHE_TYPE);
32
33// must hold thread worker comm lock at call.
34static bool EnterCreepMode(Term, Term CACHE_TYPE);
35
36static Int current_choice_point(USES_REGS1);
37
38static Int execute(USES_REGS1);
39
40static Int execute0(USES_REGS1);
41
42static Term cp_as_integer(choiceptr cp USES_REGS)
43{
44 return (MkIntegerTerm(LCL0 - (CELL *)cp));
45}
46
47static choiceptr cp_from_integer(Term cpt USES_REGS)
48{
49 return (choiceptr)(LCL0 - IntegerOfTerm(cpt));
50}
51
58Term Yap_cp_as_integer(choiceptr cp)
59{
60 CACHE_REGS
61 return cp_as_integer(
62 cp PASS_REGS);
63}
64
65PredEntry *Yap_track_cpred(op_numbers op, yamop *ip, size_t min, void *v)
66{
67 gc_entry_info_t *i = v;
68 if (ip == NULL)
69 ip = P;
70 i->at_yaam = true;
71 CalculateStackGap(PASS_REGS1);
72 i->gc_min = 2 * MinStackGap;
73 yamop *ip0 = PREVOP(ip, Osbpp);
74 if (!op)
75 {
76 op_numbers op1 = Yap_op_from_opcode(ip0->opc);
77 i->at_yaam = false;
78 if (op1 == _call_cpred || op1 == _call_usercpred)
79 op = op1;
80 else
81 {
82 op = Yap_op_from_opcode(ip->opc);
83 ip0 = ip;
84 }
85 }
86 else if (ip->opc == Yap_opcode(op))
87 {
88 ip0 = ip;
89 }
90 switch (op)
91 {
92 case _call:
93 i->env = ENV; // YENV should be tracking ENV
94 i->p = ip;
95 i->p_env = NEXTOP(ip, Osbpp);
96 i->a = i->p->y_u.Osbpp.p->ArityOfPE;
97 i->env_size = -i->p->y_u.Osbpp.s / sizeof(CELL);
98 i->callee = i->p->y_u.Osbpp.p;
99 return i->p->y_u.Osbpp.p0;
100 case _call_cpred:
101 case _call_usercpred:
102 i->env = ENV; // YENV should be tracking ENV
103 i->p_env = NEXTOP(ip0, Osbpp);
104 i->a = ip0->y_u.Osbpp.p->ArityOfPE;
105 i->p = ip0;
106 i->env_size = -ip0->y_u.Osbpp.s / sizeof(CELL);
107 i->callee = i->p->y_u.Osbpp.p;
108 return ip0->y_u.Osbpp.p0;
109 case _execute_cpred:
110 case _execute:
111 case _p_execute:
112 i->a = ip0->y_u.Osbpp.p->ArityOfPE;
113 i->p_env = CP;
114 i->env = ENV;
115 i->p = ip0;
116 i->env_size = -ip0->y_u.Osbpp.s / sizeof(CELL);
117 i->callee = i->p->y_u.Osbpp.p;
118 return ip0->y_u.Osbpp.p0;
119
120 case _dexecute:
121 i->a = P->y_u.Osbpp.p->ArityOfPE;
122 i->p_env = NEXTOP(ip, Osbpp);
123 i->env = ENV;
124 i->p = P;
125 i->env_size = EnvSizeInCells;
126 i->callee = i->p->y_u.Osbpp.p;
127 return ip->y_u.Osbpp.p0;
128 case _try_c:
129 case _retry_c:
130 case _try_userc:
131 case _retry_userc:
132 i->p = P;
133 i->a = i->p->y_u.OtapFs.s + i->p->y_u.OtapFs.extra;
134 i->p_env = CP;
135 i->env = ENV;
136 i->env_size = EnvSizeInCells;
137 i->callee = PP;
138 return PP;
139 case _copy_idb_term:
140 i->env = ENV; // YENV should be tracking ENV
141 i->p = P;
142 i->p_env = CP;
143 i->a = 3;
144 i->env_size = EnvSizeInCells;
145 i->callee = NULL;
146 return NULL;
147 case _ensure_space:
148 i->env = ENV;
149 i->p = P;
150 i->p_env = CP;
151 i->a = P->y_u.Osbpa.p->ArityOfPE;
152 i->op = _ensure_space;
153 i->env_size = EnvSizeInCells;
154 i->callee = NULL;
155 return NULL;
156 case _p_func2s_vv:
157 i->env = ENV;
158 i->p = P;
159 i->p_env = CP;
160 i->a = 0;
161 i->op = _p_func2s_vv;
162 i->env_size = -NEXTOP(P, xxx)->y_u.Osbpp.s / sizeof(CELL);
163 i->callee = NULL;
164 return NULL;
165 case _p_func2s_cv:
166 i->env = ENV;
167 i->p = P;
168 i->p_env = CP;
169 i->a = 0;
170 i->op = _p_func2s_vc;
171 i->env_size = -NEXTOP(P, xxc)->y_u.Osbpp.s / sizeof(CELL);
172 i->callee = NULL;
173 return NULL;
174 case _p_func2s_vc:
175 i->env = ENV;
176 i->p = P;
177 i->p_env = CP;
178 i->a = 0;
179 i->op = _p_func2s_cv;
180 i->env_size = -NEXTOP(P, xxn)->y_u.Osbpp.s / sizeof(CELL);
181 i->callee = NULL;
182 return NULL;
183 case _p_func2s_y_vv:
184 i->env = ENV;
185 i->p = P;
186 i->p_env = CP;
187 i->a = 0;
188 i->op = _p_func2s_y_vv;
189 i->env_size = -NEXTOP(P, yxx)->y_u.Osbpp.s / sizeof(CELL);
190 return NULL;
191 case _p_func2s_y_vc:
192 i->env = ENV;
193 i->p = P;
194 i->p_env = CP;
195 i->a = 0;
196 i->op = _p_func2s_y_vc;
197 i->env_size = -NEXTOP(P, yxc)->y_u.Osbpp.s / sizeof(CELL);
198 i->callee = NULL;
199 return NULL;
200 case _p_func2s_y_cv:
201 i->env = ENV;
202 i->p = P;
203 i->p_env = CP;
204 i->a = 0;
205 i->op = _p_func2s_y_cv;
206 i->env_size = -NEXTOP(P, yxn)->y_u.Osbpp.s / sizeof(CELL);
207 i->callee = NULL;
208 return NULL;
209 case _p_functor:
210 i->env = ENV;
211 i->p = P;
212 i->p_env = CP;
213 i->a = 3;
214 i->op = _p_functor;
215 i->env_size = -NEXTOP(P, yxx)->y_u.Osbpp.s / sizeof(CELL);
216 i->callee = NULL;
217 return NULL;
218 default:
219 i->env = ENV;
220 i->p = P;
221 i->p_env = CP;
222 i->a = 0;
223 i->op = 0;
224 i->env_size = EnvSizeInCells;
225 i->callee = NULL;
226 return NULL;
227 }
228}
229
237static inline bool CallPredicate(PredEntry *pen, choiceptr cut_pt,
238 yamop *code USES_REGS)
239{
240#ifdef LOW_LEVEL_TRACER
241 if (Yap_do_low_level_trace)
242 low_level_trace(enter_pred, pen, XREGS + 1);
243#endif /* LOW_LEVEL_TRACE */
244#ifdef DEPTH_LIMIT
245 if (DEPTH <= MkIntTerm(1))
246 { /* I assume Module==0 is prolog */
247 if (pen->ModuleOfPred)
248 {
249 if (DEPTH == MkIntTerm(0))
250 {
251 UNLOCK(pen->PELock);
252 return false;
253 }
254 else
255 DEPTH = RESET_DEPTH();
256 }
257 }
258 else if (pen->ModuleOfPred)
259 DEPTH -= MkIntConstant(2);
260#endif /* DEPTH_LIMIT */
261 if (P->opc != EXECUTE_CPRED_OP_CODE)
262 {
263 // YENV[E_CP] = CP;
264 // YENV[E_E] = ENV;
265 //#ifdef DEPTH_LIMIT
266 // YENV[E_DEPTH] = DEPTH;
267 //#endif
268 // ENV = YENV;
269 ENV = YENV;
270 YENV = ASP;
271 CP = P;
272 }
273 /* make sure we have access to the user given cut */
274 YENV[E_CB] = (CELL)cut_pt;
275 P = code;
276 return true;
277}
278
285inline static bool CallMetaCall(Term t, Term mod USES_REGS)
286{
287 // we have a creep requesr waiting
288
289 ARG1 = t;
290 ARG2 = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
291 ARG3 = t;
292 if (mod)
293 {
294 ARG4 = mod;
295 }
296 else
297 {
298 ARG4 = TermProlog;
299 }
300 if (Yap_GetGlobal(AtomDebugMeta) == TermOn)
301 {
302 return CallPredicate(PredTraceMetaCall, B,
303 PredTraceMetaCall->CodeOfPred PASS_REGS);
304 }
305 else
306 {
307 return CallPredicate(PredMetaCall, B, PredMetaCall->CodeOfPred PASS_REGS);
308 }
309}
310
316Term Yap_ExecuteCallMetaCall(Term g, Term mod)
317{
318 CACHE_REGS
319 Term ts[4];
320 ts[0] = g;
321 ts[1] = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
322 ts[2] = g;
323 ts[3] = mod;
324 if (Yap_GetGlobal(AtomDebugMeta) == TermOn)
325 {
326 return Yap_MkApplTerm(PredTraceMetaCall->FunctorOfPred, 3, ts);
327 }
328 return Yap_MkApplTerm(PredMetaCall->FunctorOfPred, 4, ts);
329}
330
331Term Yap_PredicateIndicator(Term t, Term mod)
332{
333 CACHE_REGS
334 // generate predicate indicator in this case
335 Term ti[2];
336 t = Yap_YapStripModule(t, &mod);
337 if (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t)))
338 {
339 ti[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(t)));
340 ti[1] = MkIntegerTerm(ArityOfFunctor(FunctorOfTerm(t)));
341 }
342 else if (IsPairTerm(t))
343 {
344 ti[0] = MkAtomTerm(AtomDot);
345 ti[1] = MkIntTerm(2);
346 }
347 else
348 {
349 ti[0] = t;
350 ti[1] = MkIntTerm(0);
351 }
352 t = Yap_MkApplTerm(FunctorSlash, 2, ti);
353 if (mod != CurrentModule)
354 {
355 ti[0] = mod;
356 ti[1] = t;
357 return Yap_MkApplTerm(FunctorModule, 2, ti);
358 }
359 return t;
360}
361
362static bool CallError(yap_error_number err, Term t, Term mod USES_REGS)
363{
364 if (err == TYPE_ERROR_CALLABLE)
365 {
366 t = Yap_YapStripModule(t, &mod);
367 }
368 Yap_ThrowError(err, t, "call/1");
369 return false;
370}
371
380static Int current_choice_point(USES_REGS1)
381{
382 Term t = Deref(ARG1);
383 Term td;
384#if SHADOW_HB
385 register CELL *HBREG = HB;
386#endif
387 if (!IsVarTerm(t))
388 return false;
389 choiceptr b = B;
390 while (b && b->cp_ap == TRUSTFAILCODE && b->cp_b)
391 b = b->cp_b;
392 td = cp_as_integer(b PASS_REGS);
393 YapBind((CELL *)t, td);
394 return true;
395}
396
397static Int save_env_b(USES_REGS1)
398{
399 Term t = Deref(ARG1);
400 Term td;
401#if SHADOW_HB
402 register CELL *HBREG = HB;
403#endif
404 if (!IsVarTerm(t))
405 return (FALSE);
406 td = cp_as_integer((choiceptr)YENV[E_CB] PASS_REGS);
407 YapBind((CELL *)t, td);
408 return true;
409}
410
411
412bool comma_goal(Term t1, Term t0[4], bool first) {
413 Term ts[2], m1 = t0[3];
414 if (IsVarTerm(t1)) {
415 if (first) {
416 CallError(INSTANTIATION_ERROR, t0[0], t0[3] PASS_REGS);
417 } else {
418 ts[0] = m1;
419 ts[1] = t1;
420 t1 = Yap_MkApplTerm(FunctorModule,2,ts);
421 t0[1] = Yap_MkApplTerm(FunctorCall,1,&t1);
422 return false;
423 }
424
425 } else if (IsAtomTerm(t1)) {
426 if (t1 == TermCut) {
427 if (first) t1 = TermTrue;
428 }
429 t0[1] = t1;
430 return false;
431 }
432 else if (IsPairTerm(t1)) {
433 Term ts[2];
434 ts[0] = t1;
435 ts[1] = (CurrentModule == 0 ? TermProlog : CurrentModule);
436 t0[1] = Yap_MkApplTerm(FunctorCsult, 2, ts);
437 return false;
438 } else if (IsApplTerm(t1)) {
439 Functor f = FunctorOfTerm(t1);
440 if (f==FunctorComma) {
441 Term l = Yap_YapStripModule(ArgOfTerm(1,t1),t0+3);
442 comma_goal(l, t0, first);
443 t0[1] = l;
444 t0[2] = ArgOfTerm(2,t1);
445 return true;
446 } else if (IsExtensionFunctor(f)) {
447 return CallError(TYPE_ERROR_CALLABLE, t0[0], t0[3] PASS_REGS);
448 }
449 }
450 t0[1] = t1;
451 return false;
452}
453
454
455inline static bool do_execute(Term t, Term mod USES_REGS)
456{
457 register CELL *pt;
458 PredEntry *pen;
459 arity_t i, arity;
460 restart:
461 /* first do predicate expansion, even before you process signals.
462 This way you don't get to spy goal_expansion(). */
463 if (Yap_has_a_signal() && !LOCAL_InterruptsDisabled &&
464 !(LOCAL_PrologMode & (AbortMode | InterruptMode | SystemMode)))
465 {
466 return EnterCreepMode(t, mod PASS_REGS);
467 }
468 Term t0 = t, mod0 = mod;
469 t = Yap_YapStripModule(t, &mod);
470 if (IsVarTerm(t) || IsVarTerm(mod))
471 {
472 return CallError(INSTANTIATION_ERROR, t0, mod0 PASS_REGS);
473 }
474if (IsPairTerm(t)) {
475 Term ts[2];
476 ts[0] = t;
477 ts[1] = (CurrentModule == 0 ? TermProlog : CurrentModule);
478 t = Yap_MkApplTerm(FunctorCsult, 2, ts);
479 }
480 if (IsApplTerm(t))
481 {
482 register Functor f = FunctorOfTerm(t);
483 if (f == FunctorCall) {
484 t = ArgOfTerm(1,t);
485 goto restart;
486 };
487 #if 0
488 Term ts[4];
489 ts[0] = t;
490 ts[3] = mod;
491 Term *o = &t, t1=t;
492 bool comma;
493 bool first = true;
494 while((comma = comma_goal((t1=Yap_YapStripModule(t1, ts+3)), ts, first))) {
495 CELL *sreg = HR;
496 *o = AbsAppl(HR);
497 HR += 3;
498 sreg[0]=(CELL)FunctorComma;
499 sreg[1] = ts[1];
500 // o = sreg+2;
501 ts[3] = mod;
502 t1 = ts[2];
503 first = false;
504
505 }
506 // *o = ts[1];
507 #endif
508 f = FunctorOfTerm(t);
509 arity = ArityOfFunctor(f);
510 if (arity > MaxTemps)
511 {
512 return CallError(TYPE_ERROR_CALLABLE, t0, mod0 PASS_REGS);
513 }
514 pen = RepPredProp(PredPropByFunc(f, mod));
515 /* You thought we would be over by now */
516 /* but no meta calls require special preprocessing */
517 /* now let us do what we wanted to do from the beginning !! */
518 /* I cannot use the standard macro here because
519 otherwise I would dereference the argument and
520 might skip a svar */
521 if (pen->PredFlags & (MetaPredFlag | UndefPredFlag))
522 {
523 return CallMetaCall(t0, mod0 PASS_REGS);
524 }
525 pt = RepAppl(t) + 1;
526 for (i = 1; i <= arity; i++)
527 {
528#if YAPOR_SBA
529 Term d0 = *pt++;
530 if (d0 == 0)
531 XREGS[i] = (CELL)(pt - 1);
532 else
533 XREGS[i] = d0;
534#else
535
536 XREGS[i] = *pt++;
537#endif
538 }
539 return CallPredicate(pen, B, pen->CodeOfPred PASS_REGS);
540 }
541 else if (IsAtomTerm(t))
542 {
543 PredEntry *pen;
544 Atom a = AtomOfTerm(t);
545 if (a==AtomCut)
546 return true;
547 pen = RepPredProp(PredPropByAtom(a, mod));
548
549
550 return (CallPredicate(pen, B, pen->CodeOfPred PASS_REGS));
551 }
552 return CallMetaCall(t0, mod0 PASS_REGS);
553}
554
555// enter locked
556static bool EnterCreepMode(Term t, Term mod USES_REGS)
557{
558 PredEntry *PredCreep;
559
560 if (Yap_get_signal(YAP_CDOVF_SIGNAL))
561 {
562 ARG1 = t;
563 if (!Yap_locked_growheap(FALSE, 0, NULL))
564 {
565 Yap_Error(RESOURCE_ERROR_HEAP, TermNil,
566 "YAP failed to grow heap at meta-call");
567 }
568 if (!Yap_has_a_signal())
569 {
570 return do_execute(ARG1, mod PASS_REGS);
571 }
572 }
573 PredCreep = RepPredProp(PredPropByFunc(FunctorCreep, 1));
574 PP = PredCreep;
575 if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == FunctorModule)
576 {
577 ARG1 = t;
578 }
579 else
580 {
581 Term ts[2];
582 if (mod)
583 {
584 ts[0] = mod;
585 }
586 else
587 {
588 ts[0] = TermProlog;
589 }
590 ts[1] = t;
591 ARG1 = Yap_MkApplTerm(FunctorModule, 2, ts);
592 }
593 CalculateStackGap(PASS_REGS1);
594 P_before_spy = P;
595 return CallPredicate(PredCreep, B, PredCreep->CodeOfPred PASS_REGS);
596}
597
598static Int execute(USES_REGS1)
599{ /* 'call'(Goal) */
600 Term t = Deref(ARG1);
601 return do_execute(t, CurrentModule PASS_REGS);
602}
603
604bool Yap_Execute(Term t USES_REGS)
605{ /* 'call'(Goal) */
606 return do_execute(t, CurrentModule PASS_REGS);
607}
608
609static void heap_store(Term t USES_REGS)
610{
611 if (IsVarTerm(t))
612 {
613 if (VarOfTerm(t) < HR)
614 {
615 *HR++ = t;
616 }
617 else
618 {
619 RESET_VARIABLE(HR);
620 Bind_Local(VarOfTerm(t), (CELL)HR);
621 HR++;
622 }
623 }
624 else
625 {
626 *HR++ = t;
627 }
628}
629
630static Int do_execute_n(arity_t n, Term g, Term mod)
631{
632 Atom name;
633 arity_t arity;
634 g = Yap_YapStripModule(g, &mod);
635 if (IsVarTerm(g)) {
636 Yap_ThrowError(INSTANTIATION_ERROR, g, NULL);
637 }
638
639 if (IsApplTerm(g)) {
640 Functor f = FunctorOfTerm(g);
641 if (IsExtensionFunctor(f)) {
642 return CallError(TYPE_ERROR_CALLABLE, g, mod PASS_REGS);
643 }
644 arity = f->ArityOfFE;
645 name = NameOfFunctor(f);
646 memmove( &ARG1+arity, &ARG2, n*sizeof(CELL));
647 memcpy(&ARG1,RepAppl(g)+1, arity*sizeof(CELL));
648 } else if (IsAtomTerm(g)) {
649 arity = 0;
650 name = AtomOfTerm(g);
651 memmove( &ARG1, &ARG2, n*sizeof(CELL));
652 } else if (IsPairTerm(g)) {
653 arity = 2;
654 name = AtomCsult;
655 memmove( &ARG1+2, &ARG2, n*sizeof(CELL));
656 memcpy(&ARG1,RepAppl(g)+1, 2*sizeof(CELL));
657 } else {
658 Yap_ThrowError(TYPE_ERROR_CALLABLE,g,NULL);
659 return false;
660 }
661 Functor f = Yap_MkFunctor(name, arity+n);
662 PredEntry * pen = RepPredProp(PredPropByFunc(f, mod));
663 /* You thought we would be over by now */
664 /* but no meta calls require special preprocessing */
665 /* now let us do what we wanted to do from the beginning !! */
666 /* I cannot use the standard macro here because
667 otherwise I would dereference the argument and
668 might skip a svar */
669 return CallPredicate(pen, B, pen->CodeOfPred PASS_REGS);
670}
671
672static Int execute2(USES_REGS1)
673{ /* 'call'(Goal) */
674 return do_execute_n(1, ARG1, CurrentModule PASS_REGS);
675}
676
677static Int execute3(USES_REGS1)
678{ /* 'call'(Goal) */
679 return do_execute_n(2, ARG1, CurrentModule PASS_REGS);
680}
681
682static Int execute4(USES_REGS1)
683{ /* 'call'(Goal) */
684 return do_execute_n(3, ARG1, CurrentModule PASS_REGS);
685}
686
687static Int execute5(USES_REGS1)
688{ /* 'call'(Goal) */
689 return do_execute_n(4, ARG1, CurrentModule PASS_REGS);
690}
691
692static Int execute6(USES_REGS1)
693{ /* 'call'(Goal) */
694 return do_execute_n(5, ARG1, CurrentModule PASS_REGS);
695}
696
697static Int execute7(USES_REGS1)
698{ /* 'call'(Goal) */
699 return do_execute_n(6, ARG1, CurrentModule PASS_REGS);
700}
701
702static Int execute8(USES_REGS1)
703{ /* 'call'(Goal) */
704 return do_execute_n(7, ARG1, CurrentModule PASS_REGS);
705}
706
707static Int execute9(USES_REGS1)
708{ /* 'call'(Goal) */
709 return do_execute_n(8, ARG1, CurrentModule PASS_REGS);
710}
711
712static Int execute10(USES_REGS1)
713{ /* 'call'(Goal) */
714 return do_execute_n(9, ARG1, CurrentModule PASS_REGS);
715}
716
717static Int execute11(USES_REGS1)
718{ /* 'call'(Goal) */
719 return do_execute_n(10, ARG1, CurrentModule PASS_REGS);
720}
721
722static Int execute12(USES_REGS1)
723{ /* 'call'(Goal) */
724 return do_execute_n(11, ARG1, CurrentModule PASS_REGS);
725}
726
727static Int execute_clause(USES_REGS1)
728{ /* 'call_clause'(Goal) */
729 Term t = Deref(ARG1);
730 Term mod = Deref(ARG2);
731 choiceptr cut_cp = cp_from_integer(Deref(ARG4) PASS_REGS);
732 unsigned int arity;
733 Prop pe;
734 yamop *code;
735 Term clt = Deref(ARG3);
736
737restart_exec:
738 if (IsVarTerm(t))
739 {
740 Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
741 return FALSE;
742 }
743 else if (IsAtomTerm(t))
744 {
745 Atom a = AtomOfTerm(t);
746 pe = PredPropByAtom(a, mod);
747 }
748 else if (IsApplTerm(t))
749 {
750 register Functor f = FunctorOfTerm(t);
751 register unsigned int i;
752 register CELL *pt;
753
754 if (IsExtensionFunctor(f))
755 return (FALSE);
756 if (f == FunctorModule)
757 {
758 Term tmod = ArgOfTerm(1, t);
759 if (!IsVarTerm(tmod) && IsAtomTerm(tmod))
760 {
761 mod = tmod;
762 t = ArgOfTerm(2, t);
763 goto restart_exec;
764 }
765 }
766 pe = PredPropByFunc(f, mod);
767 arity = ArityOfFunctor(f);
768 if (arity > MaxTemps)
769 {
770 return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
771 }
772 /* I cannot use the standard macro here because
773 otherwise I would dereference the argument and
774 might skip a svar */
775 pt = RepAppl(t) + 1;
776 for (i = 1; i <= arity; ++i)
777 {
778#if YAPOR_SBA
779 Term d0 = *pt++;
780 if (d0 == 0)
781 XREGS[i] = (CELL)(pt - 1);
782 else
783 XREGS[i] = d0;
784#else
785 XREGS[i] = *pt++;
786#endif
787 }
788 }
789 else
790 {
791 return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
792 }
793 /* N = arity; */
794 /* call may not define new system predicates!! */
795 if (RepPredProp(pe)->PredFlags & MegaClausePredFlag)
796 {
797 code = Yap_MegaClauseFromTerm(clt);
798 }
799 else
800 {
801 code = Yap_ClauseFromTerm(clt)->ClCode;
802 }
803 if (Yap_get_signal(YAP_CREEP_SIGNAL))
804 {
805 Yap_signal(YAP_CREEP_SIGNAL);
806 }
807 return CallPredicate(RepPredProp(pe), cut_cp, code PASS_REGS);
808}
809
810static Int execute_in_mod(USES_REGS1)
811{ /* '$execute'(Goal) */
812 return do_execute(Deref(ARG1), Deref(ARG2) PASS_REGS);
813}
814
819static void prune_inner_computation(choiceptr parent)
820{
821 /* code */
822 choiceptr cut_pt;
823 yamop *oP = P, *oCP = CP;
824 Int oENV = LCL0 - ENV;
825
826 cut_pt = B;
827 while (cut_pt->cp_b && cut_pt->cp_b < parent)
828 {
829 cut_pt = cut_pt->cp_b;
830 }
831#ifdef YAPOR
832 CUT_prune_to(cut_pt);
833#endif
834 B = cut_pt;
835 Yap_TrimTrail();
836 LOCAL_AllowRestart = FALSE;
837 P = oP;
838 CP = oCP;
839 ENV = LCL0 - oENV;
840 B = parent;
841}
842
847static void complete_inner_computation(choiceptr old_B)
848{
849 choiceptr myB = B;
850 if (myB == NULL)
851 {
852 return;
853 }
854 else if (myB->cp_b == old_B)
855 {
856 B = old_B;
857#ifdef DEPTH_LIMIT
858 DEPTH = myB->cp_depth;
859#endif
860 }
861 else if (myB->cp_b && myB->cp_b < old_B)
862 {
863 while (myB->cp_b < old_B)
864 {
865 // we're recovering from a non-deterministic computation...
866 myB = myB->cp_b;
867 }
868 }
869 else
870 {
871 return;
872 }
873 // restore environment at call...
874 CP = myB->cp_cp;
875 ENV = myB->cp_env;
876}
877
878static Int Yap_ignore(Term t, bool fail USES_REGS)
879{
880 yamop *oP = P, *oCP = CP;
881 Int oENV = LCL0 - ENV;
882 Int oYENV = LCL0 - YENV;
883 Int oB = LCL0 - (CELL *)B;
884 {
885 bool rc = Yap_RunTopGoal(t, true);
886
887 if (!rc)
888 {
889 complete_inner_computation((choiceptr)(LCL0 - oB));
890 }
891 else
892 {
893 prune_inner_computation((choiceptr)(LCL0 - oB));
894 }
895 // We'll pass it through
896 P = oP;
897 CP = oCP;
898 ENV = LCL0 - oENV;
899 YENV = LCL0 - oYENV;
900 choiceptr nb = (choiceptr)(LCL0 - oB);
901 if (nb > B)
902 {
903 B = nb;
904 }
905 }
906 return true;
907}
908
909extern void *Yap_blob_info(Term t);
910
911static bool set_watch(Int Bv, Term task)
912{
913 CELL *pt;
914 Term t = Yap_AllocExternalDataInStack((CELL)setup_call_catcher_cleanup_tag,sizeof(Int), &pt);
915 if (t == TermNil)
916 return false;
917 *pt = Bv;
918 *HR++ = t;
919 *HR++ = task;
920 TrailTerm(TR) = AbsPair(HR - 2);
921 TR++;
922 return true;
923}
924
925static bool watch_cut(Term ext USES_REGS)
926{
927 // called after backtracking..
928 //
929 Term task = TailOfTerm(ext);
930 Term cleanup = ArgOfTerm(3, task);
931 Term e = 0;
932 bool complete = IsNonVarTerm(Deref(ArgOfTerm(4, task)));
933 bool active = ArgOfTerm(5, task) == TermTrue;
934 bool ex_mode = false;
935
936 if (complete)
937 {
938 return true;
939 }
940 yap_error_descriptor_t old;
941 CELL *port_pt = deref_ptr(RepAppl(task) + 2);
942 CELL *completion_pt = deref_ptr(RepAppl(task) + 4);
943 if ((ex_mode = Yap_HasException()))
944 {
945 CELL *hold = Yap_ArenaPt(LOCAL_GlobalArena);
946 CELL *max = Yap_ArenaLimit(LOCAL_GlobalArena);
947 memcpy(&old,LOCAL_ActiveError,sizeof(yap_error_descriptor_t));
948 hold[1] = MkAddressTerm(&old);
949 Term t;
950 if (active)
951 {
952 hold[0] = Yap_MkApplTerm(FunctorException, 1, &e);
953 }
954 else
955 {
956 hold[0] = Yap_MkApplTerm(FunctorExternalException, 1, &e);
957 }
958 t = AbsAppl(hold);
959 port_pt[0] = t;
960 LOCAL_GlobalArena = Yap_MkArena(hold+2,max);
961 completion_pt[0] = TermException;
962 }
963 else
964 {
965 completion_pt[0] = port_pt[0] = TermCut;
966 }
967
968 old.errorNo = YAP_NO_ERROR;
969 Yap_ignore(cleanup, false);
970 CELL *complete_pt = deref_ptr(RepAppl(task) + 4);
971 complete_pt[0] = TermTrue;
972 if (old.errorNo) {
973 Yap_RestartException(&old);
974 LOCAL_PrologMode |= InErrorMode;
975 }
976
977 if (ex_mode)
978 {
979 //Yap_PutException(e);
980 return true;
981 }
982 if (Yap_RaiseException())
983 return false;
984 return true;
985}
986
994static bool watch_retry(Term d0 USES_REGS)
995{
996 // called after backtracking..
997 //
998 Term task = TailOfTerm(d0);
999 bool box = ArgOfTerm(1, task) == TermTrue;
1000 Term cleanup = ArgOfTerm(3, task);
1001 bool complete = !IsVarTerm(ArgOfTerm(4, task));
1002 bool active = ArgOfTerm(5, task) == TermTrue;
1003 choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(ArgOfTerm(6, task)));
1004 yap_error_descriptor_t old;
1005 if (complete)
1006 return true;
1007 CELL *port_pt = deref_ptr(RepAppl(Deref(task)) + 2);
1008 CELL *complete_pt = deref_ptr(RepAppl(Deref(task)) + 4);
1009 Term t, e = 0;
1010 bool ex_mode = false;
1011 while (B->cp_ap->opc == FAIL_OPCODE ||
1012 B->cp_ap == TRUSTFAILCODE)
1013 B = B->cp_b;
1014
1015 // just do the simplest
1016 if (B >= B0 && !ex_mode && !active)
1017 return true;
1018 if ((ex_mode = Yap_HasException()))
1019 {
1020 CELL *hold = Yap_ArenaPt(LOCAL_GlobalArena);
1021 CELL *max = Yap_ArenaLimit(LOCAL_GlobalArena);
1022 memcpy(&old,LOCAL_ActiveError,sizeof(yap_error_descriptor_t));
1023 hold[1] = MkAddressTerm(&old);
1024 Term t;
1025 if (active)
1026 {
1027 hold[0] = Yap_MkApplTerm(FunctorException, 1, &e);
1028 }
1029 else
1030 {
1031 hold[0] = Yap_MkApplTerm(FunctorExternalException, 1, &e);
1032 }
1033 t = AbsAppl(hold);
1034 port_pt[0] = t;
1035 LOCAL_GlobalArena = Yap_MkArena(hold+2,max);
1036 completion_pt[0] = TermException;
1037 }
1038 else
1039 {
1040 completion_pt[0] = port_pt[0] = TermCut;
1041 }
1042 else if (B >= B0)
1043 {
1044 t = TermFail;
1045 complete_pt[0] = t;
1046 }
1047 else if (box)
1048 {
1049 t = TermRedo;
1050 }
1051 else if (!ex_mode)
1052 {
1053 return true;
1054 }
1055 port_pt[0] = t;
1056 Yap_ignore(cleanup, true);
1057 RESET_VARIABLE(port_pt);
1058 // Yap_PutException(e);
1059 if (ex_mode) {
1060 Yap_RestartException(&old);
1061 }
1062
1063 if (Yap_RaiseException())
1064 return false;
1065 return true;
1066}
1067
1076static Int setup_call_catcher_cleanup(USES_REGS1)
1077{
1078 Term Setup = Deref(ARG1);
1079 choiceptr B0 = B;
1080 yamop *oP = P, *oCP = CP;
1081 Int oENV = LCL0 - ENV;
1082 Int oYENV = LCL0 - YENV;
1083 bool rc;
1084
1085 Yap_DisableInterrupts(worker_id);
1086 rc = Yap_RunTopGoal(Setup, true);
1087 Yap_EnableInterrupts(worker_id);
1088
1089 if (Yap_RaiseException())
1090 {
1091 return false;
1092 }
1093 if (!rc)
1094 {
1095 complete_inner_computation(B0);
1096 // We'll pass it throughs
1097
1098 return false;
1099 }
1100 else
1101 {
1102 prune_inner_computation(B0);
1103 }
1104 P = oP;
1105 CP = oCP;
1106 ENV = LCL0 - oENV;
1107 YENV = LCL0 - oYENV;
1108 return rc;
1109}
1110
1111static Int tag_cleanup(USES_REGS1)
1112{
1113 Int iB = LCL0 - (CELL *)B;
1114 set_watch(iB, Deref(ARG2));
1115 return Yap_unify(ARG1, MkIntegerTerm(iB));
1116}
1117
1118static Int cleanup_on_exit(USES_REGS1)
1119{
1120
1121 choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(Deref(ARG1)));
1122 Term task = Deref(ARG2);
1123 bool box = ArgOfTerm(1, task) == TermTrue;
1124 Term cleanup = ArgOfTerm(3, task);
1125 Term complete = IsNonVarTerm(ArgOfTerm(4, task));
1126
1127 while (B->cp_ap->opc == FAIL_OPCODE ||
1128 B->cp_ap == TRUSTFAILCODE)
1129 B = B->cp_b;
1130 if (complete)
1131 {
1132 return true;
1133 }
1134 CELL *catcher_pt = deref_ptr(RepAppl(Deref(task)) + 2);
1135 CELL *complete_pt = deref_ptr(RepAppl(Deref(task)) + 4);
1136 if (B < B0)
1137 {
1138 // non-deterministic
1139 set_watch(LCL0 - (CELL *)B, task);
1140 if (!box)
1141 {
1142 return true;
1143 }
1144 catcher_pt[0] = TermAnswer;
1145 }
1146 else
1147 {
1148 catcher_pt[0] = TermExit;
1149 complete_pt[0] = TermExit;
1150 }
1151 Term tq, tg[2];
1152 if ((tq = Yap_ReadTimedVar(LOCAL_WokenGoals)) == 0 ||
1153 tq == TermNil)
1154 {
1155 Yap_UpdateTimedVar(LOCAL_WokenGoals, TermTrue);
1156 tg[0] = tq;
1157 tg[1] = cleanup;
1158 cleanup = Yap_MkApplTerm(FunctorComma, 1, tg);
1159 }
1160 Yap_ignore(cleanup, false);
1161 if (Yap_RaiseException())
1162 {
1163 return false;
1164 }
1165 return true;
1166}
1167
1168static bool complete_ge(bool out, Term omod, yhandle_t sl, bool creeping)
1169{
1170 CACHE_REGS
1171 if (creeping)
1172 {
1173 Yap_signal(YAP_CREEP_SIGNAL);
1174 }
1175 CurrentModule = omod;
1176 Yap_CloseSlots(sl);
1177 if (out)
1178 {
1179 }
1180 return out;
1181}
1182
1183static Int _user_expand_goal(USES_REGS1)
1184{
1185 yhandle_t sl = Yap_StartSlots();
1186 Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
1187 PredEntry *pe;
1188 Term cmod = CurrentModule, omod = cmod;
1189 Term mg_args[2];
1190 Term g = Yap_YapStripModule(ARG1, &cmod);
1191 yhandle_t h1 = Yap_InitSlot(g), h2 = Yap_InitSlot(ARG2);
1192
1193 /* CurMod:goal_expansion(A,B) */
1194 ARG1 = g;
1195 if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod))) &&
1196 pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
1197 Yap_execute_pred(pe, NULL, true PASS_REGS))
1198 {
1199 return complete_ge(true, omod, sl, creeping);
1200 }
1201 /* system:goal_expansion(A,B) */
1202 mg_args[0] = cmod;
1203 mg_args[1] = Yap_GetFromSlot(h1);
1204 ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
1205 ARG2 = Yap_GetFromSlot(h2);
1206 if ((pe = RepPredProp(
1207 Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) &&
1208 pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
1209 Yap_execute_pred(pe, NULL, true PASS_REGS))
1210 {
1211 return complete_ge(true, omod, sl, creeping);
1212 }
1213 ARG1 = Yap_GetFromSlot(h1);
1214 ARG2 = cmod;
1215 ARG3 = Yap_GetFromSlot(h2);
1216 /* user:goal_expansion(A,CurMod,B) */
1217 if ((pe = RepPredProp(
1218 Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) &&
1219 pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
1220 Yap_execute_pred(pe, NULL PASS_REGS, true))
1221 {
1222 return complete_ge(true, omod, sl, creeping);
1223 }
1224 mg_args[0] = cmod;
1225 mg_args[1] = Yap_GetFromSlot(h1);
1226 ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
1227 ARG2 = Yap_GetFromSlot(h2);
1228 /* user:goal_expansion(A,B) */
1229 if (cmod != USER_MODULE && /* we have tried this before */
1230 (pe = RepPredProp(
1231 Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) &&
1232 pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
1233 Yap_execute_pred(pe, NULL PASS_REGS, true))
1234 {
1235 return complete_ge(true, omod, sl, creeping);
1236 }
1237 return complete_ge(false, omod, sl, creeping);
1238}
1239
1240static Int do_term_expansion(USES_REGS1)
1241{
1242 yhandle_t sl = Yap_StartSlots();
1243 Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
1244 PredEntry *pe;
1245 Term cmod = CurrentModule, omod = cmod;
1246 Term mg_args[2];
1247 Term g = Yap_YapStripModule(ARG1, &cmod);
1248 yhandle_t h1 = Yap_InitSlot(g), h2 = Yap_InitSlot(ARG2);
1249 /* user:term_expansion(A,B) */
1250
1251 ARG1 = g;
1252 if ((pe = RepPredProp(
1253 Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE))) &&
1254 pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
1255 Yap_execute_pred(pe, NULL, true PASS_REGS))
1256 {
1257 return complete_ge(true, omod, sl, creeping);
1258 }
1259 ARG1 = Yap_GetFromSlot(h1);
1260 ARG2 = cmod;
1261 ARG3 = Yap_GetFromSlot(h2);
1262 if ((pe = RepPredProp(
1263 Yap_GetPredPropByFunc(FunctorTermExpansion3, USER_MODULE))) &&
1264 pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
1265 Yap_execute_pred(pe, NULL, true PASS_REGS))
1266 {
1267 return complete_ge(true, omod, sl, creeping);
1268 }
1269 /* CurMod:term_expansion(A,B) */
1270 ARG1 = g;
1271 if (cmod != USER_MODULE &&
1272 (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, cmod))) &&
1273 pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
1274 Yap_execute_pred(pe, NULL, true PASS_REGS))
1275 {
1276 return complete_ge(true, omod, sl, creeping);
1277 }
1278 /* system:term_expansion(A,B) */
1279 mg_args[0] = cmod;
1280 mg_args[1] = Yap_GetFromSlot(h1);
1281 ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
1282 ARG2 = Yap_GetFromSlot(h2);
1283 if ((pe = RepPredProp(
1284 Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE))) &&
1285 pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
1286 Yap_execute_pred(pe, NULL, true PASS_REGS))
1287 {
1288 return complete_ge(true, omod, sl, creeping);
1289 }
1290 return complete_ge(false, omod, sl, creeping);
1291}
1292
1293static Int execute0(USES_REGS1)
1294{ /* '$execute0'(Goal,Mod) */
1295 Term t = Deref(ARG1);
1296 Term mod = Deref(ARG2);
1297 arity_t i, arity;
1298 PredEntry *pe;
1299
1300 if (Yap_has_a_signal() && !LOCAL_InterruptsDisabled)
1301 {
1302 return EnterCreepMode(t, mod PASS_REGS);
1303 }
1304 pe = Yap_get_pred(t, mod, "call");
1305 if (!pe)
1306 return false;
1307 arity = pe->ArityOfPE;
1308 if (arity)
1309 {
1310 if (arity > MaxTemps)
1311 {
1312 return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
1313 }
1314 /* I cannot use the standard macro here because
1315 otherwise I would dereference the argument and
1316 might skip a svar */
1317 CELL *pt = RepAppl(t) + 1;
1318 for (i = 1; i <= arity; ++i)
1319 {
1320#if YAPOR_SBA
1321 Term d0 = *pt++;
1322 if (d0 == 0)
1323 XREGS[i] = (CELL)(pt - 1);
1324 else
1325 XREGS[i] = d0;
1326#else
1327 XREGS[i] = *pt++;
1328#endif
1329 }
1330 }
1331 /* N = arity; */
1332 /* call may not define new system predicates!! */
1333 return CallPredicate(pe, B,
1334 pe->CodeOfPred PASS_REGS);
1335}
1336
1337static Int creep_step(USES_REGS1)
1338{ /* '$execute_nonstop'(Goal,Mod)
1339 */
1340 Term t = Deref(ARG1);
1341 Term mod = Deref(ARG2);
1342 arity_t arity, i;
1343 bool rc;
1344 PredEntry *pe = Yap_get_pred(t, mod, "execute0");
1345 if (!pe)
1346 return false;
1347 arity = pe->ArityOfPE;
1348 if (arity)
1349 {
1350 CELL *pt = RepAppl(t) + 1;
1351 for (i = 1; i <= arity; ++i)
1352 {
1353#if YAPOR_SBA
1354 Term d0 = *pt++;
1355 if (d0 == 0)
1356 XREGS[i] = (CELL)(pt - 1);
1357 else
1358 XREGS[i] = d0;
1359#else
1360 XREGS[i] = *pt++;
1361#endif
1362 }
1363 }
1364 /* N = arity; */
1365 /* call may not define new system predicates!! */
1366 if (pe->PredFlags & SpiedPredFlag)
1367 {
1368 if (!LOCAL_InterruptsDisabled && Yap_get_signal(YAP_CREEP_SIGNAL))
1369 {
1370 Yap_signal(YAP_CREEP_SIGNAL);
1371 }
1372#if defined(YAPOR) || defined(THREADS)
1373 if (pe->PredFlags & LogUpdatePredFlag)
1374 {
1375 PP = pe;
1376 PELOCK(80, PP);
1377 }
1378#endif
1379 rc = CallPredicate(pe, B,
1380 pe->cs.p_code.TrueCodeOfPred PASS_REGS);
1381 }
1382 else
1383 {
1384 rc = CallPredicate(pe, B,
1385 pe->CodeOfPred PASS_REGS);
1386 }
1387 if (!LOCAL_InterruptsDisabled &&
1388 (!(pe->PredFlags & (AsmPredFlag | CPredFlag)) ||
1389 pe->OpcodeOfPred == Yap_opcode(_call_bfunc_xx)))
1390 {
1391 Yap_signal(YAP_CREEP_SIGNAL);
1392 }
1393 return rc;
1394}
1395
1396static Int execute_nonstop(USES_REGS1)
1397{ /* '$execute_nonstop'(Goal,Mod)
1398 */
1399 Term t = Deref(ARG1);
1400 Term mod = Deref(ARG2);
1401 unsigned int arity;
1402 Prop pe;
1403
1404 t = Yap_YapStripModule(t, &mod);
1405 if (IsVarTerm(mod))
1406 {
1407 mod = CurrentModule;
1408 }
1409 else if (!IsAtomTerm(mod))
1410 {
1411 Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1");
1412 return FALSE;
1413 }
1414 if (IsVarTerm(t))
1415 {
1416 Yap_Error(INSTANTIATION_ERROR, ARG1, "call/1");
1417 return FALSE;
1418 }
1419 else if (IsAtomTerm(t))
1420 {
1421 Atom a = AtomOfTerm(t);
1422 pe = PredPropByAtom(a, mod);
1423 }
1424 else if (IsApplTerm(t))
1425 {
1426 register Functor f = FunctorOfTerm(t);
1427 register unsigned int i;
1428 register CELL *pt;
1429
1430 if (IsExtensionFunctor(f))
1431 return (FALSE);
1432 pe = PredPropByFunc(f, mod);
1433 arity = ArityOfFunctor(f);
1434 if (arity > MaxTemps)
1435 {
1436 return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
1437 }
1438 /* I cannot use the standard macro here because
1439 otherwise I would dereference the argument and
1440 might skip a svar */
1441 pt = RepAppl(t) + 1;
1442 for (i = 1; i <= arity; ++i)
1443 {
1444#if YAPOR_SBA
1445 Term d0 = *pt++;
1446 if (d0 == 0)
1447 XREGS[i] = (CELL)(pt - 1);
1448 else
1449 XREGS[i] = d0;
1450#else
1451 XREGS[i] = *pt++;
1452#endif
1453 }
1454 }
1455 else
1456 {
1457 Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
1458 return FALSE;
1459 }
1460 /* N = arity; */
1461 /* call may not define new system predicates!! */
1462 if (RepPredProp(pe)->PredFlags & SpiedPredFlag)
1463 {
1464 if (!LOCAL_InterruptsDisabled && Yap_get_signal(YAP_CREEP_SIGNAL))
1465 {
1466 Yap_signal(YAP_CREEP_SIGNAL);
1467 }
1468#if defined(YAPOR) || defined(THREADS)
1469 if (RepPredProp(pe)->PredFlags & LogUpdatePredFlag)
1470 {
1471 PP = RepPredProp(pe);
1472 PELOCK(80, PP);
1473 }
1474#endif
1475 return CallPredicate(RepPredProp(pe), B,
1476 RepPredProp(pe)->cs.p_code.TrueCodeOfPred PASS_REGS);
1477 }
1478 else
1479 {
1480 if (Yap_get_signal(YAP_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled &&
1481 (!(RepPredProp(pe)->PredFlags & (AsmPredFlag | CPredFlag)) ||
1482 RepPredProp(pe)->OpcodeOfPred == Yap_opcode(_call_bfunc_xx)))
1483 {
1484 Yap_signal(YAP_CREEP_SIGNAL);
1485 }
1486 return CallPredicate(RepPredProp(pe), B,
1487 RepPredProp(pe)->CodeOfPred PASS_REGS);
1488 }
1489}
1490
1491static Int execute_0(USES_REGS1)
1492{ /* '$execute_0'(Goal) */
1493 Term mod = CurrentModule;
1494 Term t = Yap_YapStripModule(Deref(ARG1), &mod);
1495 if (t == 0)
1496 return false;
1497 return do_execute(t, mod PASS_REGS);
1498}
1499
1500static bool call_with_args(int i USES_REGS)
1501{
1502 Term mod = CurrentModule, t;
1503 int j;
1504
1505 t = Yap_YapStripModule(Deref(ARG1), &mod);
1506 if (t == 0)
1507 return false;
1508 for (j = 0; j < i; j++)
1509 heap_store(Deref(XREGS[j + 2]) PASS_REGS);
1510 return (do_execute_n(t, mod, i PASS_REGS));
1511}
1512
1513static Int execute_1(USES_REGS1)
1514{ /* '$execute_0'(Goal) */
1515 return call_with_args(1 PASS_REGS);
1516}
1517
1518static Int execute_2(USES_REGS1)
1519{ /* '$execute_2'(Goal) */
1520 return call_with_args(2 PASS_REGS);
1521}
1522
1523static Int execute_3(USES_REGS1)
1524{ /* '$execute_3'(Goal) */
1525 return call_with_args(3 PASS_REGS);
1526}
1527
1528static Int execute_4(USES_REGS1)
1529{ /* '$execute_4'(Goal) */
1530 return call_with_args(4 PASS_REGS);
1531}
1532
1533static Int execute_5(USES_REGS1)
1534{ /* '$execute_5'(Goal) */
1535 return call_with_args(5 PASS_REGS);
1536}
1537
1538static Int execute_6(USES_REGS1)
1539{ /* '$execute_6'(Goal) */
1540 return call_with_args(6 PASS_REGS);
1541}
1542
1543static Int execute_7(USES_REGS1)
1544{ /* '$execute_7'(Goal) */
1545 return call_with_args(7 PASS_REGS);
1546}
1547
1548static Int execute_8(USES_REGS1)
1549{ /* '$execute_8'(Goal) */
1550 return call_with_args(8 PASS_REGS);
1551}
1552
1553static Int execute_9(USES_REGS1)
1554{ /* '$execute_9'(Goal) */
1555 return call_with_args(9 PASS_REGS);
1556}
1557
1558static Int execute_10(USES_REGS1)
1559{ /* '$execute_10'(Goal) */
1560 return call_with_args(10 PASS_REGS);
1561}
1562
1563#ifdef DEPTH_LIMIT
1564
1565static Int execute_depth_limit(USES_REGS1)
1566{
1567 Term d = Deref(ARG2);
1568 if (IsVarTerm(d))
1569 {
1570 Yap_Error(INSTANTIATION_ERROR, d, "depth_bound_call/2");
1571 return false;
1572 }
1573 else if (!IsIntegerTerm(d))
1574 {
1575 if (IsFloatTerm(d) && isinf(FloatOfTerm(d)))
1576 {
1577 DEPTH = RESET_DEPTH();
1578 }
1579 else
1580 {
1581 Yap_Error(TYPE_ERROR_INTEGER, d, "depth_bound_call/2");
1582 return false;
1583 }
1584 }
1585 else
1586 {
1587 DEPTH = MkIntTerm(IntegerOfTerm(d) * 2);
1588 }
1589 return execute(PASS_REGS1);
1590}
1591
1592#endif
1593
1594static int exec_absmi(bool top, yap_reset_t reset_mode USES_REGS)
1595{
1596 int lval, out;
1597 Int OldBorder = LOCAL_CBorder;
1598 LOCAL_CBorder = LCL0 - (CELL *)B;
1599 sigjmp_buf signew, *sighold = LOCAL_RestartEnv;
1600 LOCAL_RestartEnv = &signew;
1601 int lvl = push_text_stack();
1602
1603
1604 if (top && (lval = sigsetjmp(signew, 1)) != 0)
1605 {
1606 switch (lval)
1607 {
1608 case 1:
1609 { /* restart */
1610 /* otherwise, SetDBForThrow will fail entering critical mode */
1611 LOCAL_PrologMode |= UserMode;
1612 LOCAL_PrologMode &= ~(BootMode | CCallMode | UnifyMode | UserCCallMode);
1613 /* find out where to cut to */
1614 /* siglongjmp resets the TR hardware register */
1615 /* TR and B are crucial, they might have been changed, or pnot */
1616 restore_TR();
1617 restore_B();
1618 /* H is not so important, because we're gonna backtrack */
1619 restore_H();
1620 /* set stack */
1621 ASP = (CELL *)PROTECT_FROZEN_B(B);
1622 /* forget any signals active, we're reborne */
1623 LOCAL_Signals = 0;
1624 CalculateStackGap(PASS_REGS1);
1625 LOCAL_PrologMode |= UserMode;
1626 LOCAL_PrologMode &= ~(BootMode | CCallMode | UnifyMode | UserCCallMode);
1627 P = (yamop *)FAILCODE;
1628 }
1629 break;
1630 case 2:
1631 {
1632 /* arithmetic exception */
1633 /* must be done here, otherwise siglongjmp will clobber all the
1634 * registers
1635 */
1636 /* reset the registers so that we don't have trash in abstract
1637 * machine */
1638 Yap_set_fpu_exceptions(
1639 getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG));
1640 P = (yamop *)FAILCODE;
1641 LOCAL_PrologMode |= UserMode;
1642 LOCAL_PrologMode &= ~(BootMode | CCallMode | UnifyMode | UserCCallMode);
1643 }
1644 break;
1645 case 3:
1646 { /* saved state */
1647 LOCAL_CBorder = OldBorder;
1648 LOCAL_RestartEnv = sighold;
1649 return false;
1650 }
1651 case 4:
1652 /* abort */
1653 /* can be called from anywhere, must reset registers,
1654 */
1655 pop_text_stack(lvl);
1656 Yap_CloseTemporaryStreams();
1657
1658 while (B)
1659 {
1660 Yap_JumpToEnv(TermDAbort);
1661 }
1662 LOCAL_PrologMode &= ~AbortMode;
1663 P = (yamop *)FAILCODE;
1664 LOCAL_RestartEnv = sighold;
1665 return false;
1666 break;
1667 case 5:
1668 // going up, unless there is no up to go to. or someone
1669 // but we should inform the caller on what happened.
1670 Yap_CloseTemporaryStreams();
1671 pop_text_stack(lvl);
1672 LOCAL_PrologMode |= UserMode;
1673 LOCAL_PrologMode &= ~(BootMode | CCallMode | UnifyMode | UserCCallMode);
1674 P = FAILCODE;
1675 if (B && B->cp_b && B->cp_b <= (choiceptr)(LCL0 - LOCAL_CBorder))
1676 {
1677 goto restart;
1678 }
1679 LOCAL_RestartEnv = sighold;
1680 LOCAL_CBorder = OldBorder;
1681 return false;
1682 default:
1683 /* do nothing */
1684 LOCAL_PrologMode |= UserMode;
1685 LOCAL_PrologMode &= ~(BootMode | CCallMode | UnifyMode | UserCCallMode);
1686 pop_text_stack(lvl);
1687 }
1688 }
1689 else
1690 {
1691 LOCAL_PrologMode |= UserMode;
1692 LOCAL_PrologMode &= ~(BootMode | CCallMode | UnifyMode | UserCCallMode);
1693 pop_text_stack(lvl);
1694 }
1695 restart:
1696 YENV = ASP;
1697 YENV[E_CB] = Unsigned(B);
1698 out = Yap_absmi(0);
1699 /* make sure we don't leave a FAIL signal hanging around */
1700 Yap_get_signal(YAP_FAIL_SIGNAL);
1701 if (!Yap_has_a_signal())
1702 CalculateStackGap(PASS_REGS1);
1703 LOCAL_CBorder = OldBorder;
1704
1705 LOCAL_RestartEnv = sighold;
1706 LOCAL_Error_TYPE = YAP_NO_ERROR;
1707 return out;
1708}
1709
1710void Yap_PrepGoal(arity_t arity, CELL *pt, choiceptr saved_b USES_REGS)
1711{
1712 /* create an initial pseudo environment so that when garbage
1713 collection is going up in the environment chain it doesn't get
1714 confused */
1715 // Yap_ResetException(worker_id);
1716 // sl = Yap_InitSlot(t);
1717 YENV = ASP;
1718 YENV[E_CP] = (CELL)YESCODE;
1719 YENV[E_CB] = (CELL)B;
1720 YENV[E_E] = (CELL)ENV;
1721#ifdef TABLING
1722 YENV[E_B] = (CELL)B;
1723#endif
1724#ifdef DEPTH_LIMIT
1725 YENV[E_DEPTH] = DEPTH;
1726#endif
1727 ENV = YENV;
1728 ASP -= EnvSizeInCells;
1729 /* and now create a pseudo choicepoint for much the same reasons */
1730 /* CP = YESCODE; */
1731 /* keep a place where you can inform you had an exception */
1732 if (pt)
1733 {
1734 int i;
1735 for (i = 0; i < arity; i++)
1736 {
1737 XREGS[i + 1] = *pt++;
1738 }
1739 }
1740 B = (choiceptr)ASP;
1741 B--;
1742 B->cp_h = HR;
1743 B->cp_tr = TR;
1744 B->cp_cp = CP;
1745 B->cp_ap = NOCODE;
1746 B->cp_env = ENV;
1747 B->cp_b = saved_b;
1748#ifdef DEPTH_LIMIT
1749 B->cp_depth = DEPTH;
1750#endif /* DEPTH_LIMIT */
1751 YENV = ASP = (CELL *)B;
1752 YENV[E_CB] = (CELL)B;
1753 HB = HR;
1754 CP = YESCODE;
1755}
1756
1757static int do_goal(yamop *CodeAdr, int arity, CELL *pt, bool top USES_REGS)
1758{
1759 choiceptr saved_b = B;
1760 int out;
1761
1762
1763 Yap_PrepGoal(arity, pt, saved_b PASS_REGS);
1764 CACHE_A1();
1765 P = (yamop *)CodeAdr;
1766 // S = CellPtr(RepPredProp(
1767 // PredPropByFunc(Yap_MkFunctor(AtomCall, 1), 0))); /* A1 mishaps */
1768 out = -1;
1769 while (out < 0)
1770 {
1771 out = exec_absmi(top, YAP_EXEC_ABSMI PASS_REGS);
1772 }
1773 // if (out) {
1774 // out = Yap_GetFromSlot(sl);
1775 // }
1776 // Yap_RecoverSlots(1);
1777 LOCAL_PrologMode &= ~TopGoalMode;
1778 return out;
1779}
1780
1781bool Yap_exec_absmi(bool top, yap_reset_t has_reset)
1782{
1783 CACHE_REGS
1784 return exec_absmi(top, has_reset PASS_REGS);
1785}
1786
1791void Yap_fail_all(choiceptr bb USES_REGS)
1792{
1793 yamop *saved_p, *saved_cp;
1794
1795 saved_p = P;
1796 saved_cp = CP;
1797 /* prune away choicepoints */
1798 while (B->cp_b && B->cp_b != bb && B->cp_ap != NOCODE)
1799 {
1800 B = B->cp_b;
1801#ifdef YAPOR
1802 CUT_prune_to(B);
1803#endif
1804 }
1805 P = FAILCODE;
1806 int a = -1;
1807 while (a < 0)
1808 {
1809 a = exec_absmi(true, YAP_EXEC_ABSMI PASS_REGS);
1810 }
1811 /* recover stack space */
1812 HR = B->cp_h;
1813 TR = B->cp_tr;
1814#ifdef DEPTH_LIMIT
1815 DEPTH = B->cp_depth;
1816#endif /* DEPTH_LIMIT */
1817 YENV = ENV = B->cp_env;
1818/* recover local stack */
1819#ifdef DEPTH_LIMIT
1820 DEPTH = ENV[E_DEPTH];
1821#endif
1822 /* make sure we prune C-choicepoints */
1823 if (POP_CHOICE_POINT(B->cp_b))
1824 {
1825 POP_EXECUTE();
1826 }
1827 ENV = (CELL *)(ENV[E_E]);
1828 /* ASP should be set to the top of the local stack when we
1829 did the call */
1830 ASP = B->cp_env;
1831 /* YENV should be set to the current environment */
1832 YENV = ENV = (CELL *)((B->cp_env)[E_E]);
1833 if (B->cp_b)
1834 {
1835 B = B->cp_b;
1836 }
1837 // SET_BB(B);
1838 HB = PROTECT_FROZEN_H(B);
1839 CP = saved_cp;
1840 P = saved_p;
1841}
1842
1843bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS)
1844{
1845 yamop *saved_p, *saved_cp;
1846 yamop *CodeAdr;
1847 bool out;
1848
1849 saved_p = P;
1850 saved_cp = CP;
1851 LOCAL_PrologMode |= TopGoalMode;
1852
1853 PELOCK(81, ppe);
1854 CodeAdr = ppe->CodeOfPred;
1855 UNLOCK(ppe->PELock);
1856 out = do_goal(CodeAdr, ppe->ArityOfPE, pt, true PASS_REGS);
1857
1858 if (out)
1859 {
1860 choiceptr cut_B;
1861 /* we succeeded, let's prune */
1862 /* restore the old environment */
1863 /* get to previous environment */
1864 cut_B = (choiceptr)ENV[E_CB];
1865 {
1866 /* Note that
1867 cut_B == (choiceptr)ENV[E_CB] */
1868 while (POP_CHOICE_POINT(ENV[E_CB]))
1869 {
1870 POP_EXECUTE();
1871 }
1872 }
1873#ifdef YAPOR
1874 CUT_prune_to(cut_B);
1875#endif /* YAPOR */
1876#ifdef TABLING
1877 if (B != cut_B)
1878 {
1879 while (B->cp_b < cut_B)
1880 {
1881 B = B->cp_b;
1882 }
1883#ifdef TABLING
1884 abolish_incomplete_subgoals(B);
1885#endif
1886 }
1887#endif /* TABLING */
1888 B = cut_B;
1889 CP = saved_cp;
1890 P = saved_p;
1891 ASP = ENV;
1892#ifdef DEPTH_LIMIT
1893 DEPTH = ENV[E_DEPTH];
1894#endif
1895 ENV = (CELL *)(ENV[E_E]);
1896 /* we have failed, and usually we would backtrack to this B,
1897 trouble is, we may also have a delayed cut to do */
1898 if (B != NULL)
1899
1900 HB = B->cp_h;
1901 YENV = ENV;
1902 // should we catch the exception or pass it through?
1903 // We'll pass it through
1904 if (pass_ex && Yap_HasException())
1905 {
1906 Yap_RaiseException();
1907 return false;
1908 }
1909 return true;
1910 }
1911 else if (out == 0)
1912 {
1913 P = saved_p;
1914 CP = saved_cp;
1915 HR = B->cp_h;
1916#ifdef DEPTH_LIMIT
1917 DEPTH = B->cp_depth;
1918#endif
1919 /* ASP should be set to the top of the local stack when we
1920 did the call */
1921 ASP = B->cp_env;
1922 /* YENV should be set to the current environment */
1923 YENV = ENV = (CELL *)((B->cp_env)[E_E]);
1924 B = B->cp_b;
1925 SET_BB(B);
1926 HB = PROTECT_FROZEN_H(B);
1927 // should we catch the exception or pass it through?
1928 // We'll pass it through
1929 if (pass_ex && Yap_RaiseException())
1930 return false;
1931 return false;
1932 }
1933 else
1934 {
1935 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "emulator crashed");
1936 return false;
1937 }
1938}
1939
1940bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex)
1941{
1942 CACHE_REGS
1943 Prop pe;
1944 PredEntry *ppe;
1945 CELL *pt;
1946 /* preserve the current restart environment */
1947 /* visualc*/
1948 /* just keep the difference because of possible garbage collections
1949 */
1950
1951 if (IsAtomTerm(t))
1952 {
1953 Atom a = AtomOfTerm(t);
1954 pt = NULL;
1955 pe = PredPropByAtom(a, mod);
1956 }
1957 else if (IsApplTerm(t))
1958 {
1959 Functor f = FunctorOfTerm(t);
1960
1961 if (IsBlobFunctor(f))
1962 {
1963 Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
1964 return false;
1965 }
1966 /* I cannot use the standard macro here because
1967 otherwise I would dereference the argument and
1968 might skip a svar */
1969 pt = RepAppl(t) + 1;
1970 pe = PredPropByFunc(f, mod);
1971 }
1972 else
1973 {
1974 Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
1975 return false;
1976 }
1977 ppe = RepPredProp(pe);
1978 if (pe == NIL)
1979 {
1980 return CallMetaCall(t, mod PASS_REGS);
1981 }
1982 return Yap_execute_pred(ppe, pt, pass_ex PASS_REGS);
1983}
1984
1985void Yap_trust_last(void)
1986{
1987 CACHE_REGS
1988 ASP = B->cp_env;
1989 CP = B->cp_cp;
1990 HR = B->cp_h;
1991#ifdef DEPTH_LIMIT
1992 DEPTH = B->cp_depth;
1993#endif
1994 YENV = ASP = B->cp_env;
1995 ENV = (CELL *)((B->cp_env)[E_E]);
1996 B = B->cp_b;
1997 P = (yamop *)(ENV[E_CP]);
1998 if (B)
1999 {
2000 SET_BB(B);
2001 HB = PROTECT_FROZEN_H(B);
2002 }
2003}
2004
2005Term Yap_RunTopGoal(Term t, bool handle_errors)
2006{
2007 CACHE_REGS
2008 yamop *CodeAdr;
2009 Prop pe;
2010 PredEntry *ppe;
2011 CELL *pt;
2012 UInt arity;
2013 Term tmod = CurrentModule;
2014 Term goal_out = 0;
2015 LOCAL_PrologMode |= TopGoalMode;
2016
2017 t = Yap_YapStripModule(t, &tmod);
2018 if (IsVarTerm(t))
2019 {
2020 Yap_Error(INSTANTIATION_ERROR, t, "call/1");
2021 LOCAL_PrologMode &= ~TopGoalMode;
2022 return (FALSE);
2023 }
2024 if (IsPairTerm(t))
2025 {
2026 Term ts[2];
2027 ts[0] = t;
2028 ts[1] = (CurrentModule == 0 ? TermProlog : CurrentModule);
2029 t = Yap_MkApplTerm(FunctorCsult, 2, ts);
2030 }
2031 if (IsAtomTerm(t))
2032 {
2033 Atom a = AtomOfTerm(t);
2034 pt = NULL;
2035 pe = Yap_GetPredPropByAtom(a, tmod);
2036 arity = 0;
2037 }
2038 else if (IsApplTerm(t))
2039 {
2040 Functor f = FunctorOfTerm(t);
2041
2042 if (IsBlobFunctor(f))
2043 {
2044 Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
2045 LOCAL_PrologMode &= ~TopGoalMode;
2046 return (FALSE);
2047 }
2048 /* I cannot use the standard macro here because
2049 otherwise I would dereference the argument and
2050 might skip a svar */
2051 pe = Yap_GetPredPropByFunc(f, tmod);
2052 pt = RepAppl(t) + 1;
2053 arity = ArityOfFunctor(f);
2054 }
2055 else
2056 {
2057 Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), "call/1");
2058 LOCAL_PrologMode &= ~TopGoalMode;
2059 return (FALSE);
2060 }
2061 ppe = RepPredProp(pe);
2062 if (pe == NIL || ppe->cs.p_code.TrueCodeOfPred->opc == UNDEF_OPCODE ||
2063 (ppe->PredFlags & (MetaPredFlag | UndefPredFlag)))
2064 {
2065 // we're in a meta-call, rake care about modules
2066 //
2067 Term ts[2];
2068 ts[0] = tmod;
2069 ts[1] = t;
2070 Functor f = Yap_MkFunctor(Yap_LookupAtom("call"), 1);
2071
2072 pt = &t;
2073 t = Yap_MkApplTerm(FunctorModule, 2, ts);
2074 pe = Yap_GetPredPropByFunc(f, tmod);
2075 ppe = RepPredProp(pe);
2076 arity = 1;
2077 }
2078 PELOCK(82, ppe);
2079 CodeAdr = ppe->CodeOfPred;
2080 UNLOCK(ppe->PELock);
2081
2082#if !USE_SYSTEM_MALLOC
2083 if (LOCAL_TrailTop - HeapTop < 2048)
2084 {
2085 Yap_Error(RESOURCE_ERROR_TRAIL, TermNil,
2086 "unable to boot because of too little Trail space");
2087 }
2088#endif
2089 LOCAL_PrologMode &= ~TopGoalMode;
2090 goal_out = do_goal(CodeAdr, arity, pt, handle_errors PASS_REGS);
2091 return goal_out;
2092}
2093
2094static void do_restore_regs(Term t, int restore_all USES_REGS)
2095{
2096 if (IsApplTerm(t))
2097 {
2098 Int i;
2099 Int max = ArityOfFunctor(FunctorOfTerm(t)) - 4;
2100 CELL *ptr = RepAppl(t) + 5;
2101
2102 P = (yamop *)IntegerOfTerm(ptr[-4]);
2103 CP = (yamop *)IntegerOfTerm(ptr[-3]);
2104 ENV = (CELL *)(LCL0 - IntegerOfTerm(ptr[-2]));
2105 YENV = (CELL *)(LCL0 - IntegerOfTerm(ptr[-1]));
2106 for (i = 0; i < max; i += 2)
2107 {
2108 Int j = IntOfTerm(ptr[0]);
2109 XREGS[j] = ptr[1];
2110 ptr += 2;
2111 }
2112 }
2113}
2114
2115/* low level voodoo to restore temporary registers after a call */
2116static Int restore_regs(USES_REGS1)
2117{
2118 Term t = Deref(ARG1);
2119 if (IsVarTerm(t))
2120 {
2121 Yap_Error(INSTANTIATION_ERROR, t, "support for coroutining");
2122 return (FALSE);
2123 }
2124 if (IsAtomTerm(t))
2125 return (TRUE);
2126 do_restore_regs(t, FALSE PASS_REGS);
2127 return (TRUE);
2128}
2129
2130/* low level voodoo to cut and then restore temporary registers after
2131 * a
2132 * call */
2133static Int restore_regs2(USES_REGS1)
2134{
2135
2136 Term t = Deref(ARG1), d0;
2137 choiceptr pt0;
2138 Int d;
2139
2140 if (IsVarTerm(t))
2141 {
2142 Yap_Error(INSTANTIATION_ERROR, t, "support for coroutining");
2143 return (FALSE);
2144 }
2145 d0 = Deref(ARG2);
2146 if (!IsAtomTerm(t))
2147 {
2148 do_restore_regs(t, TRUE PASS_REGS);
2149 }
2150 if (IsVarTerm(d0))
2151 {
2152 Yap_Error(INSTANTIATION_ERROR, d0, "support for coroutining");
2153 return (FALSE);
2154 }
2155 if (!IsIntegerTerm(d0))
2156 {
2157 return (FALSE);
2158 }
2159 d = IntegerOfTerm(d0);
2160 if (!d)
2161 return TRUE;
2162#if YAPOR_SBA
2163 pt0 = (choiceptr)d;
2164#else
2165 pt0 = (choiceptr)(LCL0 - d);
2166#endif
2167 /* find where to cut to */
2168 if ((CELL *)pt0 != LCL0 && pt0 > B)
2169 {
2170 /* Wow, we're gonna cut!!! */
2171 while (B->cp_b < pt0)
2172 {
2173 while (POP_CHOICE_POINT(B->cp_b))
2174 {
2175 POP_EXECUTE();
2176 }
2177 HB = B->cp_h;
2178 Yap_TrimTrail();
2179 B = B->cp_b;
2180 }
2181#ifdef TABLING
2182 abolish_incomplete_subgoals(B);
2183#endif
2184#ifdef YAPOR
2185 CUT_prune_to(pt0);
2186#endif /* YAPOR */
2187 B = pt0;
2188 }
2189 return (TRUE);
2190}
2191
2192static Int clean_ifcp(USES_REGS1)
2193{
2194 Term t = Deref(ARG2);
2195 Term t0 = Deref(ARG1);
2196 choiceptr pt0;
2197
2198 must_be_integer(t0);
2199 must_be_integer(t);
2200 if (t0 == t)
2201 return true;
2202#if YAPOR_SBA
2203 pt0 = (choiceptr)IntegerOfTerm(t);
2204#else
2205 pt0 = cp_from_integer(t PASS_REGS);
2206#endif
2207 if (pt0 < B)
2208 {
2209 /* this should never happen */
2210 return true;
2211 }
2212 else if (pt0 == B)
2213 {
2214 prune(pt0 PASS_REGS);
2215 }
2216 else
2217 {
2218 choiceptr b = B;
2219 while (b != pt0 && b->cp_b != pt0 && b->cp_b)
2220 b = b->cp_b;
2221 if (b == B)
2222 pt0->cp_ap = (yamop *)TRUSTFAILCODE;
2223 }
2224 return true;
2225}
2226
2227
2228static Int drop_choice_point(USES_REGS1)
2229{
2230 Term t0 = Deref(ARG1);
2231 choiceptr pt0;
2232
2233 must_be_integer(t0);
2234#if YAPOR_SBA
2235 pt0 = (choiceptr)IntegerOfTerm(t);
2236#else
2237 pt0 = cp_from_integer(t0 PASS_REGS);
2238#endif
2239 if (pt0 < B)
2240 {
2241 /* this should never happen */
2242 Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,t0,NULL);
2243 return false ;
2244 }
2245 else if (pt0 == B)
2246 {
2247 prune(pt0 PASS_REGS);
2248 }
2249 else
2250 {
2251 choiceptr b = B;
2252 bool doprune = false;
2253 while (b && b->cp_b && b->cp_b < pt0) {
2254 if (b->cp_ap != TRUSTFAILCODE) doprune = false;
2255 b = b->cp_b;
2256 }
2257 if (b->cp_b == pt0) {
2258 if (doprune)
2259 prune(pt0 PASS_REGS);
2260 else
2261 pt0->cp_ap = TRUSTFAILCODE;
2262 }
2263 }
2264 return true;
2265}
2266
2267static int disj_marker(yamop *apc)
2268{
2269 op_numbers opnum = Yap_op_from_opcode(apc->opc);
2270
2271 return opnum == _or_else || opnum == _or_last;
2272}
2273
2274static Int cut_up_to_next_disjunction(USES_REGS1)
2275{
2276 choiceptr pt0 = B;
2277 CELL *qenv = (CELL *)ENV[E_E];
2278
2279 while (pt0 && !(qenv == pt0->cp_env && disj_marker(pt0->cp_ap)))
2280 {
2281 pt0 = pt0->cp_b;
2282 }
2283 if (!pt0)
2284 return TRUE;
2285#ifdef YAPOR
2286 CUT_prune_to(pt0);
2287#endif /* YAPOR */
2288 /* find where to cut to */
2289 if (SHOULD_CUT_UP_TO(B, pt0))
2290 {
2291 B = pt0;
2292#ifdef TABLING
2293 abolish_incomplete_subgoals(B);
2294#endif /* TABLING */
2295 }
2296 HB = B->cp_h;
2297 Yap_TrimTrail();
2298 return TRUE;
2299}
2300
2310bool Yap_Reset(yap_reset_t mode, bool hard)
2311{
2312 CACHE_REGS
2313 int res = TRUE;
2314
2315 Yap_ResetException(NULL);
2316 /* first, backtrack to the root */
2317 while (B)
2318 {
2319 P = FAILCODE;
2320 int a = -1;
2321 while (a < 0)
2322 {
2323 a = exec_absmi(true, mode PASS_REGS);
2324 }
2325 B = B->cp_b;
2326 }
2327 /* reinitialize the engine */
2328 Yap_InitYaamRegs(worker_id, false);
2329 GLOBAL_Initialised = true;
2330 ENV = LCL0;
2331 ASP = (CELL *)B;
2332 /* the first real choice-point will also have AP=FAIL */
2333 /* always have an empty slots for people to use */
2334 P = CP = YESCODE;
2335 // ensure that we have slots where we need them
2336 Yap_RebootSlots(worker_id);
2337 return res;
2338}
2339
2340bool is_cleanup_cp(choiceptr cp_b)
2341{
2342 PredEntry *pe;
2343
2344 if (cp_b->cp_ap->opc != ORLAST_OPCODE)
2345 return FALSE;
2346#ifdef YAPOR
2347 pe = cp_b->cp_ap->y_u.Osblp.p0;
2348#else
2349 pe = cp_b->cp_ap->y_u.p.p;
2350#endif /* YAPOR */
2351 /*
2352 it has to be a cleanup and it has to be a completed goal,
2353 otherwise the throw will be caught anyway.
2354 */
2355 return pe == PredSafeCallCleanup;
2356}
2357
2358void Yap_InitYaamRegs(int myworker_id, bool full_reset)
2359{
2360 // getchar();
2361#if PUSH_REGS
2362 /* Guarantee that after a longjmp we go back to the original abstract
2363 machine registers */
2364#ifdef THREADS
2365 if (myworker_id)
2366 {
2367 REGSTORE *rs = REMOTE_ThreadHandle(myworker_id).default_yaam_regs;
2368 pthread_setspecific(Yap_yaamregs_key, (const void *)rs);
2369 REMOTE_ThreadHandle(myworker_id).current_yaam_regs = rs;
2370 }
2371 /* may be run by worker_id on behalf on myworker_id */
2372#else
2373 Yap_regp = &Yap_standard_regs;
2374#endif
2375#endif /* PUSH_REGS */
2376 CACHE_REGS
2377 Yap_PutValue(AtomBreak, MkIntTerm(0));
2378
2379 Yap_InitPreAllocCodeSpace(myworker_id);
2380 TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
2381 HR = H0 = ((CELL *)REMOTE_GlobalBase(myworker_id)) ;
2382 LCL0 = ASP = (CELL *)REMOTE_LocalBase(myworker_id);
2383 CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id) - MinTrailGap);
2384 /* notice that an initial choice-point and environment
2385 *must* be created for the garbage collector to work */
2386 B = NULL;
2387 ENV = NULL;
2388 P = CP = YESCODE;
2389#ifdef DEPTH_LIMIT
2390 DEPTH = RESET_DEPTH();
2391#endif
2392 STATIC_PREDICATES_MARKED = FALSE;
2393 HR = H0;
2394 if (full_reset)
2395 {
2396 Yap_AllocateDefaultArena(128 * 128, 0, NULL);
2397 }
2398 else
2399 {
2400 HR = Yap_ArenaLimit(REMOTE_GlobalArena(myworker_id));
2401 }
2402#ifdef FROZEN_STACKS
2403 H_FZ = HR;
2404#ifdef YAPOR_SBA
2405 BSEG =
2406#endif /* YAPOR_SBA */
2407 BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id);
2408 TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
2409#endif /* FROZEN_STACKS */
2410 REMOTE_GcGeneration(myworker_id) = Yap_NewCompactTimedVar(MkIntTerm(0));
2411 REMOTE_GcCurrentPhase(myworker_id) = MkIntTerm(0L);
2412 REMOTE_GcPhase(myworker_id) = Yap_NewCompactTimedVar(MkIntTerm(0L));
2413 REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermTrue);
2414 REMOTE_AttsMutableList(myworker_id) = Yap_NewEmptyTimedVar();
2415
2416 CalculateStackGap(PASS_REGS1);
2417 /* the first real choice-point will also have AP=FAIL */
2418 /* always have an empty slots for people to use */
2419#if defined(YAPOR) || defined(THREADS)
2420 LOCAL = REMOTE(myworker_id);
2421 worker_id = myworker_id;
2422#endif /* THREADS */
2423 Yap_RebootSlots(myworker_id);
2424#if defined(YAPOR) || defined(THREADS)
2425 PP = NULL;
2426 PREG_ADDR = NULL;
2427#endif
2428 cut_c_initialize(myworker_id);
2429 Yap_PrepGoal(0, NULL, NULL PASS_REGS);
2430#ifdef FROZEN_STACKS
2431 H_FZ = HR;
2432#ifdef YAPOR_SBA
2433 BSEG =
2434#endif /* YAPOR_SBA */
2435 BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id);
2436 TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
2437#endif /* FROZEN_STACKS */
2438 CalculateStackGap(PASS_REGS1);
2439#ifdef TABLING
2440 /* ensure that LOCAL_top_dep_fr is always valid */
2441 if (REMOTE_top_dep_fr(myworker_id))
2442 DepFr_cons_cp(REMOTE_top_dep_fr(myworker_id)) = NORM_CP(B);
2443#endif
2444}
2445
2446void Yap_InitExecFs(void)
2447{
2448 CACHE_REGS
2449 YAP_opaque_handler_t catcher_ops;
2450 memset(&catcher_ops, 0, sizeof(catcher_ops));
2451 catcher_ops.cut_handler = watch_cut;
2452 catcher_ops.fail_handler = watch_retry;
2453 setup_call_catcher_cleanup_tag = YAP_NewOpaqueType(&catcher_ops);
2454
2455 Term cm = CurrentModule;
2456 Yap_InitComma();
2457 Yap_InitCPred("$execute", 1, execute, 0);
2458 Yap_InitCPred("call", 1, execute, 0);
2459 Yap_InitCPred("call", 2, execute2, 0);
2460 Yap_InitCPred("call", 3, execute3, 0);
2461 Yap_InitCPred("call", 4, execute4, 0);
2462 Yap_InitCPred("call", 5, execute5, 0);
2463 Yap_InitCPred("call", 6, execute6, 0);
2464 Yap_InitCPred("call", 7, execute7, 0);
2465 Yap_InitCPred("call", 8, execute8, 0);
2466 Yap_InitCPred("call", 9, execute9, 0);
2467 Yap_InitCPred("call", 10, execute10, 0);
2468 Yap_InitCPred("call", 11, execute11, 0);
2469 Yap_InitCPred("call", 12, execute12, 0);
2470 Yap_InitCPred("call_in_mod", 2, execute_in_mod, 0);
2471 Yap_InitCPred("call_wo_mod", 2, execute_in_mod, 0);
2472 Yap_InitCPred("call_with_args", 1, execute_0, 0);
2473 Yap_InitCPred("call_with_args", 2, execute_1, 0);
2474 Yap_InitCPred("call_with_args", 3, execute_2, 0);
2475 Yap_InitCPred("call_with_args", 4, execute_3, 0);
2476 Yap_InitCPred("call_with_args", 5, execute_4, 0);
2477 Yap_InitCPred("call_with_args", 6, execute_5, 0);
2478 Yap_InitCPred("call_with_args", 7, execute_6, 0);
2479 Yap_InitCPred("call_with_args", 8, execute_7, 0);
2480 Yap_InitCPred("call_with_args", 9, execute_8, 0);
2481 Yap_InitCPred("call_with_args", 10, execute_9, 0);
2482 Yap_InitCPred("call_with_args", 11, execute_10, 0);
2483#ifdef DEPTH_LIMIT
2484 Yap_InitCPred("$execute_under_depth_limit", 2, execute_depth_limit, 0);
2485#endif
2486 Yap_InitCPred("$execute0", 2, execute0, NoTracePredFlag);
2487 Yap_InitCPred("$execute_nonstop", 2, execute_nonstop, NoTracePredFlag);
2488 Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag);
2489 Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag);
2490 Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0);
2491 Yap_InitCPred("$drop_choice_point", 1, drop_choice_point, 0);
2492 Yap_InitCPred("$current_choice_point", 1,current_choice_point, 0);
2493 CurrentModule = HACKS_MODULE;
2494 Yap_InitCPred("current_choice_point", 1, current_choice_point, 0);
2495 Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0);
2496 Yap_InitCPred("env_choice_point", 1, save_env_b, 0);
2497 Yap_InitCPred("cut_at", 2, clean_ifcp, SafePredFlag);
2498 CurrentModule = cm;
2499 Yap_InitCPred("$restore_regs", 1, restore_regs,
2500 NoTracePredFlag | SafePredFlag);
2501 Yap_InitCPred("$restore_regs", 2, restore_regs2,
2502 NoTracePredFlag | SafePredFlag);
2503 Yap_InitCPred("$clean_ifcp", 2, clean_ifcp, SafePredFlag);
2504 Yap_InitCPred("qpack_clean_up_to_disjunction", 0, cut_up_to_next_disjunction,
2505 SafePredFlag);
2506 // Yap_InitCPred("$generate_pred_info", 4, generate_pred_info, 0);
2507 Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0);
2508 Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0);
2509 Yap_InitCPred("$setup_call_catcher_cleanup", 1, setup_call_catcher_cleanup,
2510 0);
2511 Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, 0);
2512 Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0);
2513
2514 Yap_InitDebugFs();
2515}
Yap_ResetException
bool Yap_ResetException(yap_error_descriptor_t *i)
clean up (notice that the code ensures ActiveError exists on exit
Definition: errors.c:1425
Yap_RaiseException
bool Yap_RaiseException()
let's go
Definition: errors.c:1410
Yap_RestartException
bool Yap_RestartException(yap_error_descriptor_t *i)
clean up (notice that the code ensures ActiveError exists on exit
Definition: errors.c:1438
YAP_opaque_handler_struct
opaque variables can interact with the system
Definition: YapDefs.h:229
gc_entry_info
Definition: heapgc.h:272
pred_entry
Definition: Yatom.h:544
regstore_t
Definition: Regs.h:94
s_yap_error_descriptor
all we need to know about an error/throw
Definition: YapError.h:205
s_yap_error_descriptor::errorNo
yap_error_number errorNo
error identifier
Definition: YapError.h:207
yami
Definition: amidefs.h:264