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: non backtrackable term support *
12 * Last rev: 2/8/06 *
13 * mods: *
14 * comments: non-backtrackable term support *
15 * *
16 *************************************************************************/
17 #ifdef SCCS
18 static char SccsId[] = "%W% %G%";
19 #endif
20
21 #include "Yap.h"
22 #include "Yatom.h"
23 #include "YapHeap.h"
24 #include "yapio.h"
25 #include "iopreds.h"
26 #include "attvar.h"
27 #include "eval.h"
28 #include <math.h>
29
30 /* Non-backtrackable terms will from now on be stored on arenas, a
31 special term on the heap. Arenas automatically contract as we add terms to
32 the front.
33
34 */
35
36 #define QUEUE_FUNCTOR_ARITY 4
37
38 #define QUEUE_ARENA 0
39 #define QUEUE_HEAD 1
40 #define QUEUE_TAIL 2
41 #define QUEUE_SIZE 3
42
43 #define HEAP_FUNCTOR_MIN_ARITY
44
45 #define HEAP_SIZE 0
46 #define HEAP_MAX 1
47 #define HEAP_ARENA 2
48 #define HEAP_START 3
49
50 #define MIN_ARENA_SIZE 1048
51 #define MAX_ARENA_SIZE (2048*16)
52
53 #define Global_MkIntegerTerm(I) MkIntegerTerm(I)
54
55 static UInt
big2arena_sz(CELL * arena_base)56 big2arena_sz(CELL *arena_base)
57 {
58 return (((MP_INT*)(arena_base+2))->_mp_alloc*sizeof(mp_limb_t) + sizeof(MP_INT) + sizeof(Functor)+2*sizeof(CELL))/sizeof(CELL);
59 }
60
61 static UInt
arena2big_sz(UInt sz)62 arena2big_sz(UInt sz)
63 {
64 return sz - (sizeof(MP_INT) + sizeof(Functor) + 2*sizeof(CELL))/sizeof(CELL);
65 }
66
67
68 /* pointer to top of an arena */
69 static inline CELL *
ArenaLimit(Term arena)70 ArenaLimit(Term arena)
71 {
72 CELL *arena_base = RepAppl(arena);
73 UInt sz = big2arena_sz(arena_base);
74 return arena_base+sz;
75 }
76
77 /* pointer to top of an arena */
78 static inline CELL *
ArenaPt(Term arena)79 ArenaPt(Term arena)
80 {
81 return (CELL *)RepAppl(arena);
82 }
83
84 static inline UInt
ArenaSz(Term arena)85 ArenaSz(Term arena)
86 {
87 return big2arena_sz(RepAppl(arena));
88 }
89
90 static Term
CreateNewArena(CELL * ptr,UInt size)91 CreateNewArena(CELL *ptr, UInt size)
92 {
93 Term t = AbsAppl(ptr);
94 MP_INT *dst;
95
96 ptr[0] = (CELL)FunctorBigInt;
97 ptr[1] = EMPTY_ARENA;
98 dst = (MP_INT *)(ptr+2);
99 dst->_mp_size = 0L;
100 dst->_mp_alloc = (sizeof(CELL)/sizeof(mp_limb_t))*arena2big_sz(size);
101 ptr[size-1] = EndSpecials;
102 return t;
103 }
104
105 static Term
NewArena(UInt size,UInt arity,CELL * where)106 NewArena(UInt size, UInt arity, CELL *where)
107 {
108 Term t;
109 UInt new_size;
110
111 if (where == NULL || where == H) {
112 while (H+size > ASP-1024) {
113 if (!Yap_gcl(size*sizeof(CELL), arity, ENV, P)) {
114 Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
115 return TermNil;
116 }
117 }
118 t = CreateNewArena(H, size);
119 H += size;
120 } else {
121 if ((new_size=Yap_InsertInGlobal(where, size*sizeof(CELL)))==0) {
122 Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms");
123 return TermNil;
124 }
125 size = new_size/sizeof(CELL);
126 t = CreateNewArena(where, size);
127 }
128 return t;
129 }
130
131 static Int
p_allocate_arena(void)132 p_allocate_arena(void)
133 {
134 Term t = Deref(ARG1);
135 if (IsVarTerm(t)) {
136 Yap_Error(INSTANTIATION_ERROR,t,"allocate_arena");
137 return FALSE;
138 } else if (!IsIntegerTerm(t)) {
139 Yap_Error(TYPE_ERROR_INTEGER,t,"allocate_arena");
140 return FALSE;
141 }
142 return Yap_unify(ARG2,NewArena(IntegerOfTerm(t), 1, NULL));
143 }
144
145
146 static Int
p_default_arena_size(void)147 p_default_arena_size(void)
148 {
149 return Yap_unify(ARG1,MkIntegerTerm(ArenaSz(GlobalArena)));
150 }
151
152
153 void
Yap_AllocateDefaultArena(Int gsize,Int attsize)154 Yap_AllocateDefaultArena(Int gsize, Int attsize)
155 {
156 GlobalArena = NewArena(gsize, 2, NULL);
157 }
158
159 static void
adjust_cps(UInt size)160 adjust_cps(UInt size)
161 {
162 /* adjust possible back pointers in choice-point stack */
163 choiceptr b_ptr = B;
164 while (b_ptr->cp_h == H) {
165 b_ptr->cp_h += size;
166 b_ptr = b_ptr->cp_b;
167 }
168 }
169
170
171 static int
GrowArena(Term arena,CELL * pt,UInt old_size,UInt size,UInt arity)172 GrowArena(Term arena, CELL *pt, UInt old_size, UInt size, UInt arity)
173 {
174 ArenaOverflows++;
175 if (size == 0) {
176 if (old_size < 128*1024) {
177 size = old_size;
178 } else {
179 size = old_size+128*1024;
180 }
181 }
182 if (size < 4096) {
183 size = 4096;
184 }
185 if (pt == H) {
186 if (H+size > ASP-1024) {
187
188 XREGS[arity+1] = arena;
189 if (!Yap_gcl(size*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) {
190 Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
191 return FALSE;
192 }
193 arena = XREGS[arity+1];
194 /* we don't know if the GC added junk on top of the global */
195 pt = ArenaLimit(arena);
196 return GrowArena(arena, pt, old_size, size, arity);
197 }
198 adjust_cps(size);
199 H += size;
200 } else {
201 XREGS[arity+1] = arena;
202 /* try to recover some room */
203 if (arena == GlobalArena && 10*(pt-H0) > 8*(H-H0)) {
204 if (!Yap_gcl(size*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) {
205 Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
206 return FALSE;
207 }
208 }
209 arena = XREGS[arity+1];
210 pt = ArenaLimit(arena);
211 if ((size=Yap_InsertInGlobal(pt, size*sizeof(CELL)))==0) {
212 return FALSE;
213 }
214 size = size/sizeof(CELL);
215 arena = XREGS[arity+1];
216 }
217 CreateNewArena(ArenaPt(arena), size+old_size);
218 return TRUE;
219 }
220
221 int
Yap_GrowGlobalArena(UInt size)222 Yap_GrowGlobalArena(UInt size)
223 {
224 UInt old_size = ArenaSz(GlobalArena);
225 CELL *pt = ArenaLimit(GlobalArena);
226
227 GlobalArenaOverflows++;
228 if ((size=Yap_InsertInGlobal(pt, size*sizeof(CELL)))==0) {
229 return FALSE;
230 }
231 size /= sizeof(CELL);
232 CreateNewArena(ArenaPt(GlobalArena), size+old_size);
233 return TRUE;
234 }
235
236 CELL *
Yap_GetFromArena(Term * arenap,UInt cells,UInt arity)237 Yap_GetFromArena(Term *arenap, UInt cells, UInt arity)
238 {
239 restart:
240 {
241 Term arena = *arenap;
242 CELL *max = ArenaLimit(arena);
243 CELL *base = ArenaPt(arena);
244 CELL *newH;
245 UInt old_sz = ArenaSz(arena), new_size;
246
247 if (IN_BETWEEN(base, H, max)) {
248 base = H;
249 H += cells;
250 return base;
251 }
252 if (base+cells > max-1024) {
253 if (!GrowArena(arena, max, old_sz, old_sz+sizeof(CELL)*1024, arity))
254 return NULL;
255 goto restart;
256 }
257
258 newH = base+cells;
259 new_size = old_sz - cells;
260 *arenap = CreateNewArena(newH, new_size);
261 return base;
262 }
263 }
264
265 static void
CloseArena(CELL * oldH,CELL * oldHB,CELL * oldASP,Term * oldArenaP,UInt old_size)266 CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP, UInt old_size)
267 {
268 UInt new_size;
269
270 if (H == oldH)
271 return;
272 new_size = old_size - (H-RepAppl(*oldArenaP));
273 *oldArenaP = CreateNewArena(H, new_size);
274 H = oldH;
275 HB = oldHB;
276 ASP = oldASP;
277 }
278
279 static inline void
clean_dirty_tr(tr_fr_ptr TR0)280 clean_dirty_tr(tr_fr_ptr TR0) {
281 if (TR != TR0) {
282 tr_fr_ptr pt = TR0;
283
284 do {
285 Term p = TrailTerm(pt++);
286 if (IsVarTerm(p)) {
287 RESET_VARIABLE(p);
288 } else {
289 /* copy downwards */
290 TrailTerm(TR0+1) = TrailTerm(pt);
291 TrailTerm(TR0) = TrailTerm(TR0+2) = p;
292 pt+=2;
293 TR0 += 3;
294 }
295 } while (pt != TR);
296 TR = TR0;
297 }
298 }
299
300 static int
copy_complex_term(register CELL * pt0,register CELL * pt0_end,int share,int copy_att_vars,CELL * ptf,CELL * HLow)301 copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int copy_att_vars, CELL *ptf, CELL *HLow)
302 {
303
304 struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace();
305 CELL *HB0 = HB;
306 tr_fr_ptr TR0 = TR;
307 int ground = TRUE;
308 #ifdef COROUTINING
309 CELL *dvarsmin = NULL, *dvarsmax=NULL;
310 #endif
311
312 HB = HLow;
313 to_visit0 = to_visit;
314 loop:
315 while (pt0 < pt0_end) {
316 register CELL d0;
317 register CELL *ptd0;
318 ++ pt0;
319 ptd0 = pt0;
320 d0 = *ptd0;
321 deref_head(d0, copy_term_unk);
322 copy_term_nvar:
323 {
324 if (IsPairTerm(d0)) {
325 CELL *ap2 = RepPair(d0);
326 if ((share && ap2 < HB) ||
327 (ap2 >= HB && ap2 < H)) {
328 /* If this is newer than the current term, just reuse */
329 *ptf++ = d0;
330 continue;
331 }
332 *ptf = AbsPair(H);
333 ptf++;
334 #ifdef RATIONAL_TREES
335 if (to_visit+1 >= (struct cp_frame *)AuxSp) {
336 goto heap_overflow;
337 }
338 to_visit->start_cp = pt0;
339 to_visit->end_cp = pt0_end;
340 to_visit->to = ptf;
341 to_visit->oldv = *pt0;
342 to_visit->ground = ground;
343 /* fool the system into thinking we had a variable there */
344 *pt0 = AbsPair(H);
345 to_visit ++;
346 #else
347 if (pt0 < pt0_end) {
348 if (to_visit + 1 >= (CELL **)AuxSp) {
349 goto heap_overflow;
350 }
351 to_visit->start_cp = pt0;
352 to_visit->end_cp = pt0_end;
353 to_visit->to = ptf;
354 to_visit->ground = ground;
355 to_visit ++;
356 }
357 #endif
358 ground = TRUE;
359 pt0 = ap2 - 1;
360 pt0_end = ap2 + 1;
361 ptf = H;
362 H += 2;
363 if (H > ASP - MIN_ARENA_SIZE) {
364 goto overflow;
365 }
366 } else if (IsApplTerm(d0)) {
367 register Functor f;
368 register CELL *ap2;
369 /* store the terms to visit */
370 ap2 = RepAppl(d0);
371 if ((share && ap2 < HB) ||
372 (ap2 >= HB && ap2 < H)) {
373 /* If this is newer than the current term, just reuse */
374 *ptf++ = d0;
375 continue;
376 }
377 f = (Functor)(*ap2);
378
379 if (IsExtensionFunctor(f)) {
380 switch((CELL)f) {
381 case (CELL)FunctorDBRef:
382 case (CELL)FunctorAttVar:
383 *ptf++ = d0;
384 break;
385 case (CELL)FunctorLongInt:
386 if (H > ASP - (MIN_ARENA_SIZE+3)) {
387 goto overflow;
388 }
389 *ptf++ = AbsAppl(H);
390 H[0] = (CELL)f;
391 H[1] = ap2[1];
392 H[2] = EndSpecials;
393 H += 3;
394 if (H > ASP - MIN_ARENA_SIZE) {
395 goto overflow;
396 }
397 break;
398 case (CELL)FunctorDouble:
399 if (H > ASP - (MIN_ARENA_SIZE+(2+SIZEOF_DOUBLE/sizeof(CELL)))) {
400 goto overflow;
401 }
402 *ptf++ = AbsAppl(H);
403 H[0] = (CELL)f;
404 H[1] = ap2[1];
405 #if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
406 H[2] = ap2[2];
407 H[3] = EndSpecials;
408 H += 4;
409 #else
410 H[2] = EndSpecials;
411 H += 3;
412 #endif
413 break;
414 default:
415 {
416 /* big int */
417 UInt sz = (sizeof(MP_INT)+3*CellSize+
418 ((MP_INT *)(ap2+2))->_mp_alloc*sizeof(mp_limb_t))/CellSize, i;
419
420 if (H > ASP - (MIN_ARENA_SIZE+sz)) {
421 goto overflow;
422 }
423 *ptf++ = AbsAppl(H);
424 H[0] = (CELL)f;
425 for (i = 1; i < sz; i++) {
426 H[i] = ap2[i];
427 }
428 H += sz;
429 }
430 }
431 continue;
432 }
433 *ptf = AbsAppl(H);
434 ptf++;
435 /* store the terms to visit */
436 #ifdef RATIONAL_TREES
437 if (to_visit+1 >= (struct cp_frame *)AuxSp) {
438 goto heap_overflow;
439 }
440 to_visit->start_cp = pt0;
441 to_visit->end_cp = pt0_end;
442 to_visit->to = ptf;
443 to_visit->oldv = *pt0;
444 to_visit->ground = ground;
445 /* fool the system into thinking we had a variable there */
446 *pt0 = AbsAppl(H);
447 to_visit ++;
448 #else
449 if (pt0 < pt0_end) {
450 if (to_visit ++ >= (CELL **)AuxSp) {
451 goto heap_overflow;
452 }
453 to_visit->start_cp = pt0;
454 to_visit->end_cp = pt0_end;
455 to_visit->to = ptf;
456 to_visit->ground = ground;
457 to_visit ++;
458 }
459 #endif
460 ground = (f != FunctorMutable);
461 d0 = ArityOfFunctor(f);
462 pt0 = ap2;
463 pt0_end = ap2 + d0;
464 /* store the functor for the new term */
465 H[0] = (CELL)f;
466 ptf = H+1;
467 H += 1+d0;
468 if (H > ASP - MIN_ARENA_SIZE) {
469 goto overflow;
470 }
471 } else {
472 /* just copy atoms or integers */
473 *ptf++ = d0;
474 }
475 continue;
476 }
477
478 derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar);
479 ground = FALSE;
480 /* don't need to copy variables if we want to share the global term */
481 if ((share && ptd0 < HB && ptd0 > H0) ||
482 (ptd0 >= HLow && ptd0 < H)) {
483 /* we have already found this cell */
484 *ptf++ = (CELL) ptd0;
485 } else {
486 #if COROUTINING
487 if (copy_att_vars && IsAttachedTerm((CELL)ptd0)) {
488 /* if unbound, call the standard copy term routine */
489 struct cp_frame *bp;
490 if (IN_BETWEEN(dvarsmin, ptd0, dvarsmax)) {
491 *ptf++ = (CELL) ptd0;
492 } else {
493 CELL new;
494 CELL *max = ArenaLimit(GlobalArena);
495 CELL *base = ArenaPt(GlobalArena);
496
497 if (base+2*sizeof(attvar_record)/sizeof(CELL) > max-1024) {
498 goto arena_overflow;
499 }
500 bp = to_visit;
501 if (!attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf)) {
502 goto overflow;
503 }
504 to_visit = bp;
505 new = *ptf;
506 if (TR > (tr_fr_ptr)Yap_TrailTop - 256) {
507 /* Trail overflow */
508 if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
509 goto trail_overflow;
510 }
511 }
512 *ptd0 = new;
513 if (dvarsmin == NULL) {
514 dvarsmin = CellPtr(new);
515 }
516 dvarsmax = CellPtr(new)+1;
517 ptf++;
518 }
519 } else {
520 #endif
521 /* first time we met this term */
522 RESET_VARIABLE(ptf);
523 if ((ADDR)TR > Yap_TrailTop-MIN_ARENA_SIZE)
524 goto trail_overflow;
525 Bind_and_Trail(ptd0, (CELL)ptf);
526 ptf++;
527 #ifdef COROUTINING
528 }
529 #endif
530 }
531 }
532
533 /* Do we still have compound terms to visit */
534 if (to_visit > to_visit0) {
535 to_visit --;
536 pt0 = to_visit->start_cp;
537 pt0_end = to_visit->end_cp;
538 ptf = to_visit->to;
539 #ifdef RATIONAL_TREES
540 *pt0 = to_visit->oldv;
541 #endif
542 ground = (ground && to_visit->ground);
543 goto loop;
544 }
545
546 /* restore our nice, friendly, term to its original state */
547 HB = HB0;
548 clean_dirty_tr(TR0);
549 /* follow chain of multi-assigned variables */
550 return 0;
551
552 overflow:
553 /* oops, we're in trouble */
554 H = HLow;
555 /* we've done it */
556 /* restore our nice, friendly, term to its original state */
557 HB = HB0;
558 #ifdef RATIONAL_TREES
559 while (to_visit > to_visit0) {
560 to_visit --;
561 pt0 = to_visit->start_cp;
562 pt0_end = to_visit->end_cp;
563 ptf = to_visit->to;
564 *pt0 = to_visit->oldv;
565 }
566 #endif
567 reset_trail(TR0);
568 return -1;
569
570 heap_overflow:
571 /* oops, we're in trouble */
572 H = HLow;
573 /* we've done it */
574 /* restore our nice, friendly, term to its original state */
575 HB = HB0;
576 #ifdef RATIONAL_TREES
577 while (to_visit > to_visit0) {
578 to_visit--;
579 pt0 = to_visit->start_cp;
580 pt0_end = to_visit->end_cp;
581 ptf = to_visit->to;
582 *pt0 = to_visit->oldv;
583 }
584 #endif
585 reset_trail(TR0);
586 return -2;
587
588 trail_overflow:
589 /* oops, we're in trouble */
590 H = HLow;
591 /* we've done it */
592 /* restore our nice, friendly, term to its original state */
593 HB = HB0;
594 #ifdef RATIONAL_TREES
595 while (to_visit > to_visit0) {
596 to_visit--;
597 pt0 = to_visit->start_cp;
598 pt0_end = to_visit->end_cp;
599 ptf = to_visit->to;
600 *pt0 = to_visit->oldv;
601 }
602 #endif
603 reset_trail(TR0);
604 return -4;
605
606 arena_overflow:
607 /* oops, we're in trouble */
608 H = HLow;
609 /* we've done it */
610 /* restore our nice, friendly, term to its original state */
611 HB = HB0;
612 #ifdef RATIONAL_TREES
613 while (to_visit > to_visit0) {
614 to_visit--;
615 pt0 = to_visit->start_cp;
616 pt0_end = to_visit->end_cp;
617 ptf = to_visit->to;
618 *pt0 = to_visit->oldv;
619 }
620 #endif
621 reset_trail(TR0);
622 return -5;
623 }
624
625 static Term
CopyTermToArena(Term t,Term arena,int share,int copy_att_vars,UInt arity,Term * newarena,UInt min_grow)626 CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Term *newarena, UInt min_grow)
627 {
628 UInt old_size = ArenaSz(arena);
629 CELL *oldH = H;
630 CELL *oldHB = HB;
631 CELL *oldASP = ASP;
632 int res = 0;
633 Term tn;
634
635 restart:
636 t = Deref(t);
637 if (IsVarTerm(t)) {
638 ASP = ArenaLimit(arena);
639 H = HB = ArenaPt(arena);
640 #if COROUTINING
641 if (IsAttachedTerm(t)) {
642 CELL *Hi;
643
644 *H = t;
645 Hi = H+1;
646 H += 2;
647 if ((res = copy_complex_term(Hi-2, Hi-1, share, copy_att_vars, Hi, Hi)) < 0)
648 goto error_handler;
649 CloseArena(oldH, oldHB, oldASP, newarena, old_size);
650 return Hi[0];
651 }
652 #endif
653 if (share && VarOfTerm(t) > ArenaPt(arena)) {
654 CloseArena(oldH, oldHB, oldASP, newarena, old_size);
655 return t;
656 }
657 tn = MkVarTerm();
658 if (H > ASP - MIN_ARENA_SIZE) {
659 res = -1;
660 goto error_handler;
661 }
662 CloseArena(oldH, oldHB, oldASP, newarena, old_size);
663 return tn;
664 } else if (IsAtomOrIntTerm(t)) {
665 return t;
666 } else if (IsPairTerm(t)) {
667 Term tf;
668 CELL *ap;
669 CELL *Hi;
670
671 if (share && ArenaPt(arena) > RepPair(t)) {
672 return t;
673 }
674 H = HB = ArenaPt(arena);
675 ASP = ArenaLimit(arena);
676 ap = RepPair(t);
677 Hi = H;
678 tf = AbsPair(H);
679 H += 2;
680 if ((res = copy_complex_term(ap-1, ap+1, share, copy_att_vars, Hi, Hi)) < 0) {
681 goto error_handler;
682 }
683 CloseArena(oldH, oldHB, oldASP, newarena, old_size);
684 return tf;
685 } else {
686 Functor f;
687 Term tf;
688 CELL *HB0;
689 CELL *ap;
690
691 if (share && ArenaPt(arena) > RepAppl(t)) {
692 return t;
693 }
694 H = HB = ArenaPt(arena);
695 ASP = ArenaLimit(arena);
696 f = FunctorOfTerm(t);
697 HB0 = H;
698 ap = RepAppl(t);
699 tf = AbsAppl(H);
700 H[0] = (CELL)f;
701 if (IsExtensionFunctor(f)) {
702 switch((CELL)f) {
703 case (CELL)FunctorDBRef:
704 CloseArena(oldH, oldHB, oldASP, newarena, old_size);
705 return t;
706 case (CELL)FunctorLongInt:
707 if (H > ASP - (MIN_ARENA_SIZE+3)) {
708 res = -1;
709 goto error_handler;
710 }
711 H[1] = ap[1];
712 H[2] = EndSpecials;
713 H += 3;
714 break;
715 case (CELL)FunctorDouble:
716 if (H > ASP - (MIN_ARENA_SIZE+(2+SIZEOF_DOUBLE/sizeof(CELL)))) {
717 res = -1;
718 goto error_handler;
719 }
720 H[1] = ap[1];
721 #if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
722 H[2] = ap[2];
723 H[3] = EndSpecials;
724 H += 4;
725 #else
726 H[2] = EndSpecials;
727 H += 3;
728 #endif
729 break;
730 default:
731 {
732 UInt sz = ArenaSz(t), i;
733
734 if (H > ASP - (MIN_ARENA_SIZE+sz)) {
735 res = -1;
736 goto error_handler;
737 }
738 for (i = 1; i < sz; i++) {
739 H[i] = ap[i];
740 }
741 H += sz;
742 }
743 }
744 } else {
745 H += 1+ArityOfFunctor(f);
746 if (H > ASP-MIN_ARENA_SIZE) {
747 res = -1;
748 goto error_handler;
749 }
750 if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, copy_att_vars, HB0+1, HB0)) < 0) {
751 goto error_handler;
752 }
753 }
754 CloseArena(oldH, oldHB, oldASP, newarena, old_size);
755 return tf;
756 }
757 error_handler:
758 H = HB;
759 CloseArena(oldH, oldHB, oldASP, newarena, old_size);
760 XREGS[arity+1] = t;
761 XREGS[arity+2] = arena;
762 XREGS[arity+3] = (CELL)newarena;
763 {
764 CELL *old_top = ArenaLimit(*newarena);
765 ASP = oldASP;
766 H = oldH;
767 HB = oldHB;
768 switch (res) {
769 case -1:
770 if (arena == GlobalArena)
771 GlobalArenaOverflows++;
772 if (!GrowArena(arena, old_top, old_size, min_grow, arity+3)) {
773 Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
774 return 0L;
775 }
776 break;
777 case -5:
778 GlobalArenaOverflows++;
779 if (!GrowArena(GlobalArena, old_top, old_size, min_grow, arity+3)) {
780 Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
781 return 0L;
782 }
783 break;
784 default: /* temporary space overflow */
785 if (!Yap_ExpandPreAllocCodeSpace(0,NULL,TRUE)) {
786 Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage);
787 return 0L;
788 }
789 }
790 }
791 oldH = H;
792 oldHB = HB;
793 oldASP = ASP;
794 newarena = (CELL *)XREGS[arity+3];
795 arena = Deref(XREGS[arity+2]);
796 t = XREGS[arity+1];
797 old_size = ArenaSz(arena);
798 goto restart;
799 }
800
801 static Term
CreateTermInArena(Term arena,Atom Na,UInt Nar,UInt arity,Term * newarena,Term init)802 CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity, Term *newarena, Term init)
803 {
804 UInt old_size = ArenaSz(arena);
805 CELL *oldH = H;
806 CELL *oldHB = HB;
807 CELL *oldASP = ASP;
808 Term tf;
809 CELL *HB0;
810 Functor f = Yap_MkFunctor(Na, Nar);
811 UInt i;
812
813 restart:
814 H = HB = ArenaPt(arena);
815 ASP = ArenaLimit(arena);
816 HB0 = H;
817 tf = AbsAppl(H);
818 H[0] = (CELL)f;
819 H += 1+ArityOfFunctor(f);
820 if (H > ASP-MIN_ARENA_SIZE) {
821 /* overflow */
822 H = HB;
823 CloseArena(oldH, oldHB, oldASP, newarena, old_size);
824 XREGS[arity+1] = arena;
825 XREGS[arity+2] = (CELL)newarena;
826 {
827 CELL *old_top = ArenaLimit(*newarena);
828 ASP = oldASP;
829 H = oldH;
830 HB = oldHB;
831 if (arena == GlobalArena)
832 GlobalArenaOverflows++;
833 if (!GrowArena(arena, old_top, old_size, Nar*sizeof(CELL), arity+2)) {
834 Yap_Error(OUT_OF_STACK_ERROR, TermNil, "while creating large global term");
835 return 0L;
836 }
837 }
838 oldH = H;
839 oldHB = HB;
840 oldASP = ASP;
841 newarena = (CELL *)XREGS[arity+2];
842 arena = Deref(XREGS[arity+1]);
843 old_size = ArenaSz(arena);
844 goto restart;
845 }
846 if (init == 0L) {
847 for (i=1; i<=Nar; i++) {
848 RESET_VARIABLE(HB0+i);
849 }
850 } else {
851 for (i=1; i<=Nar; i++) {
852 HB0[i] = init;
853 }
854 }
855 CloseArena(oldH, oldHB, oldASP, newarena, old_size);
856 return tf;
857 }
858
859 inline static GlobalEntry *
FindGlobalEntry(Atom at)860 FindGlobalEntry(Atom at)
861 /* get predicate entry for ap/arity; create it if neccessary. */
862 {
863 Prop p0;
864 AtomEntry *ae = RepAtom(at);
865
866 READ_LOCK(ae->ARWLock);
867 p0 = ae->PropsOfAE;
868 while (p0) {
869 GlobalEntry *pe = RepGlobalProp(p0);
870 if ( pe->KindOfPE == GlobalProperty
871 #if THREADS
872 && pe->owner_id == worker_id
873 #endif
874 ) {
875 READ_UNLOCK(ae->ARWLock);
876 return pe;
877 }
878 p0 = pe->NextOfPE;
879 }
880 READ_UNLOCK(ae->ARWLock);
881 return NULL;
882 }
883
884 inline static GlobalEntry *
GetGlobalEntry(Atom at)885 GetGlobalEntry(Atom at)
886 /* get predicate entry for ap/arity; create it if neccessary. */
887 {
888 Prop p0;
889 AtomEntry *ae = RepAtom(at);
890 GlobalEntry *new;
891
892 WRITE_LOCK(ae->ARWLock);
893 p0 = ae->PropsOfAE;
894 while (p0) {
895 GlobalEntry *pe = RepGlobalProp(p0);
896 if ( pe->KindOfPE == GlobalProperty
897 #if THREADS
898 && pe->owner_id == worker_id
899 #endif
900 ) {
901 WRITE_UNLOCK(ae->ARWLock);
902 return pe;
903 }
904 p0 = pe->NextOfPE;
905 }
906 new = (GlobalEntry *) Yap_AllocAtomSpace(sizeof(*new));
907 INIT_RWLOCK(new->GRWLock);
908 new->KindOfPE = GlobalProperty;
909 #if THREADS
910 new->owner_id = worker_id;
911 #endif
912 new->NextGE = GlobalVariables;
913 GlobalVariables = new;
914 new->AtomOfGE = ae;
915 new->NextOfPE = ae->PropsOfAE;
916 ae->PropsOfAE = AbsGlobalProp(new);
917 RESET_VARIABLE(&new->global);
918 WRITE_UNLOCK(ae->ARWLock);
919 return new;
920 }
921
922 static UInt
garena_overflow_size(CELL * arena)923 garena_overflow_size(CELL *arena)
924 {
925 UInt dup = (((CELL *)arena-H0)*sizeof(CELL))>>3;
926 if (dup < 64*1024*GlobalArenaOverflows)
927 dup = 64*1024*GlobalArenaOverflows;
928 if (dup > 1024*1024)
929 return 1024*1024;
930 return dup;
931 }
932
933 static Int
p_nb_setarg(void)934 p_nb_setarg(void)
935 {
936 Term wheret = Deref(ARG1);
937 Term dest = Deref(ARG2);
938 Term to;
939 UInt arity, pos;
940 CELL *destp;
941
942 if (IsVarTerm(wheret)) {
943 Yap_Error(INSTANTIATION_ERROR,wheret,"nb_setarg");
944 return FALSE;
945 }
946 if (!IsIntegerTerm(wheret)) {
947 Yap_Error(TYPE_ERROR_INTEGER,wheret,"nb_setarg");
948 return FALSE;
949 }
950 pos = IntegerOfTerm(wheret);
951 if (IsVarTerm(dest)) {
952 Yap_Error(INSTANTIATION_ERROR,dest,"nb_setarg");
953 return FALSE;
954 } else if (IsPrimitiveTerm(dest)) {
955 arity = 0;
956 } else if (IsPairTerm(dest)) {
957 arity = 2;
958 } else {
959 arity = ArityOfFunctor(FunctorOfTerm(dest));
960 }
961
962 if (pos < 1 || pos > arity)
963 return FALSE;
964 to = Deref(ARG3);
965 to = CopyTermToArena(ARG3, GlobalArena, FALSE, TRUE, 3, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
966 if (to == 0L)
967 return FALSE;
968 /* restart this in case there was a stack shift */
969 dest = Deref(ARG2);
970 if (IsPairTerm(dest)) {
971 destp = RepPair(dest)-1;
972 } else {
973 destp = RepAppl(dest);
974 }
975 destp[pos] = to;
976 return TRUE;
977 }
978
979 static Int
p_nb_set_shared_arg(void)980 p_nb_set_shared_arg(void)
981 {
982 Term wheret = Deref(ARG1);
983 Term dest = Deref(ARG2);
984 Term to;
985 UInt arity, pos;
986 CELL *destp;
987
988 if (IsVarTerm(wheret)) {
989 Yap_Error(INSTANTIATION_ERROR,wheret,"nb_setarg");
990 return FALSE;
991 }
992 if (!IsIntegerTerm(wheret)) {
993 Yap_Error(TYPE_ERROR_INTEGER,wheret,"nb_setarg");
994 return FALSE;
995 }
996 pos = IntegerOfTerm(wheret);
997 if (IsVarTerm(dest)) {
998 Yap_Error(INSTANTIATION_ERROR,dest,"nb_setarg");
999 return FALSE;
1000 } else if (IsPrimitiveTerm(dest)) {
1001 arity = 0;
1002 } else if (IsPairTerm(dest)) {
1003 arity = 2;
1004 } else {
1005 arity = ArityOfFunctor(FunctorOfTerm(dest));
1006 }
1007 if (pos < 1 || pos > arity)
1008 return FALSE;
1009 to = CopyTermToArena(ARG3, GlobalArena, TRUE, TRUE, 3, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
1010 if (to == 0L)
1011 return FALSE;
1012 /* in case there was garbage collection or stack shifting */
1013 dest = Deref(ARG2);
1014 if (IsPairTerm(dest)) {
1015 destp = RepPair(dest)-1;
1016 } else {
1017 destp = RepAppl(dest);
1018 }
1019 destp[pos] = to;
1020 return TRUE;
1021 }
1022
1023 static Int
p_nb_create_accumulator(void)1024 p_nb_create_accumulator(void)
1025 {
1026 Term t = Deref(ARG1), acct, to;
1027 CELL *destp;
1028
1029 if (IsVarTerm(t)) {
1030 Yap_Error(INSTANTIATION_ERROR,t,"nb_create_accumulator");
1031 return FALSE;
1032 }
1033 if (!IsIntegerTerm(t) && !IsBigIntTerm(t) && !IsFloatTerm(t)) {
1034 Yap_Error(TYPE_ERROR_NUMBER,t,"nb_create_accumulator");
1035 return FALSE;
1036 }
1037 acct = Yap_MkApplTerm(FunctorGNumber,1,&t);
1038 if (!Yap_unify(ARG2, acct)) {
1039 return FALSE;
1040 }
1041 to = CopyTermToArena(t, GlobalArena, TRUE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
1042 if (to == 0L)
1043 return FALSE;
1044 destp = RepAppl(Deref(ARG2));
1045 destp[1] = to;
1046 return TRUE;
1047 }
1048
1049 static Int
p_nb_add_to_accumulator(void)1050 p_nb_add_to_accumulator(void)
1051 {
1052 Term t = Deref(ARG1), t0, tadd;
1053 Functor f;
1054 CELL *destp;
1055
1056 if (IsVarTerm(t)) {
1057 Yap_Error(INSTANTIATION_ERROR,t,"nb_create_accumulator");
1058 return FALSE;
1059 }
1060 if (!IsApplTerm(t)) {
1061 Yap_Error(TYPE_ERROR_NUMBER,t,"nb_accumulator_value");
1062 return FALSE;
1063 }
1064 f = FunctorOfTerm(t);
1065 if (f != FunctorGNumber) {
1066 return FALSE;
1067 }
1068 destp = RepAppl(t);
1069 t0 = Deref(destp[1]);
1070 tadd = Deref(ARG2);
1071 if (IsVarTerm(tadd)) {
1072 Yap_Error(INSTANTIATION_ERROR,tadd,"nb_create_accumulator");
1073 return FALSE;
1074 }
1075 if (IsIntegerTerm(t0) && IsIntegerTerm(tadd)) {
1076 Int i0 = IntegerOfTerm(t0);
1077 Int i1 = IntegerOfTerm(tadd);
1078 Term new = MkIntegerTerm(i0+i1);
1079
1080 if (IsIntTerm(new)) {
1081 /* forget it if it was something else */
1082 destp[1] = new;
1083 } else {
1084 /* long, do we have spapce or not ?? */
1085 if (IsLongIntTerm(t0)) {
1086 CELL *target = RepAppl(t0);
1087 CELL *source = RepAppl(new);
1088 target[1] = source[1];
1089 } else {
1090 /* we need to create a new long int */
1091 new = CopyTermToArena(new, GlobalArena, TRUE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
1092 destp = RepAppl(Deref(ARG1));
1093 destp[1] = new;
1094 }
1095 }
1096 return TRUE;
1097 }
1098 if (IsFloatTerm(t0) && IsFloatTerm(tadd)) {
1099 Float f0 = FloatOfTerm(t0);
1100 Float f1 = FloatOfTerm(tadd);
1101 Term new = MkFloatTerm(f0+f1);
1102 CELL *target = RepAppl(t0);
1103 CELL *source = RepAppl(new);
1104
1105 #if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
1106 target[2] = source[2];
1107 #endif
1108 target[1] = source[1];
1109 return TRUE;
1110 }
1111 if (IsNumTerm(t0) && IsNumTerm(tadd)) {
1112 Term t2[2], new;
1113 t2[0] = t0;
1114 t2[1] = tadd;
1115 new = Yap_MkApplTerm(FunctorPlus, 2, t2);
1116
1117 new = Yap_Eval(new);
1118 new = CopyTermToArena(new, GlobalArena, TRUE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
1119 destp = RepAppl(Deref(ARG1));
1120 destp[1] = new;
1121
1122 return TRUE;
1123 }
1124 return FALSE;
1125 }
1126
1127
1128 static Int
p_nb_accumulator_value(void)1129 p_nb_accumulator_value(void)
1130 {
1131 Term t = Deref(ARG1), to;
1132 Functor f;
1133
1134 if (IsVarTerm(t)) {
1135 Yap_Error(INSTANTIATION_ERROR,t,"nb_accumulator_value");
1136 return FALSE;
1137 }
1138 if (!IsApplTerm(t)) {
1139 Yap_Error(TYPE_ERROR_NUMBER,t,"nb_accumulator_value");
1140 return FALSE;
1141 }
1142 f = FunctorOfTerm(t);
1143 if (f != FunctorGNumber) {
1144 return FALSE;
1145 }
1146 to = Yap_CopyTerm(RepAppl(t)[1]);
1147 return Yap_unify(to, ARG2);
1148 }
1149
1150
1151 static Int
p_nb_linkarg(void)1152 p_nb_linkarg(void)
1153 {
1154 Term wheret = Deref(ARG1);
1155 Term dest = Deref(ARG2);
1156 UInt arity, pos;
1157 CELL *destp;
1158
1159 if (IsVarTerm(wheret)) {
1160 Yap_Error(INSTANTIATION_ERROR,wheret,"nb_setarg");
1161 return FALSE;
1162 }
1163 if (!IsIntegerTerm(wheret)) {
1164 Yap_Error(TYPE_ERROR_INTEGER,wheret,"nb_setarg");
1165 return FALSE;
1166 }
1167 pos = IntegerOfTerm(wheret);
1168 if (IsVarTerm(dest)) {
1169 Yap_Error(INSTANTIATION_ERROR,dest,"nb_setarg");
1170 return FALSE;
1171 } else if (IsPrimitiveTerm(dest)) {
1172 arity = 0;
1173 destp = NULL;
1174 } else if (IsPairTerm(dest)) {
1175 arity = 2;
1176 destp = RepPair(dest)-1;
1177 } else {
1178 arity = ArityOfFunctor(FunctorOfTerm(dest));
1179 destp = RepAppl(dest);
1180 }
1181 if (pos < 1 || pos > arity)
1182 return FALSE;
1183 destp[pos] = Deref(ARG3);
1184 return TRUE;
1185 }
1186
1187 static Int
p_nb_linkval(void)1188 p_nb_linkval(void)
1189 {
1190 Term t = Deref(ARG1), to;
1191 GlobalEntry *ge;
1192 if (IsVarTerm(t)) {
1193 Yap_Error(INSTANTIATION_ERROR,t,"nb_linkval");
1194 return (TermNil);
1195 } else if (!IsAtomTerm(t)) {
1196 Yap_Error(TYPE_ERROR_ATOM,t,"nb_linkval");
1197 return (FALSE);
1198 }
1199 ge = GetGlobalEntry(AtomOfTerm(t));
1200 to = Deref(ARG2);
1201 WRITE_LOCK(ge->GRWLock);
1202 ge->global=to;
1203 WRITE_UNLOCK(ge->GRWLock);
1204 return TRUE;
1205 }
1206
1207 Term
Yap_SetGlobalVal(Atom at,Term t0)1208 Yap_SetGlobalVal(Atom at, Term t0)
1209 {
1210 Term to;
1211 GlobalEntry *ge;
1212 ge = GetGlobalEntry(at);
1213 to = CopyTermToArena(t0, GlobalArena, FALSE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
1214 if (to == 0L)
1215 return to;
1216 WRITE_LOCK(ge->GRWLock);
1217 ge->global=to;
1218 WRITE_UNLOCK(ge->GRWLock);
1219 return to;
1220 }
1221
1222 Term
Yap_SaveTerm(Term t0)1223 Yap_SaveTerm(Term t0)
1224 {
1225 Term to;
1226 to = CopyTermToArena(t0, GlobalArena, FALSE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
1227 if (to == 0L)
1228 return to;
1229 return to;
1230 }
1231
1232 static Int
p_nb_setval(void)1233 p_nb_setval(void)
1234 {
1235 Term t = Deref(ARG1);
1236 if (IsVarTerm(t)) {
1237 Yap_Error(INSTANTIATION_ERROR,t,"nb_setval");
1238 return (TermNil);
1239 } else if (!IsAtomTerm(t)) {
1240 Yap_Error(TYPE_ERROR_ATOM,t,"nb_setval");
1241 return (FALSE);
1242 }
1243 return Yap_SetGlobalVal(AtomOfTerm(t), ARG2);
1244 }
1245
1246 static Int
p_nb_set_shared_val(void)1247 p_nb_set_shared_val(void)
1248 {
1249 Term t = Deref(ARG1), to;
1250 GlobalEntry *ge;
1251 if (IsVarTerm(t)) {
1252 Yap_Error(INSTANTIATION_ERROR,t,"nb_setval");
1253 return (TermNil);
1254 } else if (!IsAtomTerm(t)) {
1255 Yap_Error(TYPE_ERROR_ATOM,t,"nb_setval");
1256 return (FALSE);
1257 }
1258 ge = GetGlobalEntry(AtomOfTerm(t));
1259 to = CopyTermToArena(ARG2, GlobalArena, TRUE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
1260 if (to == 0L)
1261 return FALSE;
1262 WRITE_LOCK(ge->GRWLock);
1263 ge->global=to;
1264 WRITE_UNLOCK(ge->GRWLock);
1265 return TRUE;
1266 }
1267
1268 static Int
p_b_setval(void)1269 p_b_setval(void)
1270 {
1271 Term t = Deref(ARG1);
1272 GlobalEntry *ge;
1273
1274 if (IsVarTerm(t)) {
1275 Yap_Error(INSTANTIATION_ERROR,t,"b_setval");
1276 return (TermNil);
1277 } else if (!IsAtomTerm(t)) {
1278 Yap_Error(TYPE_ERROR_ATOM,t,"b_setval");
1279 return (FALSE);
1280 }
1281 ge = GetGlobalEntry(AtomOfTerm(t));
1282 WRITE_LOCK(ge->GRWLock);
1283 #ifdef MULTI_ASSIGNMENT_VARIABLES
1284 /* the evil deed is to be done now */
1285 {
1286 /* but first make sure we are doing on a global object, or a constant! */
1287 Term t = Deref(ARG2);
1288 if (IsVarTerm(t) && VarOfTerm(t) > H && VarOfTerm(t) < ASP) {
1289 Term tn = MkVarTerm();
1290 Bind_Local(VarOfTerm(t), tn);
1291 t = tn;
1292 }
1293 MaBind(&ge->global, t);
1294 }
1295 WRITE_UNLOCK(ge->GRWLock);
1296 return TRUE;
1297 #else
1298 WRITE_UNLOCK(ge->GRWLock);
1299 Yap_Error(SYSTEM_ERROR,t2,"update_array");
1300 return FALSE;
1301 #endif
1302 }
1303
1304 static Int
p_nb_getval(void)1305 p_nb_getval(void)
1306 {
1307 Term t = Deref(ARG1), to;
1308 GlobalEntry *ge;
1309
1310 if (IsVarTerm(t)) {
1311 Yap_Error(INSTANTIATION_ERROR,t,"nb_getval");
1312 return FALSE;
1313 } else if (!IsAtomTerm(t)) {
1314 Yap_Error(TYPE_ERROR_ATOM,t,"nb_getval");
1315 return FALSE;
1316 }
1317 ge = FindGlobalEntry(AtomOfTerm(t));
1318 if (!ge) {
1319 return Yap_unify(TermNil, ARG3);
1320 }
1321 READ_LOCK(ge->GRWLock);
1322 to = ge->global;
1323 if (IsVarTerm(to) && IsUnboundVar(VarOfTerm(to))) {
1324 Term t = MkVarTerm();
1325 Bind(VarOfTerm(to), t);
1326 to = t;
1327 }
1328 READ_UNLOCK(ge->GRWLock);
1329 if (to == TermFoundVar)
1330 return FALSE;
1331 return Yap_unify(ARG2, to);
1332 }
1333
1334
1335 static Int
nbdelete(Atom at)1336 nbdelete(Atom at)
1337 {
1338 GlobalEntry *ge, *g;
1339 AtomEntry *ae;
1340 Prop gp, g0;
1341
1342 ge = FindGlobalEntry(at);
1343 if (!ge) {
1344 Yap_Error(EXISTENCE_ERROR_VARIABLE,MkAtomTerm(at),"nb_delete");
1345 return FALSE;
1346 }
1347 WRITE_LOCK(ge->GRWLock);
1348 ae = ge->AtomOfGE;
1349 if (GlobalVariables == ge) {
1350 GlobalVariables = ge->NextGE;
1351 } else {
1352 g = GlobalVariables;
1353 while (g->NextGE != ge)
1354 g = g->NextGE;
1355 g->NextGE = ge->NextGE;
1356 }
1357 gp = AbsGlobalProp(ge);
1358 WRITE_LOCK(ae->ARWLock);
1359 if (ae->PropsOfAE == gp) {
1360 ae->PropsOfAE = ge->NextOfPE;
1361 } else {
1362 g0 = ae->PropsOfAE;
1363 while (g0->NextOfPE != gp)
1364 g0 = g0->NextOfPE;
1365 g0->NextOfPE = ge->NextOfPE;
1366 }
1367 WRITE_UNLOCK(ae->ARWLock);
1368 WRITE_UNLOCK(ge->GRWLock);
1369 Yap_FreeCodeSpace((char *)ge);
1370 return TRUE;
1371 }
1372
1373 Int
Yap_DeleteGlobal(Atom at)1374 Yap_DeleteGlobal(Atom at)
1375 {
1376 return nbdelete(at);
1377 }
1378
1379 static Int
p_nb_delete(void)1380 p_nb_delete(void)
1381 {
1382 Term t = Deref(ARG1);
1383
1384 if (IsVarTerm(t)) {
1385 Yap_Error(INSTANTIATION_ERROR,t,"nb_delete");
1386 return FALSE;
1387 } else if (!IsAtomTerm(t)) {
1388 Yap_Error(TYPE_ERROR_ATOM,t,"nb_delete");
1389 return FALSE;
1390 }
1391 return nbdelete(AtomOfTerm(t));
1392 }
1393
1394 static Int
p_nb_create(void)1395 p_nb_create(void)
1396 {
1397 Term t = Deref(ARG1);
1398 Term tname = Deref(ARG2);
1399 Term tarity = Deref(ARG3);
1400 Term to;
1401 GlobalEntry *ge;
1402
1403 if (IsVarTerm(t)) {
1404 Yap_Error(INSTANTIATION_ERROR,t,"nb_create");
1405 return FALSE;
1406 } else if (!IsAtomTerm(t)) {
1407 Yap_Error(TYPE_ERROR_ATOM,t,"nb_create");
1408 return FALSE;
1409 }
1410 ge = GetGlobalEntry(AtomOfTerm(t));
1411 if (!ge) {
1412 Yap_Error(EXISTENCE_ERROR_VARIABLE,t,"nb_create");
1413 return FALSE;
1414 }
1415 if (IsVarTerm(tarity)) {
1416 Yap_Error(INSTANTIATION_ERROR,tarity,"nb_create");
1417 return FALSE;
1418 } else if (!IsIntegerTerm(tarity)) {
1419 Yap_Error(TYPE_ERROR_INTEGER,tarity,"nb_create");
1420 return FALSE;
1421 }
1422 if (IsVarTerm(tname)) {
1423 Yap_Error(INSTANTIATION_ERROR,tname,"nb_create");
1424 return FALSE;
1425 } else if (!IsAtomTerm(tname)) {
1426 Yap_Error(TYPE_ERROR_ATOM,tname,"nb_create");
1427 return FALSE;
1428 }
1429 to = CreateTermInArena(GlobalArena, AtomOfTerm(tname), IntegerOfTerm(tarity), 3, &GlobalArena, 0L);
1430 if (!to)
1431 return FALSE;
1432 WRITE_LOCK(ge->GRWLock);
1433 ge->global=to;
1434 WRITE_UNLOCK(ge->GRWLock);
1435 return TRUE;
1436 }
1437
1438 static Int
p_nb_create2(void)1439 p_nb_create2(void)
1440 {
1441 Term t = Deref(ARG1);
1442 Term tname = Deref(ARG2);
1443 Term tarity = Deref(ARG3);
1444 Term tinit = Deref(ARG4);
1445 Term to;
1446 GlobalEntry *ge;
1447
1448 if (IsVarTerm(t)) {
1449 Yap_Error(INSTANTIATION_ERROR,t,"nb_create");
1450 return FALSE;
1451 } else if (!IsAtomTerm(t)) {
1452 Yap_Error(TYPE_ERROR_ATOM,t,"nb_create");
1453 return FALSE;
1454 }
1455 ge = GetGlobalEntry(AtomOfTerm(t));
1456 if (!ge) {
1457 Yap_Error(EXISTENCE_ERROR_VARIABLE,t,"nb_create");
1458 return FALSE;
1459 }
1460 if (IsVarTerm(tarity)) {
1461 Yap_Error(INSTANTIATION_ERROR,tarity,"nb_create");
1462 return FALSE;
1463 } else if (!IsIntegerTerm(tarity)) {
1464 Yap_Error(TYPE_ERROR_INTEGER,tarity,"nb_create");
1465 return FALSE;
1466 }
1467 if (IsVarTerm(tname)) {
1468 Yap_Error(INSTANTIATION_ERROR,tname,"nb_create");
1469 return FALSE;
1470 } else if (!IsAtomTerm(tname)) {
1471 Yap_Error(TYPE_ERROR_ATOM,tname,"nb_create");
1472 return FALSE;
1473 }
1474 if (IsVarTerm(tinit)) {
1475 Yap_Error(INSTANTIATION_ERROR,tname,"nb_create");
1476 return FALSE;
1477 } else if (!IsAtomTerm(tinit)) {
1478 Yap_Error(TYPE_ERROR_ATOM,tname,"nb_create");
1479 return FALSE;
1480 }
1481 to = CreateTermInArena(GlobalArena, AtomOfTerm(tname), IntegerOfTerm(tarity), 4, &GlobalArena, tinit);
1482 if (!to)
1483 return FALSE;
1484 WRITE_LOCK(ge->GRWLock);
1485 ge->global=to;
1486 WRITE_UNLOCK(ge->GRWLock);
1487 return TRUE;
1488 }
1489
1490 /* a non-backtrackable queue is a term of the form $array(Arena,Start,End,Size) plus an Arena. */
1491
1492 static Int
nb_queue(UInt arena_sz)1493 nb_queue(UInt arena_sz)
1494 {
1495 Term queue_arena, queue, ar[QUEUE_FUNCTOR_ARITY], *nar;
1496 Term t = Deref(ARG1);
1497
1498 DepthArenas++;
1499 if (!IsVarTerm(t)) {
1500 if (!IsApplTerm(t)) {
1501 return FALSE;
1502 }
1503 return (FunctorOfTerm(t) == FunctorNBQueue);
1504 }
1505 ar[QUEUE_ARENA] =
1506 ar[QUEUE_HEAD] =
1507 ar[QUEUE_TAIL] =
1508 ar[QUEUE_SIZE] =
1509 MkIntTerm(0);
1510 queue = Yap_MkApplTerm(FunctorNBQueue,QUEUE_FUNCTOR_ARITY,ar);
1511 if (!Yap_unify(queue,ARG1))
1512 return FALSE;
1513 if (arena_sz < 4*1024)
1514 arena_sz = 4*1024;
1515 queue_arena = NewArena(arena_sz,1,NULL);
1516 if (queue_arena == 0L) {
1517 return FALSE;
1518 }
1519 nar = RepAppl(Deref(ARG1))+1;
1520 nar[QUEUE_ARENA] = queue_arena;
1521 return TRUE;
1522 }
1523
1524 static Int
p_nb_queue(void)1525 p_nb_queue(void)
1526 {
1527 UInt arena_sz = (ASP-H)/16;
1528 if (DepthArenas > 1)
1529 arena_sz /= DepthArenas;
1530 if (arena_sz < MIN_ARENA_SIZE)
1531 arena_sz = MIN_ARENA_SIZE;
1532 if (arena_sz > MAX_ARENA_SIZE)
1533 arena_sz = MAX_ARENA_SIZE;
1534 return nb_queue(arena_sz);
1535 }
1536
1537 static Int
p_nb_queue_sized(void)1538 p_nb_queue_sized(void)
1539 {
1540 Term t = Deref(ARG2);
1541 if (IsVarTerm(t)) {
1542 Yap_Error(INSTANTIATION_ERROR,t,"nb_queue");
1543 return FALSE;
1544 }
1545 if (!IsIntegerTerm(t)) {
1546 Yap_Error(TYPE_ERROR_INTEGER,t,"nb_queue");
1547 return FALSE;
1548 }
1549 return nb_queue((UInt)IntegerOfTerm(t));
1550 }
1551
1552 static CELL *
GetQueue(Term t,char * caller)1553 GetQueue(Term t, char* caller)
1554 {
1555 t = Deref(t);
1556
1557 if (IsVarTerm(t)) {
1558 Yap_Error(INSTANTIATION_ERROR,t,caller);
1559 return NULL;
1560 }
1561 if (!IsApplTerm(t)) {
1562 Yap_Error(TYPE_ERROR_COMPOUND,t,caller);
1563 return NULL;
1564 }
1565 if (FunctorOfTerm(t) != FunctorNBQueue) {
1566 Yap_Error(DOMAIN_ERROR_ARRAY_TYPE,t,caller);
1567 return NULL;
1568 }
1569 return RepAppl(t)+1;
1570 }
1571
1572 static Term
GetQueueArena(CELL * qd,char * caller)1573 GetQueueArena(CELL *qd, char* caller)
1574 {
1575 Term t = Deref(qd[QUEUE_ARENA]);
1576
1577 if (IsVarTerm(t)) {
1578 Yap_Error(INSTANTIATION_ERROR,t,caller);
1579 return 0L;
1580 }
1581 if (!IsApplTerm(t)) {
1582 Yap_Error(TYPE_ERROR_COMPOUND,t,caller);
1583 return 0L;
1584 }
1585 if (FunctorOfTerm(t) != FunctorBigInt) {
1586 Yap_Error(DOMAIN_ERROR_ARRAY_TYPE,t,caller);
1587 return 0L;
1588 }
1589 return t;
1590 }
1591
1592 static void
RecoverArena(Term arena)1593 RecoverArena(Term arena)
1594 {
1595 CELL *pt = ArenaPt(arena),
1596 *max = ArenaLimit(arena);
1597
1598 if (max == H) {
1599 H = pt;
1600 }
1601 }
1602
1603 static Int
p_nb_queue_close(void)1604 p_nb_queue_close(void)
1605 {
1606 Term t = Deref(ARG1);
1607 Int out;
1608
1609 DepthArenas--;
1610 if (!IsVarTerm(t)) {
1611 CELL *qp;
1612
1613 qp = GetQueue(t, "queue/3");
1614 if (qp == NULL) {
1615 return
1616 Yap_unify(ARG3, ARG2);
1617 }
1618 if (qp[QUEUE_ARENA] != MkIntTerm(0))
1619 RecoverArena(qp[QUEUE_ARENA]);
1620 if (qp[QUEUE_SIZE] == MkIntTerm(0)) {
1621 return
1622 Yap_unify(ARG3, ARG2);
1623 }
1624 out =
1625 Yap_unify(ARG3, qp[QUEUE_TAIL]) &&
1626 Yap_unify(ARG2, qp[QUEUE_HEAD]);
1627 qp[-1] = (CELL)Yap_MkFunctor(AtomHeap,1);
1628 qp[QUEUE_ARENA] =
1629 qp[QUEUE_HEAD] =
1630 qp[QUEUE_TAIL] = MkIntegerTerm(0);
1631 return out;
1632 }
1633 Yap_Error(INSTANTIATION_ERROR,t,"queue/3");
1634 return FALSE;
1635 }
1636
1637 static Int
p_nb_queue_enqueue(void)1638 p_nb_queue_enqueue(void)
1639 {
1640 CELL *qd = GetQueue(ARG1,"enqueue"), *oldH, *oldHB;
1641 UInt old_sz;
1642 Term arena, qsize, to;
1643 UInt min_size;
1644
1645 if (!qd)
1646 return FALSE;
1647 arena = GetQueueArena(qd,"enqueue");
1648 if (arena == 0L)
1649 return FALSE;
1650 if (IsPairTerm(qd[QUEUE_HEAD])) {
1651 min_size = ArenaPt(arena)-RepPair(qd[QUEUE_HEAD]);
1652 } else {
1653 min_size = 0L;
1654 }
1655 to = CopyTermToArena(ARG2, arena, FALSE, TRUE, 2, qd+QUEUE_ARENA, min_size);
1656 if (to == 0L)
1657 return FALSE;
1658 qd = GetQueue(ARG1,"enqueue");
1659 arena = GetQueueArena(qd,"enqueue");
1660 /* garbage collection ? */
1661 oldH = H;
1662 oldHB = HB;
1663 H = HB = ArenaPt(arena);
1664 old_sz = ArenaSz(arena);
1665 qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
1666 while (old_sz < MIN_ARENA_SIZE) {
1667 UInt gsiz = H-RepPair(qd[QUEUE_HEAD]);
1668 H = oldH;
1669 HB = oldHB;
1670 if (gsiz > 1024*1024) {
1671 gsiz = 1024*1024;
1672 } else if (gsiz < 1024) {
1673 gsiz = 1024;
1674 }
1675 ARG3 = to;
1676 /* fprintf(stderr,"growing %ld cells\n",(unsigned long int)gsiz);*/
1677 if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) {
1678 Yap_Error(OUT_OF_STACK_ERROR, arena, Yap_ErrorMessage);
1679 return 0L;
1680 }
1681 to = ARG3;
1682 qd = RepAppl(Deref(ARG1))+1;
1683 arena = GetQueueArena(qd,"enqueue");
1684 oldH = H;
1685 oldHB = HB;
1686 H = HB = ArenaPt(arena);
1687 old_sz = ArenaSz(arena);
1688 }
1689 qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsize+1);
1690 if (qsize == 0) {
1691 qd[QUEUE_HEAD] = AbsPair(H);
1692 } else {
1693 *VarOfTerm(qd[QUEUE_TAIL]) = AbsPair(H);
1694 }
1695 *H++ = to;
1696 RESET_VARIABLE(H);
1697 qd[QUEUE_TAIL] = (CELL)H;
1698 H++;
1699 CloseArena(oldH, oldHB, ASP, qd+QUEUE_ARENA, old_sz);
1700 return TRUE;
1701 }
1702
1703 static Int
p_nb_queue_dequeue(void)1704 p_nb_queue_dequeue(void)
1705 {
1706 CELL *qd = GetQueue(ARG1,"dequeue");
1707 UInt old_sz, qsz;
1708 Term arena, out;
1709 CELL *oldH, *oldHB;
1710
1711 if (!qd)
1712 return FALSE;
1713 qsz = IntegerOfTerm(qd[QUEUE_SIZE]);
1714 if (qsz == 0)
1715 return FALSE;
1716 arena = GetQueueArena(qd,"dequeue");
1717 if (arena == 0L)
1718 return FALSE;
1719 old_sz = ArenaSz(arena);
1720 out = HeadOfTerm(qd[QUEUE_HEAD]);
1721 qd[QUEUE_HEAD] = TailOfTerm(qd[QUEUE_HEAD]);
1722 /* garbage collection ? */
1723 oldH = H;
1724 oldHB = HB;
1725 qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsz-1);
1726 CloseArena(oldH, oldHB, ASP, &arena, old_sz);
1727 return Yap_unify(out, ARG2);
1728 }
1729
1730 static Int
p_nb_queue_peek(void)1731 p_nb_queue_peek(void)
1732 {
1733 CELL *qd = GetQueue(ARG1,"queue_peek");
1734 UInt qsz;
1735
1736 if (!qd)
1737 return FALSE;
1738 qsz = IntegerOfTerm(qd[QUEUE_SIZE]);
1739 if (qsz == 0)
1740 return FALSE;
1741 return Yap_unify(HeadOfTerm(qd[QUEUE_HEAD]), ARG2);
1742 }
1743
1744 static Int
p_nb_queue_empty(void)1745 p_nb_queue_empty(void)
1746 {
1747 CELL *qd = GetQueue(ARG1,"queue_empty");
1748
1749 if (!qd)
1750 return FALSE;
1751 return (IntegerOfTerm(qd[QUEUE_SIZE]) == 0);
1752 }
1753
1754 static Int
p_nb_queue_size(void)1755 p_nb_queue_size(void)
1756 {
1757 CELL *qd = GetQueue(ARG1,"queue_size");
1758
1759 if (!qd)
1760 return FALSE;
1761 return Yap_unify(ARG2,qd[QUEUE_SIZE]);
1762 }
1763
1764
1765 static CELL *
GetHeap(Term t,char * caller)1766 GetHeap(Term t, char* caller)
1767 {
1768 t = Deref(t);
1769
1770 if (IsVarTerm(t)) {
1771 Yap_Error(INSTANTIATION_ERROR,t,caller);
1772 return NULL;
1773 }
1774 if (!IsApplTerm(t)) {
1775 Yap_Error(TYPE_ERROR_COMPOUND,t,caller);
1776 return NULL;
1777 }
1778 return RepAppl(t)+1;
1779 }
1780
1781 static Term
MkZeroApplTerm(Functor f,UInt sz)1782 MkZeroApplTerm(Functor f, UInt sz)
1783 {
1784 Term t0, tf;
1785 CELL *pt;
1786
1787 if (H+(sz+1) > ASP-1024)
1788 return TermNil;
1789 tf = AbsAppl(H);
1790 *H = (CELL)f;
1791 t0 = MkIntTerm(0);
1792 pt = H+1;
1793 while (sz--) {
1794 *pt++ = t0;
1795 }
1796 H = pt;
1797 return tf;
1798 }
1799
1800 static Int
p_nb_heap(void)1801 p_nb_heap(void)
1802 {
1803 Term heap_arena, heap, *ar, *nar;
1804 UInt hsize;
1805 Term tsize = Deref(ARG1);
1806 UInt arena_sz = (H-H0)/16;
1807
1808 if (IsVarTerm(tsize)) {
1809 Yap_Error(INSTANTIATION_ERROR,tsize,"nb_heap");
1810 return FALSE;
1811 } else {
1812 if (!IsIntegerTerm(tsize)) {
1813 Yap_Error(TYPE_ERROR_INTEGER,tsize,"nb_heap");
1814 return FALSE;
1815 }
1816 hsize = IntegerOfTerm(tsize);
1817 }
1818
1819 while ((heap = MkZeroApplTerm(Yap_MkFunctor(AtomHeap,2*hsize+HEAP_START+1),2*hsize+HEAP_START+1)) == TermNil) {
1820 if (!Yap_gcl((2*hsize+HEAP_START+1)*sizeof(CELL), 2, ENV, P)) {
1821 Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
1822 return FALSE;
1823 }
1824 }
1825 if (!Yap_unify(heap,ARG2))
1826 return FALSE;
1827 ar = RepAppl(heap)+1;
1828 ar[HEAP_ARENA] =
1829 ar[HEAP_SIZE] =
1830 MkIntTerm(0);
1831 ar[HEAP_MAX] = tsize;
1832 if (arena_sz < 1024)
1833 arena_sz = 1024;
1834 heap_arena = NewArena(arena_sz,1,NULL);
1835 if (heap_arena == 0L) {
1836 return FALSE;
1837 }
1838 nar = RepAppl(Deref(ARG2))+1;
1839 nar[HEAP_ARENA] = heap_arena;
1840 return TRUE;
1841 }
1842
1843 static Int
p_nb_heap_close(void)1844 p_nb_heap_close(void)
1845 {
1846 Term t = Deref(ARG1);
1847 if (!IsVarTerm(t)) {
1848 CELL *qp;
1849
1850 qp = RepAppl(t)+1;
1851 if (qp[HEAP_ARENA] != MkIntTerm(0))
1852 RecoverArena(qp[HEAP_ARENA]);
1853 qp[-1] = (CELL)Yap_MkFunctor(AtomHeap,1);
1854 qp[0] = MkIntegerTerm(0);
1855 return TRUE;
1856 }
1857 Yap_Error(INSTANTIATION_ERROR,t,"heap_close/1");
1858 return FALSE;
1859 }
1860
1861 static void
PushHeap(CELL * pt,UInt off)1862 PushHeap(CELL *pt, UInt off)
1863 {
1864 while (off) {
1865 UInt noff = (off+1)/2-1;
1866 if (Yap_compare_terms(pt[2*off], pt[2*noff]) < 0) {
1867 Term tk = pt[2*noff];
1868 Term tv = pt[2*noff+1];
1869 pt[2*noff] = pt[2*off];
1870 pt[2*noff+1] = pt[2*off+1];
1871 pt[2*off] = tk;
1872 pt[2*off+1] = tv;
1873 off = noff;
1874 } else {
1875 return;
1876 }
1877 }
1878 }
1879
1880 static void
DelHeapRoot(CELL * pt,UInt sz)1881 DelHeapRoot(CELL *pt, UInt sz)
1882 {
1883 UInt indx = 0;
1884 Term tk, tv;
1885
1886 sz--;
1887 tk = pt[2*sz];
1888 tv = pt[2*sz+1];
1889 pt[2*sz] = TermNil;
1890 pt[2*sz+1] = TermNil;
1891 while (TRUE) {
1892 if (sz < 2*indx+3 || Yap_compare_terms(pt[4*indx+2],pt[4*indx+4]) < 0) {
1893 if (sz < 2*indx+2 || Yap_compare_terms(tk, pt[4*indx+2]) < 0) {
1894 pt[2*indx] = tk;
1895 pt[2*indx+1] = tv;
1896 return;
1897 } else {
1898 pt[2*indx] = pt[4*indx+2];
1899 pt[2*indx+1] = pt[4*indx+3];
1900 indx = 2*indx+1;
1901 }
1902 } else {
1903 if (Yap_compare_terms(tk, pt[4*indx+4]) < 0) {
1904 pt[2*indx] = tk;
1905 pt[2*indx+1] = tv;
1906 return;
1907 } else {
1908 pt[2*indx] = pt[4*indx+4];
1909 pt[2*indx+1] = pt[4*indx+5];
1910 indx = 2*indx+2;
1911 }
1912 }
1913 }
1914 }
1915
1916 static Int
p_nb_heap_add_to_heap(void)1917 p_nb_heap_add_to_heap(void)
1918 {
1919 CELL *qd = GetHeap(ARG1,"add_to_heap"), *oldH, *oldHB, *pt;
1920 UInt hsize, hmsize, old_sz;
1921 Term arena, to, key;
1922 UInt mingrow;
1923
1924 if (!qd)
1925 return FALSE;
1926 restart:
1927 hsize = IntegerOfTerm(qd[HEAP_SIZE]);
1928 hmsize = IntegerOfTerm(qd[HEAP_MAX]);
1929 if (hsize == hmsize) {
1930 CELL *top = qd+(HEAP_START+2*hmsize);
1931 UInt extra_size;
1932
1933 if (hmsize <= 64*1024) {
1934 extra_size = 64*1024;
1935 } else {
1936 extra_size = hmsize;
1937 }
1938 if ((extra_size=Yap_InsertInGlobal(top, extra_size*2*sizeof(CELL)))==0) {
1939 Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms");
1940 return FALSE;
1941 }
1942 extra_size = extra_size/(2*sizeof(CELL));
1943 qd = GetHeap(ARG1,"add_to_heap");
1944 hmsize += extra_size;
1945 if (!qd)
1946 return FALSE;
1947 qd[-1] = (CELL)Yap_MkFunctor(AtomHeap,2*hmsize+HEAP_START);
1948 top = qd+(HEAP_START+2*(hmsize-extra_size));
1949 while (extra_size) {
1950 RESET_VARIABLE(top);
1951 RESET_VARIABLE(top+1);
1952 top+=2;
1953 extra_size--;
1954 }
1955 arena = qd[HEAP_ARENA];
1956 old_sz = ArenaSz(arena);
1957 oldH = H;
1958 oldHB = HB;
1959 H = HB = ArenaPt(arena);
1960 qd[HEAP_MAX] = Global_MkIntegerTerm(hmsize);
1961 CloseArena(oldH, oldHB, ASP, qd+HEAP_ARENA, old_sz);
1962 goto restart;
1963 }
1964 arena = qd[HEAP_ARENA];
1965 if (arena == 0L)
1966 return FALSE;
1967 mingrow = garena_overflow_size(ArenaPt(arena));
1968 ARG2 = CopyTermToArena(ARG2, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, mingrow);
1969 qd = GetHeap(ARG1,"add_to_heap");
1970 arena = qd[HEAP_ARENA];
1971 to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, mingrow);
1972 /* protect key in ARG2 in case there is an overflow while copying to */
1973 key = ARG2;
1974 if (key == 0 || to == 0L)
1975 return FALSE;
1976 qd = GetHeap(ARG1,"add_to_heap");
1977 arena = qd[HEAP_ARENA];
1978 /* garbage collection ? */
1979 oldH = H;
1980 oldHB = HB;
1981 H = HB = ArenaPt(arena);
1982 old_sz = ArenaSz(arena);
1983 while (old_sz < MIN_ARENA_SIZE) {
1984 UInt gsiz = hsize*2;
1985
1986 H = oldH;
1987 HB = oldHB;
1988 if (gsiz > 1024*1024) {
1989 gsiz = 1024*1024;
1990 } else if (gsiz < 1024) {
1991 gsiz = 1024;
1992 }
1993 ARG3 = to;
1994 if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) {
1995 Yap_Error(OUT_OF_STACK_ERROR, arena, Yap_ErrorMessage);
1996 return 0L;
1997 }
1998 to = ARG3;
1999 qd = RepAppl(Deref(ARG1))+1;
2000 arena = qd[HEAP_ARENA];
2001 oldH = H;
2002 oldHB = HB;
2003 H = HB = ArenaPt(arena);
2004 old_sz = ArenaSz(arena);
2005 }
2006 pt = qd+HEAP_START;
2007 pt[2*hsize] = key;
2008 pt[2*hsize+1] = to;
2009 PushHeap(pt, hsize);
2010 qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize+1);
2011 CloseArena(oldH, oldHB, ASP, qd+HEAP_ARENA, old_sz);
2012 return TRUE;
2013 }
2014
2015 static Int
p_nb_heap_del(void)2016 p_nb_heap_del(void)
2017 {
2018 CELL *qd = GetHeap(ARG1,"deheap");
2019 UInt old_sz, qsz;
2020 Term arena;
2021 CELL *oldH, *oldHB;
2022 Term tk, tv;
2023
2024 if (!qd)
2025 return FALSE;
2026 qsz = IntegerOfTerm(qd[HEAP_SIZE]);
2027 if (qsz == 0)
2028 return FALSE;
2029 arena = qd[HEAP_ARENA];
2030 if (arena == 0L)
2031 return FALSE;
2032 old_sz = ArenaSz(arena);
2033 /* garbage collection ? */
2034 oldH = H;
2035 oldHB = HB;
2036 qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz-1);
2037 CloseArena(oldH, oldHB, ASP, &arena, old_sz);
2038 tk = qd[HEAP_START];
2039 tv = qd[HEAP_START+1];
2040 DelHeapRoot(qd+HEAP_START, qsz);
2041 return Yap_unify(tk, ARG2) &&
2042 Yap_unify(tv, ARG3);
2043 }
2044
2045 static Int
p_nb_heap_peek(void)2046 p_nb_heap_peek(void)
2047 {
2048 CELL *qd = GetHeap(ARG1,"heap_peek");
2049 UInt qsz;
2050 Term tk, tv;
2051
2052 if (!qd)
2053 return FALSE;
2054 qsz = IntegerOfTerm(qd[HEAP_SIZE]);
2055 if (qsz == 0)
2056 return FALSE;
2057 tk = qd[HEAP_START];
2058 tv = qd[HEAP_START+1];
2059 return Yap_unify(tk, ARG2) &&
2060 Yap_unify(tv, ARG3);
2061 }
2062
2063 static Int
p_nb_heap_empty(void)2064 p_nb_heap_empty(void)
2065 {
2066 CELL *qd = GetHeap(ARG1,"heap_empty");
2067
2068 if (!qd)
2069 return FALSE;
2070 return (IntegerOfTerm(qd[HEAP_SIZE]) == 0);
2071 }
2072
2073 static Int
p_nb_heap_size(void)2074 p_nb_heap_size(void)
2075 {
2076 CELL *qd = GetHeap(ARG1,"heap_size");
2077
2078 if (!qd)
2079 return FALSE;
2080 return Yap_unify(ARG2,qd[HEAP_SIZE]);
2081 }
2082
2083 static Int
p_nb_beam(void)2084 p_nb_beam(void)
2085 {
2086 Term beam_arena, beam, *ar, *nar;
2087 UInt hsize;
2088 Term tsize = Deref(ARG1);
2089 UInt arena_sz = (H-H0)/16;
2090
2091 if (IsVarTerm(tsize)) {
2092 Yap_Error(INSTANTIATION_ERROR,tsize,"nb_beam");
2093 return FALSE;
2094 } else {
2095 if (!IsIntegerTerm(tsize)) {
2096 Yap_Error(TYPE_ERROR_INTEGER,tsize,"nb_beam");
2097 return FALSE;
2098 }
2099 hsize = IntegerOfTerm(tsize);
2100 }
2101 while ((beam = MkZeroApplTerm(Yap_MkFunctor(AtomHeap,5*hsize+HEAP_START+1),5*hsize+HEAP_START+1)) == TermNil) {
2102 if (!Yap_gcl((4*hsize+HEAP_START+1)*sizeof(CELL), 2, ENV, P)) {
2103 Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
2104 return FALSE;
2105 }
2106 }
2107 if (!Yap_unify(beam,ARG2))
2108 return FALSE;
2109 ar = RepAppl(beam)+1;
2110 ar[HEAP_ARENA] =
2111 ar[HEAP_SIZE] =
2112 MkIntTerm(0);
2113 ar[HEAP_MAX] = tsize;
2114 if (arena_sz < 1024)
2115 arena_sz = 1024;
2116 beam_arena = NewArena(arena_sz,1,NULL);
2117 if (beam_arena == 0L) {
2118 return FALSE;
2119 }
2120 nar = RepAppl(Deref(ARG2))+1;
2121 nar[HEAP_ARENA] = beam_arena;
2122 return TRUE;
2123 }
2124
2125 static Int
p_nb_beam_close(void)2126 p_nb_beam_close(void)
2127 {
2128 return p_nb_heap_close();
2129 }
2130
2131
2132 /* we have two queues, one with
2133 Key, IndxQueue2
2134 the other with
2135 Key, IndxQueue1, Val
2136 */
2137 static void
PushBeam(CELL * pt,CELL * npt,UInt hsize,Term key,Term to)2138 PushBeam(CELL *pt, CELL *npt, UInt hsize, Term key, Term to)
2139 {
2140 UInt off = hsize, off2 = hsize;
2141 Term toff, toff2;
2142
2143 /* push into first queue */
2144 while (off) {
2145 UInt noff = (off+1)/2-1;
2146 if (Yap_compare_terms(key, pt[2*noff]) < 0) {
2147 UInt i2 = IntegerOfTerm(pt[2*noff+1]);
2148
2149 pt[2*off] = pt[2*noff];
2150 pt[2*off+1] = pt[2*noff+1];
2151 npt[3*i2+1] = Global_MkIntegerTerm(off);
2152 off = noff;
2153 } else {
2154 break;
2155 }
2156 }
2157 toff = Global_MkIntegerTerm(off);
2158 /* off says where we are in first queue */
2159 /* push into second queue */
2160 while (off2) {
2161 UInt noff = (off2+1)/2-1;
2162 if (Yap_compare_terms(key, npt[3*noff]) > 0) {
2163 UInt i1 = IntegerOfTerm(npt[3*noff+1]);
2164
2165 npt[3*off2] = npt[3*noff];
2166 npt[3*off2+1] = npt[3*noff+1];
2167 npt[3*off2+2] = npt[3*noff+2];
2168 pt[2*i1+1] = Global_MkIntegerTerm(off2);
2169 off2 = noff;
2170 } else {
2171 break;
2172 }
2173 }
2174 toff2 = Global_MkIntegerTerm(off2);
2175 /* store elements in their rightful place */
2176 npt[3*off2] = pt[2*off] = key;
2177 pt[2*off+1] = toff2;
2178 npt[3*off2+1] = toff;
2179 npt[3*off2+2] = to;
2180 }
2181
2182 static void
DelBeamMax(CELL * pt,CELL * pt2,UInt sz)2183 DelBeamMax(CELL *pt, CELL *pt2, UInt sz)
2184 {
2185 UInt off = IntegerOfTerm(pt2[1]);
2186 UInt indx = 0;
2187 Term tk, ti, tv;
2188
2189 sz--;
2190 /* first, fix the reverse queue */
2191 tk = pt2[3*sz];
2192 ti = pt2[3*sz+1];
2193 tv = pt2[3*sz+2];
2194 while (TRUE) {
2195 if (sz < 2*indx+3 || Yap_compare_terms(pt2[6*indx+3],pt2[6*indx+6]) > 0) {
2196 if (sz < 2*indx+2 || Yap_compare_terms(tk, pt2[6*indx+3]) > 0) {
2197 break;
2198 } else {
2199 UInt off = IntegerOfTerm(pt2[6*indx+4]);
2200
2201 pt2[3*indx] = pt2[6*indx+3];
2202 pt2[3*indx+1] = pt2[6*indx+4];
2203 pt2[3*indx+2] = pt2[6*indx+5];
2204 pt[2*off+1] = Global_MkIntegerTerm(indx);
2205 indx = 2*indx+1;
2206 }
2207 } else {
2208 if (Yap_compare_terms(tk, pt2[6*indx+6]) > 0) {
2209 break;
2210 } else {
2211 UInt off = IntegerOfTerm(pt2[6*indx+7]);
2212
2213 pt2[3*indx] = pt2[6*indx+6];
2214 pt2[3*indx+1] = pt2[6*indx+7];
2215 pt2[3*indx+2] = pt2[6*indx+8];
2216 pt[2*off+1] = Global_MkIntegerTerm(indx);
2217 indx = 2*indx+2;
2218 }
2219 }
2220 }
2221 pt[2*IntegerOfTerm(ti)+1] = Global_MkIntegerTerm(indx);
2222 pt2[3*indx] = tk;
2223 pt2[3*indx+1] = ti;
2224 pt2[3*indx+2] = tv;
2225 /* now, fix the standard queue */
2226 if (off != sz) {
2227 Term toff, toff2, key;
2228 UInt off2;
2229
2230 key = pt[2*sz];
2231 toff2 = pt[2*sz+1];
2232 off2 = IntegerOfTerm(toff2);
2233 /* off says where we are in first queue */
2234 /* push into second queue */
2235 while (off) {
2236 UInt noff = (off+1)/2-1;
2237 if (Yap_compare_terms(key, pt[2*noff]) < 0) {
2238 UInt i1 = IntegerOfTerm(pt[2*noff+1]);
2239
2240 pt[2*off] = pt[2*noff];
2241 pt[2*off+1] = pt[2*noff+1];
2242 pt2[3*i1+1] = Global_MkIntegerTerm(off);
2243 off = noff;
2244 } else {
2245 break;
2246 }
2247 }
2248 toff = Global_MkIntegerTerm(off);
2249 /* store elements in their rightful place */
2250 pt[2*off] = key;
2251 pt2[3*off2+1] = toff;
2252 pt[2*off+1] = toff2;
2253 }
2254 }
2255
2256 static Term
DelBeamMin(CELL * pt,CELL * pt2,UInt sz)2257 DelBeamMin(CELL *pt, CELL *pt2, UInt sz)
2258 {
2259 UInt off2 = IntegerOfTerm(pt[1]);
2260 Term ov = pt2[3*off2+2]; /* return value */
2261 UInt indx = 0;
2262 Term tk, tv;
2263
2264 sz--;
2265 /* first, fix the standard queue */
2266 tk = pt[2*sz];
2267 tv = pt[2*sz+1];
2268 while (TRUE) {
2269 if (sz < 2*indx+3 || Yap_compare_terms(pt[4*indx+2],pt[4*indx+4]) < 0) {
2270 if (sz < 2*indx+2 || Yap_compare_terms(tk, pt[4*indx+2]) < 0) {
2271 break;
2272 } else {
2273 UInt off2 = IntegerOfTerm(pt[4*indx+3]);
2274 pt[2*indx] = pt[4*indx+2];
2275 pt[2*indx+1] = pt[4*indx+3];
2276 pt2[3*off2+1] = Global_MkIntegerTerm(indx);
2277 indx = 2*indx+1;
2278 }
2279 } else {
2280 if (Yap_compare_terms(tk, pt[4*indx+4]) < 0) {
2281 break;
2282 } else {
2283 UInt off2 = IntegerOfTerm(pt[4*indx+5]);
2284
2285 pt[2*indx] = pt[4*indx+4];
2286 pt[2*indx+1] = pt[4*indx+5];
2287 pt2[3*off2+1] = Global_MkIntegerTerm(indx);
2288 indx = 2*indx+2;
2289 }
2290 }
2291 }
2292 pt[2*indx] = tk;
2293 pt[2*indx+1] = tv;
2294 pt2[3*IntegerOfTerm(tv)+1] = Global_MkIntegerTerm(indx);
2295 /* now, fix the reverse queue */
2296 if (off2 != sz) {
2297 Term to, toff, toff2, key;
2298 UInt off;
2299
2300 key = pt2[3*sz];
2301 toff = pt2[3*sz+1];
2302 to = pt2[3*sz+2];
2303 off = IntegerOfTerm(toff);
2304 /* off says where we are in first queue */
2305 /* push into second queue */
2306 while (off2) {
2307 UInt noff = (off2+1)/2-1;
2308 if (Yap_compare_terms(key, pt2[3*noff]) > 0) {
2309 UInt i1 = IntegerOfTerm(pt2[3*noff+1]);
2310
2311 pt2[3*off2] = pt2[3*noff];
2312 pt2[3*off2+1] = pt2[3*noff+1];
2313 pt2[3*off2+2] = pt2[3*noff+2];
2314 pt[2*i1+1] = Global_MkIntegerTerm(off2);
2315 off2 = noff;
2316 } else {
2317 break;
2318 }
2319 }
2320 toff2 = Global_MkIntegerTerm(off2);
2321 /* store elements in their rightful place */
2322 pt2[3*off2] = key;
2323 pt[2*off+1] = toff2;
2324 pt2[3*off2+1] = toff;
2325 pt2[3*off2+2] = to;
2326 }
2327 return ov;
2328 }
2329
2330 static Int
p_nb_beam_add_to_beam(void)2331 p_nb_beam_add_to_beam(void)
2332 {
2333 CELL *qd = GetHeap(ARG1,"add_to_beam"), *oldH, *oldHB, *pt;
2334 UInt hsize, hmsize, old_sz;
2335 Term arena, to, key;
2336 UInt mingrow;
2337
2338 if (!qd)
2339 return FALSE;
2340 hsize = IntegerOfTerm(qd[HEAP_SIZE]);
2341 hmsize = IntegerOfTerm(qd[HEAP_MAX]);
2342 key = Deref(ARG2);
2343 if (hsize == hmsize) {
2344 pt = qd+HEAP_START;
2345 if (Yap_compare_terms(pt[2*hmsize],Deref(ARG2)) > 0) {
2346 /* smaller than current max, we need to drop current max */
2347 DelBeamMax(pt, pt+2*hmsize, hmsize);
2348 hsize--;
2349 } else {
2350 return TRUE;
2351 }
2352 }
2353 arena = qd[HEAP_ARENA];
2354 if (arena == 0L)
2355 return FALSE;
2356 mingrow = garena_overflow_size(ArenaPt(arena));
2357 key = CopyTermToArena(ARG2, qd[HEAP_ARENA], FALSE, TRUE, 3, qd+HEAP_ARENA, mingrow);
2358 arena = qd[HEAP_ARENA];
2359 to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, mingrow);
2360 if (key == 0 || to == 0L)
2361 return FALSE;
2362 qd = GetHeap(ARG1,"add_to_beam");
2363 arena = qd[HEAP_ARENA];
2364 /* garbage collection ? */
2365 oldH = H;
2366 oldHB = HB;
2367 H = HB = ArenaPt(arena);
2368 old_sz = ArenaSz(arena);
2369 while (old_sz < MIN_ARENA_SIZE) {
2370 UInt gsiz = hsize*2;
2371
2372 H = oldH;
2373 HB = oldHB;
2374 if (gsiz > 1024*1024) {
2375 gsiz = 1024*1024;
2376 } else if (gsiz < 1024) {
2377 gsiz = 1024;
2378 }
2379 ARG3 = to;
2380 if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) {
2381 Yap_Error(OUT_OF_STACK_ERROR, arena, Yap_ErrorMessage);
2382 return 0L;
2383 }
2384 to = ARG3;
2385 qd = RepAppl(Deref(ARG1))+1;
2386 arena = qd[HEAP_ARENA];
2387 oldH = H;
2388 oldHB = HB;
2389 H = HB = ArenaPt(arena);
2390 old_sz = ArenaSz(arena);
2391 }
2392 pt = qd+HEAP_START;
2393 PushBeam(pt, pt+2*hmsize, hsize, key, to);
2394 qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize+1);
2395 CloseArena(oldH, oldHB, ASP, qd+HEAP_ARENA, old_sz);
2396 return TRUE;
2397 }
2398
2399 static Int
p_nb_beam_del(void)2400 p_nb_beam_del(void)
2401 {
2402 CELL *qd = GetHeap(ARG1,"debeam");
2403 UInt old_sz, qsz;
2404 Term arena;
2405 CELL *oldH, *oldHB;
2406 Term tk, tv;
2407
2408 if (!qd)
2409 return FALSE;
2410 qsz = IntegerOfTerm(qd[HEAP_SIZE]);
2411 if (qsz == 0)
2412 return FALSE;
2413 arena = qd[HEAP_ARENA];
2414 if (arena == 0L)
2415 return FALSE;
2416 old_sz = ArenaSz(arena);
2417 /* garbage collection ? */
2418 oldH = H;
2419 oldHB = HB;
2420 qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz-1);
2421 CloseArena(oldH, oldHB, ASP, &arena, old_sz);
2422 tk = qd[HEAP_START];
2423 tv = DelBeamMin(qd+HEAP_START, qd+(HEAP_START+2*IntegerOfTerm(qd[HEAP_MAX])), qsz);
2424 return Yap_unify(tk, ARG2) &&
2425 Yap_unify(tv, ARG3);
2426 }
2427
2428 #ifdef DEBUG
2429 static Int
p_nb_beam_check(void)2430 p_nb_beam_check(void)
2431 {
2432 CELL *qd = GetHeap(ARG1,"debeam");
2433 UInt qsz, qmax;
2434 CELL *pt, *pt2;
2435 UInt i;
2436
2437 if (!qd)
2438 return FALSE;
2439 qsz = IntegerOfTerm(qd[HEAP_SIZE]);
2440 qmax = IntegerOfTerm(qd[HEAP_MAX]);
2441 if (qsz == 0)
2442 return TRUE;
2443 pt = qd+HEAP_START;
2444 pt2 = pt+2*qmax;
2445 for (i = 1; i < qsz; i++) {
2446 UInt back;
2447 if (Yap_compare_terms(pt[2*((i+1)/2-1)],pt[2*i]) > 0) {
2448 Yap_DebugPlWrite(pt[2*((i+1)/2-1)]); fprintf(stderr,"\n");
2449 Yap_DebugPlWrite(pt[2*i]); fprintf(stderr,"\n");
2450 fprintf(stderr,"Error at %ld\n",(unsigned long int)i);
2451 return FALSE;
2452 }
2453 back = IntegerOfTerm(pt[2*i+1]);
2454 if (IntegerOfTerm(pt2[3*back+1]) != i) {
2455 fprintf(stderr,"Link error at %ld\n",(unsigned long int)i);
2456 return FALSE;
2457 }
2458 }
2459 for (i = 1; i < qsz; i++) {
2460 if (Yap_compare_terms(pt2[3*((i+1)/2-1)],pt2[3*i]) < 0) {
2461 fprintf(stderr,"Error at sec %ld\n",(unsigned long int)i);
2462 Yap_DebugPlWrite(pt2[3*((i+1)/2-1)]); fprintf(stderr,"\n");
2463 Yap_DebugPlWrite(pt2[3*i]); fprintf(stderr,"\n");
2464 return FALSE;
2465 }
2466 }
2467 return TRUE;
2468 }
2469
2470 #endif
2471
2472 static Int
p_nb_beam_keys(void)2473 p_nb_beam_keys(void)
2474 {
2475 CELL *qd;
2476 UInt qsz;
2477 CELL *pt, *ho;
2478 UInt i;
2479
2480 restart:
2481 qd = GetHeap(ARG1,"beam_keys");
2482 if (!qd)
2483 return FALSE;
2484 qsz = IntegerOfTerm(qd[HEAP_SIZE]);
2485 ho = H;
2486 pt = qd+HEAP_START;
2487 if (qsz == 0)
2488 return Yap_unify(ARG2, TermNil);
2489 for (i=0; i < qsz; i++) {
2490 if (H > ASP-1024) {
2491 H = ho;
2492 if (!Yap_gcl(((ASP-H)-1024)*sizeof(CELL), 2, ENV, P)) {
2493 Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
2494 return TermNil;
2495 }
2496 goto restart;
2497 }
2498 *H++ = pt[0];
2499 *H = AbsPair(H+1);
2500 H++;
2501 pt += 2;
2502 }
2503 H[-1] = TermNil;
2504 return Yap_unify(ARG2, AbsPair(ho));
2505 }
2506
2507 static Int
p_nb_beam_peek(void)2508 p_nb_beam_peek(void)
2509 {
2510 CELL *qd = GetHeap(ARG1,"beam_peek"), *pt, *pt2;
2511 UInt qsz, qbsize;
2512 Term tk, tv;
2513
2514 if (!qd)
2515 return FALSE;
2516 qsz = IntegerOfTerm(qd[HEAP_SIZE]);
2517 qbsize = IntegerOfTerm(qd[HEAP_MAX]);
2518 if (qsz == 0)
2519 return FALSE;
2520 pt = qd+HEAP_START;
2521 pt2 = pt+2*qbsize;
2522 tk = pt[0];
2523 tv = pt2[2];
2524 return Yap_unify(tk, ARG2) &&
2525 Yap_unify(tv, ARG3);
2526 }
2527
2528 static Int
p_nb_beam_empty(void)2529 p_nb_beam_empty(void)
2530 {
2531 CELL *qd = GetHeap(ARG1,"beam_empty");
2532
2533 if (!qd)
2534 return FALSE;
2535 return (IntegerOfTerm(qd[HEAP_SIZE]) == 0);
2536 }
2537
2538 static Int
p_nb_beam_size(void)2539 p_nb_beam_size(void)
2540 {
2541 CELL *qd = GetHeap(ARG1,"beam_size");
2542
2543 if (!qd)
2544 return FALSE;
2545 return Yap_unify(ARG2,qd[HEAP_SIZE]);
2546 }
2547
2548 static Int
cont_current_nb(void)2549 cont_current_nb(void)
2550 {
2551 Int unif;
2552 GlobalEntry *ge = (GlobalEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(1,1));
2553
2554 unif = Yap_unify(MkAtomTerm(AbsAtom(ge->AtomOfGE)), ARG1);
2555 ge = ge->NextGE;
2556 if (!ge) {
2557 if (unif)
2558 cut_succeed();
2559 else
2560 cut_fail();
2561 } else {
2562 EXTRA_CBACK_ARG(1,1) = MkIntegerTerm((Int)ge);
2563 return unif;
2564 }
2565 }
2566
2567 static Int
init_current_nb(void)2568 init_current_nb(void)
2569 { /* current_atom(?Atom) */
2570 Term t1 = Deref(ARG1);
2571 if (!IsVarTerm(t1)) {
2572 if (IsAtomTerm(t1)) {
2573 if (!FindGlobalEntry(AtomOfTerm(t1))) {
2574 cut_fail();
2575 } else {
2576 cut_succeed();
2577 }
2578 } else {
2579 Yap_Error(TYPE_ERROR_ATOM,t1,"nb_current");
2580 cut_fail();
2581 }
2582 }
2583 READ_LOCK(HashChain[0].AERWLock);
2584 EXTRA_CBACK_ARG(1,1) = MkIntegerTerm((Int)GlobalVariables);
2585 return cont_current_nb();
2586 }
2587
2588
Yap_InitGlobals(void)2589 void Yap_InitGlobals(void)
2590 {
2591 Term cm = CurrentModule;
2592 Yap_InitCPred("$allocate_arena", 2, p_allocate_arena, 0);
2593 Yap_InitCPred("arena_size", 1, p_default_arena_size, 0);
2594 Yap_InitCPred("b_setval", 2, p_b_setval, SafePredFlag);
2595 Yap_InitCPred("nb_setval", 2, p_nb_setval, 0L);
2596 Yap_InitCPred("nb_set_shared_val", 2, p_nb_set_shared_val, 0L);
2597 Yap_InitCPred("nb_linkval", 2, p_nb_linkval, 0L);
2598 Yap_InitCPred("$nb_getval", 3, p_nb_getval, SafePredFlag);
2599 Yap_InitCPred("nb_setarg", 3, p_nb_setarg, 0L);
2600 Yap_InitCPred("nb_set_shared_arg", 3, p_nb_set_shared_arg, 0L);
2601 Yap_InitCPred("nb_linkarg", 3, p_nb_linkarg, 0L);
2602 Yap_InitCPred("nb_delete", 1, p_nb_delete, 0L);
2603 Yap_InitCPred("nb_create", 3, p_nb_create, 0L);
2604 Yap_InitCPred("nb_create", 4, p_nb_create2, 0L);
2605 Yap_InitCPredBack("$nb_current", 1, 1, init_current_nb, cont_current_nb, SafePredFlag);
2606 CurrentModule = GLOBALS_MODULE;
2607 Yap_InitCPred("nb_queue", 1, p_nb_queue, 0L);
2608 Yap_InitCPred("nb_queue", 2, p_nb_queue_sized, 0L);
2609 Yap_InitCPred("nb_queue_close", 3, p_nb_queue_close, SafePredFlag);
2610 Yap_InitCPred("nb_queue_enqueue", 2, p_nb_queue_enqueue, 0L);
2611 Yap_InitCPred("nb_queue_dequeue", 2, p_nb_queue_dequeue, SafePredFlag);
2612 Yap_InitCPred("nb_queue_peek", 2, p_nb_queue_peek, SafePredFlag);
2613 Yap_InitCPred("nb_queue_empty", 1, p_nb_queue_empty, SafePredFlag);
2614 Yap_InitCPred("nb_queue_size", 2, p_nb_queue_size, SafePredFlag);
2615 Yap_InitCPred("nb_heap", 2, p_nb_heap, 0L);
2616 Yap_InitCPred("nb_heap_close", 1, p_nb_heap_close, SafePredFlag);
2617 Yap_InitCPred("nb_heap_add", 3, p_nb_heap_add_to_heap, 0L);
2618 Yap_InitCPred("nb_heap_del", 3, p_nb_heap_del, SafePredFlag);
2619 Yap_InitCPred("nb_heap_peek", 3, p_nb_heap_peek, SafePredFlag);
2620 Yap_InitCPred("nb_heap_empty", 1, p_nb_heap_empty, SafePredFlag);
2621 Yap_InitCPred("nb_heap_size", 2, p_nb_heap_size, SafePredFlag);
2622 Yap_InitCPred("nb_beam", 2, p_nb_beam, 0L);
2623 Yap_InitCPred("nb_beam_close", 1, p_nb_beam_close, SafePredFlag);
2624 Yap_InitCPred("nb_beam_add", 3, p_nb_beam_add_to_beam, 0L);
2625 Yap_InitCPred("nb_beam_del", 3, p_nb_beam_del, SafePredFlag);
2626 Yap_InitCPred("nb_beam_peek", 3, p_nb_beam_peek, SafePredFlag);
2627 Yap_InitCPred("nb_beam_empty", 1, p_nb_beam_empty, SafePredFlag);
2628 Yap_InitCPred("nb_beam_keys", 2, p_nb_beam_keys, 0L);
2629 Yap_InitCPred("nb_create_accumulator", 2, p_nb_create_accumulator, 0L);
2630 Yap_InitCPred("nb_add_to_accumulator", 2, p_nb_add_to_accumulator, 0L);
2631 Yap_InitCPred("nb_accumulator_value", 2, p_nb_accumulator_value, 0L);
2632 #ifdef DEBUG
2633 Yap_InitCPred("nb_beam_check", 1, p_nb_beam_check, SafePredFlag);
2634 #endif
2635 Yap_InitCPred("nb_beam_size", 2, p_nb_beam_size, SafePredFlag);
2636 CurrentModule = cm;
2637 }
2638