make chr work and other minor fixes.

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

C/absmi.c

@@ -10,8 +10,11 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2006-04-27 14:11:57 $,$Author: rslopes $						 *
+* Last rev:     $Date: 2006-05-24 02:35:39 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.201  2006/04/27 14:11:57  rslopes
+* *** empty log message ***
+*
 * Revision 1.200  2006/04/12 17:14:58  rslopes
 * fix needed by the EAM engine
 *
@@ -3789,7 +3792,9 @@ Yap_absmi(int inp)
       BIND(pt0, d1, bind_gstruct);
 #ifdef COROUTINING
       DO_TRAIL(pt0, d1);
-      if (pt0 < H0) Yap_WakeUp(pt0);
+      if (pt0 < H0) {
+	Yap_WakeUp(pt0);
+      }
     bind_gstruct:
 #endif
       /* now, set pt0 to point to the heap where we are going to
@@ -4184,7 +4189,10 @@ Yap_absmi(int inp)
       BIND(pt0, d0, bind_glist_valy_write);
 #ifdef COROUTINING
       DO_TRAIL(pt0, d0);
-      if (pt0 < H0) Yap_WakeUp(pt0);
+      if (pt0 < H0) {
+	Yap_WakeUp(pt0);
+	pt1 = H;
+      }
     bind_glist_valy_write:
 #endif
       BEGD(d0);
@@ -4389,7 +4397,10 @@ Yap_absmi(int inp)
       BIND(pt0, d0, bind_glist_void_valx_write);
 #ifdef COROUTINING
       DO_TRAIL(pt0, d0);
-      if (pt0 < H0) Yap_WakeUp(pt0);
+      if (pt0 < H0) {
+	Yap_WakeUp(pt0);
+	pt1 = H;
+      }
     bind_glist_void_valx_write:
 #endif
       BEGD(d0);
@@ -4498,7 +4509,10 @@ Yap_absmi(int inp)
       BIND(pt0, d0, bind_glist_void_valy_write);
 #ifdef COROUTINING
       DO_TRAIL(pt0, d0);
-      if (pt0 < H0) Yap_WakeUp(pt0);
+      if (pt0 < H0) {
+	Yap_WakeUp(pt0);
+	S_SREG = H;
+      }
     bind_glist_void_valy_write:
 #endif
       /* include XREG on it */

C/cdmgr.c

@@ -11,8 +11,11 @@
 * File:		cdmgr.c							 *
 * comments:	Code manager						 *
 *									 *
-* Last rev:     $Date: 2006-05-18 16:33:04 $,$Author: vsc $						 *
+* Last rev:     $Date: 2006-05-24 02:35:39 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.188  2006/05/18 16:33:04  vsc
+* fix info reported by memory manager under DL_MALLOC and SYSTEM_MALLOC
+*
 * Revision 1.187  2006/04/29 01:15:18  vsc
 * fix expand_consult patch
 *
@@ -1833,6 +1836,7 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
 	    PredEntry *pe = RepPredProp(p0);
 
 	    pe->PredFlags |= GoalExPredFlag;
+	    p0 = pe->NextOfPE;
 	    found = TRUE;
 	  }
 	  if (!found) {

C/tracer.c

@@ -161,6 +161,8 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   LOCK(Yap_heap_regs->low_level_trace_lock);
   sc = Yap_heap_regs;
   vsc_count++;
+  if (vsc_count == 27) Yap_Portray_delays = TRUE;
+  else Yap_Portray_delays = TRUE;
 #ifdef COMMENTED
   if (worker_id != 04 || worker_id != 03) return;
   //  if (vsc_count == 218280)

CHR/chr.yap

@@ -76,9 +76,9 @@
 	  assoc_to_list/2
       ]).
 
-:- use_module(library('chr/sbag')).   % link to sbag_l.pl or sbag_a.pl
+:- use_module('chr/sbag').   % link to sbag_l.pl or sbag_a.pl
-:- use_module(library('chr/chrcmp')).
+:- use_module('chr/chrcmp').
-:- use_module(library('chr/trace')).
+:- use_module('chr/trace').
 
 :- use_module(library(atts)).
 

CHR/chr/chrcmp.pl

@@ -32,9 +32,9 @@
 %vsc
 % debug
 :- ['operator'].
-:- use_module(library('chr/getval')).
+:- use_module(getval).
 :- ['matching'].
-:- use_module( library('chr/concat'), [concat_name/2]).
+:- use_module(concat, [concat_name/2]).
 
 :- use_module( library(terms),
 	[

changes-5.1.html

@@ -16,6 +16,12 @@
 
 <h2>Yap-5.1.2:</h2>
 <ul>
+<li> NEW: add select/3 and intersection/3 to SWI emulation.</li>
+<li> FIXED: always keep in mind that Yap_WakeUp may change H (would
+break chr).</li>
+<li> FIXED: add_clause of new predicate could get in loop.</li>
+<li> FIXED: don't have to print anything if there is not anything to
+print.</li>
 <li> FIXED: current_thread/2 should fail if called with bad alias or
 ID (obs Paulo Moura).</li>
 <li> FIXED: correct code statistics with DL_MALLOC or SYSTEM_MALLOC.</li>
@@ -28,7 +34,6 @@ allocate up to 3GB).</li>
 <li> FIXED: compilation bug in arg(X,1,A).</li>
 <li> NEW: extend interface to pass chunks of integers/floats.</li>
 <li> FIXED: get rid of some more global variables.</li>
->>>>>>> 1.73
 <li> NEW: thread_yield/0 (request Paulo Moura).</li>
 <li> FIXED: current_thread was not returning aliases (obs Paulo Moura).</li>
 <li> FIXED: AuxSp was not properly initialised for new threads (obs Paulo Moura).</li>

library/swi.yap

@@ -183,6 +183,10 @@ prolog:member(X,[X|_]).
 prolog:member(X,[_|L0]) :-
 	prolog:member(X,L0).
 
+prolog:select(Element, [Element|Rest], Rest).
+prolog:select(Element, [Head|Tail], [Head|Rest]) :-
+	prolog:select(Element, Tail, Rest).
+
 tv(Term,List) :- term_variables(Term,List).
 
 prolog:term_variables(Term,List) :- tv(Term,List).
@@ -245,7 +249,13 @@ prolog:memberchk(Element, [Element|_]) :- !.
 prolog:memberchk(Element, [_|Rest]) :-
         prolog:memberchk(Element, Rest).
 
-
+% copied from SWI lists library.
-	
+prolog:intersection([], _, []) :- !.
+prolog:intersection([X|T], L, Intersect) :-
+	memberchk(X, L), !, 
+	Intersect = [X|R], 
+	prolog:intersection(T, L, R).
+prolog:intersection([_|T], L, R) :-
+	prolog:intersection(T, L, R).
 
 

pl/boot.yap

@@ -505,7 +505,7 @@ true :- true.
 '$another' :-
 	format(user_error,' ? ',[]),
 	'$get0'(user_input,C),
-	(   C== 0'; ->  '$skip'(user_input,10),
+	(   C== 0'; ->  '$skip'(user_input,10), %'
 	    '$add_nl_outside_console',
 	    fail
 	;
@@ -538,7 +538,7 @@ true :- true.
 	'$sort'(IVs, NVs),
 	'$prep_answer_var_by_var'(NVs, LAnsw, LBlk),
 	'$name_vars_in_goals'(LAnsw, Vs, NLAnsw),
-        '$write_vars_and_goals'(NLAnsw, FLAnsw).
+        '$write_vars_and_goals'(NLAnsw, first, FLAnsw).
 
 '$purge_dontcares'([],[]).
 '$purge_dontcares'([[[95|_]|_]|Vs],NVs) :- !,
@@ -577,25 +577,27 @@ true :- true.
 	C is I1+65,
 	'$gen_name_string'(I2,[C|L0],LF).
 
-'$write_vars_and_goals'([], []).
+'$write_vars_and_goals'([], _, []).
-'$write_vars_and_goals'([G1|LG], NG) :-
+'$write_vars_and_goals'([nl,G1|LG], First, NG) :- !,
-	'$write_goal_output'(G1, NG, IG),
-	'$write_remaining_vars_and_goals'(LG, IG).
-
-'$write_remaining_vars_and_goals'([], []).
-'$write_remaining_vars_and_goals'([nl,G1|LG], NG) :- !,
 	nl(user_error),
-	'$write_goal_output'(G1, NG, IG),
+	'$write_goal_output'(G1, First, NG, Next, IG),
-	'$write_remaining_vars_and_goals'(LG, IG).
+	'$write_vars_and_goals'(LG, Next, IG).
-'$write_remaining_vars_and_goals'([G1|LG], NG) :-
+'$write_vars_and_goals'([G1|LG], First, NG) :-
-	( LG = [] -> nl(user_error) ; format(user_error,',~n',[]) ),
+	'$write_goal_output'(G1, First, NG, Next, IG),
-	'$write_goal_output'(G1, NG, IG),
+	'$write_vars_and_goals'(LG, Next, IG).
-	'$write_remaining_vars_and_goals'(LG, IG).
 
-'$write_goal_output'(var([V|VL]), [var([V|VL])|L], L) :-
+'$goal_to_string'(Format, G, String) :-			  
+	charsio:open_mem_write_stream(W),
+        format(W,Format,G),
+	charsio:peek_mem_write_stream(W, [], String),
+	close(W).
+
+'$write_goal_output'(var([V|VL]), First, [var([V|VL])|L], next, L) :-
+        ( First = first -> true ; format(user_error,',~n',[]) ),
 	format(user_error,'~s',[V]),
 	'$write_output_vars'(VL).
-'$write_goal_output'(nonvar([V|VL],B), [nonvar([V|VL],B)|L], L) :-
+'$write_goal_output'(nonvar([V|VL],B), First, [nonvar([V|VL],B)|L], next, L) :-
+        ( First = first -> true ; format(user_error,',~n',[]) ),
 	format(user_error,'~s',[V]),
 	'$write_output_vars'(VL),
 	format(user_error,' = ', []),
@@ -603,10 +605,22 @@ true :- true.
 	   write_term(user_error,B,Opts) ;
 	   format(user_error,'~w',[B])
         ).
-'$write_goal_output'(Format-G, [G|NG], NG) :-
+'$write_goal_output'(Format-G, First, NG, Next, IG) :-
 	G = [_|_], !,
-        format(user_error,Format,G).
+	% dump on string first so that we can check whether we actually
-'$write_goal_output'(_-G, [G|NG], NG) :-
+	% had any output from the solver.
+	'$goal_to_string'(Format, G, String),
+	( String == [] ->
+	    % we didn't
+	    IG = NG, First = Next
+	;
+	    % we did
+	    ( First = first -> true ; format(user_error,',~n',[]) ),
+	    format(user_error, '~s', [String]),
+	    NG = [G|IG]
+	).
+'$write_goal_output'(_-G, First, [G|NG], next, NG) :-
+        ( First = first -> true ; format(user_error,',~n',[]) ),
         ( recorded('$print_options','$toplevel'(Opts),_) ->
 	   write_term(user_error,G,Opts) ;
 	   format(user_error,'~w',[G])