From bac54329506f8c27141f2ae77134db5d7d56bfb6 Mon Sep 17 00:00:00 2001 From: vsc Date: Mon, 7 May 2001 19:56:02 +0000 Subject: [PATCH] garbage collecting fixes compile trues at the end of body fix call_residue/2 so that constraints cannot escape (yet again). git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@30 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/alloc.c | 10 +++++----- C/compiler.c | 29 +++++++++++++++++++++++++++-- C/heapgc.c | 46 +++++++++++++++++++++++++++++++++++++++------- C/init.c | 22 +++++++++------------- changes4.3.html | 3 +++ pl/corout.yap | 3 +-- pl/errors.yap | 3 +++ 7 files changed, 87 insertions(+), 29 deletions(-) diff --git a/C/alloc.c b/C/alloc.c index fe946888e..053fe3e3e 100644 --- a/C/alloc.c +++ b/C/alloc.c @@ -12,7 +12,7 @@ * Last rev: * * mods: * * comments: allocating space * -* version:$Id: alloc.c,v 1.5 2001-05-07 13:53:19 vsc Exp $ * +* version:$Id: alloc.c,v 1.6 2001-05-07 19:56:02 vsc Exp $ * *************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; @@ -924,20 +924,20 @@ InitMemory(int Trail, int Heap, int Stack) #ifdef DEBUG #if SIZEOF_INT_P!=SIZEOF_INT if (output_msg) { - YP_fprintf(YP_stderr, "HeapBase = %p GlobalBase = %p\n LocalBase = %p TrailTop = %p\n", + fprintf(stderr, "HeapBase = %p GlobalBase = %p\n LocalBase = %p TrailTop = %p\n", HeapBase, GlobalBase, LocalBase, TrailTop); #else if (output_msg) { - YP_fprintf(YP_stderr, "HeapBase = %x GlobalBase = %x\n LocalBase = %x TrailTop = %x\n", + fprintf(stderr, "HeapBase = %x GlobalBase = %x\n LocalBase = %x TrailTop = %x\n", (UInt) HeapBase, (UInt) GlobalBase, (UInt) LocalBase, (UInt) TrailTop); #endif #if !SHORT_INTS - YP_fprintf(YP_stderr, "Heap+Aux: %d\tLocal+Global: %d\tTrail: %d\n", + fprintf(stderr, "Heap+Aux: %d\tLocal+Global: %d\tTrail: %d\n", pm - sa - ta, sa, ta); #else /* SHORT_INTS */ - YP_fprintf(YP_stderr, "Heap+Aux: %ld\tLocal+Global: %ld\tTrail: %ld\n", + fprintf(stderr, "Heap+Aux: %ld\tLocal+Global: %ld\tTrail: %ld\n", pm - sa - ta, sa, ta); #endif /* SHORT_INTS */ } diff --git a/C/compiler.c b/C/compiler.c index a00fb0f54..76493f777 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -1107,6 +1107,22 @@ c_functor(Term Goal) } } +static int +IsTrueGoal(Term t) { + if (IsVarTerm(t)) return(FALSE); + if (IsApplTerm(t)) { + Functor f = FunctorOfTerm(t); + if (f == FunctorModule) { + return(IsTrueGoal(ArgOfTerm(2,t))); + } + if (f == FunctorComma || f == FunctorOr || f == FunctorArrow) { + return(IsTrueGoal(ArgOfTerm(1,t)) && IsTrueGoal(ArgOfTerm(2,t))); + } + return(FALSE); + } + return(t == MkAtomTerm(AtomTrue)); +} + static void c_goal(Term Goal) { @@ -1372,11 +1388,12 @@ c_goal(Term Goal) } else if (f == FunctorComma) { int save = onlast; + int t2 = ArgOfTerm(2, Goal); onlast = FALSE; c_goal(ArgOfTerm(1, Goal)); onlast = save; - c_goal(ArgOfTerm(2, Goal)); + c_goal(t2); CurrentModule = save_CurrentModule; return; } @@ -1690,8 +1707,16 @@ c_body(Term Body) } while (IsNonVarTerm(Body) && IsApplTerm(Body) && FunctorOfTerm(Body) == FunctorComma) { + Term t2 = ArgOfTerm(2, Body); + if (IsTrueGoal(t2)) { + /* optimise the case where some idiot left trues at the end + of the clause. + */ + Body = ArgOfTerm(1, Body); + break; + } c_goal(ArgOfTerm(1, Body)); - Body = ArgOfTerm(2, Body); + Body = t2; } onlast = TRUE; c_goal(Body); diff --git a/C/heapgc.c b/C/heapgc.c index 63099476d..124ae7860 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -1300,7 +1300,6 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B #if MULTI_ASSIGNMENT_VARIABLES while (live_list != NULL) { CELL trail_cell = TrailTerm(live_list->trptr-1); - printf("multi assignment marking cell %p:%x\n", &TrailTerm(live_list->trptr-1), trail_cell); if (HEAP_PTR(trail_cell)) { mark_external_reference(&TrailTerm(live_list->trptr-1)); } @@ -1327,6 +1326,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B #endif #ifdef DEBUG +//#define CHECK_CHOICEPOINTS 1 #endif #ifdef CHECK_CHOICEPOINTS @@ -2328,6 +2328,43 @@ compact_heap(void) } #ifdef HYBRID_SCHEME +static void +adjust_cp_hbs(void) +{ + choiceptr gc_B = B; + CELL_PTR *top = iptop-1, *base = (CELL_PTR *)H; + + while (gc_B != NULL) { + CELL *gc_H = gc_B->cp_h; + CELL_PTR *nbase = base; + if (top[0] <= gc_H) { + if (top[0] == gc_H) + gc_B->cp_h = H0+(top-base); + else + gc_B->cp_h = H0+((top+1)-base); + } else while (TRUE) { + CELL_PTR *nxt = nbase+(top-nbase)/2; + if (nxt[0] > gc_H) { + top = nxt; + } else if (nxt[0] < gc_H && nxt[1] < gc_H) { + nbase = nxt+1; + } else { + if (nxt[0] == gc_H) { + gc_B->cp_h = H0+(nxt-base); + top = nxt; + break; + } else { + gc_B->cp_h = H0+((nxt-base)+1); + top = nxt; + break; + } + } + } + gc_B = gc_B->cp_b; + } +} + + /* * move marked objects on the heap upwards over unmarked objects, and reset * all pointers to point to new locations @@ -2339,8 +2376,6 @@ icompact_heap(void) #ifdef DEBUG Int found_marked = 0; #endif /* DEBUG */ - choiceptr gc_B = B; - /* * upward phase - scan heap from high to low, setting marked upward @@ -2360,7 +2395,6 @@ icompact_heap(void) int nofcells = (UNMARK_CELL(*current)-EndSpecials) / sizeof(CELL); CELL *ptr = current - nofcells ; - gc_B = update_B_H(gc_B, current, H0+(iptr-ibase), H0+(iptr-ibase)+1); iptr -= nofcells; #ifdef DEBUG found_marked+=nofcells; @@ -2373,9 +2407,6 @@ icompact_heap(void) ptr[1] = tmp; } current = ptr; - } else { - /* process the functor next */ - gc_B = update_B_H(gc_B, current, H0+(iptr-ibase), H0+((iptr-ibase)+1)); } #ifdef DEBUG found_marked++; @@ -2555,6 +2586,7 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max) fprintf(stderr,"using pointers (%d)\n", effectiveness); #endif quicksort((CELL_PTR *)H, 0, (iptop-(CELL_PTR *)H)-1); + adjust_cp_hbs(); icompact_heap(); } else #endif /* HYBRID_SCHEME */ diff --git a/C/init.c b/C/init.c index 9c12e4026..8b29e7d85 100644 --- a/C/init.c +++ b/C/init.c @@ -488,26 +488,22 @@ InitDebug(void) if (output_msg) { char ch; opcode(_Ystop); -#if !SHORT_INTS - YP_fprintf(YP_stderr,"absmi address:%x\n", Unsigned(FunAdr(absmi))); -#else - YP_fprintf(YP_stderr,"absmi address:%lx\n", Unsigned(FunAdr(absmi))); -#endif - YP_fprintf(YP_stderr,"Set Trace Options:\n"); - YP_fprintf(YP_stderr,"a getch\t\tb token\t\tc Lookup\td LookupVar\ti Index\n"); - YP_fprintf(YP_stderr,"e SetOp\t\tf compile\tg icode\t\th boot\t\tl log\n"); - YP_fprintf(YP_stderr,"m Machine\n"); + fprintf(stderr,"absmi address:%p\n", FunAdr(absmi)); + fprintf(stderr,"Set Trace Options:\n"); + fprintf(stderr,"a getch\t\tb token\t\tc Lookup\td LookupVar\ti Index\n"); + fprintf(stderr,"e SetOp\t\tf compile\tg icode\t\th boot\t\tl log\n"); + fprintf(stderr,"m Machine\n"); while ((ch = YP_putchar(YP_getchar())) != '\n') if (ch >= 'a' && ch <= 'z') Option[ch - 'a' + 1] = 1; if (Option['l' - 96]) { - logfile = YP_fopen(LOGFILE, "w"); + logfile = fopen(LOGFILE, "w"); if (logfile == Nill) { - YP_fprintf(YP_stderr,"can not open %s\n", LOGFILE); - YP_getchar(); + fprintf(stderr,"can not open %s\n", LOGFILE); + getchar(); exit(0); } - YP_fprintf(YP_stderr,"logging session to file 'logfile'\n"); + fprintf(stderr,"logging session to file 'logfile'\n"); #ifdef MAC SetTextFile(LOGFILE); lp = my_line; diff --git a/changes4.3.html b/changes4.3.html index dcf4f6304..038f5cf4b 100644 --- a/changes4.3.html +++ b/changes4.3.html @@ -6,6 +6,9 @@

Yap-4.3.19: