diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

garbage collecting fixes

Browse Source 
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
This commit is contained in:
vsc 2001-05-07 19:56:02 +00:00
parent 04f75a9662
commit bac5432950
7 changed files with 87 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
C/alloc.c
View File

@ -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 */
}

29
C/compiler.c
View File

@ -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);

46
C/heapgc.c
View File

@ -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 */

22
C/init.c
View File

@ -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;

3
changes4.3.html
View File

@ -6,6 +6,9 @@
<H2 ALIGN=CENTER>Yap-4.3.19:</H2>
<UL>
<LI> FIXED: call_residue/2 should not allow constraints to
escape (use copy_term_no_variables/2 to avoid this).
<LI> SPEEDUP: optimise away true/0 at the end of a clause.
<LI> FIXED: do not short circuit trail entries.
<LI> FIXED: Patches for memory allocation in Apple's OS/X..
<LI> FIXED: checked whether mmap work right in alloc.c.

3
pl/corout.yap
View File

@ -541,8 +541,7 @@ call_residue(Goal,Residue) :-
'$execute'(NGoal),
'$call_residue_continuation'(NGoal,NResidue),
( '$set_svar_list'(OldList,OldAttsList),
Goal = NGoal,
Residue = NResidue
'$copy_term_but_not_constraints'(NGoal+NResidue, Goal+Residue)
;
'$set_svar_list'(CurrentList,CurrentAttsList), fail
)

3
pl/errors.yap
View File

@ -284,6 +284,9 @@ print_message(help,M) :-
'$output_error_message'(system_error, Where) :-
format(user_error,"[ SYSTEM ERROR- ~w ]~n",
[Where]).
'$output_error_message'(type_error(T,_,Err,M), Where) :-
format(user_error,"[ TYPE ERROR- ~w: expected ~w, got ~w ]~n",
[T,Err,M]).
'$output_error_message'(type_error(array,W), Where) :-
format(user_error,"[ TYPE ERROR- ~w: expected array, got ~w ]~n",
[Where,W]).