minor fixes
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1946 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
642b498728
commit
d4f01ee67b
41
C/gprof.c
41
C/gprof.c
@ -11,8 +11,11 @@
|
||||
* File: gprof.c *
|
||||
* comments: Interrupt Driven Profiler *
|
||||
* *
|
||||
* Last rev: $Date: 2007-04-10 22:13:20 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2007-10-08 23:02:15 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.8 2007/04/10 22:13:20 vsc
|
||||
* fix max modules limitation
|
||||
*
|
||||
* Revision 1.7 2006/08/22 16:12:45 vsc
|
||||
* global variables
|
||||
*
|
||||
@ -383,8 +386,11 @@ RBExactQuery(yamop* q) {
|
||||
|
||||
static rb_red_blk_node*
|
||||
RBLookup(yamop *entry) {
|
||||
rb_red_blk_node *current = ProfilerRoot->left;
|
||||
rb_red_blk_node *current;
|
||||
|
||||
if (!ProfilerRoot)
|
||||
return NULL;
|
||||
current = ProfilerRoot->left;
|
||||
while (current != ProfilerNil) {
|
||||
if (current->key <= entry && current->lim >= entry) {
|
||||
return current;
|
||||
@ -994,7 +1000,6 @@ prof_alrm(int signo, siginfo_t *si, void *scv)
|
||||
return;
|
||||
}
|
||||
ProfOn = TRUE;
|
||||
|
||||
if ((node = RBLookup((yamop *)current_p))) {
|
||||
node->pcs++;
|
||||
if (Yap_OffLineProfiler) fprintf(FProf,"%p\n", node->pe);
|
||||
@ -1141,11 +1146,9 @@ profglobs(void) {
|
||||
Yap_unify(ARG6,MkIntegerTerm(ProfOns)) ;
|
||||
}
|
||||
|
||||
static Int profinit(void)
|
||||
static Int
|
||||
do_profinit(void)
|
||||
{
|
||||
if (ProfilerOn!=0) return (FALSE);
|
||||
|
||||
|
||||
if (Yap_OffLineProfiler) {
|
||||
FPreds=fopen(profile_names(PROFPREDS_FILE),"w+");
|
||||
if (FPreds == NULL) return FALSE;
|
||||
@ -1153,7 +1156,7 @@ static Int profinit(void)
|
||||
if (FProf==NULL) { fclose(FPreds); return FALSE; }
|
||||
|
||||
Yap_dump_code_area_for_profiler();
|
||||
// } else {
|
||||
} else {
|
||||
if (ProfilerRoot)
|
||||
reset_tree();
|
||||
while (!(ProfilerRoot = RBTreeCreate())) {
|
||||
@ -1163,6 +1166,16 @@ static Int profinit(void)
|
||||
}
|
||||
}
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int profinit(void)
|
||||
{
|
||||
if (ProfilerOn!=0) return (FALSE);
|
||||
|
||||
if (!do_profinit())
|
||||
return FALSE;
|
||||
|
||||
ProfilerOn = -1; /* Inited but not yet started */
|
||||
return(TRUE);
|
||||
}
|
||||
@ -1207,8 +1220,14 @@ static Int start_profilers(int msec)
|
||||
struct itimerval t;
|
||||
struct sigaction sa;
|
||||
|
||||
if (ProfilerOn!=-1) return (FALSE); /* have to go through profinit */
|
||||
|
||||
if (ProfilerOn!=-1) {
|
||||
if (Yap_OffLineProfiler) {
|
||||
return FALSE; /* have to go through profinit */
|
||||
} else {
|
||||
if (!do_profinit())
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
sa.sa_sigaction=prof_alrm;
|
||||
sigemptyset(&sa.sa_mask);
|
||||
sa.sa_flags=SA_SIGINFO;
|
||||
@ -1222,7 +1241,7 @@ static Int start_profilers(int msec)
|
||||
setitimer(ITIMER_PROF,&t,NULL);
|
||||
|
||||
ProfilerOn = msec;
|
||||
return(TRUE);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
|
||||
|
||||
148
C/stdpreds.c
148
C/stdpreds.c
@ -11,8 +11,12 @@
|
||||
* File: stdpreds.c *
|
||||
* comments: General-purpose C implemented system predicates *
|
||||
* *
|
||||
* Last rev: $Date: 2007-04-18 23:01:16 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2007-10-08 23:02:15 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.119 2007/04/18 23:01:16 vsc
|
||||
* fix deadlock when trying to create a module with the same name as a
|
||||
* predicate (for now, just don't lock modules). obs Paulo Moura.
|
||||
*
|
||||
* Revision 1.118 2007/02/26 10:41:40 vsc
|
||||
* fix prolog_flags for chr.
|
||||
*
|
||||
@ -2121,6 +2125,74 @@ p_number_codes(void)
|
||||
return (Yap_unify(ARG1, NewT));
|
||||
}
|
||||
|
||||
static Int
|
||||
p_atom_number(void)
|
||||
{
|
||||
Term t = Deref(ARG1), t2 = Deref(ARG2);
|
||||
Term NewT;
|
||||
|
||||
if (IsVarTerm(t)) {
|
||||
char *String; /* alloc temp space on Trail */
|
||||
char *s;
|
||||
if (IsVarTerm(t2)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, t2, "atom_number/2");
|
||||
return FALSE;
|
||||
}
|
||||
String = Yap_PreAllocCodeSpace();
|
||||
if (String+1024 > (char *)AuxSp) {
|
||||
s = String = Yap_ExpandPreAllocCodeSpace(0,NULL);
|
||||
if (String + 1024 > (char *)AuxSp) {
|
||||
/* crash in flames */
|
||||
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in number_codes/2");
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
if (IsIntTerm(t2)) {
|
||||
#if SHORT_INTS
|
||||
sprintf(String, "%ld", IntOfTerm(t2));
|
||||
#else
|
||||
sprintf(String, "%d", IntOfTerm(t2));
|
||||
#endif
|
||||
} else if (IsFloatTerm(t2)) {
|
||||
sprintf(String, "%g", FloatOfTerm(t2));
|
||||
} else if (IsLongIntTerm(t2)) {
|
||||
#if SHORT_INTS
|
||||
sprintf(String, "%ld", LongIntOfTerm(t2));
|
||||
#else
|
||||
sprintf(String, "%d", LongIntOfTerm(t2));
|
||||
#endif
|
||||
#if USE_GMP
|
||||
} else if (IsBigIntTerm(t2)) {
|
||||
mpz_get_str(String, 10, Yap_BigIntOfTerm(t2));
|
||||
#endif
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_NUMBER, t2, "atom_number/2");
|
||||
return FALSE;
|
||||
}
|
||||
NewT = MkAtomTerm(Yap_LookupAtom(String));
|
||||
return Yap_unify(NewT, ARG1);
|
||||
} else {
|
||||
Atom at;
|
||||
char *s;
|
||||
|
||||
if (!IsAtomTerm(t)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, t, "atom_number/2");
|
||||
return FALSE;
|
||||
}
|
||||
at = AtomOfTerm(t);
|
||||
if (IsWideAtom(at)) {
|
||||
Yap_Error(SYNTAX_ERROR, gen_syntax_error("number_codes"), "while scanning %S", RepAtom(at)->WStrOfAE);
|
||||
return FALSE;
|
||||
}
|
||||
s = RepAtom(at)->StrOfAE; /* alloc temp space on Trail */
|
||||
if ((NewT = get_num(s)) == TermNil) {
|
||||
Yap_Error(SYNTAX_ERROR, gen_syntax_error("atom_number"), "while scanning %s", s);
|
||||
return FALSE;
|
||||
}
|
||||
return Yap_unify(ARG2, NewT);
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_univ(void)
|
||||
{ /* A =.. L */
|
||||
@ -2276,6 +2348,78 @@ p_univ(void)
|
||||
return (Yap_unify(ARG2, twork));
|
||||
}
|
||||
|
||||
/* $sub_atom_extract(A,Bef,Size,After,SubAt).*/
|
||||
static Int
|
||||
p_sub_atom_extract(void)
|
||||
{
|
||||
Atom at = AtomOfTerm(Deref(ARG1)), nat;
|
||||
Int start = IntegerOfTerm(Deref(ARG2));
|
||||
Int len = IntegerOfTerm(Deref(ARG3));
|
||||
Int leftover;
|
||||
|
||||
if (start < 0)
|
||||
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ARG2,"sub_atom/5");
|
||||
if (len < 0)
|
||||
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ARG3,"sub_atom/5");
|
||||
start:
|
||||
if (IsWideAtom(at)) {
|
||||
wchar_t *s = RepAtom(at)->WStrOfAE;
|
||||
int max = wcslen(s);
|
||||
Int i;
|
||||
|
||||
leftover = max-(start+len);
|
||||
if (leftover < 0)
|
||||
return FALSE;
|
||||
for (i=0;i<len;i++) {
|
||||
if ((s+start)[i] > 255) break;
|
||||
}
|
||||
if (i == len) {
|
||||
char *String = Yap_PreAllocCodeSpace();
|
||||
if (String + (len+1024) >= (char *)AuxSp)
|
||||
goto expand_auxsp;
|
||||
for (i=0;i<len;i++) {
|
||||
String[i] = (s+start)[i];
|
||||
}
|
||||
String[len] = '\0';
|
||||
nat = Yap_LookupAtom(String);
|
||||
} else {
|
||||
wchar_t *String = (wchar_t *)Yap_PreAllocCodeSpace();
|
||||
if (String + (len+1024) >= (wchar_t *)AuxSp)
|
||||
goto expand_auxsp;
|
||||
wcsncpy(String, s+start, len);
|
||||
String[len] = '\0';
|
||||
nat = Yap_LookupWideAtom(String);
|
||||
}
|
||||
} else {
|
||||
char *s = RepAtom(at)->StrOfAE, *String;
|
||||
int max = strlen(s);
|
||||
|
||||
leftover = max-(start+len);
|
||||
if (leftover < 0)
|
||||
return FALSE;
|
||||
String = Yap_PreAllocCodeSpace();
|
||||
if (String + (len+1024) >= (char *)AuxSp)
|
||||
goto expand_auxsp;
|
||||
strncpy(String, s+start, len);
|
||||
String[len] = '\0';
|
||||
nat = Yap_LookupAtom(String);
|
||||
}
|
||||
return Yap_unify(ARG5,MkAtomTerm(nat)) &&
|
||||
Yap_unify(ARG4,MkIntegerTerm(leftover));
|
||||
|
||||
expand_auxsp:
|
||||
{
|
||||
char *String = Yap_ExpandPreAllocCodeSpace(len,NULL);
|
||||
if (String + 1024 > (char *)AuxSp) {
|
||||
/* crash in flames */
|
||||
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in sub_atom/5");
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
goto start;
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_abort(void)
|
||||
{ /* abort */
|
||||
@ -3654,9 +3798,11 @@ Yap_InitCPreds(void)
|
||||
Yap_InitCPred("atom_codes", 2, p_atom_codes, 0);
|
||||
Yap_InitCPred("atom_length", 2, p_atom_length, SafePredFlag);
|
||||
Yap_InitCPred("$atom_split", 4, p_atom_split, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$sub_atom_extract", 5, p_sub_atom_extract, HiddenPredFlag);
|
||||
Yap_InitCPred("number_chars", 2, p_number_chars, 0);
|
||||
Yap_InitCPred("number_atom", 2, p_number_atom, 0);
|
||||
Yap_InitCPred("number_codes", 2, p_number_codes, 0);
|
||||
Yap_InitCPred("atom_number", 2, p_atom_number, 0);
|
||||
Yap_InitCPred("atom_concat", 2, p_atom_concat, 0);
|
||||
Yap_InitCPred("atomic_concat", 2, p_atomic_concat, 0);
|
||||
Yap_InitCPred("=..", 2, p_univ, 0);
|
||||
|
||||
@ -17,6 +17,10 @@
|
||||
|
||||
<h2>Yap-5.1.3:</h2>
|
||||
<ul>
|
||||
<li> FIXED: profon was broken.</li>
|
||||
<li> NEW: send newline even for unleashed ports (obs from Miguel
|
||||
Filgueiras).</li>
|
||||
<li> NEW: atom_number/2 for SWI compatibility.</li>
|
||||
<li> FIXED: fix YAP_LeaveGoal() (obs from Trevor Walker).</li>
|
||||
<li> FIXED: gc generation should not be an integer: otherwise it can
|
||||
be misled by global growth.</li>
|
||||
|
||||
@ -1367,7 +1367,7 @@ mkdir -p LGPL/clp
|
||||
mkdir -p LGPL/clpr
|
||||
mkdir -p LGPL/chr
|
||||
|
||||
AC_OUTPUT(Makefile library/matrix/Makefile library/matlab/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/chr/Makefile LGPL/chr/chr_swi_bootstrap.yap CLPBN/Makefile LGPL/clp/Makefile LGPL/clpr/Makefile library/lammpi/Makefile library/tries/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap)
|
||||
AC_OUTPUT(Makefile library/matrix/Makefile library/matlab/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/chr/Makefile LGPL/chr/chr_swi_bootstrap.yap CLPBN/Makefile LGPL/clp/Makefile LGPL/clpr/Makefile library/lammpi/Makefile library/tries/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap)
|
||||
|
||||
make depend
|
||||
|
||||
|
||||
13
docs/yap.tex
13
docs/yap.tex
@ -2879,6 +2879,16 @@ The predicate holds when at least one of the arguments is ground
|
||||
will be unified with a number and @var{L} with the list of the ASCII
|
||||
codes for the characters of the external representation of @var{A}.
|
||||
|
||||
@item atom_number(?@var{Atom},?@var{Number}) [ISO]
|
||||
@findex atom_number/2
|
||||
@syindex atom_number/2
|
||||
@cnindex atom_number/2
|
||||
The predicate holds when at least one of the arguments is ground
|
||||
(otherwise, an error message will be displayed). If the argument
|
||||
@var{Atom} is an atom, @var{Number} must be the number corresponding
|
||||
to the characters in @var{Atom}, otherwise the characters in
|
||||
@var{Atom} must encode a number @var{Number}.
|
||||
|
||||
@item number_atom(?@var{I},?@var{L})
|
||||
@findex number_atom/2
|
||||
@snindex number_atom/2
|
||||
@ -6289,7 +6299,8 @@ The following procedures are available:
|
||||
@findex profinit/0
|
||||
@snindex profinit/0
|
||||
@cnindex profinit/0
|
||||
Initialise the data-structures for the profiler.
|
||||
Initialise the data-structures for the profiler. Unnecessary for
|
||||
dynamic profiler.
|
||||
|
||||
@item profon
|
||||
@findex profon/0
|
||||
|
||||
@ -492,8 +492,9 @@ debugging :-
|
||||
repeat,
|
||||
'$trace_msg'(P,G,Module,L,Deterministic),
|
||||
(
|
||||
'$unleashed'(P),
|
||||
'$action'(10,P,L,G,Module,Debug)
|
||||
'$unleashed'(P) ->
|
||||
'$action'(10,P,L,G,Module,Debug),
|
||||
put_code(user_error, 10)
|
||||
;
|
||||
write(user_error,' ? '), get0(user_input,C),
|
||||
'$action'(C,P,L,G,Module,Debug)
|
||||
|
||||
@ -590,6 +590,10 @@ atomic_concat(X,Y,At) :-
|
||||
Len2 is Len1+1,
|
||||
'$atom_contact_split'(At,Len2,Len,X,Y).
|
||||
|
||||
sub_atom(At, Bef, Size, After, SubAt) :-
|
||||
% extract something from an atom
|
||||
atom(At), integer(Bef), integer(Size), !,
|
||||
'$sub_atom_extract'(At, Bef, Size, After, SubAt).
|
||||
sub_atom(At, Bef, Size, After, SubAt) :-
|
||||
atom(At), !,
|
||||
atom_codes(At, Atl),
|
||||
|
||||
Reference in New Issue
Block a user