yap_flag(gc_trace,very_verbose).

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@333 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/heapgc.c

@@ -70,7 +70,7 @@ STATIC_PROTO(void mark_db_fixed, (CELL *));
 STATIC_PROTO(void mark_regs, (tr_fr_ptr));
 STATIC_PROTO(void mark_trail, (tr_fr_ptr, tr_fr_ptr, CELL *, choiceptr));
 STATIC_PROTO(void mark_environments, (CELL *, OPREG, CELL *));
-STATIC_PROTO(void mark_choicepoints, (choiceptr, tr_fr_ptr));
+STATIC_PROTO(void mark_choicepoints, (choiceptr, tr_fr_ptr, int));
 STATIC_PROTO(void into_relocation_chain, (CELL *, CELL *));
 STATIC_PROTO(void sweep_trail, (choiceptr, tr_fr_ptr));
 STATIC_PROTO(void sweep_environments, (CELL *, OPREG, CELL *));
@@ -78,6 +78,7 @@ STATIC_PROTO(void sweep_choicepoints, (choiceptr));
 STATIC_PROTO(choiceptr update_B_H, (choiceptr, CELL *, CELL *, CELL *));
 STATIC_PROTO(void compact_heap, (void));
 STATIC_PROTO(void update_relocation_chain, (CELL *, CELL *));
+STATIC_PROTO(int  is_gc_very_verbose, (void));
 
 #include "heapgc.h"
 
@@ -572,7 +573,6 @@ init_dbtable(tr_fr_ptr trail_ptr) {
 #ifdef DEBUG
 
 /* #define INSTRUMENT_GC 1 */
-/* #define CHECK_CHOICEPOINTS 1  */
 
 #ifdef INSTRUMENT_GC
 typedef enum {
@@ -1269,7 +1269,6 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
 #endif /* TABLING_SCHEDULING */
 #endif
 
-#ifdef CHECK_CHOICEPOINTS
 #ifndef ANALYST
 
 static char *op_names[_std_top + 1] =
@@ -1280,11 +1279,10 @@ static char *op_names[_std_top + 1] =
 };
 
 #endif
-#endif
 
 
 static void 
-mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR)
+mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
 {
 
 #ifdef EASY_SHUNTING
@@ -1312,54 +1310,57 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR)
 #endif
     op = rtp->opc;
     opnum = op_from_opcode(op);
-#ifdef CHECK_CHOICEPOINTS
+    if (very_verbose) {
-    switch (opnum) {
+      switch (opnum) {
-    case _or_else:
+      case _or_else:
-    case _or_last:
+      case _or_last:
-    case _Nstop:
+      case _Nstop:
-    case _switch_last:
+      case _switch_last:
-    case _switch_l_list:
+      case _switch_l_list:
-    case _retry_c:
+      case _retry_c:
-    case _retry_userc:
+      case _retry_userc:
-    case _trust_logical_pred:
+      case _trust_logical_pred:
-    case _retry_profiled:
+      case _retry_profiled:
-      {
+	{
-	Atom at;
+	  Atom at;
-	Int arity;
+	  Int arity;
-	SMALLUNSGN mod;
+	  SMALLUNSGN mod;
-	if (PredForCode((CODEADDR)gc_B->cp_ap, &at, &arity, &mod))
+	  if (PredForCode((CODEADDR)gc_B->cp_ap, &at, &arity, &mod)) {
-	  YP_fprintf(YP_stderr,"B  %p (%s) at %s/%d  with %d,%d\nf", gc_B, op_names[opnum], RepAtom(at)->StrOfAE, arity, gc_B->cp_h-H0, total_marked);
+	    if (arity) 
-        else
+	      YP_fprintf(YP_stderr,"[GC]       %s/%d marked %d (%s)\n", RepAtom(at)->StrOfAE, arity, total_marked, op_names[opnum]);
-	  YP_fprintf(YP_stderr,"B  %p (%s) with %d,%d\n", gc_B, op_names[opnum], gc_B->cp_h-H0, total_marked);
+	    else
-      }
+	      YP_fprintf(YP_stderr,"[GC]       %s marked %d (%s)\n", RepAtom(at)->StrOfAE, total_marked, op_names[opnum]);
-      break;
+	  } else
+	    YP_fprintf(YP_stderr,"[GC]       marked %d (%s)\n", total_marked, op_names[opnum]);
+	}
+	break;
 #ifdef TABLING
-    case _table_completion:
+      case _table_completion:
-    case _table_answer_resolution:
+      case _table_answer_resolution:
-      {
+	{
-	PredEntry *pe = ENV_ToP(gc_B->cp_cp);
+	  PredEntry *pe = ENV_ToP(gc_B->cp_cp);
-	op_numbers caller_op = op_from_opcode(ENV_ToOp(gc_B->cp_cp));
+	  op_numbers caller_op = op_from_opcode(ENV_ToOp(gc_B->cp_cp));
-	/* first condition  checks if this was a meta-call */
+	  /* first condition  checks if this was a meta-call */
-	if ((caller_op != _call  && caller_op != _fcall) || pe == NULL) {
+	  if ((caller_op != _call  && caller_op != _fcall) || pe == NULL) {
-	  YP_fprintf(YP_stderr,"B  %p (%s) with %d,%d\n", gc_B, op_names[opnum], gc_B->cp_h-H0, total_marked);
+	    YP_fprintf(YP_stderr,"[GC]       marked %d (%s)\n", total_marked, op_names[opnum]);
-	} else
+	  } else
-	  YP_fprintf(YP_stderr,"B  %p (%s for %s/%d) with %d,%d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, gc_B->cp_h-H0, total_marked);
+	    YP_fprintf(YP_stderr,"[GC]       %s/%d marked %d (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked, op_names[opnum]);
-      }
+	}
-      break;
+	break;
 #endif
-    default:
+      default:
-      {
+	{
-	PredEntry *pe = (PredEntry *)gc_B->cp_ap->u.ld.p;
+	  PredEntry *pe = (PredEntry *)gc_B->cp_ap->u.ld.p;
-	if (pe == NULL) {
+	  if (pe == NULL) {
-	  YP_fprintf(YP_stderr,"B  %p (%s) with %d\n", gc_B, op_names[opnum], total_marked);
+	    YP_fprintf(YP_stderr,"[GC]       marked %d (%s)\n", total_marked, op_names[opnum]);
-	} else
+	  } else
-	  if (pe->ArityOfPE)
+	    if (pe->ArityOfPE)
-	    YP_fprintf(YP_stderr,"B  %p (%s for %s/%d) with %d,%d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, gc_B->cp_h-H0, total_marked);
+	      YP_fprintf(YP_stderr,"[GC]       %s/%d marked %d (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked, op_names[opnum]);
-	  else
+	    else
-	    YP_fprintf(YP_stderr,"B  %p (%s for %s) with %d,%d\n", gc_B, op_names[opnum], RepAtom(pe->FunctorOfPred)->StrOfAE, gc_B->cp_h-H0, total_marked);
+	      YP_fprintf(YP_stderr,"[GC]       %s marked %d (%s)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, total_marked, op_names[opnum]);
+	}
       }
     }
-#endif /* CHECK_CHOICEPOINTS */
     {
       /* find out how many cells are still alive in the trail */
 #ifndef FROZEN_STACKS
@@ -2544,7 +2545,7 @@ marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
 #endif
   /* active environments */
   mark_environments(current_env, EnvSize(curp), EnvBMap((CELL *)curp));
-  mark_choicepoints(B, old_TR);	/* choicepoints, and environs  */
+  mark_choicepoints(B, old_TR, is_gc_very_verbose());	/* choicepoints, and environs  */
 #ifdef EASY_SHUNTING
   set_conditionals(sTR);
 #endif
@@ -2746,10 +2747,17 @@ is_gc_verbose(void)
   /* always give info when we are debugging gc */
   return(TRUE);
 #else
-  return(GetValue(AtomGcVerbose) != TermNil);
+  return(GetValue(AtomGcVerbose) != TermNil ||
+	 GetValue(AtomGcVeryVerbose) != TermNil);
 #endif
 }
 
+static int
+is_gc_very_verbose(void)
+{
+  return(GetValue(AtomGcVeryVerbose) != TermNil);
+}
+
 Int total_gc_time(void)
 {
   return(tot_gc_time);

C/init.c

@@ -909,6 +909,7 @@ InitCodes(void)
   heap_regs->atom_gc_margin = LookupAtom("$gc_margin");
   heap_regs->atom_gc_trace = LookupAtom("$gc_trace");
   heap_regs->atom_gc_verbose = LookupAtom("$gc_verbose");
+  heap_regs->atom_gc_very_verbose = LookupAtom("$gc_very_verbose");
   AtomGVar = LookupAtom("var");
   heap_regs->atom_global = LookupAtom("global_sp");
   heap_regs->atom_heap_used = LookupAtom("heapused");

C/save.c

@@ -1032,6 +1032,7 @@ restore_codes(void)
   heap_regs->atom_gc_margin = AtomAdjust(heap_regs->atom_gc_margin);
   heap_regs->atom_gc_trace = AtomAdjust(heap_regs->atom_gc_trace);
   heap_regs->atom_gc_verbose = AtomAdjust(heap_regs->atom_gc_verbose);
+  heap_regs->atom_gc_very_verbose = AtomAdjust(heap_regs->atom_gc_very_verbose);
   heap_regs->atom_global = AtomAdjust(heap_regs->atom_global);
   heap_regs->atom_heap_used = AtomAdjust(heap_regs->atom_heap_used);
   heap_regs->atom_index = AtomAdjust(heap_regs->atom_index);

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.21 2002-01-24 23:55:34 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.22 2002-01-28 04:30:40 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -178,6 +178,7 @@ typedef struct various_codes {
     atom_gc_margin,
     atom_gc_trace,
     atom_gc_verbose,
+    atom_gc_very_verbose,
     atom_global,
     atom_heap_used,
     atom_index,
@@ -373,6 +374,7 @@ typedef struct various_codes {
 #define  AtomGcMargin             heap_regs->atom_gc_margin
 #define  AtomGcTrace              heap_regs->atom_gc_trace
 #define  AtomGcVerbose            heap_regs->atom_gc_verbose
+#define  AtomGcVeryVerbose        heap_regs->atom_gc_very_verbose
 #define  AtomGlobal               heap_regs->atom_global
 #define  AtomHeapUsed             heap_regs->atom_heap_used
 #define  AtomIndex                heap_regs->atom_index

docs/yap.tex

@@ -5991,11 +5991,12 @@ collection. The default depends on total stack size.
 
 @item  gc_trace
 @findex gc_trace (yap_flag/2 option)
-@*
+@* If @code{off} (default) do not show information on garbage collection
-If @code{off} (default) do not show information on garbage collection and
+and stack shifts, if @code{on} inform when a garbage collection or stack
-stack shifts, if @code{on} inform when a garbage collection or stack shift
+shift happened, if @code{verbose} give detailed information on garbage
-happened, if @code{verbose} give detailed information on garbage collection
+collection and stack shifts. Last, if @code{very_verbose} give detailed
-and stack shifts.
+information on data-structures found during the garbage collection
+process, namely, on choice-points.
 
 @item  index
 @findex index (yap_flag/2 option)

pl/boot.yap

@@ -1164,7 +1164,7 @@ expand_term(Term,Expanded) :-
 % what is ball;
 % where was the previous catch	
 catch(G, C, A) :-
-	'$mark_tr'(C,A,_),
+	'$catch'(C,A,_),
 	'$execute'(G).
 
 				%
@@ -1175,7 +1175,7 @@ catch(G, C, A) :-
 %
 '$system_catch'(G, M, C, A) :-
 	% check current trail
-	'$mark_tr'(C,A,_),
+	'$catch'(C,A,_),
 	'$execute0'(G, M).
 
 %
@@ -1190,8 +1190,8 @@ throw(Ball) :-
 
 	
 % just create a choice-point
-'$mark_tr'(_,_,_).
+'$catch'(_,_,_).
-'$mark_tr'(_,_,_) :- fail.
+'$catch'(_,_,_) :- fail.
 
 '$handle_throw'(_, _, _).
 '$handle_throw'(C, A, Ball) :-

pl/directives.yap

@@ -135,16 +135,24 @@ yap_flag(gc_trace,V) :-
 	var(V), !,
 	'$get_value'('$gc_trace',N1),
 	'$get_value'('$gc_verbose',N2),
-	'$yap_flag_show_tracing'(N1, N2, V).
+	'$get_value'('$gc_very_verbose',N3),
+	'$yap_flag_show_gc_tracing'(N1, N2, N3, V).
 yap_flag(gc_trace,on) :-
 	'$set_value'('$gc_trace',true),
-	'$set_value'('$gc_verbose',[]).
+	'$set_value'('$gc_verbose',[]),
+	'$set_value'('$gc_very_verbose',[]).
 yap_flag(gc_trace,verbose) :-
 	'$set_value'('$gc_trace',[]),
-	'$set_value'('$gc_verbose',true).
+	'$set_value'('$gc_verbose',true),
+	'$set_value'('$gc_very_verbose',[]).
+yap_flag(gc_trace,very_verbose) :-
+	'$set_value'('$gc_trace',[]),
+	'$set_value'('$gc_verbose',true),
+	'$set_value'('$gc_very_verbose',true).
 yap_flag(gc_trace,off) :-
 	'$set_value'('$gc_trace',[]),
-	'$set_value'('$gc_verbose',[]).
+	'$set_value'('$gc_verbose',[]),
+	'$set_value'('$gc_very_verbose',[]).
 yap_flag(syntax_errors, V) :- var(V), !,
 	'$get_read_error_handler'(V).
 yap_flag(syntax_errors, Option) :-
@@ -586,9 +594,10 @@ yap_flag(host_type,X) :-
 '$transl_to_trl_types'(1,codes).
 '$transl_to_trl_types'(2,atom).
 
-'$yap_flag_show_tracing'(true, _, on) :- !.
+'$yap_flag_show_gc_tracing'(true, _, _, on) :- !.
-'$yap_flag_show_tracing'(_, true, verbose) :- !.
+'$yap_flag_show_gc_tracing'(_, true, _, verbose) :- !.
-'$yap_flag_show_tracing'(_, _, off).
+'$yap_flag_show_gc_tracing'(_, _, on, very_verbose) :- !.
+'$yap_flag_show_gc_tracing'(_, _, _, off).
 
 '$flag_check_alias'(OUT, Alias) :-
 	stream_property(OUT,[alias(Alias)]), !.