YAP 7.1.0
globals.c
Go to the documentation of this file.
1
93#ifndef GLOBALS_C
94#define GLOBALS_C 1
95
96#include "Yap.h"
97#include "YapEval.h"
98#include "YapHeap.h"
99#include "Yatom.h"
100#include "attvar.h"
101#include "clause.h"
102#include "heapgc.h"
103#include "iopreds.h"
104#include "yapio.h"
105#include <math.h>
106
107#include "YapArenas.h"
108#include "YapError.h"
109
110#include "terms.h"
111
112#ifdef HAVE_STRING_H
113
114#include "string.h"
115
116#endif
117
118/* Non-backtrackable terms will from now on be stored on arenas, a
119 special term on the heap. Arenas automatically contract as we add terms to
120 the front.
121
122*/
123
124#define QUEUE_FUNCTOR_ARITY 4
125
126#define QUEUE_ARENA 0
127#define QUEUE_HEAD 1
128#define QUEUE_TAIL 2
129#define QUEUE_SIZE 3
130
131#define HEAP_FUNCTOR_MIN_ARITY
132
133#define HEAP_SIZE 0
134#define HEAP_MAX 1
135#define HEAP_ARENA 2
136#define HEAP_START 3
137
138
139inline static GlobalEntry *FindGlobalEntry(Atom at USES_REGS)
140/* get predicate entry for ap/arity; create it if neccessary. */
141{
142 Prop p0;
143 AtomEntry *ae = RepAtom(at);
144
145 READ_LOCK(ae->ARWLock);
146 p0 = ae->PropsOfAE;
147 while (p0) {
148 GlobalEntry *pe = RepGlobalProp(p0);
149 if (pe->KindOfPE == GlobalProperty
150#if THREADS
151 && pe->owner_id == worker_id
152#endif
153 ) {
154 READ_UNLOCK(ae->ARWLock);
155 return pe;
156 }
157 p0 = pe->NextOfPE;
158 }
159 READ_UNLOCK(ae->ARWLock);
160 return NULL;
161}
162
163
164
165static Int nb_create_accumulator(USES_REGS1) {
166 Term t = Deref(ARG1), acct, to, t2;
167 CELL *destp;
168
169 if (IsVarTerm(t)) {
170 Yap_ThrowError(INSTANTIATION_ERROR, t, "nb_create_accumulator");
171 return FALSE;
172 }
173 if (!IsIntegerTerm(t) && !IsBigIntTerm(t) && !IsFloatTerm(t)) {
174 Yap_ThrowError(TYPE_ERROR_NUMBER, t, "nb_create_accumulator");
175 return FALSE;
176 }
177 acct = Yap_MkApplTerm(FunctorGNumber, 1, &t);
178 if (!Yap_unify(ARG2, acct)) {
179 return FALSE;
180 }
181 COPY(t);
182 to = CopyTermToArena(t, TRUE, TRUE, NULL, &LOCAL_GlobalArena, NULL PASS_REGS);
183 if (to == 0L)
184 return FALSE;
185 t2 = Deref(ARG2);
186 if (IsVarTerm(t2)) {
187 return Yap_unify(t2, Yap_MkApplTerm(FunctorGNumber, 1, &to));
188 }
189 destp = RepAppl(Deref(ARG2));
190 destp[1] = to;
191 return TRUE;
192}
193
194static Int nb_add_to_accumulator(USES_REGS1) {
195 Term t = Deref(ARG1), t0, tadd;
196 Functor f;
197 CELL *destp;
198
199 if (IsVarTerm(t)) {
200 Yap_ThrowError(INSTANTIATION_ERROR, t, "nb_crate_accumulator");
201 return FALSE;
202 }
203 if (!IsApplTerm(t)) {
204 Yap_ThrowError(TYPE_ERROR_NUMBER, t, "nb_accumulator_value");
205 return FALSE;
206 }
207 f = FunctorOfTerm(t);
208 if (f != FunctorGNumber) {
209 return FALSE;
210 }
211 destp = RepAppl(t);
212 t0 = Deref(destp[1]);
213 tadd = Deref(ARG2);
214 if (IsVarTerm(tadd)) {
215 Yap_ThrowError(INSTANTIATION_ERROR, tadd, "nb_create_accumulator");
216 return FALSE;
217 }
218 if (IsIntegerTerm(t0) && IsIntegerTerm(tadd)) {
219 Int i0 = IntegerOfTerm(t0);
220 Int i1 = IntegerOfTerm(tadd);
221 Term new = MkIntegerTerm(i0 + i1);
222
223 if (IsIntTerm(new)) {
224 /* forget it if it was something else */
225 destp[1] = new;
226 } else {
227 /* long, do we have space or not ?? */
228 if (IsLongIntTerm(t0)) {
229 CELL *target = RepAppl(t0);
230 CELL *source = RepAppl(new);
231 target[1] = source[1];
232 } else {
233 /* we need to create a new long int */
234 COPY(new);
235 new = CopyTermToArena(new, TRUE, TRUE, NULL, &LOCAL_GlobalArena, NULL PASS_REGS);
236 destp = RepAppl(Deref(ARG1));
237 destp[1] = new;
238 }
239 }
240 return TRUE;
241 }
242 if (IsFloatTerm(t0) && IsFloatTerm(tadd)) {
243 Float f0 = FloatOfTerm(t0);
244 Float f1 = FloatOfTerm(tadd);
245 Term new = MkFloatTerm(f0 + f1);
246 CELL *target = RepAppl(t0);
247 CELL *source = RepAppl(new);
248
249#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
250 target[2] = source[2];
251#endif
252 target[1] = source[1];
253 return TRUE;
254 }
255 if (IsNumTerm(t0) && IsNumTerm(tadd)) {
256 Term t2[2], new;
257 t2[0] = t0;
258 t2[1] = tadd;
259 new = Yap_MkApplTerm(FunctorPlus, 2, t2);
260
261 new = Yap_Eval(new);
262 COPY(new);
263 new = CopyTermToArena(new, TRUE, TRUE, NULL, &(LOCAL_GlobalArena), NULL PASS_REGS);
264 destp = RepAppl(Deref(ARG1));
265 destp[1] = new;
266
267 return TRUE;
268 }
269 return FALSE;
270}
271
272static Int nb_accumulator_value(USES_REGS1) {
273 Term t = Deref(ARG1);
274 Functor f;
275
276 if (IsVarTerm(t)) {
277 Yap_ThrowError(INSTANTIATION_ERROR, t, "nb_accumulator_value");
278 return FALSE;
279 }
280 if (!IsApplTerm(t)) {
281 Yap_ThrowError(TYPE_ERROR_NUMBER, t, "nb_accumulator_value");
282 return FALSE;
283 }
284 f = FunctorOfTerm(t);
285 if (f != FunctorGNumber) {
286 return FALSE;
287 }
288 return Yap_unify(ArgOfTerm(1, t), ARG2);
289}
290
291Term Yap_SetGlobalVal(Atom at, Term t0) {
292 CACHE_REGS
293 Term to;
294 GlobalEntry *ge;
295 ge = GetGlobalEntry(at PASS_REGS);
296 COPY(t0);
297 to = CopyTermToArena(t0, FALSE, TRUE, NULL, &(LOCAL_GlobalArena), NULL PASS_REGS);
298 if (to == 0L)
299 return to;
300 WRITE_LOCK(ge->GRWLock);
301 ge->global = to;
302 WRITE_UNLOCK(ge->GRWLock);
303 return to;
304}
305
306Term Yap_CopyTermToArena(Term inp, Term *arenap) {
307 CACHE_REGS
308 return CopyTermToArena(inp, false, true, NULL, arenap, NULL PASS_REGS);
309}
310
311Term Yap_SaveTerm(Term t0) {
312 CACHE_REGS
313 Term to;
314 to = CopyTermToArena(Deref(t0), false, true, NULL, &LOCAL_GlobalArena, NULL PASS_REGS);
315 if (to == 0L)
316 return to;
317 return to;
318}
319
329static Int nb_setval(USES_REGS1) {
330 Term t = Deref(ARG1);
331 if (IsVarTerm(t)) {
332 Yap_ThrowError(INSTANTIATION_ERROR, t, "nb_setval");
333 return false;
334 } else if (!IsAtomTerm(t)) {
335 Yap_ThrowError(TYPE_ERROR_ATOM, t, "nb_setval");
336 return (FALSE);
337 }
338 return Yap_SetGlobalVal(AtomOfTerm(t), ARG2) != 0;
339}
340
367static Int nb_set_shared_val(USES_REGS1) {
368 Term t = Deref(ARG1), to;
369 GlobalEntry *ge;
370 if (IsVarTerm(t)) {
371 Yap_ThrowError(INSTANTIATION_ERROR, t, "nb_setval");
372 return (TermNil);
373 } else if (!IsAtomTerm(t)) {
374 Yap_ThrowError(TYPE_ERROR_ATOM, t, "nb_setval");
375 return (FALSE);
376 }
377 ge = GetGlobalEntry(AtomOfTerm(t) PASS_REGS);
378 COPY(ARG2);
379 to = CopyTermToArena(ARG2, TRUE, TRUE, NULL, &LOCAL_GlobalArena, NULL PASS_REGS);
380 if (to == 0L)
381 return FALSE;
382 WRITE_LOCK(ge->GRWLock);
383 ge->global = to;
384 WRITE_UNLOCK(ge->GRWLock);
385 return TRUE;
386}
387
388static Int p_b_setval(USES_REGS1) {
389 Term t = Deref(ARG1);
390 GlobalEntry *ge;
391
392 if (IsVarTerm(t)) {
393 Yap_ThrowError(INSTANTIATION_ERROR, t, "b_setval");
394 return (TermNil);
395 } else if (!IsAtomTerm(t)) {
396 Yap_ThrowError(TYPE_ERROR_ATOM, t, "b_setval");
397 return (FALSE);
398 }
399 ge = GetGlobalEntry(AtomOfTerm(t) PASS_REGS);
400 WRITE_LOCK(ge->GRWLock);
401#ifdef MULTI_ASSIGNMENT_VARIABLES
402 /* the evil deed is to be done now */
403 {
404 /* but first make sure we are doing on a global object, or a constant!
405 */
406 Term t = Deref(ARG2);
407 if (IsVarTerm(t) && VarOfTerm(t) > HR && VarOfTerm(t) < LCL0) {
408 Term tn = MkVarTerm();
409 Bind_Local(VarOfTerm(t), tn);
410 t = tn;
411 }
412 MaBind(&ge->global, t);
413 }
414 WRITE_UNLOCK(ge->GRWLock);
415 return TRUE;
416#else
417 WRITE_UNLOCK(ge->GRWLock);
418 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, t, "update_array");
419 return FALSE;
420#endif
421}
422
423static int undefined_global(USES_REGS1) {
424 Term t3 = Deref(ARG3);
425
426 if (IsApplTerm(t3)) {
427 if (FunctorOfTerm(t3) == FunctorEq)
428 return Yap_unify(ArgOfTerm(1, t3), ArgOfTerm(2, t3));
429 return FALSE;
430 }
431 return Yap_unify(t3, TermNil);
432}
433
434static Int nb_getval(USES_REGS1) {
435 Term t = Deref(ARG1), to;
436 GlobalEntry *ge;
437
438 if (IsVarTerm(t)) {
439 Yap_ThrowError(INSTANTIATION_ERROR, t, "nb_getval");
440 return FALSE;
441 } else if (!IsAtomTerm(t)) {
442 Yap_ThrowError(TYPE_ERROR_ATOM, t, "nb_getval");
443 return FALSE;
444 }
445 ge = FindGlobalEntry(AtomOfTerm(t) PASS_REGS);
446 if (!ge)
447 return undefined_global(PASS_REGS1);
448 READ_LOCK(ge->GRWLock);
449 to = ge->global;
450 if (!to)
451 Yap_ThrowError(INSTANTIATION_ERROR, ARG1, "nb_getval");
452 READ_UNLOCK(ge->GRWLock);
453 if (to == TermFoundVar) {
454 return FALSE;
455 }
456 return Yap_unify(ARG2, to);
457}
458
459Term Yap_GetGlobal(Atom at) {
460 CACHE_REGS
461 GlobalEntry *ge;
462 Term to;
463
464 ge = FindGlobalEntry(at PASS_REGS);
465 if (!ge)
466 return 0L;
467 READ_LOCK(ge->GRWLock);
468 to = ge->global;
469 if (IsVarTerm(to) && IsUnboundVar(VarOfTerm(to))) {
470 Term t = MkVarTerm();
471 Bind_and_Trail(VarOfTerm(to), t);
472 to = t;
473 }
474 READ_UNLOCK(ge->GRWLock);
475 if (to == TermFoundVar) {
476 return 0;
477 }
478 return to;
479}
480
498static Int nbdelete(Atom at USES_REGS) {
499 GlobalEntry *ge, *g;
500 AtomEntry *ae;
501 Prop gp, g0;
502
503 ge = FindGlobalEntry(at PASS_REGS);
504 if (!ge) {
505 Yap_ThrowError(EXISTENCE_ERROR_VARIABLE, MkAtomTerm(at), "nb_delete");
506 return FALSE;
507 }
508 WRITE_LOCK(ge->GRWLock);
509 ae = ge->AtomOfGE;
510 if (LOCAL_GlobalVariables == ge) {
511 LOCAL_GlobalVariables = ge->NextGE;
512 } else {
513 g = LOCAL_GlobalVariables;
514 while (g->NextGE != ge)
515 g = g->NextGE;
516 g->NextGE = ge->NextGE;
517 }
518 gp = AbsGlobalProp(ge);
519 WRITE_LOCK(ae->ARWLock);
520 if (ae->PropsOfAE == gp) {
521 ae->PropsOfAE = ge->NextOfPE;
522 } else {
523 g0 = ae->PropsOfAE;
524 while (g0->NextOfPE != gp)
525 g0 = g0->NextOfPE;
526 g0->NextOfPE = ge->NextOfPE;
527 }
528 WRITE_UNLOCK(ae->ARWLock);
529 WRITE_UNLOCK(ge->GRWLock);
530 Yap_FreeCodeSpace((char *) ge);
531 return TRUE;
532}
533
534Int Yap_DeleteGlobal(Atom at) {
535 CACHE_REGS
536 return nbdelete(at PASS_REGS);
537}
538
539static Int nb_delete(USES_REGS1) {
540 Term t = Deref(ARG1);
541
542 if (IsVarTerm(t)) {
543 Yap_ThrowError(INSTANTIATION_ERROR, t, "nb_delete");
544 return FALSE;
545 } else if (!IsAtomTerm(t)) {
546 Yap_ThrowError(TYPE_ERROR_ATOM, t, "nb_delete");
547 return FALSE;
548 }
549 return nbdelete(AtomOfTerm(t) PASS_REGS);
550}
551
552static Int nb_create(USES_REGS1) {
553 Term t = Deref(ARG1);
554 Term tname = Deref(ARG2);
555 Term tarity = Deref(ARG3);
556 Term to;
557 GlobalEntry *ge;
558
559 if (IsVarTerm(t)) {
560 Yap_ThrowError(INSTANTIATION_ERROR, t, "nb_create");
561 return FALSE;
562 } else if (!IsAtomTerm(t)) {
563 Yap_ThrowError(TYPE_ERROR_ATOM, t, "nb_create");
564 return FALSE;
565 }
566 ge = GetGlobalEntry(AtomOfTerm(t) PASS_REGS);
567 if (!ge) {
568 Yap_ThrowError(EXISTENCE_ERROR_VARIABLE, t, "nb_create");
569 return FALSE;
570 }
571 if (IsVarTerm(tarity)) {
572 Yap_ThrowError(INSTANTIATION_ERROR, tarity, "nb_create");
573 return FALSE;
574 } else if (!IsIntegerTerm(tarity)) {
575 Yap_ThrowError(TYPE_ERROR_INTEGER, tarity, "nb_create");
576 return FALSE;
577 }
578 if (IsVarTerm(tname)) {
579 Yap_ThrowError(INSTANTIATION_ERROR, tname, "nb_create");
580 return FALSE;
581 } else if (!IsAtomTerm(tname)) {
582 Yap_ThrowError(TYPE_ERROR_ATOM, tname, "nb_create");
583 return FALSE;
584 }
585 to = CopyTermToArena(t, false, TRUE, NULL, &LOCAL_GlobalArena, NULL PASS_REGS);
586 COPY(t);
587 if (!to) {
588 return false;
589 }
590
591 WRITE_LOCK(ge->GRWLock);
592 ge->global = to;
593 WRITE_UNLOCK(ge->GRWLock);
594 return TRUE;
595}
596
597static Int nb_create2(USES_REGS1) {
598 Term t = Deref(ARG1);
599 Term tname = Deref(ARG2);
600 Term tarity = Deref(ARG3);
601 Term tinit = Deref(ARG4);
602 Term to;
603 GlobalEntry *ge;
604
605 if (IsVarTerm(t)) {
606 Yap_ThrowError(INSTANTIATION_ERROR, t, "nb_create");
607 return FALSE;
608 } else if (!IsAtomTerm(t)) {
609 Yap_ThrowError(TYPE_ERROR_ATOM, t, "nb_create");
610 return FALSE;
611 }
612 ge = GetGlobalEntry(AtomOfTerm(t) PASS_REGS);
613 if (!ge) {
614 Yap_ThrowError(EXISTENCE_ERROR_VARIABLE, t, "nb_create");
615 return FALSE;
616 }
617 if (IsVarTerm(tarity)) {
618 Yap_ThrowError(INSTANTIATION_ERROR, tarity, "nb_create");
619 return FALSE;
620 } else if (!IsIntegerTerm(tarity)) {
621 Yap_ThrowError(TYPE_ERROR_INTEGER, tarity, "nb_create");
622 return FALSE;
623 }
624 if (IsVarTerm(tname)) {
625 Yap_ThrowError(INSTANTIATION_ERROR, tname, "nb_create");
626 return FALSE;
627 } else if (!IsAtomTerm(tname)) {
628 Yap_ThrowError(TYPE_ERROR_ATOM, tname, "nb_create");
629 return FALSE;
630 }
631 if (IsVarTerm(tinit)) {
632 Yap_ThrowError(INSTANTIATION_ERROR, tname, "nb_create");
633 return FALSE;
634 } else if (!IsAtomTerm(tinit)) {
635 Yap_ThrowError(TYPE_ERROR_ATOM, tname, "nb_create");
636 return FALSE;
637 }
638 to = CopyTermToArena(tinit, false, false, NULL, &LOCAL_GlobalArena, NULL PASS_REGS);
639 if (to == 0)
640 return false;
641 WRITE_LOCK(ge->GRWLock);
642 ge->global = to;
643 WRITE_UNLOCK(ge->GRWLock);
644 return true;
645}
646
647
648
649/* queue is a term of the form
650 * $array(Arena,Start,End,Size) plus an Arena. */
651static Int nb_queue_sized(size_t arena_sz USES_REGS) {
652 Term queue, *ar;
653 Term t = Deref(ARG1);
654 LOCAL_DepthArenas++;
655 if (!IsVarTerm(t)) {
656 if (!IsApplTerm(t)) {
657 return FALSE;
658 }
659 return (FunctorOfTerm(t) == FunctorNBQueue);
660 }
661 if (arena_sz < 32 * MIN_ARENA_SIZE)
662 arena_sz = 32 * MIN_ARENA_SIZE;
663 ar = HR;
664 queue = AbsAppl(HR);
665 HR += QUEUE_FUNCTOR_ARITY + 1;
666 if (queue == 0L) {
667 return FALSE;
668 }
669 ar[0] = (CELL) FunctorNBQueue;
670 ar += 1;
671 RESET_VARIABLE(ar + QUEUE_TAIL);
672 ar[QUEUE_HEAD] = ar[QUEUE_TAIL];
673 ar[QUEUE_SIZE] = MkIntTerm(0);
674 ar[QUEUE_ARENA] = Yap_MkArena(HR, HR + arena_sz);
675 HR = ArenaLimit(ar[QUEUE_ARENA]);
676 return Yap_unify(queue, ARG1);
677}
678
679static Int nb_queue(USES_REGS1) {
680 UInt arena_sz = (ASP - HR) / 16;
681 if (LOCAL_DepthArenas > 1)
682 arena_sz /= LOCAL_DepthArenas;
683 if (arena_sz < MIN_ARENA_SIZE)
684 arena_sz = MIN_ARENA_SIZE;
685 if (arena_sz > MAX_ARENA_SIZE)
686 arena_sz = MAX_ARENA_SIZE;
687 return nb_queue_sized(arena_sz PASS_REGS);
688}
689
690static Int nb_queue2(USES_REGS1) {
691 Term t = Deref(ARG2);
692 if (IsVarTerm(t)) {
693 Yap_ThrowError(INSTANTIATION_ERROR, t, "nb_queue");
694 return FALSE;
695 }
696 if (!IsIntegerTerm(t)) {
697 Yap_ThrowError(TYPE_ERROR_INTEGER, t, "nb_queue");
698 return FALSE;
699 }
700 return nb_queue_sized((UInt) IntegerOfTerm(t) PASS_REGS);
701}
702
703static CELL *GetQueue(Term t, char *caller) {
704 t = Deref(t);
705
706 if (IsVarTerm(t)) {
707 Yap_ThrowError(INSTANTIATION_ERROR, t, caller);
708 return NULL;
709 }
710 if (!IsApplTerm(t)) {
711 Yap_ThrowError(TYPE_ERROR_COMPOUND, t, caller);
712 return NULL;
713 }
714 if (FunctorOfTerm(t) != FunctorNBQueue) {
715 Yap_ThrowError(DOMAIN_ERROR_ARRAY_TYPE, t, caller);
716 return NULL;
717 }
718 return RepAppl(t) + 1;
719}
720
721static Term GetQueueArena(CELL *qd, char *caller) {
722 Term t = Deref(qd[QUEUE_ARENA]);
723
724 if (IsVarTerm(t)) {
725 Yap_ThrowError(INSTANTIATION_ERROR, t, caller);
726 return 0L;
727 }
728 if (!IsApplTerm(t)) {
729 Yap_ThrowError(TYPE_ERROR_COMPOUND, t, caller);
730 return 0L;
731 }
732 if (FunctorOfTerm(t) != FunctorBlob) {
733 Yap_ThrowError(DOMAIN_ERROR_ARRAY_TYPE, t, caller);
734 return 0L;
735 }
736 return t;
737}
738
739static void RecoverArena(Term arena USES_REGS) {
740 CELL *pt = ArenaPt(arena), *a_max = ArenaLimit(arena);
741
742 // printf("%p/%p %p %lx %lx\n", pt,HR, a_max, pt[0], a_max[-1]);
743 if (a_max == HR) {
744 HR = pt;
745 choiceptr bb = B;
746 while (bb && bb->cp_h > HR) {
747 bb->cp_h = HR;
748
749 bb = bb->cp_b;
750 }
751
752 } else {
753 while (pt < a_max)
754 *pt++ = TermNil;
755 }
756}
757
758static void RecoverQueue(Term *qp USES_REGS) {
759 Term arena = qp[QUEUE_ARENA];
760 RecoverArena(arena PASS_REGS);
761 qp[QUEUE_ARENA] = MkIntTerm(0);
762}
763
764static Int nb_queue_close(USES_REGS1) {
765 Term t = Deref(ARG1);
766 Int out;
767 LOCAL_DepthArenas--;
768 if (!IsVarTerm(t)) {
769 CELL *qp;
770
771 qp = GetQueue(t, "queue/3");
772 if (qp == NULL) {
773 return Yap_unify(ARG3, ARG2);
774 }
775 if (qp[QUEUE_ARENA] != MkIntTerm(0))
776 RecoverQueue(qp PASS_REGS);
777 if (qp[QUEUE_SIZE] == MkIntTerm(0)) {
778 return Yap_unify(ARG3, ARG2);
779 }
780 out = Yap_unify(ARG3, qp[QUEUE_TAIL]) && Yap_unify(ARG2, qp[QUEUE_HEAD]);
781 RESET_VARIABLE(qp + QUEUE_TAIL);
782 qp[QUEUE_HEAD] = qp[QUEUE_TAIL];
783 RESET_VARIABLE(qp + QUEUE_TAIL);
784 qp[QUEUE_SIZE] = MkIntTerm(0);
785 return out;
786 }
787 Yap_ThrowError(INSTANTIATION_ERROR, t, "queue/3");
788 return FALSE;
789}
790
791static Int nb_queue_enqueue(USES_REGS1) {
792
793 CELL *qd;
794 qd = GetQueue(ARG1, "enqueue");
795 if (!qd)
796 return FALSE;
797 Term arena = GetQueueArena(qd, "enqueue");
798 if (arena == 0L) {
799 return FALSE;
800 }
801 Term to = CopyTermToArena(MkPairTerm(Deref(ARG2),TermNil), false, true, NULL, &arena, NULL PASS_REGS);
802 qd = GetQueue(ARG1, "enqueue");
803
804
805 Int qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
806 if (qsize == 0) {
807 qd[QUEUE_HEAD] = to;
808 } else {
809 VarOfTerm(qd[QUEUE_TAIL])[0] = to;
810 }
811 qd[QUEUE_SIZE] = MkIntTerm(qsize + 1);
812 RESET_VARIABLE(RepPair(to)+1);
813 qd[QUEUE_TAIL] = RepPair(to)[1];
814 qd[QUEUE_ARENA] = arena;
815 /* garbage collection ? */
816 return true;
817}
818
819static Int nb_queue_dequeue(USES_REGS1) {
820 CELL *qd = GetQueue(ARG1, "dequeue");
821 UInt qsz;
822 Term arena, out;
823
824 if (!qd)
825 return FALSE;
826 qsz = IntegerOfTerm(qd[QUEUE_SIZE]);
827 if (qsz == 0)
828 return FALSE;
829 arena = GetQueueArena(qd, "dequeue");
830 if (arena == 0L)
831 return FALSE;
832 out = HeadOfTerm(qd[QUEUE_HEAD]);
833 qd[QUEUE_HEAD] = TailOfTerm(qd[QUEUE_HEAD]);
834 qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsz - 1);
835 qd[QUEUE_ARENA] = arena;
836 return Yap_unify(out, ARG2);
837}
838
839/* purge an entry from the queue, replacing it by [] */
840static Int nb_queue_replace(USES_REGS1) {
841 CELL *qd = GetQueue(ARG1, "dequeue");
842 UInt qsz;
843 Term queue, t = Deref(ARG2);
844
845 if (!qd)
846 return FALSE;
847 qsz = IntegerOfTerm(qd[QUEUE_SIZE]);
848 if (qsz == 0)
849 return FALSE;
850
851 queue = qd[QUEUE_HEAD];
852 for (; qsz > 0; qsz--) {
853 if (Yap_eq(HeadOfTerm(queue), t)) {
854 *RepPair(Deref(queue)) = Deref(ARG3);
855 return TRUE;
856 }
857 queue = TailOfTerm(queue);
858 }
859 return FALSE;
860}
861
862static Int nb_queue_peek(USES_REGS1) {
863 CELL *qd = GetQueue(ARG1, "queue_peek");
864 UInt qsz;
865
866 if (!qd)
867 return FALSE;
868 qsz = IntegerOfTerm(qd[QUEUE_SIZE]);
869 if (qsz == 0)
870 return FALSE;
871 return Yap_unify(HeadOfTerm(qd[QUEUE_HEAD]), ARG2);
872}
873
874static Int nb_queue_empty(USES_REGS1) {
875 CELL *qd = GetQueue(ARG1, "queue_empty");
876
877 if (!qd)
878 return FALSE;
879 return (IntegerOfTerm(qd[QUEUE_SIZE]) == 0);
880}
881
882static Int nb_queue_size(USES_REGS1) {
883 CELL *qd = GetQueue(ARG1, "queue_size");
884
885 if (!qd)
886 return FALSE;
887 return Yap_unify(ARG2, qd[QUEUE_SIZE]);
888}
889
890static Int nb_queue_show(USES_REGS1) {
891 CELL *qd = GetQueue(ARG1, "queue_size");
892
893 if (!qd)
894 return FALSE;
895 return Yap_unify(ARG2, qd[QUEUE_HEAD]);
896}
897
898static CELL *GetHeap(Term t, char *caller) {
899 t = Deref(t);
900
901 if (IsVarTerm(t)) {
902 Yap_ThrowError(INSTANTIATION_ERROR, t, caller);
903 return NULL;
904 }
905 if (!IsApplTerm(t)) {
906 Yap_ThrowError(TYPE_ERROR_COMPOUND, t, caller);
907 return NULL;
908 }
909 return RepAppl(t) + 1;
910}
911
912static Term MkZeroApplTerm(Atom f, UInt sz) {
913 Term t0;
914 CELL *pt, *pt0;
915
916 pt0 = HR;
917 Functor fsz = Yap_MkFunctor(f, sz);
918 *HR = (CELL) fsz;
919 t0 = MkIntTerm(0);
920 pt = HR + 1;
921 while (sz--) {
922 *pt++ = t0;
923 }
924 HR = pt;
925 return Yap_MkArena(pt0, HR);
926}
927
928static Int nb_heap(USES_REGS1) {
929 size_t hsize;
930 Term tsize;
931 size_t arena_sz;
932 restart:
933 tsize = Deref(ARG1);
934 if (IsVarTerm(tsize)) {
935 Yap_ThrowError(INSTANTIATION_ERROR, tsize, "nb_heap");
936 return FALSE;
937 } else {
938 if (!IsIntegerTerm(tsize)) {
939 Yap_ThrowError(TYPE_ERROR_INTEGER, tsize, "nb_heap");
940 return FALSE;
941 }
942 arena_sz = hsize = IntegerOfTerm(tsize);
943 }
944 if (arena_sz < 1024) {
945 arena_sz = 1024;
946 }
947 size_t sz = (8 * hsize * 2 + 16);
948 if (HR + sz > ASP - 1024) {
949 if (sz > HR - H0) {
950 Yap_growstack(sz * CellSize);
951 } else if (!Yap_dogcl(sz * CellSize)) {
952 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
953 "No Stack Space for Non-Backtrackable terms");
954 }
955 sz *= 2;
956 goto restart;
957 }
958 Term heap = MkZeroApplTerm(AtomHeapData, 8 * hsize + HEAP_START + 1);
959 if (heap != TermNil) {
960
961 CELL *ar = RepAppl(heap) + 1;
962 ar[HEAP_ARENA] = Yap_MkArena(ar + 2 * hsize + HEAP_START,
963 ar + 8 * hsize + HEAP_START);
964 ar[HEAP_SIZE] = MkIntTerm(0);
965 ar[HEAP_MAX] = MkIntegerTerm(hsize);
966 if (heap == 0L) {
967 return false;
968 }
969
970 return Yap_unify(heap, ARG2);
971 }
972 return true;
973}
974
975static Int nb_heap_close(USES_REGS1) {
976 Term t = Deref(ARG1);
977 if (!IsVarTerm(t)) {
978 CELL *qp;
979
980 qp = RepAppl(t) + 1;
981 if (qp[HEAP_ARENA] != MkIntTerm(0))
982 RecoverArena(qp[HEAP_ARENA] PASS_REGS);
983 qp[-1] = (CELL) Yap_MkFunctor(AtomHeapData, 1);
984 qp[0] = MkIntegerTerm(0);
985 return TRUE;
986 }
987 Yap_ThrowError(INSTANTIATION_ERROR, t, "heap_close/1");
988 return FALSE;
989}
990
991static Int nb_heap_clear(USES_REGS1) {
992 Term t = Deref(ARG1);
993 if (!IsVarTerm(t)) {
994 CELL *qp;
995
996 qp = RepAppl(t) + 1;
997 qp[HEAP_SIZE] = MkIntTerm(0);
998 CELL *p = qp + HEAP_START;
999 size_t i;
1000 for (i = 0; i < IntOfTerm(qp[HEAP_MAX]) * 2; i += 2, p += 2) {
1001 RESET_VARIABLE(p);
1002 RESET_VARIABLE(p + 1);
1003 }
1004 return TRUE;
1005 }
1006 Yap_ThrowError(INSTANTIATION_ERROR, t, "heap_close/1");
1007 return FALSE;
1008}
1009
1010
1011/*
1012 * static void PushHeap(CELL *pt, UInt off) {
1013 while (off) {
1014 UInt noff = (off + 1) / 2 - 1;
1015 if (Yap_compare_terms(pt[2 * off], pt[2 * noff]) < 0) {
1016 Term tk = pt[2 * noff];
1017 Term tv = pt[2 * noff + 1];
1018 pt[2 * noff] = pt[2 * off];
1019 pt[2 * noff + 1] = pt[2 * off + 1];
1020 pt[2 * off] = tk;
1021 pt[2 * off + 1] = tv;
1022 off = noff;
1023 } else {
1024 return;
1025 }
1026 }
1027 }
1028*/
1029static void DelHeapRoot(CELL *pt, UInt sz) {
1030 UInt indx = 0;
1031 Term tk, tv;
1032
1033 sz--;
1034 tk = pt[2 * sz];
1035 tv = pt[2 * sz + 1];
1036 pt[2 * sz] = TermNil;
1037 pt[2 * sz + 1] = TermNil;
1038 while (TRUE) {
1039 if (sz < 2 * indx + 3 ||
1040 Yap_compare_terms(pt[4 * indx + 2], pt[4 * indx + 4]) < 0) {
1041 if (sz < 2 * indx + 2 || Yap_compare_terms(tk, pt[4 * indx + 2]) < 0) {
1042 pt[2 * indx] = tk;
1043 pt[2 * indx + 1] = tv;
1044 return;
1045 } else {
1046 pt[2 * indx] = pt[4 * indx + 2];
1047 pt[2 * indx + 1] = pt[4 * indx + 3];
1048 indx = 2 * indx + 1;
1049 }
1050 } else {
1051 if (Yap_compare_terms(tk, pt[4 * indx + 4]) < 0) {
1052 pt[2 * indx] = tk;
1053 pt[2 * indx + 1] = tv;
1054 return;
1055 } else {
1056 pt[2 * indx] = pt[4 * indx + 4];
1057 pt[2 * indx + 1] = pt[4 * indx + 5];
1058 indx = 2 * indx + 2;
1059 }
1060 }
1061 }
1062}
1063
1064CELL *new_heap_entry(CELL *qd) {
1065 size_t size = HEAP_START + 2 * IntOfTerm(qd[HEAP_MAX]);
1066 size_t indx = HEAP_START + 2 * IntOfTerm(qd[HEAP_SIZE]);
1067 size_t extra = 8 * MIN_ARENA_SIZE + 2 * size; // in double cells
1068 size_t howmany = extra;
1069 CELL *a_max = qd + size;
1070 if (size < indx + 10) {
1071 while (true) {
1072 CELL *new_max = a_max;
1073 size_t nsize;
1074 if ((nsize = Yap_InsertInGlobal(a_max, howmany * CellSize, &new_max) /
1075 CellSize) >= howmany) {
1076 a_max = new_max;
1077 extra = nsize;
1078 break;
1079 }
1080 if (!Yap_dogcl(extra * CellSize)) {
1081 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
1082 "No Stack Space for Non-Backtrackable terms");
1083 }
1084 }
1085 qd = a_max - size;
1086 qd[HEAP_MAX] = MkIntTerm((size + extra) / 2 - HEAP_START);
1087 if (!qd)
1088 return NULL;
1089 CELL *top = a_max + extra;
1090 qd[-1] = (CELL) Yap_MkFunctor(AtomHeapData, size + extra);
1091 while (a_max < top) {
1092 a_max[0] = a_max[1] = TermNil;
1093 a_max += 2;
1094 }
1095 }
1096 return qd;
1097}
1098
1099static Int nb_heap_add_to_heap(USES_REGS1) {
1100 CELL *qd, *pt;
1101 Term arena = 0, to;
1102 size_t hsize;
1103
1104 qd = new_heap_entry(GetHeap(ARG1, "add_to_heap"));
1105 if (qd) {
1106 arena = qd[HEAP_ARENA];
1107 if (arena == 0L)
1108 return false;
1109 } else {
1110 return false;
1111 }
1112 Term l = MkPairTerm(ARG2, ARG3);
1113 to = CopyTermToArena(l, false, true, NULL, &arena, NULL PASS_REGS);
1114 qd = GetHeap(Deref(ARG1), "add_to_heap)");
1115 hsize = IntegerOfTerm(qd[HEAP_SIZE]);
1116 pt = qd + HEAP_START;
1117 pt[2 * hsize] = HeadOfTerm(to);
1118 /* protect key in ARG2 in case there is an overflow while copying to */
1119 pt[2 * hsize + 1] = TailOfTerm(to);
1120 Term thsz = Global_MkIntegerTerm(hsize + 1);
1121
1122 qd[HEAP_ARENA] = arena;
1123 qd[HEAP_SIZE] = thsz;
1124 return TRUE;
1125}
1126
1127static Int nb_heap_del(USES_REGS1) {
1128 CELL *qd = GetHeap(ARG1, "deheap");
1129 UInt qsz;
1130 Term arena;
1131 Term tk, tv;
1132
1133 if (!qd)
1134 return FALSE;
1135 qsz = IntegerOfTerm(qd[HEAP_SIZE]);
1136 if (qsz == 0)
1137 return FALSE;
1138 arena = qd[HEAP_ARENA];
1139 if (arena == 0L)
1140 return FALSE;
1141 /* garbage collection ? */
1142 qd[HEAP_SIZE] = MkIntTerm(qsz - 1);
1143 tk = qd[HEAP_START];
1144 tv = qd[HEAP_START + 1];
1145 DelHeapRoot(qd + HEAP_START, qsz);
1146 return Yap_unify(tk, ARG2) && Yap_unify(tv, ARG3);
1147}
1148
1149static Int nb_heap_peek(USES_REGS1) {
1150 CELL *qd = GetHeap(ARG1, "heap_peek");
1151 UInt qsz;
1152 Term tk, tv;
1153
1154 if (!qd)
1155 return FALSE;
1156 qsz = IntegerOfTerm(qd[HEAP_SIZE]);
1157 if (qsz == 0)
1158 return FALSE;
1159 tk = qd[HEAP_START];
1160 tv = qd[HEAP_START + 1];
1161 return Yap_unify(tk, ARG2) && Yap_unify(tv, ARG3);
1162}
1163
1164static Int nb_heap_empty(USES_REGS1) {
1165 CELL *qd = GetHeap(ARG1, "heap_empty");
1166
1167 if (!qd)
1168 return FALSE;
1169 return (IntegerOfTerm(qd[HEAP_SIZE]) == 0);
1170}
1171
1172static Int nb_heap_size(USES_REGS1) {
1173 CELL *qd = GetHeap(ARG1, "heap_size");
1174
1175 if (!qd)
1176 return FALSE;
1177 return Yap_unify(ARG2, qd[HEAP_SIZE]);
1178}
1179
1180static Int nb_beam(USES_REGS1) {
1181 Term beam, *ar;
1182 UInt hsize;
1183 Term tsize = Deref(ARG1);
1184 UInt arena_sz = (HR - H0) / 16;
1185
1186 if (IsVarTerm(tsize)) {
1187 Yap_ThrowError(INSTANTIATION_ERROR, tsize, "nb_beam");
1188 return FALSE;
1189 } else {
1190 if (!IsIntegerTerm(tsize)) {
1191 Yap_ThrowError(TYPE_ERROR_INTEGER, tsize, "nb_beam");
1192 return FALSE;
1193 }
1194 hsize = IntegerOfTerm(tsize);
1195 }
1196 if (arena_sz < 1024)
1197 arena_sz = 1024;
1198 while (HR + (3 * hsize + arena_sz + 16) > ASP - 1024) {
1199 CreepFlag = EventFlag =
1200 StackGap(PASS_REGS1) + (5 * hsize + HEAP_START + 1 + arena_sz);
1201
1202 gc_entry_info_t info;
1203 Yap_track_cpred(0, P, 0, &info);
1204 // p should be past the environment minus Obpp
1205 if (!Yap_gc(&info)) {
1206 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
1207 "stack overflow: gc failed");
1208 }
1209 }
1210 beam = MkZeroApplTerm(AtomHeapData, 5 * hsize + HEAP_START + 1);
1211 if (beam == TermNil) {
1212 return false;
1213 }
1214 if (!Yap_unify(beam, ARG2))
1215 return FALSE;
1216 ar = RepAppl(beam) + 1;
1217 ar[HEAP_ARENA] = ar[HEAP_SIZE] = MkIntTerm(0);
1218 ar[HEAP_MAX] = tsize;
1219
1220 return TRUE;
1221}
1222
1223static Int nb_beam_close(USES_REGS1) { return nb_heap_close(PASS_REGS1); }
1224
1225/* we have two queues, one with
1226 Key, IndxQueue2
1227 the other with
1228 Key, IndxQueue1, Val
1229*/
1230static void PushBeam(CELL *pt, CELL *npt, UInt hsize, Term key, Term to) {
1231 CACHE_REGS
1232 UInt off = hsize, off2 = hsize;
1233 Term toff, toff2;
1234
1235 /* push into first queue */
1236 while (off) {
1237 UInt noff = (off + 1) / 2 - 1;
1238 if (Yap_compare_terms(key, pt[2 * noff]) < 0) {
1239 UInt i2 = IntegerOfTerm(pt[2 * noff + 1]);
1240
1241 pt[2 * off] = pt[2 * noff];
1242 pt[2 * off + 1] = pt[2 * noff + 1];
1243 npt[3 * i2 + 1] = Global_MkIntegerTerm(off);
1244 off = noff;
1245 } else {
1246 break;
1247 }
1248 }
1249 toff = Global_MkIntegerTerm(off);
1250 /* off says where we are in first queue */
1251 /* push into second queue */
1252 while (off2) {
1253 UInt noff = (off2 + 1) / 2 - 1;
1254 if (Yap_compare_terms(key, npt[3 * noff]) > 0) {
1255 UInt i1 = IntegerOfTerm(npt[3 * noff + 1]);
1256
1257 npt[3 * off2] = npt[3 * noff];
1258 npt[3 * off2 + 1] = npt[3 * noff + 1];
1259 npt[3 * off2 + 2] = npt[3 * noff + 2];
1260 pt[2 * i1 + 1] = Global_MkIntegerTerm(off2);
1261 off2 = noff;
1262 } else {
1263 break;
1264 }
1265 }
1266 toff2 = Global_MkIntegerTerm(off2);
1267 /* store elements in their rightful place */
1268 npt[3 * off2] = pt[2 * off] = key;
1269 pt[2 * off + 1] = toff2;
1270 npt[3 * off2 + 1] = toff;
1271 npt[3 * off2 + 2] = to;
1272}
1273
1274static void DelBeamMax(CELL *pt, CELL *pt2, UInt sz) {
1275 CACHE_REGS
1276 UInt off = IntegerOfTerm(pt2[1]);
1277 UInt indx = 0;
1278 Term tk, ti, tv;
1279
1280 sz--;
1281 /* first, fix the reverse queue */
1282 tk = pt2[3 * sz];
1283 ti = pt2[3 * sz + 1];
1284 tv = pt2[3 * sz + 2];
1285 while (TRUE) {
1286 if (sz < 2 * indx + 3 ||
1287 Yap_compare_terms(pt2[6 * indx + 3], pt2[6 * indx + 6]) > 0) {
1288 if (sz < 2 * indx + 2 || Yap_compare_terms(tk, pt2[6 * indx + 3]) > 0) {
1289 break;
1290 } else {
1291 UInt off = IntegerOfTerm(pt2[6 * indx + 4]);
1292
1293 pt2[3 * indx] = pt2[6 * indx + 3];
1294 pt2[3 * indx + 1] = pt2[6 * indx + 4];
1295 pt2[3 * indx + 2] = pt2[6 * indx + 5];
1296 pt[2 * off + 1] = Global_MkIntegerTerm(indx);
1297 indx = 2 * indx + 1;
1298 }
1299 } else {
1300 if (Yap_compare_terms(tk, pt2[6 * indx + 6]) > 0) {
1301 break;
1302 } else {
1303 UInt off = IntegerOfTerm(pt2[6 * indx + 7]);
1304
1305 pt2[3 * indx] = pt2[6 * indx + 6];
1306 pt2[3 * indx + 1] = pt2[6 * indx + 7];
1307 pt2[3 * indx + 2] = pt2[6 * indx + 8];
1308 pt[2 * off + 1] = Global_MkIntegerTerm(indx);
1309 indx = 2 * indx + 2;
1310 }
1311 }
1312 }
1313 pt[2 * IntegerOfTerm(ti) + 1] = Global_MkIntegerTerm(indx);
1314 pt2[3 * indx] = tk;
1315 pt2[3 * indx + 1] = ti;
1316 pt2[3 * indx + 2] = tv;
1317 /* now, fix the standard queue */
1318 if (off != sz) {
1319 Term toff, toff2, key;
1320 UInt off2;
1321
1322 key = pt[2 * sz];
1323 toff2 = pt[2 * sz + 1];
1324 off2 = IntegerOfTerm(toff2);
1325 /* off says where we are in first queue */
1326 /* push into second queue */
1327 while (off) {
1328 UInt noff = (off + 1) / 2 - 1;
1329 if (Yap_compare_terms(key, pt[2 * noff]) < 0) {
1330 UInt i1 = IntegerOfTerm(pt[2 * noff + 1]);
1331
1332 pt[2 * off] = pt[2 * noff];
1333 pt[2 * off + 1] = pt[2 * noff + 1];
1334 pt2[3 * i1 + 1] = Global_MkIntegerTerm(off);
1335 off = noff;
1336 } else {
1337 break;
1338 }
1339 }
1340 toff = Global_MkIntegerTerm(off);
1341 /* store elements in their rightful place */
1342 pt[2 * off] = key;
1343 pt2[3 * off2 + 1] = toff;
1344 pt[2 * off + 1] = toff2;
1345 }
1346}
1347
1348static Term DelBeamMin(CELL *pt, CELL *pt2, UInt sz) {
1349 CACHE_REGS
1350 UInt off2 = IntegerOfTerm(pt[1]);
1351 Term ov = pt2[3 * off2 + 2]; /* return value */
1352 UInt indx = 0;
1353 Term tk, tv;
1354
1355 sz--;
1356 /* first, fix the standard queue */
1357 tk = pt[2 * sz];
1358 tv = pt[2 * sz + 1];
1359 while (TRUE) {
1360 if (sz < 2 * indx + 3 ||
1361 Yap_compare_terms(pt[4 * indx + 2], pt[4 * indx + 4]) < 0) {
1362 if (sz < 2 * indx + 2 || Yap_compare_terms(tk, pt[4 * indx + 2]) < 0) {
1363 break;
1364 } else {
1365 UInt off2 = IntegerOfTerm(pt[4 * indx + 3]);
1366 pt[2 * indx] = pt[4 * indx + 2];
1367 pt[2 * indx + 1] = pt[4 * indx + 3];
1368 pt2[3 * off2 + 1] = Global_MkIntegerTerm(indx);
1369 indx = 2 * indx + 1;
1370 }
1371 } else {
1372 if (Yap_compare_terms(tk, pt[4 * indx + 4]) < 0) {
1373 break;
1374 } else {
1375 UInt off2 = IntegerOfTerm(pt[4 * indx + 5]);
1376
1377 pt[2 * indx] = pt[4 * indx + 4];
1378 pt[2 * indx + 1] = pt[4 * indx + 5];
1379 pt2[3 * off2 + 1] = Global_MkIntegerTerm(indx);
1380 indx = 2 * indx + 2;
1381 }
1382 }
1383 }
1384 pt[2 * indx] = tk;
1385 pt[2 * indx + 1] = tv;
1386 pt2[3 * IntegerOfTerm(tv) + 1] = Global_MkIntegerTerm(indx);
1387 /* now, fix the reverse queue */
1388 if (off2 != sz) {
1389 Term to, toff, toff2, key;
1390 UInt off;
1391
1392 key = pt2[3 * sz];
1393 toff = pt2[3 * sz + 1];
1394 to = pt2[3 * sz + 2];
1395 off = IntegerOfTerm(toff);
1396 /* off says where we are in first queue */
1397 /* push into second queue */
1398 while (off2) {
1399 UInt noff = (off2 + 1) / 2 - 1;
1400 if (Yap_compare_terms(key, pt2[3 * noff]) > 0) {
1401 UInt i1 = IntegerOfTerm(pt2[3 * noff + 1]);
1402
1403 pt2[3 * off2] = pt2[3 * noff];
1404 pt2[3 * off2 + 1] = pt2[3 * noff + 1];
1405 pt2[3 * off2 + 2] = pt2[3 * noff + 2];
1406 pt[2 * i1 + 1] = Global_MkIntegerTerm(off2);
1407 off2 = noff;
1408 } else {
1409 break;
1410 }
1411 }
1412 toff2 = Global_MkIntegerTerm(off2);
1413 /* store elements in their rightful place */
1414 pt2[3 * off2] = key;
1415 pt[2 * off + 1] = toff2;
1416 pt2[3 * off2 + 1] = toff;
1417 pt2[3 * off2 + 2] = to;
1418 }
1419 return ov;
1420}
1421
1422static size_t new_beam_entry(CELL **qdp) {
1423 size_t hsize, hmsize;
1424 CELL *qd = *qdp;
1425 hsize = IntegerOfTerm(qd[HEAP_SIZE]);
1426 hmsize = IntegerOfTerm(qd[HEAP_MAX]);
1427 if (!qd)
1428 return 0;
1429 Term *pt;
1430 if (hsize >= hmsize - 10) {
1431 size_t nsize;
1432
1433 size_t sz = 2 * hsize + HEAP_START, ex = 2 * sz;
1434 while (true) {
1435 CELL *new_max = qd + sz, *a_max = qd + sz;
1436 if ((nsize = Yap_InsertInGlobal(a_max, ex * CellSize, &new_max) /
1437 CellSize) >= ex) {
1438 a_max = new_max;
1439 ex = nsize;
1440 qd = a_max - ex;
1441 break;
1442 }
1443 if (!Yap_dogcl(ex * CellSize)) {
1444 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
1445 "No Stack Space for Non-Backtrackable terms");
1446 }
1447 }
1448 qd[HEAP_MAX] = MkIntTerm(3 * hmsize);
1449 *qdp = qd;
1450 }
1451 pt = qd + HEAP_START;
1452
1453 if (Yap_compare_terms(pt[2 * hmsize], Deref(ARG2)) > 0) {
1454 /* smaller than current max, we need to drop current max */
1455 DelBeamMax(pt, pt + 2 * hmsize, hmsize);
1456 hsize--;
1457 }
1458
1459 return hsize;
1460}
1461
1462static Int nb_beam_add_to_beam(USES_REGS1) {
1463 CELL *qd = GetHeap(ARG1, "add_to_beam"), *pt;
1464 size_t hsize, hmsize = qd[HEAP_SIZE];
1465 Term arena, to;
1466
1467 hsize = new_beam_entry(&qd);
1468 arena = qd[HEAP_ARENA];
1469 if (arena == 0L)
1470 return FALSE;
1471 CELL *arenap = &arena;
1472 Term l = MkPairTerm(ARG2, ARG3);
1473 to = CopyTermToArena(l, FALSE, TRUE, NULL, &arena, NULL PASS_REGS);
1474 if (to == 0)
1475 return FALSE;
1476 qd = GetHeap(ARG1, "add_to_beam");
1477 arena = *arenap;
1478 qd[HEAP_ARENA] = arena;
1479 pt = qd + HEAP_START;
1480 PushBeam(pt, pt + 2 * hmsize, hsize, HeadOfTerm(to), TailOfTerm(to));
1481 qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1);
1482 return TRUE;
1483}
1484
1485static Int nb_beam_del(USES_REGS1) {
1486 CELL *qd = GetHeap(ARG1, "debeam");
1487 UInt qsz;
1488 Term tk, tv;
1489
1490 if (!qd)
1491 return FALSE;
1492 qsz = IntegerOfTerm(qd[HEAP_SIZE]);
1493 if (qsz == 0)
1494 return FALSE;
1495 /* garbage collection ? */
1496 qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz - 1);
1497 tk = qd[HEAP_START];
1498 tv = DelBeamMin(qd + HEAP_START,
1499 qd + (HEAP_START + 2 * IntegerOfTerm(qd[HEAP_MAX])), qsz);
1500 return Yap_unify(tk, ARG2) && Yap_unify(tv, ARG3);
1501}
1502
1503#ifdef DEBUG
1504
1505static Int nb_beam_check(USES_REGS1) {
1506 CELL *qd = GetHeap(ARG1, "debeam");
1507 UInt qsz, qmax;
1508 CELL *pt, *pt2;
1509 UInt i;
1510
1511 if (!qd)
1512 return FALSE;
1513 qsz = IntegerOfTerm(qd[HEAP_SIZE]);
1514 qmax = IntegerOfTerm(qd[HEAP_MAX]);
1515 if (qsz == 0)
1516 return TRUE;
1517 pt = qd + HEAP_START;
1518 pt2 = pt + 2 * qmax;
1519 for (i = 1; i < qsz; i++) {
1520 UInt back;
1521 if (Yap_compare_terms(pt[2 * ((i + 1) / 2 - 1)], pt[2 * i]) > 0) {
1522 Yap_DebugPlWrite(pt[2 * ((i + 1) / 2 - 1)]);
1523 fprintf(stderr, "\n");
1524 Yap_DebugPlWrite(pt[2 * i]);
1525 fprintf(stderr, "\n");
1526 fprintf(stderr, "Error at %ld\n", (unsigned long int) i);
1527 return FALSE;
1528 }
1529 back = IntegerOfTerm(pt[2 * i + 1]);
1530 if (IntegerOfTerm(pt2[3 * back + 1]) != i) {
1531 fprintf(stderr, "Link error at %ld\n", (unsigned long int) i);
1532 return FALSE;
1533 }
1534 }
1535 for (i = 1; i < qsz; i++) {
1536 if (Yap_compare_terms(pt2[3 * ((i + 1) / 2 - 1)], pt2[3 * i]) < 0) {
1537 fprintf(stderr, "Error at sec %ld\n", (unsigned long int) i);
1538 Yap_DebugPlWrite(pt2[3 * ((i + 1) / 2 - 1)]);
1539 fprintf(stderr, "\n");
1540 Yap_DebugPlWrite(pt2[3 * i]);
1541 fprintf(stderr, "\n");
1542 return FALSE;
1543 }
1544 }
1545 return TRUE;
1546}
1547
1548#endif
1549
1550static Int nb_beam_keys(USES_REGS1) {
1551 CELL *qd;
1552 UInt qsz;
1553 CELL *pt, *ho;
1554 UInt i;
1555
1556 restart:
1557 qd = GetHeap(ARG1, "beam_keys");
1558 if (!qd)
1559 return FALSE;
1560 qsz = IntegerOfTerm(qd[HEAP_SIZE]);
1561 ho = HR;
1562 pt = qd + HEAP_START;
1563 if (qsz == 0)
1564 return Yap_unify(ARG2, TermNil);
1565 for (i = 0; i < qsz; i++) {
1566 if (HR > ASP - 1024) {
1567 if (!Yap_dogc()) {
1568 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
1569 return 0;
1570 }
1571
1572 goto restart;
1573 }
1574 *HR++ = pt[0];
1575 *HR = AbsPair(HR + 1);
1576 HR++;
1577 pt += 2;
1578 }
1579 HR[-1] = TermNil;
1580 return Yap_unify(ARG2, AbsPair(ho));
1581}
1582
1583static Int nb_beam_peek(USES_REGS1) {
1584 CELL *qd = GetHeap(ARG1, "beam_peek"), *pt, *pt2;
1585 UInt qsz, qbsize;
1586 Term tk, tv;
1587
1588 if (!qd)
1589 return FALSE;
1590 qsz = IntegerOfTerm(qd[HEAP_SIZE]);
1591 qbsize = IntegerOfTerm(qd[HEAP_MAX]);
1592 if (qsz == 0)
1593 return FALSE;
1594 pt = qd + HEAP_START;
1595 pt2 = pt + 2 * qbsize;
1596 tk = pt[0];
1597 tv = pt2[2];
1598 return Yap_unify(tk, ARG2) && Yap_unify(tv, ARG3);
1599}
1600
1601static Int nb_beam_empty(USES_REGS1) {
1602 CELL *qd = GetHeap(ARG1, "beam_empty");
1603
1604 if (!qd)
1605 return FALSE;
1606 return (IntegerOfTerm(qd[HEAP_SIZE]) == 0);
1607}
1608
1609static Int nb_beam_size(USES_REGS1) {
1610 CELL *qd = GetHeap(ARG1, "beam_size");
1611
1612 if (!qd)
1613 return FALSE;
1614 return Yap_unify(ARG2, qd[HEAP_SIZE]);
1615}
1616
1617static Int cont_current_nb(USES_REGS1) {
1618 Int unif;
1619 GlobalEntry *ge = (GlobalEntry *) IntegerOfTerm(EXTRA_CBACK_ARG(1, 1));
1620
1621 unif = Yap_unify(MkAtomTerm(AbsAtom(ge->AtomOfGE)), ARG1);
1622 ge = ge->NextGE;
1623 if (!ge) {
1624 if (unif)
1625 cut_succeed();
1626 else
1627 cut_fail();
1628 } else {
1629 EXTRA_CBACK_ARG(1, 1) = MkIntegerTerm((Int) ge);
1630 return unif;
1631 }
1632}
1633
1634static Int init_current_nb(USES_REGS1) { /* current_atom(?Atom)
1635 */
1636 Term t1 = Deref(ARG1);
1637 if (!IsVarTerm(t1)) {
1638 if (IsAtomTerm(t1)) {
1639 if (!FindGlobalEntry(AtomOfTerm(t1) PASS_REGS)) {
1640 cut_fail();
1641 } else {
1642 cut_succeed();
1643 }
1644 } else {
1645 Yap_ThrowError(TYPE_ERROR_ATOM, t1, "nb_current");
1646 cut_fail();
1647 }
1648 }
1649 READ_LOCK(HashChain[0].AERWLock);
1650 EXTRA_CBACK_ARG(1, 1) = MkIntegerTerm((Int) LOCAL_GlobalVariables);
1651 return cont_current_nb(PASS_REGS1);
1652}
1653
1654
1655void Yap_InitGlobals(void) {
1656 CACHE_REGS
1657 Term cm = CurrentModule;
1658 Yap_InitCPred("b_setval", 2, p_b_setval, SafePredFlag);
1659 Yap_InitCPred("__B_setval__", 2, p_b_setval, HiddenPredFlag | SafePredFlag);
1660 Yap_InitCPred("nb_setval", 2, nb_setval, 0L);
1661 Yap_InitCPred("__NB_setval__", 2, nb_setval, HiddenPredFlag);
1662 Yap_InitCPred("nb_set_shared_val", 2, nb_set_shared_val, 0L);
1663 Yap_InitCPred("$nb_getval", 3, nb_getval, SafePredFlag);
1664 Yap_InitCPred("__NB_getval__", 3, nb_getval, HiddenPredFlag);
1665 Yap_InitCPred("__B_getval__", 3, nb_getval, HiddenPredFlag);
1666 Yap_InitCPred("nb_delete", 1, nb_delete, 0L);
1667 Yap_InitCPred("nb_create", 3, nb_create, 0L);
1668 Yap_InitCPred("nb_create", 4, nb_create2, 0L);
1669 Yap_InitCPredBack("$nb_current", 1, 1, init_current_nb, cont_current_nb,
1670 SafePredFlag);
1671 CurrentModule = GLOBALS_MODULE;
1672 Yap_InitCPred("nb_queue", 1, nb_queue, 0L);
1673 Yap_InitCPred("nb_queue", 2, nb_queue2, 0L);
1674 Yap_InitCPred("nb_queue_close", 3, nb_queue_close, SafePredFlag);
1675 Yap_InitCPred("nb_queue_enqueue", 2, nb_queue_enqueue, 0L);
1676 Yap_InitCPred("nb_queue_dequeue", 2, nb_queue_dequeue, SafePredFlag);
1677 Yap_InitCPred("nb_queue_peek", 2, nb_queue_peek, SafePredFlag);
1678 Yap_InitCPred("nb_queue_empty", 1, nb_queue_empty, SafePredFlag);
1679 Yap_InitCPred("nb_queue_replace", 3, nb_queue_replace, SafePredFlag);
1680 Yap_InitCPred("nb_queue_size", 2, nb_queue_size, SafePredFlag);
1681 Yap_InitCPred("nb_queue_show", 2, nb_queue_show, SafePredFlag);
1682 Yap_InitCPred("nb_heap", 2, nb_heap, 0);
1683 Yap_InitCPred("nb_heap_close", 1, nb_heap_close, SafePredFlag);
1684 Yap_InitCPred("nb_heap_clear", 1, nb_heap_clear, SafePredFlag);
1685 Yap_InitCPred("nb_heap_add", 3, nb_heap_add_to_heap, 0L);
1686 Yap_InitCPred("nb_heap_del", 3, nb_heap_del, SafePredFlag);
1687 Yap_InitCPred("nb_heap_peek", 3, nb_heap_peek, SafePredFlag);
1688 Yap_InitCPred("nb_heap_empty", 1, nb_heap_empty, SafePredFlag);
1689 Yap_InitCPred("nb_heap_size", 2, nb_heap_size, SafePredFlag);
1690 Yap_InitCPred("nb_beam", 2, nb_beam, 0L);
1691 Yap_InitCPred("nb_beam_close", 1, nb_beam_close, SafePredFlag);
1692 Yap_InitCPred("nb_beam_add", 3, nb_beam_add_to_beam, 0L);
1693 Yap_InitCPred("nb_beam_del", 3, nb_beam_del, SafePredFlag);
1694 Yap_InitCPred("nb_beam_peek", 3, nb_beam_peek, SafePredFlag);
1695 Yap_InitCPred("nb_beam_empty", 1, nb_beam_empty, SafePredFlag);
1696 Yap_InitCPred("nb_beam_keys", 2, nb_beam_keys, 0L);
1697
1698 Yap_InitCPred("nb_create_accumulator", 2, nb_create_accumulator, 0L);
1699 Yap_InitCPred("nb_add_to_accumulator", 2, nb_add_to_accumulator, 0L);
1700 Yap_InitCPred("nb_accumulator_value", 2, nb_accumulator_value, 0L);
1701#ifdef DEBUG
1702 Yap_InitCPred("nb_beam_check", 1, nb_beam_check, SafePredFlag);
1703#endif
1704 Yap_InitCPred("nb_beam_size", 2, nb_beam_size, SafePredFlag);
1705 CurrentModule = cm;
1706}
1707
1708#endif
1709
Yap.h
Main definitions.
source
@ source
If true maintain the source for all clauses.
Definition: YapGFlagInfo.h:601
gc_entry_info
Definition: heapgc.h:272
global_entry
Definition: Yatom.h:151