Merge ssh://ssh.dcc.fc.up.pt:31064//home/vsc/yap

C/absmi.c

@@ -751,7 +751,7 @@ static int interrupt_cut_e(USES_REGS1) {
   if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) {
     return v;
   }
-  if (!Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) {
+  if (Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) {
     return 2;
   }
   /* find something to fool S */

C/arith0.c

@@ -186,18 +186,6 @@ eval0(Int fi) {
     RINT((Int)ASP);
 #else
     RINT(LCL0 - ASP);
-#endif
-  case op_b:
-    /// - $b
-    ///   current choicepoint
-    ///
-#if YAPOR_SBA
-    RINT((Int)B);
-#else
-      if (B)
-    RINT(LCL0 - (CELL *)B);
-      else
-        RINT(0);
 #endif
   case op_env:
     /// - $env
@@ -257,7 +245,6 @@ static InitConstEntry InitConstTab[] = {
   {"heapused", op_heapused},
   {"local_sp", op_localsp},
   {"global_sp", op_globalsp},
-  {"$last_choice_pt", op_b},
   {"$env", op_env},
   {"$tr", op_tr},
   {"stackfree", op_stackfree},

C/stack.c

@@ -1776,9 +1776,9 @@ void Yap_dump_stack(void) {
   int max_count = 200;
 
   /* check if handled */
-  if (handled_exception(PASS_REGS1))
+  //if (handled_exception(PASS_REGS1))
-    return;
+  //  return;
-#if DEBU
+#if DEBUG
   fprintf(stderr, "%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n",
           P, CP, ASP, HR, TR, HeapTop);
 #endif

C/tracer.c

@@ -98,11 +98,9 @@ static char *send_tracer_message(char *start, char *name, arity_t arity,
         if (max <= sz) {
           min = sz + 1024;
           expand = true;
-	  free((void*)sn);
           continue;
         }
         strcpy(s, sn);
-	free((void*)sn);
 	sn = NULL;
         s += sz;
         max -= sz;

pl/absf.yap

@@ -235,8 +235,8 @@ absolute_file_name(File0,File) :-
     '$absf_trace'('  after name/library unfolding: ~w', [Name]),
     '$variable_expansion'(CorePath, Opts,ExpandedPath),
     '$absf_trace'('   after environment variable expansion: ~s', [ExpandedPath]),
-    '$prefix'(ExpandedPath, Opts, Path , []),
+    '$file_prefix'(ExpandedPath, Opts, Path , []),
-    '$absf_trace'('    after prefix expansion: ~s', [Path]),
+    '$absf_trace'('    after file_prefix expansion: ~s', [Path]),
     atom_codes( APath, Path ),
     (
 	   Expand = true
@@ -366,11 +366,12 @@ absolute_file_name(File0,File) :-
     '$absf_trace'(' try no suffix', []).
 
 '$add_suffix'(Cs) -->
-    { Cs = [0'. |_Codes] }
+    (
+	{ Cs = [0'. |_Codes] }
 	->
 	    Cs
 	;
-	".", Cs.
+	".", Cs ).
 
 '$glob'(Opts) -->
     {
@@ -392,32 +393,32 @@ absolute_file_name(File0,File) :-
     Base \= '.',
     Base \='..'.
 
-'$prefix'( CorePath, _Opts) -->
+'$file_prefix'( CorePath, _Opts) -->
     { is_absolute_file_name( CorePath ) },
     !,
     CorePath.
-'$prefix'( CorePath, Opts) -->
+'$file_prefix'( CorePath, Opts) -->
-    {  get_abs_file_parameter( relative_to, Opts, Prefix ),
+    {  get_abs_file_parameter( relative_to, Opts, File_Prefix ),
-       Prefix \= '',
+       File_Prefix \= '',
-       '$absf_trace'('    relative_to ~a', [Prefix]),
+       '$absf_trace'('    relative_to ~a', [File_Prefix]),
-       sub_atom(Prefix, _, 1, 0, Last),
+       sub_atom(File_Prefix, _, 1, 0, Last),
-       atom_codes(Prefix, S)
+       atom_codes(File_Prefix, S)
     },
     !,
     S,
     '$dir'(Last),
     CorePath.
-'$prefix'( CorePath,  _) -->
+'$file_prefix'( CorePath,  _) -->
     {
-	recorded('$path',Prefix,_),
+	recorded('$path',File_Prefix,_),
-       '$absf_trace'('    try YAP path database ~a', [Prefix]),
+       '$absf_trace'('    try YAP path database ~a', [File_Prefix]),
-       sub_atom(Prefix, _, _, 1, Last),
+       sub_atom(File_Prefix, _, _, 1, Last),
-	atom_codes(Prefix, S)    },
+	atom_codes(File_Prefix, S)    },
     S,
     '$dir'(Last),
     CorePath.
-'$prefix'(CorePath, _ ) -->
+'$file_prefix'(CorePath, _ ) -->
-    '$absf_trace'('    empty prefix', []),
+    '$absf_trace'('    empty file_prefix                  ', []),
     CorePath.
 
 

pl/control.yap

@@ -164,8 +164,8 @@ ignore(Goal) :- (Goal->true;true).
  * 
  */
 if(X,Y,Z) :-
-	(
+    (
-	 CP is '$last_choice_pt',
+	'$$save_by'(CP),
 	 '$call'(X,CP,if(X,Y,Z),M),
 	 '$execute'(X),
 	 '$clean_ifcp'(CP),

pl/debug.yap

@@ -284,7 +284,7 @@ be lost.
   * @return `call(Goal)`
 */
 '$spy'([Mod|G]) :-
-	'$trace'([Mod|G]).
+	'$trace'(Mod:G).
 
 /**
   * @pred $trace( +Goal )
@@ -298,13 +298,13 @@ be lost.
   * @param _Mod_:_Goal_ is the goal to be examined.
   * @return `call(Goal)`
 */
-%% '$trace'([Mod|G]) :-
+'$trace'(Mod:G) :-
-%%     '$stop_creeping'(_),
+     '$stop_creeping'(_),
-%     set_prolog_flag(debug, true),
+     ( prolog_flag(debug, false) ; '__NB_getval__'('$debug_status',state(zip,_Border,_Spy), fail) ),
-%%     !,
+     !,
-%%     '$execute_nonstop'(G,Mod).
+     '$execute_nonstop'(G,Mod).
-'$trace'([Mod|G]) :-
+'$trace'(Mod:G) :-
-    CP is '$last_choice_pt',
+    '$$save_by'(CP),
     '$trace_query'(G, Mod, CP, G, EG),
     gated_call(
 	'$debugger_input',
@@ -323,47 +323,47 @@ be lost.
 
 
 
-'$trace'([Mod|G], A1) :-
+'$trace'(Mod:G, A1) :-
 	G =.. L,
 	lists:append( L, [A1], NL),
 	NG =.. NL,
-	'$trace'([Mod|NG]).
+	'$trace'(Mod:NG).
 
-'$trace'([Mod|G], A1, A2) :-
+'$trace'(Mod:G, A1, A2) :-
 	G =.. L,
 	lists:append( L, [A1, A2], NL),
 	NG =.. NL,
-	'$trace'([Mod|NG]).
+	'$trace'(Mod:NG).
 
-'$trace'([Mod|G], A1, A2, A3) :-
+'$trace'(Mod:G, A1, A2, A3) :-
     G =.. L,
     lists:append( L, [A1, A2, A3], NL),
     NG =.. NL,
-    '$trace'([Mod|NG]).
+    '$trace'(Mod:NG).
 
-'$trace'([Mod|G], A1, A2, A3, A4) :-
+'$trace'(Mod:G, A1, A2, A3, A4) :-
     G =.. L,
     lists:append( L, [A1,A2,A3,A4], NL),
     NG =.. NL,
-    '$trace'([Mod|NG]).
+    '$trace'(Mod:NG).
 
-'$trace'([Mod|G], A1, A2, A3, A4, A5) :-
+'$trace'(Mod:G, A1, A2, A3, A4, A5) :-
     G =.. L,
     lists:append( L, [A1, A2, A3, A4, A5], NL),
     NG =.. NL,
-    '$trace'([Mod|NG]).
+    '$trace'(Mod:NG).
 
-'$trace'([Mod|G], A1, A2, A3, A4, A5, A6) :-
+'$trace'(Mod:G, A1, A2, A3, A4, A5, A6) :-
 	G =.. L,
 	lists:append( L, [A1, A2, A3, A4, A5, A6], NL),
 	NG =.. NL,
-	'$trace'([Mod|NG]).
+	'$trace'(Mod:NG).
 
-'$trace'([Mod|G], A1, A2, A3, A4, A5, A6, A7) :-
+'$trace'(Mod:G, A1, A2, A3, A4, A5, A6, A7) :-
 	G =.. L,
 	lists:append( L, [A1, A2, A3, A4, A5, A6, A7 ], NL),
 	NG =.. NL,
-	'$trace'([Mod|NG]).
+	'$trace'(Mod:NG).
 
 /**
   * @pred debugger_input.
@@ -573,8 +573,8 @@ be lost.
  *
  */
 '$trace_go'(GoalNumber, G, M, Info) :-
-		X=marker(_,M,G),
+    X=marker(_,M,G),
-        CP is '$last_choice_pt',
+    	 '$$save_by'(CP),
         clause(M:G, Cl, _),
 		'$retry_clause'(GoalNumber, G, M, Info, X),
 		'$trace_query'(Cl, M, CP, Cl, ECl),
@@ -651,12 +651,8 @@ be lost.
 
 
 %%% - abort: forward throw while the call is newer than goal
-'$TraceError'( abort, _, _, _, _).
+'$TraceError'( error(Id,Info), _, _, _, _) :-
-'$TraceError'(forward(redo,_G0), _, _, _, _).
+    throw( error(Id, Info) ).
-%%% - backtrack long distance
-'$TraceError'(forward(fail,_G0),GoalNumber, _, _, _) :- !,
-	throw(debugger(fail,GoalNumber)).
-%%%
 %%% - forward through the debugger
 '$TraceError'(forward('$wrapper',Event), _, _, _, _) :-
 	!,
@@ -689,8 +685,9 @@ be lost.
 %
 
 '$gg'(CP,Goal) :-
-	CP is '$last_choice_point',
+    '$$save_by'(CP0),
-	Goal.
+    CP = CP0,
+    Goal.
 
 '$port'(_P, _G, _M,GoalNumber,_Determinic, _Info ) :-   %%> leap
         '__NB_getval__'('$debug_status',state(leap,Border,_), fail),
@@ -1008,8 +1005,7 @@ be lost.
 
 
 '$cps'([CP|CPs]) :-
-    yap_hacks:choicepoint(CP,A,B,C,D,E,F),
+    yap_hacks:choicepoint(CP,_A_,_B,_C,_D,_E,_F),
-    write(A:B:C:D:E:F),nl,
     '$cps'(CPs).
 '$cps'([]).
 
@@ -1050,7 +1046,7 @@ be lost.
 '$debugger_process_meta_arguments'(G, _M, G).
 
 '$ldebugger_process_meta_args'([], _, [], []).
-'$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$trace'([M1|G1])|BG1s]) :-
+'$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$user_call'(G1,M1)|BG1s]) :-
     number(N),
     N >= 0,
 	'$yap_strip_module'( M:G, M1, G1 ),

pl/messages.yap

@@ -197,6 +197,9 @@ compose_message( halt, _Level) --> !,
 	[ 'YAP execution halted.'-[] ].
 
 		% syntax error.
+compose_message( error(event(Type),Info), _Level ) -->
+    !,
+    event(Type, Info).
 compose_message(error(warning(syntax_error,Info), Exc), Level) -->
     !,
     compose_message(error(syntax_error(Info), Exc), Level).
@@ -239,7 +242,7 @@ compose_message(trace_command(C), _Leve) -->
 compose_message(trace_help, _Leve) -->
 	!,
 	[ '   Please enter a valid debugger command (h for help).'  ].
-compose_message(version(Version), _Leve) -->
+compose_message(version(Version), _Level) -->
 	!,
 	[ '~a' - [Version] ].
 compose_message(myddas_version(Version), _Leve) -->
@@ -296,6 +299,10 @@ location( error(_,Info), Level, LC ) -->
   [  '~a:~d:0 ~a while executing ~a():'-[File, FilePos,Level,FF] ].
 location( _Ball, _Level, _LC ) --> [].
 
+event(redo, _Info) --> {fail}.
+event(fail, _Info) --> {fail}.
+event(abort, Info) --> { throw(event(abort, Info)) }.
+
 simplify_pred(user:F, F) :- !.
 simplify_pred(prolog:F, F) :- !.
 simplify_pred(F, F).

pl/protect.yap

@@ -48,8 +48,8 @@ prolog:'$protect' :-
     '$new_system_predicate'(Name,Arity,M),
     sub_atom(Name,0,1,_, '$'),
     functor(P,Name,Arity),
-%    '$hide_predicate'(P,M),
     '$stash_predicate'(P,M),
+%    '$hide_predicate'(P,M),
     fail.
 prolog:'$protect' :-
     current_atom(Name),

pl/signals.yap

@@ -178,7 +178,7 @@
 	debug,
 	'$execute'(M:G).
 '$start_creep'([Mod|G], _WhereFrom) :-
-	'$trace'([Mod|G]).
+	'$trace'(Mod:G).
 
 '$no_creep_call'('$execute_clause'(G,Mod,Ref,CP),_) :- !,
         '$enable_debugging',

pl/top.yap

@@ -13,7 +13,8 @@
   *    @{
   * \*/
 
-:- '$system_meta_predicates'([
+  :- '$system_meta_predicates'([
+	gated_call(0,0,?,0),
 	catch(0,?,0),
   log_event(+,:)]).
 
@@ -338,11 +339,10 @@ live :-
 %
 '$delayed_goals'(G, V, NV, LGs, NCP) :-
 	(
-	  CP is '$last_choice_pt',
+	 '$$save_by'(NCP1),
-	 '$current_choice_point'(NCP1),
 	 attributes:delayed_goals(G, V, NV, LGs),
-	 '$clean_ifcp'(CP),
+	 '$clean_ifcp'(NCP1),
-	 '$current_choice_point'(NCP2),
+	 '$$save_by'(NCP2),
 	 NCP is NCP2-NCP1
 	  ;
 	   copy_term_nat(V, NV),
@@ -830,6 +830,7 @@ Command = (H --> B) ->
 
 /* General purpose predicates				*/
 
+'$head_and_body'(M:(H:-B),M:H,M:B) :- !.
 '$head_and_body'((H:-B),H,B) :- !.
 '$head_and_body'(H,H,true).
 

swi/library/plunit.pl

@@ -1095,8 +1095,8 @@ setup(_,_,_).
 %	Call Goal in Module after applying goal expansion.
 
 call_ex(Module, Goal) :-
-	Module:(expand_goal(Goal, GoalEx),
+	(expand_goal(Goal,Module: GoalEx),
-		GoalEx).
+		Module:GoalEx).
 
 %%	cleanup(+Module, +Options) is det.
 %