From 29bbffc650e8f2c20cf57711652fb1dd7574f802 Mon Sep 17 00:00:00 2001 From: vsc Date: Fri, 25 Aug 2006 19:50:35 +0000 Subject: [PATCH] global data structures git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1687 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/globals.c | 757 +++++++++++++++++++++++++++++++++++++++++++- C/heapgc.c | 1 - C/init.c | 1 + C/modules.c | 4 +- H/Heap.h | 7 +- H/rheap.h | 6 +- library/Makefile.in | 1 + library/nb.yap | 40 +++ 8 files changed, 808 insertions(+), 9 deletions(-) create mode 100644 library/nb.yap diff --git a/C/globals.c b/C/globals.c index eb252bf27..f276546ae 100644 --- a/C/globals.c +++ b/C/globals.c @@ -37,6 +37,14 @@ static char SccsId[] = "%W% %G%"; #define QUEUE_TAIL 3 #define QUEUE_SIZE 4 +#define HEAP_SIZE 0 +#define HEAP_MAX 1 +#define HEAP_ARENA 2 +#define HEAP_DELAY_ARENA 3 +#define HEAP_START 4 + +#define Global_MkIntegerTerm(I) MkIntegerTerm(I) + static UInt big2arena_sz(CELL *arena_base) { @@ -1075,7 +1083,7 @@ p_nb_queue_enqueue(void) H = HB = ArenaPt(arena); old_sz = ArenaSz(arena); } - qd[QUEUE_SIZE] = MkIntegerTerm(qsize+1); + qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsize+1); if (qsize == 0) { qd[QUEUE_HEAD] = AbsPair(H); } else { @@ -1085,7 +1093,7 @@ p_nb_queue_enqueue(void) RESET_VARIABLE(H); qd[QUEUE_TAIL] = (CELL)H; H++; - CloseArena(oldH, oldHB, ASP, qd, old_sz); + CloseArena(oldH, oldHB, ASP, qd+QUEUE_ARENA, old_sz); return TRUE; } @@ -1111,7 +1119,7 @@ p_nb_queue_dequeue(void) /* garbage collection ? */ oldH = H; oldHB = HB; - qd[QUEUE_SIZE] = MkIntegerTerm(qsz-1); + qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsz-1); CloseArena(oldH, oldHB, ASP, &arena, old_sz); return Yap_unify(out, ARG2); } @@ -1150,8 +1158,734 @@ p_nb_queue_size(void) return Yap_unify(ARG2,qd[QUEUE_SIZE]); } + +static CELL * +GetHeap(Term t, char* caller) +{ + t = Deref(t); + + if (IsVarTerm(t)) { + Yap_Error(INSTANTIATION_ERROR,t,caller); + return NULL; + } + if (!IsApplTerm(t)) { + Yap_Error(TYPE_ERROR_COMPOUND,t,caller); + return NULL; + } + return RepAppl(t)+1; +} + +static Int +p_nb_heap(void) +{ + Term heap_arena, delay_heap_arena, heap, *ar, *nar; + UInt hsize; + Term tsize = Deref(ARG1); + UInt arena_sz = (H-H0)/16; + + if (IsVarTerm(tsize)) { + Yap_Error(INSTANTIATION_ERROR,tsize,"nb_heap"); + return FALSE; + } else { + if (!IsIntegerTerm(tsize)) { + Yap_Error(TYPE_ERROR_INTEGER,tsize,"nb_heap"); + return FALSE; + } + hsize = IntegerOfTerm(tsize); + } + heap = Yap_MkNewApplTerm(Yap_MkFunctor(Yap_LookupAtom("heap"),2*hsize+HEAP_START),2*hsize+HEAP_START); + if (!Yap_unify(heap,ARG2)) + return FALSE; + ar = RepAppl(heap)+1; + ar[HEAP_ARENA] = + ar[HEAP_DELAY_ARENA] = + ar[HEAP_SIZE] = + MkIntTerm(0); + ar[HEAP_MAX] = tsize; + if (arena_sz < 1024) + arena_sz = 1024; + heap_arena = NewArena(arena_sz,1,NULL); + if (heap_arena == 0L) { + return FALSE; + } + nar = RepAppl(Deref(ARG2))+1; + nar[HEAP_ARENA] = heap_arena; + arena_sz = ((attvar_record *)H0- DelayTop())/16; + if (arena_sz <2) + arena_sz = 2; + if (arena_sz > 256) + arena_sz = 256; + delay_heap_arena = NewDelayArena(arena_sz); + if (delay_heap_arena == 0L) { + return FALSE; + } + nar = RepAppl(Deref(ARG2))+1; + nar[HEAP_DELAY_ARENA] = delay_heap_arena; + return TRUE; +} + +static Int +p_nb_heap_close(void) +{ + Term t = Deref(ARG1); + if (!IsVarTerm(t)) { + CELL *qp; + + qp = RepAppl(t)+1; + if (qp[HEAP_ARENA] != MkIntTerm(0)) + RecoverArena(qp[HEAP_ARENA]); + if (qp[HEAP_DELAY_ARENA] != MkIntTerm(0)) + RecoverDelayArena(qp[HEAP_DELAY_ARENA]); + return TRUE; + } + Yap_Error(INSTANTIATION_ERROR,t,"heap/3"); + return FALSE; +} + +static void +PushHeap(CELL *pt, UInt off) +{ + while (off) { + UInt noff = (off+1)/2-1; + if (Yap_compare_terms(pt[2*off], pt[2*noff]) < 0) { + Term tk = pt[2*noff]; + Term tv = pt[2*noff+1]; + pt[2*noff] = pt[2*off]; + pt[2*noff+1] = pt[2*off+1]; + pt[2*off] = tk; + pt[2*off+1] = tv; + off = noff; + } else { + return; + } + } +} + +static void +DelHeapRoot(CELL *pt, UInt sz) +{ + UInt indx = 0; + Term tk, tv; + + sz--; + tk = pt[2*sz]; + tv = pt[2*sz+1]; + while (TRUE) { + if (sz < 2*indx+3 || Yap_compare_terms(pt[4*indx+2],pt[4*indx+4]) < 0) { + if (sz < 2*indx+2 || Yap_compare_terms(tk, pt[4*indx+2]) < 0) { + pt[2*indx] = tk; + pt[2*indx+1] = tv; + return; + } else { + pt[2*indx] = pt[4*indx+2]; + pt[2*indx+1] = pt[4*indx+3]; + indx = 2*indx+1; + } + } else { + if (Yap_compare_terms(tk, pt[4*indx+4]) < 0) { + pt[2*indx] = tk; + pt[2*indx+1] = tv; + return; + } else { + pt[2*indx] = pt[4*indx+4]; + pt[2*indx+1] = pt[4*indx+5]; + indx = 2*indx+2; + } + } + } +} + +static Int +p_nb_heap_add_to_heap(void) +{ + CELL *qd = GetHeap(ARG1,"add_to_heap"), *oldH, *oldHB, *pt; + UInt hsize, hmsize, old_sz; + Term arena, to, key; + + if (!qd) + return FALSE; + restart: + hsize = IntegerOfTerm(qd[HEAP_SIZE]); + hmsize = IntegerOfTerm(qd[HEAP_MAX]); + if (hsize == hmsize) { + CELL *top = qd+(HEAP_START+2*hmsize); + UInt extra_size; + + if (hmsize >= 64*1024) { + extra_size = 64*1024; + } else { + extra_size = hmsize; + } + if (!Yap_InsertInGlobal(top, extra_size*2*sizeof(CELL))) { + Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms"); + return FALSE; + } + qd = GetHeap(ARG1,"add_to_heap"); + hmsize += extra_size; + if (!qd) + return FALSE; + qd[-1] = (CELL)Yap_MkFunctor(Yap_LookupAtom("heap"),2*hmsize+HEAP_START); + top = qd+(HEAP_START+2*(hmsize-extra_size)); + while (extra_size) { + RESET_VARIABLE(top); + RESET_VARIABLE(top+1); + top+=2; + extra_size--; + } + arena = qd[HEAP_ARENA]; + old_sz = ArenaSz(arena); + oldH = H; + oldHB = HB; + H = HB = ArenaPt(arena); + qd[HEAP_MAX] = Global_MkIntegerTerm(hmsize); + CloseArena(oldH, oldHB, ASP, qd+HEAP_ARENA, old_sz); + goto restart; + } + arena = qd[HEAP_ARENA]; + if (arena == 0L) + return FALSE; + key = CopyTermToArena(ARG2, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA); + to = CopyTermToArena(ARG3, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA); + if (key == 0 || to == 0L) + return FALSE; + qd = GetHeap(ARG1,"add_to_heap"); + arena = qd[HEAP_ARENA]; + /* garbage collection ? */ + oldH = H; + oldHB = HB; + H = HB = ArenaPt(arena); + old_sz = ArenaSz(arena); + while (old_sz < 128) { + UInt gsiz = hsize*2*sizeof(CELL); + + H = oldH; + HB = oldHB; + if (gsiz > 1024*1024) { + gsiz = 1024*1024; + } else if (gsiz < 1024*sizeof(CELL)) { + gsiz = 1024*sizeof(CELL); + } + ARG3 = to; + if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) { + Yap_Error(OUT_OF_STACK_ERROR, arena, Yap_ErrorMessage); + return 0L; + } + to = ARG3; + qd = RepAppl(Deref(ARG1))+1; + arena = qd[HEAP_ARENA]; + oldH = H; + oldHB = HB; + H = HB = ArenaPt(arena); + old_sz = ArenaSz(arena); + } + pt = qd+HEAP_START; + pt[2*hsize] = key; + pt[2*hsize+1] = to; + PushHeap(pt, hsize); + qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize+1); + CloseArena(oldH, oldHB, ASP, qd+HEAP_ARENA, old_sz); + return TRUE; +} + +static Int +p_nb_heap_del(void) +{ + CELL *qd = GetHeap(ARG1,"deheap"); + UInt old_sz, qsz; + Term arena; + CELL *oldH, *oldHB; + Term tk, tv; + + if (!qd) + return FALSE; + qsz = IntegerOfTerm(qd[HEAP_SIZE]); + if (qsz == 0) + return FALSE; + arena = qd[HEAP_ARENA]; + if (arena == 0L) + return FALSE; + old_sz = ArenaSz(arena); + /* garbage collection ? */ + oldH = H; + oldHB = HB; + qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz-1); + CloseArena(oldH, oldHB, ASP, &arena, old_sz); + tk = qd[HEAP_START]; + tv = qd[HEAP_START+1]; + DelHeapRoot(qd+HEAP_START, qsz); + return Yap_unify(tk, ARG2) && + Yap_unify(tv, ARG3); +} + +static Int +p_nb_heap_peek(void) +{ + CELL *qd = GetHeap(ARG1,"heap_peek"); + UInt qsz; + Term tk, tv; + + if (!qd) + return FALSE; + qsz = IntegerOfTerm(qd[HEAP_SIZE]); + if (qsz == 0) + return FALSE; + tk = qd[HEAP_START]; + tv = qd[HEAP_START+1]; + return Yap_unify(tk, ARG2) && + Yap_unify(tv, ARG3); +} + +static Int +p_nb_heap_empty(void) +{ + CELL *qd = GetHeap(ARG1,"heap_empty"); + + if (!qd) + return FALSE; + return (IntegerOfTerm(qd[HEAP_SIZE]) == 0); +} + +static Int +p_nb_heap_size(void) +{ + CELL *qd = GetHeap(ARG1,"heap_size"); + + if (!qd) + return FALSE; + return Yap_unify(ARG2,qd[HEAP_SIZE]); +} + +static Int +p_nb_beam(void) +{ + Term beam_arena, delay_beam_arena, beam, *ar, *nar; + UInt hsize; + Term tsize = Deref(ARG1); + UInt arena_sz = (H-H0)/16; + + if (IsVarTerm(tsize)) { + Yap_Error(INSTANTIATION_ERROR,tsize,"nb_beam"); + return FALSE; + } else { + if (!IsIntegerTerm(tsize)) { + Yap_Error(TYPE_ERROR_INTEGER,tsize,"nb_beam"); + return FALSE; + } + hsize = IntegerOfTerm(tsize); + } + beam = Yap_MkNewApplTerm(Yap_MkFunctor(Yap_LookupAtom("beam"),5*hsize+HEAP_START),5*hsize+HEAP_START); + if (!Yap_unify(beam,ARG2)) + return FALSE; + ar = RepAppl(beam)+1; + ar[HEAP_ARENA] = + ar[HEAP_DELAY_ARENA] = + ar[HEAP_SIZE] = + MkIntTerm(0); + ar[HEAP_MAX] = tsize; + if (arena_sz < 1024) + arena_sz = 1024; + beam_arena = NewArena(arena_sz,1,NULL); + if (beam_arena == 0L) { + return FALSE; + } + nar = RepAppl(Deref(ARG2))+1; + nar[HEAP_ARENA] = beam_arena; + arena_sz = ((attvar_record *)H0- DelayTop())/16; + if (arena_sz <2) + arena_sz = 2; + if (arena_sz > 256) + arena_sz = 256; + delay_beam_arena = NewDelayArena(arena_sz); + if (delay_beam_arena == 0L) { + return FALSE; + } + nar = RepAppl(Deref(ARG2))+1; + nar[HEAP_DELAY_ARENA] = delay_beam_arena; + return TRUE; +} + +static Int +p_nb_beam_close(void) +{ + return p_nb_beam_close(); +} + + +/* we have two queues, one with + Key, IndxQueue2 + the other with + Key, IndxQueue1, Val +*/ +static void +PushBeam(CELL *pt, CELL *npt, UInt hsize, Term key, Term to) +{ + UInt off = hsize, off2 = hsize; + Term toff, toff2; + + /* push into first queue */ + while (off) { + UInt noff = (off+1)/2-1; + if (Yap_compare_terms(key, pt[2*noff]) < 0) { + UInt i2 = IntegerOfTerm(pt[2*noff+1]); + + pt[2*off] = pt[2*noff]; + pt[2*off+1] = pt[2*noff+1]; + npt[3*i2+1] = Global_MkIntegerTerm(off); + off = noff; + } else { + break; + } + } + toff = Global_MkIntegerTerm(off); + /* off says where we are in first queue */ + /* push into second queue */ + while (off2) { + UInt noff = (off2+1)/2-1; + if (Yap_compare_terms(key, npt[3*noff]) > 0) { + UInt i1 = IntegerOfTerm(npt[3*noff+1]); + + npt[3*off2] = npt[3*noff]; + npt[3*off2+1] = npt[3*noff+1]; + npt[3*off2+2] = npt[3*noff+2]; + pt[2*i1+1] = Global_MkIntegerTerm(off2); + off2 = noff; + } else { + break; + } + } + toff2 = Global_MkIntegerTerm(off2); + /* store elements in their rightful place */ + npt[3*off2] = pt[2*off] = key; + pt[2*off+1] = toff2; + npt[3*off2+1] = toff; + npt[3*off2+2] = to; +} + +static void +DelBeamMax(CELL *pt, CELL *pt2, UInt sz) +{ + UInt off = IntegerOfTerm(pt2[1]); + UInt indx = 0; + Term tk, ti, tv; + + sz--; + /* first, fix the reverse queue */ + tk = pt2[3*sz]; + ti = pt2[3*sz+1]; + tv = pt2[3*sz+2]; + while (TRUE) { + if (sz < 2*indx+3 || Yap_compare_terms(pt2[6*indx+3],pt2[6*indx+6]) > 0) { + if (sz < 2*indx+2 || Yap_compare_terms(tk, pt2[6*indx+3]) > 0) { + break; + } else { + UInt off = IntegerOfTerm(pt2[6*indx+4]); + + pt2[3*indx] = pt2[6*indx+3]; + pt2[3*indx+1] = pt2[6*indx+4]; + pt2[3*indx+2] = pt2[6*indx+5]; + pt[2*off+1] = Global_MkIntegerTerm(indx); + indx = 2*indx+1; + } + } else { + if (Yap_compare_terms(tk, pt2[6*indx+6]) > 0) { + break; + } else { + UInt off = IntegerOfTerm(pt2[6*indx+7]); + + pt2[3*indx] = pt2[6*indx+6]; + pt2[3*indx+1] = pt2[6*indx+7]; + pt2[3*indx+2] = pt2[6*indx+8]; + pt[2*off+1] = Global_MkIntegerTerm(indx); + indx = 2*indx+2; + } + } + } + pt[2*IntegerOfTerm(ti)+1] = Global_MkIntegerTerm(indx); + pt2[3*indx] = tk; + pt2[3*indx+1] = ti; + pt2[3*indx+2] = tv; + /* now, fix the standard queue */ + if (off != sz) { + Term toff, toff2, key; + UInt off2; + + key = pt[2*sz]; + toff2 = pt[2*sz+1]; + off2 = IntegerOfTerm(toff2); + /* off says where we are in first queue */ + /* push into second queue */ + while (off) { + UInt noff = (off+1)/2-1; + if (Yap_compare_terms(key, pt[2*noff]) < 0) { + UInt i1 = IntegerOfTerm(pt[2*noff+1]); + + pt[2*off] = pt[2*noff]; + pt[2*off+1] = pt[2*noff+1]; + pt2[3*i1+1] = Global_MkIntegerTerm(off); + off = noff; + } else { + break; + } + } + toff = Global_MkIntegerTerm(off); + /* store elements in their rightful place */ + pt[2*off] = key; + pt2[3*off2+1] = toff; + pt[2*off+1] = toff2; + } +} + +static Term +DelBeamMin(CELL *pt, CELL *pt2, UInt sz) +{ + UInt off2 = IntegerOfTerm(pt[1]); + Term ov = pt2[3*off2+2]; /* return value */ + UInt indx = 0; + Term tk, tv; + + sz--; + /* first, fix the standard queue */ + tk = pt[2*sz]; + tv = pt[2*sz+1]; + while (TRUE) { + if (sz < 2*indx+3 || Yap_compare_terms(pt[4*indx+2],pt[4*indx+4]) < 0) { + if (sz < 2*indx+2 || Yap_compare_terms(tk, pt[4*indx+2]) < 0) { + break; + } else { + UInt off2 = IntegerOfTerm(pt[4*indx+3]); + pt[2*indx] = pt[4*indx+2]; + pt[2*indx+1] = pt[4*indx+3]; + pt2[3*off2+1] = Global_MkIntegerTerm(indx); + indx = 2*indx+1; + } + } else { + if (Yap_compare_terms(tk, pt[4*indx+4]) < 0) { + break; + } else { + UInt off2 = IntegerOfTerm(pt[4*indx+5]); + + pt[2*indx] = pt[4*indx+4]; + pt[2*indx+1] = pt[4*indx+5]; + pt2[3*off2+1] = Global_MkIntegerTerm(indx); + indx = 2*indx+2; + } + } + } + pt[2*indx] = tk; + pt[2*indx+1] = tv; + pt2[3*IntegerOfTerm(tv)+1] = Global_MkIntegerTerm(indx); + /* now, fix the reverse queue */ + if (off2 != sz) { + Term to, toff, toff2, key; + UInt off; + + key = pt2[3*sz]; + toff = pt2[3*sz+1]; + to = pt2[3*sz+2]; + off = IntegerOfTerm(toff); + /* off says where we are in first queue */ + /* push into second queue */ + while (off2) { + UInt noff = (off2+1)/2-1; + if (Yap_compare_terms(key, pt2[3*noff]) > 0) { + UInt i1 = IntegerOfTerm(pt2[3*noff+1]); + + pt2[3*off2] = pt2[3*noff]; + pt2[3*off2+1] = pt2[3*noff+1]; + pt2[3*off2+2] = pt2[3*noff+2]; + pt[2*i1+1] = Global_MkIntegerTerm(off2); + off2 = noff; + } else { + break; + } + } + toff2 = Global_MkIntegerTerm(off2); + /* store elements in their rightful place */ + pt2[3*off2] = key; + pt[2*off+1] = toff2; + pt2[3*off2+1] = toff; + pt2[3*off2+2] = to; + } + return ov; +} + +static Int +p_nb_beam_add_to_beam(void) +{ + CELL *qd = GetHeap(ARG1,"add_to_beam"), *oldH, *oldHB, *pt; + UInt hsize, hmsize, old_sz; + Term arena, to, key; + + if (!qd) + return FALSE; + hsize = IntegerOfTerm(qd[HEAP_SIZE]); + hmsize = IntegerOfTerm(qd[HEAP_MAX]); + key = Deref(ARG2); + if (hsize == hmsize) { + pt = qd+HEAP_START; + if (Yap_compare_terms(pt[2*hmsize],Deref(ARG2)) > 0) { + /* smaller than current max, we need to drop current max */ + DelBeamMax(pt, pt+2*hmsize, hmsize); + hsize--; + } else { + return TRUE; + } + } + arena = qd[HEAP_ARENA]; + if (arena == 0L) + return FALSE; + key = CopyTermToArena(ARG2, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA); + to = CopyTermToArena(ARG3, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA); + if (key == 0 || to == 0L) + return FALSE; + qd = GetHeap(ARG1,"add_to_beam"); + arena = qd[HEAP_ARENA]; + /* garbage collection ? */ + oldH = H; + oldHB = HB; + H = HB = ArenaPt(arena); + old_sz = ArenaSz(arena); + while (old_sz < 128) { + UInt gsiz = hsize*2*sizeof(CELL); + + H = oldH; + HB = oldHB; + if (gsiz > 1024*1024) { + gsiz = 1024*1024; + } else if (gsiz < 1024*sizeof(CELL)) { + gsiz = 1024*sizeof(CELL); + } + ARG3 = to; + if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) { + Yap_Error(OUT_OF_STACK_ERROR, arena, Yap_ErrorMessage); + return 0L; + } + to = ARG3; + qd = RepAppl(Deref(ARG1))+1; + arena = qd[HEAP_ARENA]; + oldH = H; + oldHB = HB; + H = HB = ArenaPt(arena); + old_sz = ArenaSz(arena); + } + pt = qd+HEAP_START; + PushBeam(pt, pt+2*hmsize, hsize, key, to); + qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize+1); + CloseArena(oldH, oldHB, ASP, qd+HEAP_ARENA, old_sz); + return TRUE; +} + +static Int +p_nb_beam_del(void) +{ + CELL *qd = GetHeap(ARG1,"debeam"); + UInt old_sz, qsz; + Term arena; + CELL *oldH, *oldHB; + Term tk, tv; + + if (!qd) + return FALSE; + qsz = IntegerOfTerm(qd[HEAP_SIZE]); + if (qsz == 0) + return FALSE; + arena = qd[HEAP_ARENA]; + if (arena == 0L) + return FALSE; + old_sz = ArenaSz(arena); + /* garbage collection ? */ + oldH = H; + oldHB = HB; + qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz-1); + CloseArena(oldH, oldHB, ASP, &arena, old_sz); + tk = qd[HEAP_START]; + tv = DelBeamMin(qd+HEAP_START, qd+(HEAP_START+2*IntegerOfTerm(qd[HEAP_MAX])), qsz); + return Yap_unify(tk, ARG2) && + Yap_unify(tv, ARG3); +} + +static Int +p_nb_beam_check(void) +{ + CELL *qd = GetHeap(ARG1,"debeam"); + UInt qsz, qmax; + CELL *pt, *pt2; + UInt i; + + if (!qd) + return FALSE; + qsz = IntegerOfTerm(qd[HEAP_SIZE]); + qmax = IntegerOfTerm(qd[HEAP_MAX]); + if (qsz == 0) + return TRUE; + pt = qd+HEAP_START; + pt2 = pt+2*qmax; + for (i = 1; i < qsz; i++) { + UInt back; + if (Yap_compare_terms(pt[2*((i+1)/2-1)],pt[2*i]) > 0) { + Yap_DebugPlWrite(pt[2*((i+1)/2-1)]); fprintf(stderr,"\n"); + Yap_DebugPlWrite(pt[2*i]); fprintf(stderr,"\n"); + fprintf(stderr,"Error at %d\n",i); + return FALSE; + } + back = IntegerOfTerm(pt[2*i+1]); + if (IntegerOfTerm(pt2[3*back+1]) != i) { + fprintf(stderr,"Link error at %d\n",i); + return FALSE; + } + } + for (i = 1; i < qsz; i++) { + if (Yap_compare_terms(pt2[3*((i+1)/2-1)],pt2[3*i]) < 0) { + fprintf(stderr,"Error at sec %d\n",i); + Yap_DebugPlWrite(pt2[3*((i+1)/2-1)]); fprintf(stderr,"\n"); + Yap_DebugPlWrite(pt2[3*i]); fprintf(stderr,"\n"); + return FALSE; + } + } + return TRUE; +} + +static Int +p_nb_beam_peek(void) +{ + CELL *qd = GetHeap(ARG1,"beam_peek"); + UInt qsz; + Term tk, tv; + + if (!qd) + return FALSE; + qsz = IntegerOfTerm(qd[HEAP_SIZE]); + if (qsz == 0) + return FALSE; + tk = qd[HEAP_START]; + tv = qd[HEAP_START+1]; + return Yap_unify(tk, ARG2) && + Yap_unify(tv, ARG3); +} + +static Int +p_nb_beam_empty(void) +{ + CELL *qd = GetHeap(ARG1,"beam_empty"); + + if (!qd) + return FALSE; + return (IntegerOfTerm(qd[HEAP_SIZE]) == 0); +} + +static Int +p_nb_beam_size(void) +{ + CELL *qd = GetHeap(ARG1,"beam_size"); + + if (!qd) + return FALSE; + return Yap_unify(ARG2,qd[HEAP_SIZE]); +} + void Yap_InitGlobals(void) { + Term cm = CurrentModule; Yap_InitCPred("$allocate_arena", 2, p_allocate_arena, 0); Yap_InitCPred("$allocate_default_arena", 2, p_allocate_default_arena, 0); Yap_InitCPred("arena_size", 1, p_default_arena_size, 0); @@ -1160,6 +1894,7 @@ void Yap_InitGlobals(void) Yap_InitCPred("nb_setval", 2, p_nb_setval, 0L); Yap_InitCPred("nb_getval", 2, p_nb_getval, SafePredFlag); Yap_InitCPred("nb_delete", 1, p_nb_delete, 0L); + CurrentModule = GLOBALS_MODULE; Yap_InitCPred("nb_queue", 1, p_nb_queue, 0L); Yap_InitCPred("nb_queue_close", 3, p_nb_queue_close, SafePredFlag); Yap_InitCPred("nb_queue_enqueue", 2, p_nb_queue_enqueue, 0L); @@ -1167,4 +1902,20 @@ void Yap_InitGlobals(void) Yap_InitCPred("nb_queue_peek", 2, p_nb_queue_peek, SafePredFlag); Yap_InitCPred("nb_queue_empty", 1, p_nb_queue_empty, SafePredFlag); Yap_InitCPred("nb_queue_size", 2, p_nb_queue_size, SafePredFlag); + Yap_InitCPred("nb_heap", 2, p_nb_heap, 0L); + Yap_InitCPred("nb_heap_close", 1, p_nb_heap_close, SafePredFlag); + Yap_InitCPred("nb_heap_add", 3, p_nb_heap_add_to_heap, 0L); + Yap_InitCPred("nb_heap_del", 3, p_nb_heap_del, SafePredFlag); + Yap_InitCPred("nb_heap_peek", 3, p_nb_heap_peek, SafePredFlag); + Yap_InitCPred("nb_heap_empty", 1, p_nb_heap_empty, SafePredFlag); + Yap_InitCPred("nb_heap_size", 2, p_nb_heap_size, SafePredFlag); + Yap_InitCPred("nb_beam", 2, p_nb_beam, 0L); + Yap_InitCPred("nb_beam_close", 1, p_nb_beam_close, SafePredFlag); + Yap_InitCPred("nb_beam_add", 3, p_nb_beam_add_to_beam, 0L); + Yap_InitCPred("nb_beam_del", 3, p_nb_beam_del, SafePredFlag); + Yap_InitCPred("nb_beam_peek", 3, p_nb_beam_peek, SafePredFlag); + Yap_InitCPred("nb_beam_empty", 1, p_nb_beam_empty, SafePredFlag); + Yap_InitCPred("nb_beam_check", 1, p_nb_beam_check, SafePredFlag); + Yap_InitCPred("nb_beam_size", 2, p_nb_beam_size, SafePredFlag); + CurrentModule = cm; } diff --git a/C/heapgc.c b/C/heapgc.c index 96ffb38ee..dc58b7eda 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -3117,7 +3117,6 @@ compact_heap(void) if (uccur == EndSpecials) { CELL *old_dest = dest; - CELL *current0=current-1; dest++; current++; while (!MARKED_PTR(current)) { diff --git a/C/init.c b/C/init.c index 3fd65e69d..0af0e55ed 100644 --- a/C/init.c +++ b/C/init.c @@ -875,6 +875,7 @@ InitCodes(void) Yap_heap_regs->terms_module = MkAtomTerm(Yap_LookupAtom("terms")); Yap_heap_regs->system_module = MkAtomTerm(Yap_LookupAtom("system")); Yap_heap_regs->readutil_module = MkAtomTerm(Yap_LookupAtom("readutil")); + Yap_heap_regs->readutil_module = MkAtomTerm(Yap_LookupAtom("nb")); Yap_InitModules(); #ifdef BEAM Yap_heap_regs->beam_retry_code.opc = Yap_opcode(_retry_eam); diff --git a/C/modules.c b/C/modules.c index ec9a6bcbe..a22495f2c 100644 --- a/C/modules.c +++ b/C/modules.c @@ -183,6 +183,8 @@ Yap_InitModules(void) SYSTEM_MODULE; ModuleName[7] = READUTIL_MODULE; - NoOfModules = 8; + ModuleName[8] = + GLOBALS_MODULE; + NoOfModules = 9; CurrentModule = PROLOG_MODULE; } diff --git a/H/Heap.h b/H/Heap.h index ebf7befec..9dd071277 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -10,7 +10,7 @@ * File: Heap.h * * mods: * * comments: Heap Init Structure * -* version: $Id: Heap.h,v 1.103 2006-08-22 16:12:46 vsc Exp $ * +* version: $Id: Heap.h,v 1.104 2006-08-25 19:50:35 vsc Exp $ * *************************************************************************/ /* information that can be stored in Code Space */ @@ -483,7 +483,8 @@ typedef struct various_codes { charsio_module, terms_module, system_module, - readutil_module; + readutil_module, + globals_module; void *last_wtime; struct pred_entry *pred_goal_expansion; struct pred_entry *pred_meta_call; @@ -767,7 +768,7 @@ struct various_codes *Yap_heap_regs; #define TERMS_MODULE Yap_heap_regs->terms_module #define SYSTEM_MODULE Yap_heap_regs->system_module #define READUTIL_MODULE Yap_heap_regs->readutil_module -#define READUTIL_MODULE Yap_heap_regs->readutil_module +#define GLOBALS_MODULE Yap_heap_regs->globals_module #define PredGoalExpansion Yap_heap_regs->pred_goal_expansion #define PredMetaCall Yap_heap_regs->pred_meta_call #define PredDollarCatch Yap_heap_regs->pred_dollar_catch diff --git a/H/rheap.h b/H/rheap.h index e8309b00b..128ef81de 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -11,8 +11,11 @@ * File: rheap.h * * comments: walk through heap code * * * -* Last rev: $Date: 2006-08-22 16:12:46 $,$Author: vsc $ * +* Last rev: $Date: 2006-08-25 19:50:35 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.69 2006/08/22 16:12:46 vsc +* global variables +* * Revision 1.68 2006/08/02 18:18:30 vsc * preliminary support for readutil library (SWI compatible). * @@ -673,6 +676,7 @@ restore_codes(void) Yap_heap_regs->terms_module = AtomTermAdjust(Yap_heap_regs->terms_module); Yap_heap_regs->system_module = AtomTermAdjust(Yap_heap_regs->system_module); Yap_heap_regs->readutil_module = AtomTermAdjust(Yap_heap_regs->readutil_module); + Yap_heap_regs->globals_module = AtomTermAdjust(Yap_heap_regs->globals_module); if (Yap_heap_regs->file_aliases != NULL) { Yap_heap_regs->yap_streams = (struct stream_desc *)AddrAdjust((ADDR)Yap_heap_regs->yap_streams); diff --git a/library/Makefile.in b/library/Makefile.in index 07e6beeab..6d4af80cc 100644 --- a/library/Makefile.in +++ b/library/Makefile.in @@ -38,6 +38,7 @@ PROGRAMS= $(srcdir)/apply_macros.yap \ $(srcdir)/lists.yap \ $(srcdir)/logtalk.yap \ $(srcdir)/matrices.yap \ + $(srcdir)/nb.yap \ $(srcdir)/ordsets.yap \ $(srcdir)/prandom.yap \ $(srcdir)/queues.yap \ diff --git a/library/nb.yap b/library/nb.yap new file mode 100644 index 000000000..86a944e2a --- /dev/null +++ b/library/nb.yap @@ -0,0 +1,40 @@ +/************************************************************************* +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * +* * +************************************************************************** +* * +* File: nb.yap * +* Last rev: 5/12/99 * +* mods: * +* comments: non-backtrackable data-structures * +* * +*************************************************************************/ + +:- module(nb, [ + nb_queue/1, + nb_queue_close/3, + nb_queue_enqueue/2, + nb_queue_dequeue/2, + nb_queue_peek/2, + nb_queue_empty/1, + nb_queue_size/2, + nb_heap/2, + nb_heap_close/1, + nb_heap_add/3, + nb_heap_del/3, + nb_heap_peek/3, + nb_heap_empty/1, + nb_heap_size/2, + nb_beam/2, + nb_beam_close/1, + nb_beam_add/3, + nb_beam_del/3, + nb_beam_peek/3, + nb_beam_empty/1, +% nb_beam_check/1, + nb_beam_size/2]).