38#define DEB_DOOBIN(d0) \
39(fprintf(stderr, "+++ %s ", __FUNCTION__), Yap_DebugPlWriteln(d0))
40#define DEB_DOOBOUT(d0) (fprintf(stderr, "--- "), Yap_DebugPlWriteln(d0))
42(fprintf(stderr, "%s %ld %p=%p %p--%d\n ", S, to_visit - to_visit0, pt0, \
43 ptf, *AbsAppl(pt0), arity))
68CELL *Yap_ArenaLimit(Term arena) {
return ArenaLimit(arena); }
70CELL *Yap_ArenaPt(Term arena) {
return ArenaPt(arena); }
72UInt Yap_ArenaSz(Term arena) {
return ArenaSzW(arena); }
80static int copy_complex_term(CELL *pt0_, CELL *pt0_end_,
bool share,
81 bool copy_att_vars, CELL *ptf_,
87Term Yap_MkArena(CELL *ptr, CELL *max) {
88 Term t = AbsAppl(ptr);
92 ptr[0] = (CELL) FunctorBlob;
94 size_t size = (max - 1) - (ptr + 3);
96 max[-1] = CloseExtension(ptr);
102bool Yap_ArenaExpand(
size_t sz, CELL *arenap) {
106 if (!Yap_dogcl(sz * CellSize)) {
107 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
108 "No Stack Space for Non-Backtrackable terms");
114 size_t sz0 = ArenaSzW(*arenap);
115 yhandle_t yh = Yap_PushHandle(*arenap);
118 CELL *a_max = ArenaLimit(*arenap);
119 nsz = Yap_InsertInGlobal(a_max - 1, sz * CellSize, &shifted_max) /
123 CELL *ar_max = shifted_max + nsz;
124 CELL *ar_min = shifted_max - sz0;
126 *arenap = Yap_MkArena(ar_min, ar_max);
131 if (!Yap_dogcl(sz * CellSize)) {
132 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
133 "No Stack Space for Non-Backtrackable terms");
135 *arenap = Yap_GetFromHandle(yh);
139static Int p_allocate_arena(USES_REGS1) {
140 Term t = Deref(ARG1);
142 Yap_ThrowError(INSTANTIATION_ERROR, t,
"allocate_arena");
144 }
else if (!IsIntegerTerm(t)) {
145 Yap_ThrowError(TYPE_ERROR_INTEGER, t,
"allocate_arena");
148 size_t sz = IntegerOfTerm(t);
149 Term a = Yap_MkArena(HR, HR + sz);
150 return Yap_unify(ARG2, a);
153static Int arena_size(USES_REGS1) {
154 return Yap_unify(ARG1, MkIntegerTerm(ArenaSzW(LOCAL_GlobalArena)));
157void Yap_AllocateDefaultArena(
size_t gsizeW,
int wid,
void *cs) {
158 REMOTE_GlobalArena(wid) = Yap_MkArena(H0, H0 + gsizeW);
163static void adjust_cps(UInt size USES_REGS) {
166 while (b_ptr->cp_h == HR) {
173static bool visitor_error_handler( yap_error_number err, CELL *hb, CELL *asp,
174 size_t min_grow, Term *arenap) {
175 if (err == RESOURCE_ERROR_TRAIL) {
177 if (!Yap_growtrail(0,
false)) {
178 Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil,
"while visiting terms");
180 }
else if (err == RESOURCE_ERROR_STACK) {
181 return Yap_ArenaExpand(min_grow, arenap);
205static int copy_complex_term(CELL *pt0_, CELL *pt0_end_,
bool share,
206 bool copy_att_vars, CELL *ptf_,
207 Term *bindp,
Ystack_t *stt USES_REGS) {
210 CELL *pt0 = pt0_, *ptf = ptf_, *pt0_end = pt0_end_;
219 while (pt0 < pt0_end) {
230 mderef_head(d0, dd0, copy_term_unk);
232 if (IsPairTerm(d0)) {
233 CELL *ptd1 = RepPair(d0);
240 if (share && ptd1 >= HB && ptd1 < ASP) {
241 *ptf = AbsPair(ptd1);
242 }
else if (IS_VISIT_MARKER(*ptd1)) {
244 struct cp_frame *entry = VISIT_ENTRY(*ptd1);
246 if (IsVarTerm(val)) {
252 Term l = AbsAppl(HR);
254 HR[0] = (CELL) FunctorEq;
255 entry->t = HR[1] = (CELL) ptf;
257 if (HR + 3 > ASP - MIN_ARENA_SIZE) {
259 return stt->err = RESOURCE_ERROR_STACK;
263 *bindp = MkPairTerm(l, *bindp);
266 TrailedMaBind(ptf, (CELL) ptf);
274 if (stt->pt + 2 >= stt->max && !realloc_stack(stt)) {
275 return stt->err = RESOURCE_ERROR_AUXILIARY_STACK;
280 mTrailedMaBind(ptd0, d0);
281 if (TR + 32 >= (tr_fr_ptr) LOCAL_TrailTop) {
282 return stt->err = RESOURCE_ERROR_TRAIL;
287 to_visit->pt0_end = pt0_end;
289 to_visit->ground = ground;
290 to_visit->oldp = ptd1;
291 to_visit->oldv = VISIT_UNMARK(*ptd1);
294 *ptd1 = VISIT_MARK();
303 if (HR + 2 > ASP - MIN_ARENA_SIZE) {
305 return stt->err = RESOURCE_ERROR_STACK;
309 }
else if (IsApplTerm(d0)) {
310 CELL *ptd1 = RepAppl(d0);
312 if (share && ptd1 >= HB && ptd1 < ASP) {
318 if (IsExtensionFunctor((
Functor) dd1)) {
320 case (CELL) FunctorDBRef:
322 case (CELL) FunctorLongInt:
323 if (HR > ASP - (MIN_ARENA_SIZE + 3)) {
324 return stt->err = RESOURCE_ERROR_STACK;
329 HR[2] = CloseExtension(HR);
332 case (CELL) FunctorDouble:
334 ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE /
sizeof(CELL)))) {
335 return stt->err = RESOURCE_ERROR_STACK;
340#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
342 HR[3] = CloseExtension(HR);
345 HR[2] = CloseExtension(HR);
350 case (CELL) FunctorString:
351 if (ASP - HR < MIN_ARENA_SIZE + 3 + ptd1[1]) {
352 return stt->err = RESOURCE_ERROR_STACK;
355 memmove(HR, ptd1,
sizeof(CELL) * (2 + ptd1[1]));
357 HR[-1] = CloseExtension(RepAppl(*ptf));
359 case (CELL) FunctorBlob:
360 if (ASP - HR < MIN_ARENA_SIZE + 4 + ptd1[1]) {
361 return stt->err = RESOURCE_ERROR_STACK;
364 memmove(HR, ptd1,
sizeof(CELL) * (4 + ptd1[2]));
366 HR[-1] = CloseExtension(RepAppl(*ptf));
372 if (ptd1[1] == BIG_RATIONAL) {
375 (2 *
sizeof(
MP_INT) + 3 * CellSize +
376 ((
MP_INT *) (ptd1 + 2))->_mp_alloc *
sizeof(mp_limb_t)) /
378 (((
MP_INT *) (ptd1 + 2) + 1)->_mp_alloc *
sizeof(mp_limb_t)) /
381 szW = (
sizeof(
MP_INT) + 3 * CellSize +
382 ((
MP_INT *) (ptd1 + 2))->_mp_alloc *
sizeof(mp_limb_t)) /
385 if (HR > ASP - (MIN_ARENA_SIZE + szW)) {
386 return stt->err = RESOURCE_ERROR_STACK;
391 for (i = 1; i < szW - 1; i++) {
394 HR[szW - 1] = CloseExtension(HR);
399 }
else if (IS_VISIT_MARKER(dd1)) {
402 struct cp_frame *entry = VISIT_ENTRY(dd1);
404 if (IsVarTerm(val)) {
405 mBind_And_Trail(ptf, val);
408 Term l = AbsAppl(HR);
410 HR[0] = (CELL) FunctorEq;
411 entry->t = HR[1] = (CELL) ptf;
415 *bindp = MkPairTerm(l, *bindp);
419 TrailedMaBind(ptf, (CELL) ptf);
420 if (TR + 32 >= (tr_fr_ptr) LOCAL_TrailTop) {
421 return stt->err = RESOURCE_ERROR_TRAIL;
426 myt = *ptf = AbsAppl(HR);
429 if (f == FunctorAttVar)
432 arity = ArityOfFunctor(f);
435 TrailedMaBind(ptd0, d0);
436 if (TR + 32 >= (tr_fr_ptr) LOCAL_TrailTop) {
437 return stt->err = RESOURCE_ERROR_TRAIL;
441 if (to_visit + 2 >= to_visit_end && !realloc_stack(stt)) {
442 return stt->err = RESOURCE_ERROR_AUXILIARY_STACK;
446 to_visit->pt0_end = pt0_end;
449 to_visit->ground = ground;
450 to_visit->oldp = ptd1;
451 to_visit->oldv = (CELL) f;
452 *ptd1 = VISIT_MARK();
454 ground = (f != FunctorMutable);
456 pt0_end = ptd1 + arity;
460 if (HR > ASP - (arity + MIN_ARENA_SIZE)) {
461 return stt->err = RESOURCE_ERROR_STACK;
470 mderef_body(d0, dd0, ptd0, copy_term_unk, copy_term_nvar);
473 if (HB <= ptd0 && ptd0 < HR) {
479 if (copy_att_vars && GlobalIsAttVar(ptd0)) {
483 if (to_visit + 8 >= to_visit_end && !realloc_stack(stt)) {
484 return stt->err = RESOURCE_ERROR_AUXILIARY_STACK;
486 *ptf = (CELL) (HR + 1);
488 to_visit->pt0_end = pt0_end;
490 to_visit->t = AbsAppl(HR);
491 to_visit->ground =
false;
493 to_visit->oldp = ptd0 - 1;
494 to_visit->oldv = (CELL) FunctorAttVar;
495 ptd0[-1] = VISIT_MARK();
501 HR[0] = (CELL) FunctorAttVar;
503 if (HR > ASP - (3 + MIN_ARENA_SIZE)) {
504 return stt->err = RESOURCE_ERROR_STACK;
509 mBind_And_Trail(ptd0, (CELL) ptf);
510 if (TR + 32 >= (tr_fr_ptr) LOCAL_TrailTop) {
511 return stt->err = RESOURCE_ERROR_TRAIL;
515 if (to_visit <= to_visit0) {
520 pt0_end = to_visit->pt0_end;
523 VUNMARK(to_visit->oldp, to_visit->oldv);
524 ground = (ground && to_visit->ground);
529Term CopyTermToArena(Term t,
530 bool share,
bool copy_att_vars,
531 yap_error_number *errp,
532 Term *arenap, Term *bindp USES_REGS) {
539 if (arenap && *arenap) {
540 CELL *base = ArenaPt(*arenap);
541 CELL *end = ArenaLimit(*arenap);
542 RESET_VARIABLE(base);
544 *arenap = Yap_MkArena(base,end);
545 return (CELL)(base-1);
547 if (!IsAttVar(VarOfTerm(t)) || !copy_att_vars) {
549 RESET_VARIABLE(HR - 1);
550 return (CELL) (HR - 1);
552 }
else if (IsAtomOrIntTerm(t)) {
554 }
else if (IsApplTerm(t) && IsExtensionFunctor((f = FunctorOfTerm(t)))) {
555 if (f == FunctorDBRef) {
559 size_t szop = SizeOfOpaqueTerm(RepAppl(t), (CELL) f), sz = szop;
560 if (arenap && *arenap) {
561 base = ArenaPt(*arenap);
562 end = ArenaLimit(*arenap);
563 size_t sz0 = ArenaSzW(*arenap);
564 if (sz0 < sz + MIN_ARENA_SIZE) {
566 yt = Yap_InitHandle(t);
568 yt1 = Yap_InitHandle(*bindp);
569 size_t nsize = Yap_InsertInGlobal(end, (sz + 4 * MIN_ARENA_SIZE) * CellSize, &end) / CellSize;
571 *bindp = Yap_PopHandle(yt1);
572 t = Yap_PopHandle(yt);
575 if (sz0 < sz + MIN_ARENA_SIZE) {
576 stt->err = RESOURCE_ERROR_STACK;
578 memmove(base, RepAppl(t), (szop) * CellSize);
579 base[szop - 1] = CloseExtension(base);
580 Term tf = AbsAppl(base);
581 *arenap = Yap_MkArena(base + szop, end);
585 while (HR + (MIN_ARENA_SIZE + sz) > ASP) {
587 yt = Yap_InitHandle(t);
589 yt1 = Yap_InitHandle(*bindp);
590 if (!Yap_dogcl(2 * MIN_ARENA_SIZE + sz PASS_REGS)) {
591 stt->err = RESOURCE_ERROR_STACK;
595 *bindp = Yap_PopHandle(yt1);
596 t = Yap_PopHandle(yt);
597 memmove(HR, RepAppl(t), (szop - 1) * CellSize);
598 Term tf = AbsAppl(HR);
599 HR[szop - 1] = CloseExtension(HR);
607 int i = push_text_stack();
608 expand_stack =(HR-H0)/8;
609 if (expand_stack < 4 * MIN_ARENA_SIZE)
610 expand_stack = 4 * MIN_ARENA_SIZE;
611 if (expand_stack > 2 * K * K)
612 expand_stack = 2 * K * K;
621 if (arenap && *arenap) {
622 CELL *start = ArenaPt(*arenap);
623 CELL *end = ArenaLimit(*arenap);
629 stt->err = YAP_NO_ERROR;
630 stt->err = copy_complex_term(ap - 1, ap, share, copy_att_vars, pf, bindp,
632 if (arenap && *arenap) {
633 CELL *start = stt->err==YAP_NO_ERROR ? HR : HB;
634 *arenap = Yap_MkArena(start, ASP);
637 }
else if (stt->err!=YAP_NO_ERROR) {
643 if (stt->err == YAP_NO_ERROR) {
645 clean_tr(B->cp_tr+stt->tr0 PASS_REGS);
646 TR = B->cp_tr+stt->tr0;
655 while (to_visit > to_visit0) {
658 VUNMARK(to_visit->oldp, to_visit->oldv);
660 clean_tr(B->cp_tr+stt->tr0 PASS_REGS);
661 TR = B->cp_tr+stt->tr0;
666 yt = Yap_InitHandle(t);
668 yt1 = Yap_InitHandle(*bindp);
669 visitor_error_handler(stt->err, HB, ASP, expand_stack, arenap);
671 *bindp = Yap_PopHandle(yt1);
672 stt->t = t = Yap_PopHandle(yt);
673 stt->err = YAP_NO_ERROR;
679Term Yap_CopyTerm(Term inp) {
681 return CopyTermToArena(inp,
false,
true, NULL, NULL, NULL PASS_REGS);
684Term Yap_CopyTermNoShare(Term inp) {
688 return CopyTermToArena(inp,
false,
true , NULL, NULL, NULL PASS_REGS);
707static Int p_copy_term(USES_REGS1)
711 yap_error_number err = YAP_NO_ERROR;
713 Term inp = MkGlobal(Deref(ARG1));
714 CELL *hb = HR, *asp = ASP;
715 t = CopyTermToArena(inp,
false,
true , &err, NULL, NULL PASS_REGS);
717 visitor_error_handler( err, hb, asp,
722 return Yap_unify(ARG2, t);
738static Int p_duplicate_term(USES_REGS1)
742 yap_error_number err = YAP_NO_ERROR;
744 CELL *hb = HR, *asp = ASP;
745 Term inp = MkGlobal(Deref(ARG1));
746 t = CopyTermToArena(inp,
false,
true , &err, NULL, NULL PASS_REGS);
748 visitor_error_handler( err, hb, asp,
753 return Yap_unify(ARG2, t);
770rational_tree_to_forest(USES_REGS1)
773 Term list = Deref(ARG4);
775 yap_error_number err = YAP_NO_ERROR;
777 CELL *hb = HR, *asp = ASP;
778 Term inp = MkGlobal(Deref(ARG1));
780 t = CopyTermToArena(inp,
true,
false ,&err, NULL, &list PASS_REGS);
782 visitor_error_handler( err, hb, asp,
789 return Yap_unify(t2, t) && Yap_unify(t3, list);
792Term Yap_TermAsForest(Term t1)
795 Term t = CopyTermToArena(t1,
true,
false , NULL, NULL, &list PASS_REGS);
802 return Yap_MkApplTerm(FunctorAtSymbol, 2, ts);
816p_copy_term_no_delays(USES_REGS1)
819 yap_error_number err = YAP_NO_ERROR;
822 CELL *hb = HR, *asp = ASP;
823 Term inp = MkGlobal(Deref(ARG1));
824 t = CopyTermToArena(inp,
false,
false , &err, NULL, NULL PASS_REGS);
826 visitor_error_handler( err, hb, asp,
831 return Yap_unify(ARG2, t);
836void Yap_InitCopyTerm(
void) {
838 Term cm = CurrentModule;
839 Yap_InitCPred(
"$allocate_arena", 2, p_allocate_arena, 0);
840 Yap_InitCPred(
"arena_size", 1, arena_size, 0);
841 Yap_InitCPred(
"copy_term", 2, p_copy_term, 0);
842 Yap_InitCPred(
"duplicate_term", 2, p_duplicate_term, 0);
843 Yap_InitCPred(
"copy_term_nat", 2, p_copy_term_no_delays, 0);
844 Yap_InitCPred(
"rational_term_to_forest", 4, rational_tree_to_forest, 0);