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

key_statistics/3 

disable stack dump by default: yap_flags(stack_dump,_).


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@720 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-12-10 14:36:22 +00:00
parent 8bccb86a43
commit 00886e5205
6 changed files with 96 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

127
C/cdmgr.c
View File

@ -79,7 +79,6 @@ STATIC_PROTO(Int p_call_count_info, (void));
STATIC_PROTO(Int p_call_count_set, (void));
STATIC_PROTO(Int p_call_count_reset, (void));
STATIC_PROTO(Int p_toggle_static_predicates_in_use, (void));
STATIC_PROTO(void list_all_predicates_in_use, (void));
STATIC_PROTO(Atom YapConsultingFile, (void));
STATIC_PROTO(Int PredForCode,(CODEADDR, Atom *, UInt *, SMALLUNSGN *));
@ -1919,90 +1918,6 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything)
return(FALSE);
}
#ifdef DEBUG
#ifndef ANALYST
static char *op_names[_std_top + 1] =
{
#define OPCODE(OP,TYPE) #OP
#include "YapOpcodes.h"
#undef OPCODE
};
#endif
static void
list_all_predicates_in_use(void)
{
choiceptr b_ptr = B;
CELL *env_ptr = ENV;
do {
/*
I do not need to check environments for asserts,
only for retracts
*/
while (b_ptr > (choiceptr)env_ptr) {
PredEntry *pe = EnvPreg(env_ptr[E_CP]);
op_numbers op = Yap_op_from_opcode(ENV_ToOp(env_ptr[E_CP]));
if (pe->ArityOfPE)
fprintf(Yap_stderr," ENV %p %s/%d %s\n", env_ptr, RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, op_names[op]);
else
fprintf(Yap_stderr," ENV %p %s %s\n", env_ptr, RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, op_names[op]);
env_ptr = (CELL *)(env_ptr[E_E]);
}
restart_cp:
/* now mark the choicepoint */
if (b_ptr != NULL) {
op_numbers opnum = Yap_op_from_opcode(b_ptr->cp_ap->opc);
switch (opnum) {
case _or_else:
case _or_last:
case _Nstop:
case _switch_last:
case _switch_l_list:
case _retry_c:
case _retry_userc:
case _trust_logical_pred:
case _retry_profiled:
case _count_retry:
{
Atom at;
UInt arity;
SMALLUNSGN mod;
if (PredForCode((CODEADDR)b_ptr->cp_ap, &at, &arity, &mod)) {
if (arity)
fprintf(Yap_stderr,"CP %p %s/%d (%s)\n", b_ptr, RepAtom(at)->StrOfAE, arity, op_names[opnum]);
else
fprintf(Yap_stderr,"CP %p %s (%s)\n", b_ptr, RepAtom(at)->StrOfAE, op_names[opnum]);
} else
fprintf(Yap_stderr,"CP %p (%s)\n", b_ptr, op_names[opnum]);
}
break;
default:
{
PredEntry *pe = (PredEntry *)b_ptr->cp_ap->u.ld.p;
if (pe == NULL) {
fprintf(Yap_stderr,"CP %p (%s)\n", b_ptr, op_names[opnum]);
} else
if (pe->ArityOfPE)
fprintf(Yap_stderr,"CP %p %s/%d (%s)\n", b_ptr, RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, op_names[opnum]);
else
fprintf(Yap_stderr,"CP %p %s (%s)\n", b_ptr, RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, op_names[opnum]);
}
}
if (opnum == _retry_profiled || opnum == _count_retry) {
opnum = Yap_op_from_opcode(NEXTOP(b_ptr->cp_ap,l)->opc);
goto restart_cp;
}
}
env_ptr = b_ptr->cp_env;
b_ptr = b_ptr->cp_b;
} while (b_ptr != NULL);
}
#endif
static void
mark_pred(int mark, PredEntry *pe)
{
@ -2079,16 +1994,11 @@ do_toggle_static_predicates_in_use(int mask)
#endif
static Term
all_calls(void)
all_envs(CELL *env_ptr)
{
choiceptr b_ptr = B;
CELL *env_ptr = ENV;
Term tf = AbsPair(H);
CELL *bp = NULL;
Term ts[3];
Functor f = Yap_MkFunctor(AtomLocal,3);
ts[0] = MkIntegerTerm((Int)P);
ts[1] = AbsPair(H);
/* walk the environment chain */
while (env_ptr != NULL) {
bp = H;
@ -2097,14 +2007,22 @@ all_calls(void)
bp[0] = MkIntegerTerm((Int)env_ptr[E_CP]);
if (H >= ASP) {
bp[1] = TermNil;
return(ts[0]);
return tf;
} else {
bp[1] = AbsPair(H);
}
env_ptr = (CELL *)(env_ptr[E_E]);
}
bp[1] = TermNil;
ts[2] = AbsPair(H);
return tf;
}
static Term
all_cps(choiceptr b_ptr)
{
CELL *bp = NULL;
Term tf = AbsPair(H);
while (b_ptr != NULL) {
bp = H;
H += 2;
@ -2112,13 +2030,30 @@ all_calls(void)
bp[0] = MkIntegerTerm((Int)b_ptr->cp_ap);
if (H >= ASP) {
bp[1] = TermNil;
return(ts[0]);
return tf;
} else {
bp[1] = AbsPair(H);
}
b_ptr = b_ptr->cp_b;
}
bp[1] = TermNil;
return tf;
}
static Term
all_calls(void)
{
Term ts[3];
Functor f = Yap_MkFunctor(AtomLocal,3);
ts[0] = MkIntegerTerm((Int)P);
if (yap_flags[STACK_DUMP_ON_ERROR_FLAG]) {
ts[1] = all_envs(ENV);
ts[1] = all_cps(B);
} else {
ts[1] = ts[2] = TermNil;
}
return(Yap_MkApplTerm(f,3,ts));
}

23
C/dbase.c
View File

@ -3125,6 +3125,28 @@ p_first_instance(void)
return(Yap_unify(ARG3, TRef));
}
static Int
p_key_statistics(void)
{
Register DBProp p;
Register DBRef x;
UInt sz = 0, cls = 0;
if (EndOfPAEntr(p = FetchDBPropFromKey(Deref(ARG1), 0, TRUE, "key_statistics/3"))) {
/* This is not a key property */
return(FALSE);
}
/* count number of clauses and size */
x = p->First;
while (x != NULL) {
cls++;
sz += Yap_SizeOfBlock((CODEADDR)x);
x = NextDBRef(x);
}
return(Yap_unify(ARG2,MkIntegerTerm(cls)) &&
Yap_unify(ARG3,MkIntegerTerm(sz)));
}
/*
* This is called when we are erasing a data base clause, because we may have
* pending references
@ -4463,6 +4485,7 @@ Yap_InitDBPreds(void)
Yap_InitCPred("$hold_index", 3, p_hold_index, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$fetch_reference_from_index", 3, p_fetch_reference_from_index, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$resize_int_keys", 1, p_resize_int_keys, SafePredFlag|SyncPredFlag);
Yap_InitCPred("key_statistics", 3, p_key_statistics, SyncPredFlag);
}
void

5
C/stdpreds.c
View File

@ -2195,6 +2195,11 @@ p_set_yap_flags(void)
return(FALSE);
yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = value;
break;
case STACK_DUMP_ON_ERROR_FLAG:
if (value != 0 && value != 1)
return(FALSE);
yap_flags[STACK_DUMP_ON_ERROR_FLAG] = value;
break;
default:
return(FALSE);
}

23
docs/yap.tex
View File

@ -4957,7 +4957,7 @@ If a term equal to @var{T} up to variable renaming is stored under key
@item recordzifnot(+@var{K},@var{T},-@var{R})
@findex recorda/3
@saindex recorda/3
@snindex recorda/3
@cnindex recorda/3
If a term equal to @var{T} up to variable renaming is stored under key
@var{K} fail. Otherwise, make term @var{T} the first record under key
@ -5008,12 +5008,21 @@ this goal fails.
All terms belonging to the key @code{K} are erased from the internal
database. The predicate always succeeds.
@item current_key(@var{A},@var{P})
@item current_key(?@var{A},?@var{K})
@findex current_key/2
@syindex current_key/2
@cnindex current_key/2
Defines the relation: @var{P} is a currently defined database key whose
name is the atom @var{A}.
Defines the relation: @var{K} is a currently defined database key whose
name is the atom @var{A}. It can be used to generate all the keys for
the internal data-base.
@item key_statistics(+@var{K},-@var{Entries},-@var{Size})
@findex key_properties/3
@snindex key_properties/3
@cnindex key_properties/3
Returns several statistics for a key @var{K}. Currently, it says how
many entries we have for that key, @var{Entries}, and what is the
total size spent on the key, @var{Size}.
@item get_value(+@var{A},-@var{V})
@findex get_value/2
@ -6356,6 +6365,12 @@ will work the same way in every Prolog and in every platform. We thus
believe this mode is mostly useful when investigating how a program
depends on a Prolog's platform specific features.
@item stack_dump_on_error
@findex stack_dump_on_error (yap_flag/2 option)
@*
If @code{on} show a stack dump when Yap finds an error. The default is
@code{off}.
@item syntax_errors
@findex syntax_errors (yap_flag/2 option)
@*

7
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h.m4,v 1.39 2002-11-26 22:28:32 vsc Exp $ *
* version: $Id: Yap.h.m4,v 1.40 2002-12-10 14:36:21 vsc Exp $ *
*************************************************************************/
#include "config.h"
@ -508,7 +508,8 @@ typedef enum {
WRITE_QUOTED_STRING_FLAG = 13,
ALLOW_ASSERTING_STATIC_FLAG = 14,
HALT_AFTER_CONSULT_FLAG = 15,
FAST_BOOT_FLAG = 16
FAST_BOOT_FLAG = 16,
STACK_DUMP_ON_ERROR_FLAG = 17
} yap_flags;
#define STRING_AS_CHARS 0
@ -521,7 +522,7 @@ typedef enum {
#define ISO_CHARACTER_ESCAPES 1
#define SICSTUS_CHARACTER_ESCAPES 2
#define NUMBER_OF_YAP_FLAGS FAST_BOOT_FLAG+1
#define NUMBER_OF_YAP_FLAGS STACK_DUMP_ON_ERROR_FLAG+1
/************************ prototypes **********************************/

14
pl/directives.yap
View File

@ -452,6 +452,19 @@ yap_flag(write_strings,off) :- !,
yap_flag(write_strings,X) :-
'$do_error'(domain_error(flag_value,write_strings+X),yap_flag(write_strings,X)).
yap_flag(stack_dump_on_error,OUT) :-
var(OUT), !,
'$access_yap_flags'(17,X),
'$transl_to_on_off'(X,OUT).
yap_flag(stack_dump_on_error,on) :- !,
'$transl_to_on_off'(X,on),
'$set_yap_flags'(17,X).
yap_flag(stack_dump_on_error,off) :- !,
'$transl_to_on_off'(X,off),
'$set_yap_flags'(17,X).
yap_flag(stack_dump_on_error,X) :-
'$do_error'(domain_error(flag_value,stack_dump_on_error+X),yap_flag(stack_dump_on_error,X)).
yap_flag(user_input,OUT) :-
var(OUT), !,
'$flag_check_alias'(OUT, user_input).
@ -535,6 +548,7 @@ yap_flag(host_type,X) :-
V = redefine_warnings ;
V = single_var_warnings ;
V = strict_iso ;
V = stack_dump_on_error ;
V = syntax_errors ;
V = to_chars_mode ;
V = toplevel_hook ;