/*-------------------------------------------------------------------------*/
/* GNU Prolog                                                              */
/*                                                                         */
/* Part  : Prolog buit-in predicates                                       */
/* File  : debugger.pl                                                     */
/* Descr.: debugger                                                        */
/* Author: Daniel Diaz                                                     */
/*                                                                         */
/* Copyright (C) 1999 Daniel Diaz                                          */
/*                                                                         */
/* GNU Prolog is free software; you can redistribute it and/or modify it   */
/* under the terms of the GNU General Public License as published by the   */
/* Free Software Foundation; either version 2, or any later version.       */
/*                                                                         */
/* GNU Prolog is distributed in the hope that it will be useful, but       */
/* WITHOUT ANY WARRANTY; without even the implied warranty of              */
/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU        */
/* General Public License for more details.                                */
/*                                                                         */
/* You should have received a copy of the GNU General Public License along */
/* with this program; if not, write to the Free Software Foundation, Inc.  */
/* 59 Temple Place - Suite 330, Boston, MA 02111, USA.                     */
/*-------------------------------------------------------------------------*/

:- built_in.

'$init_debugger':-                            % called by Debug_Initializer()
	'$sys_var_write'(13,1),                         % debugger is present
	DebugInfo=d(0,[]),
	g_link('$debug_info',DebugInfo),
	'$debug_switch_off'.




'$debug_switch_off':-
	g_assign('$debug_mode',nodebug),
	g_assign('$debug_next',nodebug),
	g_assign('$debug_leash',0b11111),
	g_assign('$debug_depth',10),
	'$call_c'('Reset_Debug_Call_Code_0').



'$debug_switch_on'(DebugMode):-
	g_assign('$debug_mode',DebugMode),
	g_assign('$debug_next',DebugMode),
	g_read('$debug_info',DebugInfo),
	setarg(1,DebugInfo,0, false),
	setarg(2,DebugInfo,[],false),
	'$call_c'('Set_Debug_Call_Code_0').




          /*---------------------------------------------------------------*/
          /* Debugger built-in predicates                                  */
          /*                                                               */
          /*---------------------------------------------------------------*/

wam_debug:-
	set_bip_name(wam_debug,0),
	'$call_c'('Debug_Wam').




notrace:-
	set_bip_name(notrace,0),
	nodebug.




nodebug:-
	set_bip_name(nodebug,0),
	'$debug_switch_off',
	'$show_debugger_mode'.


trace:-
	set_bip_name(trace,0),
	'$debug_switch_on'(trace),
	'$show_debugger_mode'.


debug:-
	set_bip_name(debug,0),
	'$debug_switch_on'(debug),
	'$show_debugger_mode'.




'$show_debugger_mode':-
	g_read('$debug_mode',DebugMode),
	'$show_debugger_mode1'(DebugMode),
	nl(debugger_output).


'$show_debugger_mode1'(nodebug):-
	write(debugger_output,'The debugger is switched off').

'$show_debugger_mode1'(trace):-
	write(debugger_output,'The debugger will first creep -- '),
	write(debugger_output,'showing everything (trace)').

'$show_debugger_mode1'(debug):-
	write(debugger_output,'The debugger will first leap -- '),
	write(debugger_output,'showing spypoints (debug)').




debugging:-
	set_bip_name(debugging,0),
	'$show_debugger_mode',
	'$show_leashing_info',
	'$show_undefined_action',
	'$show_spy_points'.




leash(L):-
	set_bip_name(leash,1),
	var(L), 
	!,
	'$pl_err_instantiation'.


leash(full):-      !, leash([call,exit,redo,fail,exception]).
leash(half):-      !, leash([call,redo]).
leash(loose):-     !, leash([call]).
leash(none):-      !, leash([]).
leash(tight):-     !, leash([call,redo,fail,exception]).

leash(L):-
        '$leash_make_mask'(L,LeashMask),
	!,
	g_assign('$debug_leash',LeashMask),
        '$show_leashing_info'.

leash(L):-
	'$pl_err_domain'(leash_ports,L).




'$leash_make_mask'([],0).

'$leash_make_mask'([Port|L],LeashMask1):-
	'$leash_make_mask'(L,LeashMask),
	'$debug_port_mask'(Port,Mask),
	LeashMask1 is LeashMask\/Mask.




'$show_leashing_info':-
	g_read('$debug_leash',LeashMask),
	'$show_leashing_info1'(LeashMask),
	nl(debugger_output).


'$show_leashing_info1'(0):-
	!,
	write(debugger_output,'No leashing').

'$show_leashing_info1'(LeashMask):-
	write(debugger_output,'Using leashing stopping at '),
	g_assign('$debug_work',0'[),
	'$show_leashing_info2'(LeashMask),
	write(debugger_output,'] ports').


'$show_leashing_info2'(LeashMask):-
	'$debug_port_mask'(Port,Mask),
	LeashMask/\Mask > 0,
	g_read('$debug_work',C),
	g_assign('$debug_work',0',),
	format(debugger_output,'~c~a',[C,Port]),
	fail.

'$show_leashing_info2'(_).




'$debug_is_not_leashed'(Port):-
	g_read('$debug_leash',LeashMask),
	'$debug_port_mask'(Port,Mask),
	Mask/\LeashMask=:=0.




'$debug_port_mask'(call,     0b00001).

'$debug_port_mask'(exit,     0b00010).

'$debug_port_mask'(redo,     0b00100).

'$debug_port_mask'(fail,     0b01000).

'$debug_port_mask'(exception,0b10000).




'$show_undefined_action':-
	current_prolog_flag(unknown,Action),
	write(debugger_output,'Undefined predicates will '),
	'$show_undefined_action1'(Action),
	nl(debugger_output).


'$show_undefined_action1'(error):-
	write(debugger_output,'raise an existence_error').

'$show_undefined_action1'(warning):-
	write(debugger_output,'display a warning message and fail').

'$show_undefined_action1'(fail):-
	write(debugger_output,'fail').




spypoint_condition(Goal,_,_):-
	set_bip_name(spypoint_condition,3),
	var(Goal),
	!,
	'$pl_err_instantiation'.

spypoint_condition(Goal,Port,Test):-
	callable(Goal),
	!,
	'$spypoint_condition1'(Goal,Port,Test).

spypoint_condition(Goal,_,_):-
	'$pl_err_type'(callable,Goal).


'$spypoint_condition1'(Goal,Port,Test):-
	functor(Goal,N,A),
	('$current_predicate_any'(N/A)
             -> '$debug_spy_set'([N/A],c(Goal,Port,Test)),
		g_read('$debug_mode',nodebug),
		debug
             ;
                format(debugger_output,
                       'Warning: The predicate ~a/~d is undefined~n',[N,A])),
	fail.                                                            % GC

'$spypoint_condition1'(_,_,_).





spy(Spec):-
	set_bip_name(spy,1),
	'$debug_list_of_pred'(Spec,L),
	'$debug_spy_set'(L,_),
	L\==[],
	g_read('$debug_mode',nodebug),
	debug,
	fail.                                                            % GC

spy(_).




nospy(Spec):-
	set_bip_name(nospy,1),
	'$debug_list_of_pred'(Spec,L),
	'$debug_spy_reset'(L),
	fail.                                                            % GC

nospy(_).




nospyall:-
	set_bip_name(nospyall,0),
	retractall('$debug_spy_point'(_,_,_)),
	write(debugger_output,'All spypoints removed'), nl(debugger_output),
	fail.                                                            % GC

nospyall.




'$debug_spy_set'([],_).	

'$debug_spy_set'([N/A|L],Cond):-
	(retract('$debug_spy_point'(N,A,_))
              -> Msg='There is already a spypoint on'
              ;  Msg='Spypoint placed on'),
	assertz('$debug_spy_point'(N,A,Cond)),
	format(debugger_output,'~a ~a/~d~n',[Msg,N,A]),
	!,
	'$debug_spy_set'(L,Cond).




'$debug_spy_reset'([]).	

'$debug_spy_reset'([N/A|L]):-
	(retract('$debug_spy_point'(N,A,_))
              -> Msg='Spypoint removed from'
              ;  Msg='There is no spypoint on'),
	format(debugger_output,'~a ~a/~d~n',[Msg,N,A]),
	!,
	'$debug_spy_reset'(L).




'$has_spy_point'(Goal,Cond):-
	functor(Goal,N,A),
	clause('$debug_spy_point'(N,A,Cond),_),
	!.


'$has_no_spy_point'(Goal):-
	functor(Goal,N,A),
	clause('$debug_spy_point'(N,A,_),_),
	!,
	fail.

'$has_no_spy_point'(_).




'$spy_test_condition'(Goal,Port,c(Goal,Port,Test)):-
	(var(Test) -> true
                   ;  '$call'(Test,spy_conditional,1,false), !).




'$show_spy_points':-
	write(debugger_output,'Spypoints:'), nl(debugger_output),
	clause('$debug_spy_point'(N,A,_),_),
	format(debugger_output,'   ~a/~d~n',[N,A]),
	fail.

'$show_spy_points'.




'$debug_list_of_pred'(Spec,_):-
	var(Spec), !, '$pl_err_instantiation'.

'$debug_list_of_pred'([],[]):-
	!.

'$debug_list_of_pred'([Spec1|Spec2],L):-
	!,
	'$debug_list_of_pred'(Spec1,L1),
	'$debug_list_of_pred'(Spec2,L2),
	append(L1,L2,L).

'$debug_list_of_pred'(N/A1-A2,L):-
	'$debug_list_of_pred1'(N,A1,A2,L),
	!.

'$debug_list_of_pred'(N,L):-
	atom(N),
	!,
	current_prolog_flag(max_arity,Max),
	'$debug_list_of_pred1'(N,0,Max,L),
	!.

'$debug_list_of_pred'(PI,L):-
	'$get_pred_indic'(PI,N,A),
        '$debug_list_of_pred1'(N,A,A,L).




'$debug_list_of_pred1'(N,_,_,_):-
	var(N), !, '$pl_err_instantiation'.

'$debug_list_of_pred1'(_,A1,_,_):-
	var(A1), !, '$pl_err_instantiation'.

'$debug_list_of_pred1'(_,_,A2,_):-
	var(A2), !, '$pl_err_instantiation'.

'$debug_list_of_pred1'(N,A1,A2,L):-
	atom(N),
	current_prolog_flag(max_arity,Max),
	integer(A1),
	integer(A2),
	A1>=0, A1=<Max,
	A2>=0, A2=<Max,
	g_assign('$debug_work',[]),
	('$current_predicate_any'(N/A),
	 A>=A1,
	 A=<A2,
	 g_read('$debug_work',X),
	 g_assign('$debug_work',[N/A|X]),
	 fail
          ;
         g_read('$debug_work',L)),
	 (L=[],
          (A1=A2, Z=A1 ; A1=0, A2=Max, Z=any ; Z=A1-A2),
          format(debugger_output,'Warning: spy ~a/~w - no matching predicate~n',
                 [N,Z])
             ;
          true).




          /*---------------------------------------------------------------*/
          /* The debugger:                                                 */
          /*                                                               */
          /* '$debug_call'/2 is called by meta-call (cf Call_2()) when the */
          /* debugger is active, ie. Set_Debug_Call_Code() has been called */
          /*---------------------------------------------------------------*/

'$debug_call'(notrace,_):-	!, notrace.
'$debug_call'(nodebug,_):-	!, nodebug.
'$debug_call'(trace,_):-  	!, trace.
'$debug_call'(debug,_):-  	!, debug.
'$debug_call'(debugging,_):-	!, debugging.
'$debug_call'(leash(L),_):-	!, leash(L).
'$debug_call'(spy(Spec),_):-	!, spy(Spec).
'$debug_call'(spypoint_condition(Goal,Port,Test),_):-
                                !, spypoint_condition(Goal,Port,Test).
'$debug_call'(nospy(Spec),_):-	!, nospy(Spec).
'$debug_call'(nospyall,_):-	!, nospyall.


'$debug_call'(Goal,CallInfo):-
	g_read('$debug_info',DebugInfo),
	DebugInfo=d(Invoc,OldAncLst),
	(OldAncLst=[] -> Index=0 ; OldAncLst=[a(_,_,Index,_)|_]),
	Invoc1 is Invoc+1,
	Index1 is Index+1,
	'$get_current_B'(B),
	NewAncLst=[a(Goal,Invoc1,Index1,B)|OldAncLst],
	setarg(1,DebugInfo,Invoc1),
	setarg(2,DebugInfo,NewAncLst),
%format('starting of call:~w',[Goal]), disp_B(''),
	'$debug_call1'(Goal,CallInfo,Invoc1,Index1,NewAncLst,
                       DebugInfo,Invoc,OldAncLst).



%disp_B(Msg):-
%'$get_current_B'(B),
%format(' ~w B:%#x\n',[Msg,B]).


'$debug_call1'(Goal,CallInfo,Invoc1,Index1,NewAncLst,DebugInfo,_,OldAncLst):-
%format('Goal:~w  Call Info:~w~n',[Goal,CallInfo]),
        '$get_current_B'(B),
	'$catch_internal'(
          '$debug_call_port'(Goal,CallInfo,Invoc1,Index1,NewAncLst),
          Ball,
          '$debug_exception_port'(Goal,Invoc1,Index1,NewAncLst,Ball),
          0),
        '$get_current_B'(B1),
%format(' after effective call: ~w B(start):%#x B1(end):%#x~n',[Goal,B,B1]),
%disp_B('before end call'),
	'$debug_end_call'(Goal,Invoc1,Index1,NewAncLst,DebugInfo,OldAncLst),
%disp_B('after end call and before test determin'),
	(B1=<B, ! ; true).
%disp_B('after cut if determin').


'$debug_call1'(Goal,_,Invoc1,Index1,NewAncLst,_,_,_):-
	'$debug_port'(Goal,Invoc1,Index1,NewAncLst,fail),
	fail.

'$debug_call1'(Goal,CallInfo,Invoc1,_,_,DebugInfo,Invoc,OldAncLst):-
	g_read('$debug_next',retry(X)),
	X>=Invoc1,
	setarg(1,DebugInfo,Invoc),
	setarg(2,DebugInfo,OldAncLst),
	g_assign('$debug_next',trace),
	'$debug_call'(Goal,CallInfo).




'$debug_call_port'(Goal,CallInfo,Invoc,Index,AncLst):-
	g_assign('$debug_unify',''),
	'$debug_port'(Goal,Invoc,Index,AncLst,call),
	g_read('$debug_unify',DebugUnify),
	(DebugUnify=='' -> '$call_from_debugger'(Goal,CallInfo)
                        ;  Goal=DebugUnify).




'$debug_end_call'(Goal,Invoc1,Index1,AncLst,DebugInfo,OldAncLst):-
	'$debug_port'(Goal,Invoc1,Index1,AncLst,exit),
	setarg(2,DebugInfo,OldAncLst).

'$debug_end_call'(Goal,Invoc1,Index1,AncLst,_,_):-
	'$debug_port'(Goal,Invoc1,Index1,AncLst,redo),
	fail.




'$debug_exception_port'(Goal,Invoc,Index,AncLst,Ball):-
	g_assign('$debug_ball',Ball),
	'$debug_port'(Goal,Invoc,Index,AncLst,exception),
	throw(Ball).




          /* debug_port */

'$debug_port'(Goal,Invoc,Index,AncLst,Port):-
	'$get_current_B'(B),
	'$debug_port1'(Goal,Invoc,Index,AncLst,Port,B).


'$debug_port1'(Goal,Invoc,Index,AncLst,Port,B):-
	'$debug_port2'(Goal,Invoc,Index,AncLst,Port,B),
	fail.                                                            % GC

'$debug_port1'(_,_,_,_,_,_):-
	g_read('$debug_next',DebugNext),               % fail for 'r' and 'f'
	atom(DebugNext).




'$debug_port2'(Goal,Invoc,_,_,Port,_):-
	g_read('$debug_next',DebugNext),
	'$debug_port_ignore'(DebugNext,Goal,Invoc,Port),
	!.

'$debug_port2'(Goal,Invoc,Index,AncLst,Port,B):-
	'$debug_port_prompt'(Goal,Invoc,Index,AncLst,Port,B).




'$debug_port_ignore'(nodebug,_,_,_).

'$debug_port_ignore'(debug,Goal,_,_):-
	'$has_no_spy_point'(Goal).

'$debug_port_ignore'(debug,Goal,_,Port):-
	'$has_spy_point'(Goal,Cond),
	('$spy_test_condition'(Goal,Port,Cond) -> fail ; true).

'$debug_port_ignore'(skip,_,Invoc,Port):-
 	g_read('$debug_skip',s(Invoc1,Mask1)),
	'$debug_port_mask'(Port,Mask),
	(Invoc=Invoc1, Mask/\Mask1>0 -> fail ; !).

'$debug_port_ignore'(fail(Invoc1),_,Invoc,Port):-
	(Invoc>Invoc1 ; Port\==fail),
	!.

'$debug_port_ignore'(retry(_),_,_,_).




'$debug_port_prompt'(Goal,Invoc,Index,AncLst,Port,B):-
	repeat,
	g_assign('$debug_next',trace),
	'$debug_write_goal'(Goal,Invoc,Index,Port),
	('$has_no_spy_point'(Goal), '$debug_is_not_leashed'(Port)
                ->  nl(debugger_output)
                ;
                   '$debug_read_cmd'(C),
	           '$debug_exec_cmd'(C,Goal,Invoc,AncLst,Port,B)),
	!.




'$debug_read_cmd'(C):-
	write(debugger_output,' ? '), flush_output(debugger_output),
	get_code_no_echo(debugger_input,X),
	X>=0, X<255,
	char_code(C,X),
	format(debugger_output,'~N',[]).




'$debug_read_integer'(X):-
	read_integer(debugger_input,X),
	repeat,
        get_code(debugger_input,10),                      /* the last '\n' */
        !.
	


'$debug_exec_cmd'(C,_,_,_,_,_):-
	char_code(C,X),
	X>=10,
	X=<13,
	'$debug_exec_cmd'('c',_,_,_,_,_).

'$debug_exec_cmd'('c',_,_,_,_,_):-                                    % creep
	g_assign('$debug_next',trace).

'$debug_exec_cmd'('l',_,_,_,_,_):-                                     % leap
	g_assign('$debug_next',debug).

'$debug_exec_cmd'('s',_,_,_,Port,_):-                                  % skip
	(Port=exit ; Port=fail ; Port=exception),
	!,
	'$debug_exec_cmd'('c',_,_,_,_,_).

'$debug_exec_cmd'('s',_,Invoc,_,_,_):-                                 % skip
	g_assign('$debug_next',skip),
	'$debug_port_mask'(exit,Mask1),
	'$debug_port_mask'(fail,Mask2),
	'$debug_port_mask'(exception,Mask3),
	Mask is Mask1\/Mask2\/Mask3,
 	g_assign('$debug_skip',s(Invoc,Mask)).

'$debug_exec_cmd'('G',_,_,_,_,_):-                                     % goto
	write(debugger_output,'Inovcation nb: '),
	'$debug_read_integer'(Invoc),
	g_assign('$debug_next',skip),
 	g_assign('$debug_skip',s(Invoc,0b11111)).
	
'$debug_exec_cmd'('r',_,_,_,call,_):-                                 % retry
	!,
	fail.

'$debug_exec_cmd'('r',_,Invoc,_,_,_):-                                % retry
	g_assign('$debug_next',retry(Invoc)).

'$debug_exec_cmd'('f',_,_,_,fail,_):-                                  % fail
	!,
	fail.

'$debug_exec_cmd'('f',_,Invoc,_,_,_):-                                 % fail
	g_assign('$debug_next',fail(Invoc)).

'$debug_exec_cmd'('w',Goal,_,_,_,_):-                                 % write
	write(debugger_output,'                    '),
	write(debugger_output,Goal), nl(debugger_output),
	!,
	fail.

'$debug_exec_cmd'('d',Goal,_,_,_,_):-                               % display
	write(debugger_output,'                    '),
	display(debugger_output,Goal), nl(debugger_output),
	!,
	fail.

'$debug_exec_cmd'('p',Goal,_,_,_,_):-                                 % print
	write(debugger_output,'                    '),
	print(debugger_output,Goal), nl(debugger_output),
	!,
	fail.

'$debug_exec_cmd'('e',_,_,_,Port,_):-                             % exception
	(Port=exception
            -> 	g_read('$debug_ball',Ball),
	        format(debugger_output,'Exception raised: ~q~n',[Ball])
            ;
               write(debugger_output,'Option not applicable at this port'),
	       nl(debugger_output)),
	!,
	fail.

'$debug_exec_cmd'('g',_,_,AncLst,_,_):-                           % ancestors
	'$debug_disp_anc_lst'(AncLst),
	!,
	fail.

'$debug_exec_cmd'('A',_,_,AncLst,_,B):-                        % alternatives
	'$debug_disp_alternatives'(AncLst,B),
	!,
	fail.

'$debug_exec_cmd'('u',_,_,_,Port,_):-                                 % unify
	(Port=call
            -> write(debugger_output,'Head: '),
               read(debugger_input,DebugUnify),
               g_assign('$debug_unify',DebugUnify)
            ;
               write(debugger_output,'Option not applicable at this port'),
	       nl(debugger_output),
	       !,
	       fail).

'$debug_exec_cmd'('n',_,_,_,_,_):-                                  % nodebug
	'$debug_switch_off'.

'$debug_exec_cmd'('=',_,_,_,_,_):-                                % debugging
	debugging,
	!,
	fail.

'$debug_exec_cmd'('.',Goal,_,_,_,_):-                           % father file
	!,
	functor(Goal,N,A),
	('$get_predicate_file_info'(N/A,PlFile,PlLine)
             -> format(debugger_output,'~a/~d defined in ~a:~d~n',
                       [N,A,PlFile,PlLine])
             ;  format(debugger_output,'no file information for ~a/~d~n',[N,A])),
	fail.

'$debug_exec_cmd'('+',Goal,_,_,_,_):-                              % spy this
	functor(Goal,N,A),
	spy(N/A),
	!,
	fail.

'$debug_exec_cmd'('*',Goal,_,_,_,_):-                     % spy conditionally
	repeat,
	write(debugger_output,'Goal,Port,Test: '),
	read(debugger_input,(Goal1,Port1,Test1)),
	callable(Goal1),
	functor(Goal,N,A),
	functor(Goal1,N,A),
	spypoint_condition(Goal1,Port1,Test1),
	!,
	fail.

'$debug_exec_cmd'('-',Goal,_,_,_,_):-                            % nospy this
	functor(Goal,N,A),
	nospy(N/A),
	!,
	fail.

'$debug_exec_cmd'('L',Goal,_,_,_,_):-                               % listing
	!,
	functor(Goal,N,A),
	PI=N/A,
	('$current_predicate_any'(PI)
            -> ('$predicate_property_any'(PI,native_code)
                 -> format(debugger_output,'native code predicate ~a/~d~n',[N,A])
                 ;  listing(PI), nl(debugger_output))
            ;  format(debugger_output,'cannot find any info on ~a/~d~n',[N,A])),
	fail.

'$debug_exec_cmd'('a',_,_,_,_,_):-                                    % abort
	abort.

'$debug_exec_cmd'('b',_,_,_,_,_):-                                    % break
	break,
	!,
	fail.

'$debug_exec_cmd'('@',_,_,_,_,_):-                                  % command
	write(debugger_output,'Command: '),
	read(debugger_input,Command),
	('$catch'(Command,
                  Err,
                  format(debugger_output,'Warning: ~w - exception raised ~w~n',[Command,Err]),
                  debugger_exec_cmd,1,false)
              -> true
              ;  format(debugger_output,'Warning: ~w - goal failed~n',[Command])),
	!,
	fail.

'$debug_exec_cmd'('<',_,_,_,_,_):-                              % print depth
	write(debugger_output,'Print Depth: '),
	'$debug_read_integer'(Depth),
	g_assign('$debug_depth',Depth),
	!,
	fail.

'$debug_exec_cmd'('?',_,_,_,_,_):-                                     % help
	'$debug_disp_help',
	!,
	fail.

'$debug_exec_cmd'('h',_,_,_,_,_):-                                     % help
	'$debug_disp_help',
	!,
	fail.

'$debug_exec_cmd'('W',_,_,_,_,_):-                             % WAM debugger
	wam_debug,
	!,
	fail.


'$debug_exec_cmd'(_,_,_,_,_,_):-                                      % error
	write(debugger_output,'Unknown command (type h for help)'),
	nl(debugger_output),
	fail.







'$debug_write_goal'(Goal,Invoc,Index,Port):-
	g_read('$debug_depth',Depth),
	('$has_no_spy_point'(Goal) -> Indic=' ' ; Indic=(+)),
	'$debug_port_pretty'(Port,Port1),
	format(debugger_output,'~N ~a %4d %4d  ~a',[Indic,Invoc,Index,Port1]),
        write_term(debugger_output,Goal,[quoted(true),max_depth(Depth)]).





'$debug_port_pretty'(call,'Call: ').

'$debug_port_pretty'(redo,'Redo: ').

'$debug_port_pretty'(fail,'Fail: ').

'$debug_port_pretty'(exit,'Exit: ').

'$debug_port_pretty'(exception,'Exception: ').

'$debug_port_pretty'(no_port,'').




'$debug_disp_anc_lst'([a(_,_,_,_)|AncLst]):-
	write(debugger_output,'Ancestors:'), nl(debugger_output),
	'$debug_disp_anc_lst1'(AncLst).


'$debug_disp_anc_lst1'([]).

'$debug_disp_anc_lst1'([a(Goal,Invoc,Index,_)|AncLst]):-
	'$debug_disp_anc_lst1'(AncLst),
	'$debug_write_goal'(Goal,Invoc,Index,no_port).




'$debug_disp_alternatives'(AncLst,B):-
	write(debugger_output,'Alternatives:'), nl(debugger_output),
	'$debug_disp_alternatives1'(AncLst,B),
	 format(debugger_output,'~N--------------~n',[]).


'$debug_disp_alternatives1'([],_).

'$debug_disp_alternatives1'([a(Goal,Invoc,Index,B1)|AncLst],B2):-
	'$debug_disp_alternatives1'(AncLst,B1),
	'$debug_write_goal'(Goal,Invoc,Index,no_port),
	'$debug_disp_alt'(B2,B1).


'$debug_disp_alt'(B,B):-
	!.

'$debug_disp_alt'(BFrom,BTo):-
	'$choice_point_info'(BFrom,N,A,B1),
	'$debug_disp_alt'(B1,BTo),
	'$pred_without_aux'(N,A,N1,A1),
	'$debug_disp_alt1'(N1,A1,BFrom),
	!.


'$debug_disp_alt1'(N,_,_):-                         % hide debug alternatives
	'$debug_is_debug_predicate'(N).

'$debug_disp_alt1'(_,_,B):-                              % clause selection ?
	'$call_c_test'('Scan_Choice_Point_Info_3'(B,N,A)),      % fail if not
	'$pred_without_aux'(N,A,N1,A1),
	'$debug_disp_alt2'(N1/A1).

'$debug_disp_alt1'('$catch_internal1',5,B):-               % hide debug catch
	'$choice_point_arg'(B,1,Goal),
	functor(Goal,N,_),
	'$debug_is_debug_predicate'(N).

'$debug_disp_alt1'('$trail_handler',1,_).                  % hide debug catch

'$debug_disp_alt1'(N,A,_):-                         % detect system predicate
	sub_atom(N,0,1,_,'$'),
	'$predicate_property_any'(N/A,native_code),
	((sub_atom(N,1,_,4,N1), '$debug_check_bip'(N1,A1) 
                   ;
          sub_atom(N,1,_,1,N1), '$debug_check_bip'(N1,A1))
             -> '$debug_disp_alt2'(N1/A1)
             ;  '$debug_disp_alt2'('system predicate'(N/A))).

'$debug_disp_alt1'(N,A,_):-                                % normal predicate
	'$debug_disp_alt2'(N/A).


'$debug_disp_alt2'(X):-
	format(debugger_output,'~N   1 choice-point for ~w~n',[X]).




'$debug_is_debug_predicate'(N):-
	sub_atom(N,0,7,_,'$debug_').
	



'$debug_check_bip'(N1,A1):-
	predicate_property(N1/A1,built_in),
	!.

'$debug_check_bip'(N1,A1):-
	predicate_property(N1/A1,built_in_fd).




'$debug_disp_help':-
	format(debugger_output,'Debugging commands:~n~n',[]),
	format(debugger_output,'RET/c creep        l  leap ~n',[]),
	format(debugger_output,'   s  skip         G  goto~n',[]),
	format(debugger_output,'   r  retry        f  fail~n',[]),
	format(debugger_output,'   w  write        d  display~n',[]),
	format(debugger_output,'   p  print        e  exception~n',[]),
	format(debugger_output,'   g  ancestors    A  alternatives~n',[]),
	format(debugger_output,'   u  unify        .  father file~n',[]),
	format(debugger_output,'   n  nodebug      =  debugging~n',[]),
	format(debugger_output,'   +  spy this     *  spy conditionally~n',[]),
	format(debugger_output,'   -  nospy this   L  listing~n',[]),
	format(debugger_output,'   a  abort        b  break~n',[]),
	format(debugger_output,'   @  command      <  set printdepth~n',[]),
	format(debugger_output,'  h/? help         W  WAM debugger~n',[]),
	nl(debugger_output).





'$choice_point_info'(B,N,A,LastB):-
	'$call_c'('Choice_Point_Info_4'(B,N,A,LastB)).


'$choice_point_arg'(B,I,Arg):-
	'$call_c'('Choice_Point_Arg_3'(B,I,Arg)).

