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