minor fixes

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

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

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

changes-5.1.html

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

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

pl/debug.yap

@@ -492,8 +492,9 @@ debugging :-
 	repeat,
 	'$trace_msg'(P,G,Module,L,Deterministic),
 	( 
-	  '$unleashed'(P),
+	  '$unleashed'(P) ->
-	  '$action'(10,P,L,G,Module,Debug)
+	  '$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)

pl/utils.yap

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