YAP 7.1.0
copy.c
Go to the documentation of this file.
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: copy.c *
12* Last rev: *
13* mods: *
14* comments: support from multiple assignment variables in YAP *
15* *
16*************************************************************************/
17
18
38#define DEB_DOOBIN(d0) \
39(fprintf(stderr, "+++ %s ", __FUNCTION__), Yap_DebugPlWriteln(d0))
40#define DEB_DOOBOUT(d0) (fprintf(stderr, "--- "), Yap_DebugPlWriteln(d0))
41#define DEB_DOOB(S) \
42(fprintf(stderr, "%s %ld %p=%p %p--%d\n ", S, to_visit - to_visit0, pt0, \
43 ptf, *AbsAppl(pt0), arity)) //, Yap_DebugPlWriteln(d0))
44
45#include "Yap.h"
46#include "YapEval.h"
47#include "YapHeap.h"
48#include "Yatom.h"
49#include "attvar.h"
50#include "clause.h"
51#include "heapgc.h"
52#include "iopreds.h"
53#include "yapio.h"
54#include <math.h>
55
56#include "YapArenas.h"
57#include "YapError.h"
58
59#include "terms.h"
60
61#ifdef HAVE_STRING_H
62
63#include "string.h"
64
65#endif
66
67/* pointer to top of an arena */
68CELL *Yap_ArenaLimit(Term arena) { return ArenaLimit(arena); }
69
70CELL *Yap_ArenaPt(Term arena) { return ArenaPt(arena); }
71
72UInt Yap_ArenaSz(Term arena) { return ArenaSzW(arena); }
73
74/* Non-backtrackable terms will from now on be stored on arenas, a
75 special term on the heap. Arenas automatically contract as we add terms to
76 the front.
77
78*/
79
80static int copy_complex_term(CELL *pt0_, CELL *pt0_end_, bool share,
81 bool copy_att_vars, CELL *ptf_,
82 Term *bindp,
83 Ystack_t *stt USES_REGS);
84
85
86
87Term Yap_MkArena(CELL *ptr, CELL *max) {
88 Term t = AbsAppl(ptr);
89
90
91 // printf("<< %p %p %ld \n", ptr, max, max - ptr);
92 ptr[0] = (CELL) FunctorBlob;
93 ptr[1] = EMPTY_ARENA;
94 size_t size = (max - 1) - (ptr + 3);
95 ptr[2] = size;
96 max[-1] = CloseExtension(ptr);
97 if (max >= HR)
98 HR = max;
99 return t;
100}
101
102bool Yap_ArenaExpand(size_t sz, CELL *arenap) {
103 sz += MinStackGap;
104 if (!arenap) {
105
106 if (!Yap_dogcl(sz * CellSize)) {
107 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
108 "No Stack Space for Non-Backtrackable terms");
109 }
110
111 return true;
112 } else {
113 size_t nsz;
114 size_t sz0 = ArenaSzW(*arenap);
115 yhandle_t yh = Yap_PushHandle(*arenap);
116 while (true) {
117 CELL *shifted_max;
118 CELL *a_max = ArenaLimit(*arenap);
119 nsz = Yap_InsertInGlobal(a_max - 1, sz * CellSize, &shifted_max) /
120 CellSize;
121 if (nsz >= sz) {
122 shifted_max += 1;
123 CELL *ar_max = shifted_max + nsz;
124 CELL *ar_min = shifted_max - sz0;
125 Yap_PopHandle(yh);
126 *arenap = Yap_MkArena(ar_min, ar_max);
127 return true;
128 }
129 }
130
131 if (!Yap_dogcl(sz * CellSize)) {
132 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
133 "No Stack Space for Non-Backtrackable terms");
134 }
135 *arenap = Yap_GetFromHandle(yh);
136 }
137}
138
139static Int p_allocate_arena(USES_REGS1) {
140 Term t = Deref(ARG1);
141 if (IsVarTerm(t)) {
142 Yap_ThrowError(INSTANTIATION_ERROR, t, "allocate_arena");
143 return FALSE;
144 } else if (!IsIntegerTerm(t)) {
145 Yap_ThrowError(TYPE_ERROR_INTEGER, t, "allocate_arena");
146 return FALSE;
147 }
148 size_t sz = IntegerOfTerm(t);
149 Term a = Yap_MkArena(HR, HR + sz);
150 return Yap_unify(ARG2, a);
151}
152
153static Int arena_size(USES_REGS1) {
154 return Yap_unify(ARG1, MkIntegerTerm(ArenaSzW(LOCAL_GlobalArena)));
155}
156
157void Yap_AllocateDefaultArena(size_t gsizeW, int wid, void *cs) {
158 REMOTE_GlobalArena(wid) = Yap_MkArena(H0, H0 + gsizeW);
159 HR = H0 + gsizeW;
160}
161
162#if 0
163static void adjust_cps(UInt size USES_REGS) {
164 /* adjust possible back pointers in choice-point stack */
165 choiceptr b_ptr = B;
166 while (b_ptr->cp_h == HR) {
167 b_ptr->cp_h += size;
168 b_ptr = b_ptr->cp_b;
169 }
170}
171#endif
172
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) {
176
177 if (!Yap_growtrail(0, false)) {
178 Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil, "while visiting terms");
179 }
180 } else if (err == RESOURCE_ERROR_STACK) {
181 return Yap_ArenaExpand(min_grow, arenap);
182 }
183 return true;
184}
185
186
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) {
208 // allocate space for internal stack, so that we do not have yo rely on
209 // m C-stack.
210 CELL *pt0 = pt0_, *ptf = ptf_, *pt0_end = pt0_end_;
211 Term myt;
212 bool forest = bindp;
213 bool ground;
214 ground = true;
215 share = false;
216
217 ptf--; // synch with pt0;
218 do {
219 while (pt0 < pt0_end) {
220 CELL d0, dd0;
221 CELL *ptd0;
222 // next cell
223 ++pt0;
224 ++ptf;
225 ptd0 = pt0;
226 // notice that this is the true value of d0
227
228 dd0 = *ptd0;
229 // DEB_DOOB("enter");
230 mderef_head(d0, dd0, copy_term_unk);
231 copy_term_nvar:
232 if (IsPairTerm(d0)) {
233 CELL *ptd1 = RepPair(d0);
234
240 if (share && ptd1 >= HB && ptd1 < ASP) {
241 *ptf = AbsPair(ptd1);
242 } else if (IS_VISIT_MARKER(*ptd1)) {
243 /* d0 has ance */
244 struct cp_frame *entry = VISIT_ENTRY(*ptd1);
245 Term val = entry->t;
246 if (IsVarTerm(val)) {
247 *ptf = val;
248 } else if (forest) {
249 // set up a binding PTF=D0
250
251 // set up a binding PTF=D0
252 Term l = AbsAppl(HR);
253 RESET_VARIABLE(ptf);
254 HR[0] = (CELL) FunctorEq;
255 entry->t = HR[1] = (CELL) ptf;
256 HR[2] = val;
257 if (HR + 3 > ASP - MIN_ARENA_SIZE) {
258 // same as before
259 return stt->err = RESOURCE_ERROR_STACK;
260 }
261 HR += 3;
262 if (bindp)
263 *bindp = MkPairTerm(l, *bindp);
264 } else {
265 *ptf = val;
266 TrailedMaBind(ptf, (CELL) ptf);
267 }
268 continue;
269 }
270
271 // first time we meet,
272 // save state
273 myt = AbsPair(HR);
274 if (stt->pt + 2 >= stt->max && !realloc_stack(stt)) {
275 return stt->err = RESOURCE_ERROR_AUXILIARY_STACK;
276 }
277
278 if (share) {
279 d0 = AbsPair(ptf);
280 mTrailedMaBind(ptd0, d0);
281 if (TR + 32 >= (tr_fr_ptr) LOCAL_TrailTop) {
282 return stt->err = RESOURCE_ERROR_TRAIL;
283 }
284 }
285 to_visit->tr = TR;
286 to_visit->pt0 = pt0;
287 to_visit->pt0_end = pt0_end;
288 to_visit->ptf = ptf;
289 to_visit->ground = ground;
290 to_visit->oldp = ptd1;
291 to_visit->oldv = VISIT_UNMARK(*ptd1);
292 to_visit->t = myt;
293 dd0 = (*ptd1);
294 *ptd1 = VISIT_MARK();
295 *ptf = AbsPair(HR);
296 /* the system into thinking we had a variable there */
297
298 ptf = HR - 1;
299 to_visit++;
300 ground = true;
301 pt0 = ptd1 - 1;
302 pt0_end = ptd1 + 1;
303 if (HR + 2 > ASP - MIN_ARENA_SIZE) {
304 // same as before
305 return stt->err = RESOURCE_ERROR_STACK;
306 }
307 HR += 2;
308 continue;
309 } else if (IsApplTerm(d0)) {
310 CELL *ptd1 = RepAppl(d0);
311 CELL dd1 = *ptd1;
312 if (share && ptd1 >= HB && ptd1 < ASP) {
313 /* If this is newer than the current term, just reuse */
314 *ptf = d0;
315 continue;
316 }
317
318 if (IsExtensionFunctor((Functor) dd1)) {
319 switch (dd1) {
320 case (CELL) FunctorDBRef:
321 *ptf = d0;
322 case (CELL) FunctorLongInt:
323 if (HR > ASP - (MIN_ARENA_SIZE + 3)) {
324 return stt->err = RESOURCE_ERROR_STACK;
325 }
326 *ptf = AbsAppl(HR);
327 HR[0] = dd1;
328 HR[1] = ptd1[1];
329 HR[2] = CloseExtension(HR);
330 HR += 3;
331 break;
332 case (CELL) FunctorDouble:
333 if (HR >
334 ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) {
335 return stt->err = RESOURCE_ERROR_STACK;
336 }
337 *ptf = AbsAppl(HR);
338 HR[0] = dd1;
339 HR[1] = ptd1[1];
340#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
341 HR[2] = ptd1[2];
342 HR[3] = CloseExtension(HR);
343 HR += 4;
344#else
345 HR[2] = CloseExtension(HR);
346 HR += 3;
347#endif
348
349 break;
350 case (CELL) FunctorString:
351 if (ASP - HR < MIN_ARENA_SIZE + 3 + ptd1[1]) {
352 return stt->err = RESOURCE_ERROR_STACK;
353 }
354 *ptf = AbsAppl(HR);
355 memmove(HR, ptd1, sizeof(CELL) * (2 + ptd1[1]));
356 HR += ptd1[1] + 3;
357 HR[-1] = CloseExtension(RepAppl(*ptf));
358 break;
359 case (CELL) FunctorBlob:
360 if (ASP - HR < MIN_ARENA_SIZE + 4 + ptd1[1]) {
361 return stt->err = RESOURCE_ERROR_STACK;
362 }
363 *ptf = AbsAppl(HR);
364 memmove(HR, ptd1, sizeof(CELL) * (4 + ptd1[2]));
365 HR += ptd1[2] + 4;
366 HR[-1] = CloseExtension(RepAppl(*ptf));
367 break;
368 default: {
369 size_t szW;
370
371 /* big int */
372 if (ptd1[1] == BIG_RATIONAL) {
373
374 szW =
375 (2 * sizeof(MP_INT) + 3 * CellSize +
376 ((MP_INT *) (ptd1 + 2))->_mp_alloc * sizeof(mp_limb_t)) /
377 CellSize +
378 (((MP_INT *) (ptd1 + 2) + 1)->_mp_alloc * sizeof(mp_limb_t)) /
379 CellSize;
380 } else {
381 szW = (sizeof(MP_INT) + 3 * CellSize +
382 ((MP_INT *) (ptd1 + 2))->_mp_alloc * sizeof(mp_limb_t)) /
383 CellSize;
384 }
385 if (HR > ASP - (MIN_ARENA_SIZE + szW)) {
386 return stt->err = RESOURCE_ERROR_STACK;
387 }
388 *ptf = AbsAppl(HR);
389 HR[0] = dd1;
390 size_t i;
391 for (i = 1; i < szW - 1; i++) {
392 HR[i] = ptd1[i];
393 }
394 HR[szW - 1] = CloseExtension(HR);
395 HR += szW;
396 }
397 }
398 continue;
399 } else if (IS_VISIT_MARKER(dd1)) {
400 /* If this is newer than the current term, just reuse */
401 // set up a binding PTF=D0
402 struct cp_frame *entry = VISIT_ENTRY(dd1);
403 Term val = entry->t;
404 if (IsVarTerm(val)) {
405 mBind_And_Trail(ptf, val);
406 } else if (forest) {
407 // set up a binding PTF=D0
408 Term l = AbsAppl(HR);
409 RESET_VARIABLE(ptf);
410 HR[0] = (CELL) FunctorEq;
411 entry->t = HR[1] = (CELL) ptf;
412 HR[2] = val;
413 HR += 3;
414 if (bindp)
415 *bindp = MkPairTerm(l, *bindp);
416 } else {
417 // same as before
418 *ptf = val;
419 TrailedMaBind(ptf, (CELL) ptf);
420 if (TR + 32 >= (tr_fr_ptr) LOCAL_TrailTop) {
421 return stt->err = RESOURCE_ERROR_TRAIL;
422 }
423 }
424 } else {
425 Term d1 = dd1;
426 myt = *ptf = AbsAppl(HR);
427 Functor f = (Functor) d1;
428 arity_t arity;
429 if (f == FunctorAttVar)
430 arity = 3;
431 else
432 arity = ArityOfFunctor(f);
433 if (share) {
434 d0 = AbsAppl(ptf);
435 TrailedMaBind(ptd0, d0);
436 if (TR + 32 >= (tr_fr_ptr) LOCAL_TrailTop) {
437 return stt->err = RESOURCE_ERROR_TRAIL;
438 }
439 }
440 /* store the terms to visit */
441 if (to_visit + 2 >= to_visit_end && !realloc_stack(stt)) {
442 return stt->err = RESOURCE_ERROR_AUXILIARY_STACK;
443 }
444 to_visit->tr = TR;
445 to_visit->pt0 = pt0;
446 to_visit->pt0_end = pt0_end;
447 to_visit->ptf = ptf;
448 to_visit->t = myt;
449 to_visit->ground = ground;
450 to_visit->oldp = ptd1;
451 to_visit->oldv = (CELL) f;
452 *ptd1 = VISIT_MARK();
453 to_visit++;
454 ground = (f != FunctorMutable);
455 pt0 = ptd1;
456 pt0_end = ptd1 + arity;
457 /* store the functor for the new term */
458 HR[0] = (CELL) f;
459 ptf = HR;
460 if (HR > ASP - (arity + MIN_ARENA_SIZE)) {
461 return stt->err = RESOURCE_ERROR_STACK;
462 }
463 HR += arity + 1;
464 }
465 } else {
466 /* just copy atoms or integers */
467 *ptf = d0;
468 }
469 continue;
470 mderef_body(d0, dd0, ptd0, copy_term_unk, copy_term_nvar);
471 ground = FALSE;
472 /* don't need to copy variables if we want to share the global term */
473 if (HB <= ptd0 && ptd0 < HR) {
474 if (ptd0 != ptf) {
475 *ptf = (CELL) ptd0;
476 }
477 continue;
478 }
479 if (copy_att_vars && GlobalIsAttVar(ptd0)) {
480 /* if unbound, call the standard copy term routine */
481 // if (true) { //||!GLOBAL_atd0)].copy_term_op) {
482 /* store the terms to visit */
483 if (to_visit + 8 >= to_visit_end && !realloc_stack(stt)) {
484 return stt->err = RESOURCE_ERROR_AUXILIARY_STACK;
485 }
486 *ptf = (CELL) (HR + 1);
487 to_visit->pt0 = pt0;
488 to_visit->pt0_end = pt0_end;
489 to_visit->ptf = ptf;
490 to_visit->t = AbsAppl(HR);
491 to_visit->ground = false;
492 to_visit->tr = TR;
493 to_visit->oldp = ptd0 - 1;
494 to_visit->oldv = (CELL) FunctorAttVar;
495 ptd0[-1] = VISIT_MARK();
496 to_visit++;
497 ground = false;
498 pt0 = ptd0 - 1;
499 pt0_end = ptd0 + 2;
500 /* store the functor for the new term */
501 HR[0] = (CELL) FunctorAttVar;
502 ptf = HR;
503 if (HR > ASP - (3 + MIN_ARENA_SIZE)) {
504 return stt->err = RESOURCE_ERROR_STACK;
505 }
506 HR += 3 + 1;
507 } else {
508 RESET_VARIABLE(ptf);
509 mBind_And_Trail(ptd0, (CELL) ptf);
510 if (TR + 32 >= (tr_fr_ptr) LOCAL_TrailTop) {
511 return stt->err = RESOURCE_ERROR_TRAIL;
512 }
513 }
514 }
515 if (to_visit <= to_visit0) {
516 return 0;
517 }
518 to_visit--;
519 pt0 = to_visit->pt0;
520 pt0_end = to_visit->pt0_end;
521 ptf = to_visit->ptf;
522 myt = to_visit->t;
523 VUNMARK(to_visit->oldp, to_visit->oldv);
524 ground = (ground && to_visit->ground);
525 } while (true);
526 return 0;
527}
528
529Term CopyTermToArena(Term t,
530 bool share, bool copy_att_vars,
531 yap_error_number *errp,
532 Term *arenap, Term *bindp USES_REGS) {
533 Ystack_t ystk, *stt = &ystk;
534 size_t expand_stack;
535 Functor f;
536 CELL *base;
537 t = Deref(t);
538 if (IsVarTerm(t)) {
539 if (arenap && *arenap) {
540 CELL *base = ArenaPt(*arenap);
541 CELL *end = ArenaLimit(*arenap);
542 RESET_VARIABLE(base);
543 base++;
544 *arenap = Yap_MkArena(base,end);
545 return (CELL)(base-1);
546 }
547 if (!IsAttVar(VarOfTerm(t)) || !copy_att_vars) {
548 HR++;
549 RESET_VARIABLE(HR - 1);
550 return (CELL) (HR - 1);
551 }
552 } else if (IsAtomOrIntTerm(t)) {
553 return t;
554 } else if (IsApplTerm(t) && IsExtensionFunctor((f = FunctorOfTerm(t)))) {
555 if (f == FunctorDBRef) {
556 return t;
557 } else {
558 CELL *end;
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) {
565 yhandle_t yt1, yt;
566 yt = Yap_InitHandle(t);
567 if (bindp)
568 yt1 = Yap_InitHandle(*bindp);
569 size_t nsize = Yap_InsertInGlobal(end, (sz + 4 * MIN_ARENA_SIZE) * CellSize, &end) / CellSize;
570 if (bindp)
571 *bindp = Yap_PopHandle(yt1);
572 t = Yap_PopHandle(yt);
573 sz = sz0 + nsize;
574 base = end - sz;
575 if (sz0 < sz + MIN_ARENA_SIZE) {
576 stt->err = RESOURCE_ERROR_STACK;
577 } else {
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);
582 return tf;
583 }
584 } else {
585 while (HR + (MIN_ARENA_SIZE + sz) > ASP) {
586 yhandle_t yt1, yt;
587 yt = Yap_InitHandle(t);
588 if (bindp)
589 yt1 = Yap_InitHandle(*bindp);
590 if (!Yap_dogcl(2 * MIN_ARENA_SIZE + sz PASS_REGS)) {
591 stt->err = RESOURCE_ERROR_STACK;
592 break;
593 }
594 if (bindp)
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);
600 HR += szop;
601 return tf;
602 }
603 }
604 }
605 }
606 }
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;
613 stt->pt0 = NULL;
614 init_stack(stt);
615 while (true) {
616 CELL *ap = &t;
617 CELL *pf;
618 CELL *hr, *asp;
619 hr = HR;
620 asp = ASP;
621 if (arenap && *arenap) {
622 CELL *start = ArenaPt(*arenap);
623 CELL *end = ArenaLimit(*arenap);
624 HR = start;
625 ASP = end;
626 }
627 HB = HR;
628 pf = HR;
629 stt->err = YAP_NO_ERROR;
630 stt->err = copy_complex_term(ap - 1, ap, share, copy_att_vars, pf, bindp,
631 stt PASS_REGS);
632 if (arenap && *arenap) {
633 CELL *start = stt->err==YAP_NO_ERROR ? HR : HB;
634 *arenap = Yap_MkArena(start, ASP);
635 HR = hr;
636 ASP = asp;
637 } else if (stt->err!=YAP_NO_ERROR) {
638 HR=HB;
639 }
640
641 HB = B->cp_h;
642 // done, exit!
643 if (stt->err == YAP_NO_ERROR) {
644 if (!share) {
645 clean_tr(B->cp_tr+stt->tr0 PASS_REGS);
646 TR = B->cp_tr+stt->tr0;
647 }
648 pop_text_stack(i);
649 if (IsVarTerm(t))
650 return (CELL) pf;
651 if (IsApplTerm(t))
652 return AbsAppl(pf);
653 return AbsPair(pf);
654 } else {
655 while (to_visit > to_visit0) {
656 to_visit--;
657
658 VUNMARK(to_visit->oldp, to_visit->oldv);
659 } /* restore our nice, friendly, term to its original state */
660 clean_tr(B->cp_tr+stt->tr0 PASS_REGS);
661 TR = B->cp_tr+stt->tr0;
662 if (errp && *errp) {
663 return 0;
664 }
665 yhandle_t yt1, yt;
666 yt = Yap_InitHandle(t);
667 if (bindp)
668 yt1 = Yap_InitHandle(*bindp);
669 visitor_error_handler(stt->err, HB, ASP, expand_stack, arenap);
670 if (bindp)
671 *bindp = Yap_PopHandle(yt1);
672 stt->t = t = Yap_PopHandle(yt);
673 stt->err = YAP_NO_ERROR;
674 }
675 }
676}
677
678
679Term Yap_CopyTerm(Term inp) {
680 CACHE_REGS
681 return CopyTermToArena(inp, false, true, NULL, NULL, NULL PASS_REGS);
682}
683
684Term Yap_CopyTermNoShare(Term inp) {
685 CACHE_REGS
686
687 COPY(inp);
688 return CopyTermToArena(inp, false, true , NULL, NULL, NULL PASS_REGS);
689}
690
707static Int p_copy_term(USES_REGS1) /* copy term t to a new instance */
708{
709 COPY(ARG1);
710 Term t;
711 yap_error_number err = YAP_NO_ERROR;
712 do {
713 Term inp = MkGlobal(Deref(ARG1));
714 CELL *hb = HR, *asp = ASP;
715 t = CopyTermToArena(inp, false, true , &err, NULL, NULL PASS_REGS);
716 if (t == 0L)
717 visitor_error_handler( err, hb, asp,
718 0, NULL);
719 } while (err);
720
721 /* be careful, there may be a stack shift here */
722 return Yap_unify(ARG2, t);
723 }
724
738static Int p_duplicate_term(USES_REGS1) /* copy term t to a new instance */
739{
740 COPY(ARG1);
741 Term t;
742 yap_error_number err = YAP_NO_ERROR;
743 do {
744 CELL *hb = HR, *asp = ASP;
745 Term inp = MkGlobal(Deref(ARG1));
746 t = CopyTermToArena(inp, false, true , &err, NULL, NULL PASS_REGS);
747 if (t == 0L)
748 visitor_error_handler( err, hb, asp,
749 0, NULL);
750 } while (err);
751
752 /* be careful, there may be a stack shift here */
753 return Yap_unify(ARG2, t);
754}
755
769static Int
770rational_tree_to_forest(USES_REGS1) /* copy term t to a new instance */
771{
772 COPY(ARG1);
773 Term list = Deref(ARG4);
774 Term t;
775 yap_error_number err = YAP_NO_ERROR;
776 do {
777 CELL *hb = HR, *asp = ASP;
778 Term inp = MkGlobal(Deref(ARG1));
779 COPY(ARG1);
780 t = CopyTermToArena(inp, true, false ,&err, NULL, &list PASS_REGS);
781 if (t == 0L)
782 visitor_error_handler( err, hb, asp,
783 0, NULL);
784 } while (err);
785
786 /* be careful, there may be a stack shift here */
787 Term t2 = ARG2;
788 Term t3 = ARG3;
789 return Yap_unify(t2, t) && Yap_unify(t3, list);
790}
791
792Term Yap_TermAsForest(Term t1) /* copy term t to a new instance */
793{
794 Term list = TermNil;
795 Term t = CopyTermToArena(t1, true, false , NULL, NULL, &list PASS_REGS);
796 if (t == 0L)
797 return FALSE;
798 /* be careful, there may be a stack shift here */
799 Term ts[2];
800 ts[0] = t;
801 ts[1] = list;
802 return Yap_MkApplTerm(FunctorAtSymbol, 2, ts);
803}
804
815static Int
816p_copy_term_no_delays(USES_REGS1) /* copy term t to a new instance */
817{
818 COPY(ARG1);
819 yap_error_number err = YAP_NO_ERROR;
820 Term t;
821 do {
822 CELL *hb = HR, *asp = ASP;
823 Term inp = MkGlobal(Deref(ARG1));
824 t = CopyTermToArena(inp, false, false , &err, NULL, NULL PASS_REGS);
825 if (t == 0L)
826 visitor_error_handler( err, hb, asp,
827 0, NULL);
828 } while (err);
829
830 /* be careful, there may be a stack shift here */
831 return Yap_unify(ARG2, t);
832}
833
834
835
836void Yap_InitCopyTerm(void) {
837 CACHE_REGS
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);
845 CurrentModule = cm;
846}
847
Main definitions.
Definition: terms.h:25