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

minor fixes

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1946 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
2007-10-08 23:02:16 +00:00
parent 642b498728
commit d4f01ee67b
7 changed files with 201 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
C/gprof.c
View File

@@ -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
View File

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