fix debugger messages
debug imported mnodules fix yap2swi in win32 fixes for solaris git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@505 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
		
							
								
								
									
										2
									
								
								C/eval.c
									
									
									
									
									
								
							
							
						
						
									
										2
									
								
								C/eval.c
									
									
									
									
									
								
							@@ -27,7 +27,7 @@ static char     SccsId[] = "%W% %G%";
 | 
				
			|||||||
#include "Heap.h"
 | 
					#include "Heap.h"
 | 
				
			||||||
#include "eval.h"
 | 
					#include "eval.h"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
yap_error_number YAP_matherror = NO_ERROR;
 | 
					yap_error_number YAP_matherror = YAP_NO_ERROR;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#define E_FUNC   blob_type
 | 
					#define E_FUNC   blob_type
 | 
				
			||||||
#define E_ARGS   arith_retptr o
 | 
					#define E_ARGS   arith_retptr o
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -28,7 +28,6 @@ static char SccsId[] = "%W% %G%";
 | 
				
			|||||||
#include "Yatom.h"
 | 
					#include "Yatom.h"
 | 
				
			||||||
#include "Heap.h"
 | 
					#include "Heap.h"
 | 
				
			||||||
#include "yapio.h"
 | 
					#include "yapio.h"
 | 
				
			||||||
#include "iopreds.h"
 | 
					 | 
				
			||||||
#include <stdlib.h>
 | 
					#include <stdlib.h>
 | 
				
			||||||
#if HAVE_STDARG_H
 | 
					#if HAVE_STDARG_H
 | 
				
			||||||
#include <stdarg.h>
 | 
					#include <stdarg.h>
 | 
				
			||||||
@@ -79,6 +78,7 @@ static char SccsId[] = "%W% %G%";
 | 
				
			|||||||
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
 | 
					#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
 | 
					#include "iopreds.h"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
STATIC_PROTO (Int PlIOError, (yap_error_number, Term, char *));
 | 
					STATIC_PROTO (Int PlIOError, (yap_error_number, Term, char *));
 | 
				
			||||||
STATIC_PROTO (int FilePutc, (int, int));
 | 
					STATIC_PROTO (int FilePutc, (int, int));
 | 
				
			||||||
 
 | 
				
			|||||||
							
								
								
									
										8
									
								
								C/save.c
									
									
									
									
									
								
							
							
						
						
									
										8
									
								
								C/save.c
									
									
									
									
									
								
							@@ -18,12 +18,14 @@
 | 
				
			|||||||
static char     SccsId[] = "@(#)save.c	1.3 3/15/90";
 | 
					static char     SccsId[] = "@(#)save.c	1.3 3/15/90";
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					#if _MSC_VER || defined(__MINGW32__)
 | 
				
			||||||
 | 
					#include <windows.h>
 | 
				
			||||||
 | 
					#endif
 | 
				
			||||||
#include "absmi.h"
 | 
					#include "absmi.h"
 | 
				
			||||||
#include "alloc.h"
 | 
					#include "alloc.h"
 | 
				
			||||||
#include "yapio.h"
 | 
					#include "yapio.h"
 | 
				
			||||||
#include "sshift.h"
 | 
					#include "sshift.h"
 | 
				
			||||||
#include "Foreign.h"
 | 
					#include "Foreign.h"
 | 
				
			||||||
#include "iopreds.h"
 | 
					 | 
				
			||||||
#if HAVE_STRING_H
 | 
					#if HAVE_STRING_H
 | 
				
			||||||
#include <string.h>
 | 
					#include <string.h>
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
@@ -46,12 +48,12 @@ static char     SccsId[] = "@(#)save.c	1.3 3/15/90";
 | 
				
			|||||||
#ifdef HAVE_SYS_STAT_H
 | 
					#ifdef HAVE_SYS_STAT_H
 | 
				
			||||||
#include <sys/stat.h>
 | 
					#include <sys/stat.h>
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
 | 
					#include "iopreds.h"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/*********  hack for accesing several kinds of terms. Should be cleaned **/
 | 
					/*********  hack for accesing several kinds of terms. Should be cleaned **/
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#define AbsTerm(V) ((Term) (V))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
extern char     StartUpFile[];
 | 
					extern char     StartUpFile[];
 | 
				
			||||||
 | 
					
 | 
				
			||||||
static char end_msg[256] ="*** End of YAP saved state *****";
 | 
					static char end_msg[256] ="*** End of YAP saved state *****";
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -11919,9 +11919,11 @@ prompt on Call and Redo
 | 
				
			|||||||
prompt on Call
 | 
					prompt on Call
 | 
				
			||||||
@item off
 | 
					@item off
 | 
				
			||||||
never prompt
 | 
					never prompt
 | 
				
			||||||
 | 
					@item none
 | 
				
			||||||
 | 
					never prompt, same as @code{off}
 | 
				
			||||||
@end table
 | 
					@end table
 | 
				
			||||||
@noindent
 | 
					@noindent
 | 
				
			||||||
The initial leashing mode is half.
 | 
					The initial leashing mode is @code{full}.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@noindent
 | 
					@noindent
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -185,6 +185,11 @@ buf_writer(int c)
 | 
				
			|||||||
  *bf++ = c;
 | 
					  *bf++ = c;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					#if !HAVE_SNPRINTF
 | 
				
			||||||
 | 
					#define snprintf(X,Y,Z,A) sprintf(X,Z,A)
 | 
				
			||||||
 | 
					#endif
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
 | 
					X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
  Term t = YapGetFromSlot(l);
 | 
					  Term t = YapGetFromSlot(l);
 | 
				
			||||||
@@ -937,12 +942,12 @@ PL_exception(qid_t q)
 | 
				
			|||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
X_API int
 | 
					X_API int
 | 
				
			||||||
PL_initialise(int argc, char **argv, char **environ)
 | 
					PL_initialise(int myargc, char **myargv, char **myenviron)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
  yap_init_args init_args;
 | 
					  yap_init_args init_args;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  init_args.Argv = argv;
 | 
					  init_args.Argv = myargv;
 | 
				
			||||||
  init_args.Argc = argc;
 | 
					  init_args.Argc = myargc;
 | 
				
			||||||
  init_args.SavedState = "startup";
 | 
					  init_args.SavedState = "startup";
 | 
				
			||||||
  init_args.HeapSize = 0;
 | 
					  init_args.HeapSize = 0;
 | 
				
			||||||
  init_args.StackSize = 0;
 | 
					  init_args.StackSize = 0;
 | 
				
			||||||
@@ -1102,7 +1107,7 @@ X_API int Sprintf(char *format,...)
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
int WINAPI PROTO(win_yap2swi, (HANDLE, DWORD, LPVOID));
 | 
					int WINAPI PROTO(win_yap2swi, (HANDLE, DWORD, LPVOID));
 | 
				
			||||||
 | 
					
 | 
				
			||||||
int WINAPI win_sys(HANDLE hinst, DWORD reason, LPVOID reserved)
 | 
					int WINAPI win_yap2swi(HANDLE hinst, DWORD reason, LPVOID reserved)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
  switch (reason) 
 | 
					  switch (reason) 
 | 
				
			||||||
    {
 | 
					    {
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -176,7 +176,7 @@ extern X_API void PL_close_query(qid_t);
 | 
				
			|||||||
extern X_API term_t PL_exception(qid_t);
 | 
					extern X_API term_t PL_exception(qid_t);
 | 
				
			||||||
extern X_API int PL_call_predicate(module_t, int, predicate_t, term_t);
 | 
					extern X_API int PL_call_predicate(module_t, int, predicate_t, term_t);
 | 
				
			||||||
extern X_API int PL_call(term_t, module_t);
 | 
					extern X_API int PL_call(term_t, module_t);
 | 
				
			||||||
extern X_API void PL_register_extensions(PL_extension *e);
 | 
					extern X_API void PL_register_extensions(PL_extension *);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
extern X_API int Sprintf(char *,...);
 | 
					extern X_API int Sprintf(char *,...);
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -10,7 +10,7 @@
 | 
				
			|||||||
* File:		Yap.h.m4						 *
 | 
					* File:		Yap.h.m4						 *
 | 
				
			||||||
* mods:									 *
 | 
					* mods:									 *
 | 
				
			||||||
* comments:	main header file for YAP				 *
 | 
					* comments:	main header file for YAP				 *
 | 
				
			||||||
* version:      $Id: Yap.h.m4,v 1.27 2002-05-28 17:28:25 vsc Exp $	 *
 | 
					* version:      $Id: Yap.h.m4,v 1.28 2002-06-01 01:46:06 vsc Exp $	 *
 | 
				
			||||||
*************************************************************************/
 | 
					*************************************************************************/
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#include "config.h"
 | 
					#include "config.h"
 | 
				
			||||||
@@ -386,7 +386,7 @@ extern sigjmp_buf    RestartEnv;   /* used to restart after an abort */
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
/* Types of Errors */
 | 
					/* Types of Errors */
 | 
				
			||||||
typedef enum {
 | 
					typedef enum {
 | 
				
			||||||
  NO_ERROR,
 | 
					  YAP_NO_ERROR,
 | 
				
			||||||
  FATAL_ERROR,
 | 
					  FATAL_ERROR,
 | 
				
			||||||
  INTERNAL_ERROR,
 | 
					  INTERNAL_ERROR,
 | 
				
			||||||
  PURE_ABORT,
 | 
					  PURE_ABORT,
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -80,4 +80,6 @@ YapHalt
 | 
				
			|||||||
YapTopOfLocalStack
 | 
					YapTopOfLocalStack
 | 
				
			||||||
YapPredicate
 | 
					YapPredicate
 | 
				
			||||||
YapCurrentModule
 | 
					YapCurrentModule
 | 
				
			||||||
 | 
					YapPredicateInfo
 | 
				
			||||||
 | 
					YapUserCPredicateWithArgs
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 
 | 
				
			|||||||
							
								
								
									
										193
									
								
								pl/debug.yap
									
									
									
									
									
								
							
							
						
						
									
										193
									
								
								pl/debug.yap
									
									
									
									
									
								
							@@ -35,49 +35,78 @@
 | 
				
			|||||||
    '$suspy'(S,P,M).
 | 
					    '$suspy'(S,P,M).
 | 
				
			||||||
'$suspy'([],_,_) :- !.
 | 
					'$suspy'([],_,_) :- !.
 | 
				
			||||||
'$suspy'([F|L],S,M) :- !, ( '$suspy'(F,S,M) ; '$suspy'(L,S,M) ).
 | 
					'$suspy'([F|L],S,M) :- !, ( '$suspy'(F,S,M) ; '$suspy'(L,S,M) ).
 | 
				
			||||||
'$suspy'(F/N,S,M) :- !, functor(T,F,N),
 | 
					'$suspy'(F/N,S,M) :- !,
 | 
				
			||||||
    ( '$system_predicate'(T,M) ->
 | 
					 | 
				
			||||||
	 throw(error(permission_error(access,private_procedure,F/N),spy(F/N,S)));
 | 
					 | 
				
			||||||
	'$undefined'(T,M) ->
 | 
					 | 
				
			||||||
	 throw(error(existence_error(procedure,F/N),spy(F/N,S)));
 | 
					 | 
				
			||||||
	 '$suspy2'(S,F,N,T,M) ).
 | 
					 | 
				
			||||||
'$suspy'(A,S,_) :- \+ atom(A) , !, 
 | 
					 | 
				
			||||||
        throw(error(type_error(predicate_indicator,A),spy(A,S))).
 | 
					 | 
				
			||||||
'$suspy'(A,spy,M) :- '$noclausesfor'(A,M), !,
 | 
					 | 
				
			||||||
	throw(error(existence_error(procedure,A),spy(A))).
 | 
					 | 
				
			||||||
'$suspy'(A,nospy,M) :- '$noclausesfor'(A,M), !,
 | 
					 | 
				
			||||||
	throw(error(existence_error(procedure,A),nospy(A))).
 | 
					 | 
				
			||||||
'$suspy'(A,S,M) :- current_predicate(A,M:T),
 | 
					 | 
				
			||||||
	\+ '$undefined'(T,M), \+ '$system_predicate'(T,M),
 | 
					 | 
				
			||||||
	functor(T,F,N),
 | 
						functor(T,F,N),
 | 
				
			||||||
	'$suspy2'(S,F,N,T,M).
 | 
						'$do_suspy'(S, F, N, T, M).
 | 
				
			||||||
 | 
					'$suspy'(A,S,M) :- atom(A), !,
 | 
				
			||||||
 | 
						'$suspy_predicates_by_name'(A,S,M).
 | 
				
			||||||
 | 
					'$suspy'(P,spy,M) :- !,
 | 
				
			||||||
 | 
						 throw(error(domain_error(predicate_spec,P)),spy(M:P)).
 | 
				
			||||||
 | 
					'$suspy'(P,nospy,M) :-
 | 
				
			||||||
 | 
						 throw(error(domain_error(predicate_spec,P)),nospy(M:P)).
 | 
				
			||||||
 | 
					
 | 
				
			||||||
'$noclausesfor'(A,M) :- current_predicate(A,M:T),
 | 
					'$suspy_predicates_by_name'(A,S,M) :-
 | 
				
			||||||
	\+ '$undefined'(T,M) , \+ '$system_predicate'(T,M) ,
 | 
						% just check one such predicate exists
 | 
				
			||||||
	!, fail .
 | 
						(
 | 
				
			||||||
'$noclausesfor'(_,_).
 | 
						  current_predicate(A,M:_)
 | 
				
			||||||
 | 
						;
 | 
				
			||||||
 | 
						  '$recorded'('$import','$import'(EM,M,A,_),_)
 | 
				
			||||||
 | 
						),
 | 
				
			||||||
 | 
						!,
 | 
				
			||||||
 | 
						'$do_suspy_predicates_by_name'(A,S,M).
 | 
				
			||||||
 | 
					'$suspy_predicates_by_name'(A,spy,M) :- !,
 | 
				
			||||||
 | 
						'$print_message'(warning,no_match(spy(M:A))).
 | 
				
			||||||
 | 
					'$suspy_predicates_by_name'(A,nospy,M) :-
 | 
				
			||||||
 | 
						'$print_message'(warning,no_match(nospy(M:A))).
 | 
				
			||||||
 | 
						
 | 
				
			||||||
 | 
					'$do_suspy_predicates_by_name'(A,S,M) :-
 | 
				
			||||||
 | 
						current_predicate(A,M:T),
 | 
				
			||||||
 | 
						functor(T,A,N),
 | 
				
			||||||
 | 
						'$do_suspy'(S, A, N, T, M).
 | 
				
			||||||
 | 
					'$do_suspy_predicates_by_name'(A, S, M) :-
 | 
				
			||||||
 | 
						'$recorded'('$import','$import'(EM,M,A,N),_), !,
 | 
				
			||||||
 | 
						functor(T,A,N),
 | 
				
			||||||
 | 
						'$do_suspy'(S, A, N, T, EM).
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					%
 | 
				
			||||||
 | 
					% protect against evil arguments.
 | 
				
			||||||
 | 
					%
 | 
				
			||||||
 | 
					'$do_suspy'(S, F, N, T, M) :-
 | 
				
			||||||
 | 
						'$recorded'('$import','$import'(EM,M,F,N),_), !,
 | 
				
			||||||
 | 
						'$do_suspy'(S, F, N, T, EM).
 | 
				
			||||||
 | 
					'$do_suspy'(S, F, N, T, M) :-
 | 
				
			||||||
 | 
						 '$undefined'(T,M), !,
 | 
				
			||||||
 | 
						 ( S = spy ->
 | 
				
			||||||
 | 
						     '$print_message'(warning,no_match(spy(M:F/N)))
 | 
				
			||||||
 | 
						 ;
 | 
				
			||||||
 | 
						     '$print_message'(warning,no_match(nospy(M:F/N)))
 | 
				
			||||||
 | 
						 ).
 | 
				
			||||||
 | 
					'$do_suspy'(S, F, N, T, M) :-
 | 
				
			||||||
 | 
						 '$system_predicate'(T,M),
 | 
				
			||||||
 | 
						 ( S = spy ->
 | 
				
			||||||
 | 
						     throw(error(permission_error(access,private_procedure,T),spy(M:F/N)))
 | 
				
			||||||
 | 
						 ;
 | 
				
			||||||
 | 
						     throw(error(permission_error(access,private_procedure,T),nospy(M:F/N)))
 | 
				
			||||||
 | 
						 ).
 | 
				
			||||||
 | 
					'$do_suspy'(S,F,N,T,M) :-
 | 
				
			||||||
 | 
						'$suspy2'(S,F,N,T,M).
 | 
				
			||||||
 | 
					
 | 
				
			||||||
'$suspy2'(spy,F,N,T,M) :- 
 | 
					'$suspy2'(spy,F,N,T,M) :- 
 | 
				
			||||||
	'$recorded'('$spy','$spy'(T,M),_), !,
 | 
						'$recorded'('$spy','$spy'(T,M),_), !,
 | 
				
			||||||
	'$format'(user_error, "[ Warning: there is already a spy point on ~w:~w/~w ]~n",[M,F,N]).
 | 
						'$print_message'(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)).
 | 
				
			||||||
'$suspy2'(spy,F,N,T,M) :- !,
 | 
					'$suspy2'(spy,F,N,T,M) :- !,
 | 
				
			||||||
	'$warn_if_undef'(T,F,N,M),
 | 
					 | 
				
			||||||
	'$recorda'('$spy','$spy'(T,M),_), 
 | 
						'$recorda'('$spy','$spy'(T,M),_), 
 | 
				
			||||||
	'$set_value'('$spypoint_added', true), 
 | 
						'$set_value'('$spypoint_added', true), 
 | 
				
			||||||
	'$set_spy'(T,M),
 | 
						'$set_spy'(T,M),
 | 
				
			||||||
	'$format'(user_error,"[ Spy point set on ~w:~w/~w ]~n", [M,F,N]).
 | 
						'$print_message'(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)).
 | 
				
			||||||
'$suspy2'(nospy,F,N,T,M) :- 
 | 
					'$suspy2'(nospy,F,N,T,M) :- 
 | 
				
			||||||
	'$recorded'('$spy','$spy'(T,M),R), !,
 | 
						'$recorded'('$spy','$spy'(T,M),R), !,
 | 
				
			||||||
	erase(R),
 | 
						erase(R),
 | 
				
			||||||
	'$rm_spy'(T,M),
 | 
						'$rm_spy'(T,M),
 | 
				
			||||||
	'$format'(user_error,"[ Spy point on ~w:~w/~w removed ]~n", [M,F,N]).
 | 
						'$print_message'(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),remove,last)).
 | 
				
			||||||
'$suspy2'(nospy,F,N,_,M) :-
 | 
					'$suspy2'(nospy,F,N,_,M) :-
 | 
				
			||||||
	'$format'(user_error,"[ Warning: there is no spy point on ~w:~w/~w ]~n", [M,F,N]).
 | 
						'$print_message'(informational,breakp(no,breakpoint_for,M:F/N)).
 | 
				
			||||||
 | 
					 | 
				
			||||||
'$warn_if_undef'(T,F,N,M) :-  '$undefined'(T,M), !,
 | 
					 | 
				
			||||||
	write(user_error,'[ Warning: you have no clauses for '),
 | 
					 | 
				
			||||||
	write(user_error,M:F/N), write(user_error,' ]'), nl(user_error).
 | 
					 | 
				
			||||||
'$warn_if_undef'(_,_,_,_).
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
'$pred_being_spied'(G, M) :-
 | 
					'$pred_being_spied'(G, M) :-
 | 
				
			||||||
	'$recorded'('$spy','$spy'(G,M),_), !.
 | 
						'$recorded'('$spy','$spy'(G,M),_), !.
 | 
				
			||||||
@@ -101,17 +130,18 @@ nospyall.
 | 
				
			|||||||
% debug mode -> debug flag = 1
 | 
					% debug mode -> debug flag = 1
 | 
				
			||||||
 | 
					
 | 
				
			||||||
debug :- '$get_value'(debug,1), !.
 | 
					debug :- '$get_value'(debug,1), !.
 | 
				
			||||||
debug :- '$set_value'(debug,1), write(user_error,'[ Debug mode on ]'), nl(user_error).
 | 
					debug :- '$set_value'(debug,1),
 | 
				
			||||||
 | 
						'$print_message'(informational,debug(debug)).
 | 
				
			||||||
 | 
					
 | 
				
			||||||
nodebug :- nospyall,
 | 
					nodebug :- nospyall,
 | 
				
			||||||
	'$set_value'(debug,0),
 | 
						'$set_value'(debug,0),
 | 
				
			||||||
	'$set_value'('$trace',0),
 | 
						'$set_value'('$trace',0),
 | 
				
			||||||
	'$set_yap_flags'(10,0),
 | 
						'$set_yap_flags'(10,0),
 | 
				
			||||||
	'$format'(user_error,"[ Debug mode off ]~n",[]).
 | 
						'$print_message'(informational,debug(off)).
 | 
				
			||||||
 | 
					
 | 
				
			||||||
trace :- '$get_value'('$trace',1), !.
 | 
					trace :- '$get_value'('$trace',1), !.
 | 
				
			||||||
trace :-
 | 
					trace :-
 | 
				
			||||||
	'$format'(user_error,"[ Trace mode on ]~n",[]),
 | 
						'$print_message'(informational,debug(trace)),
 | 
				
			||||||
	'$set_value'('$trace',1),
 | 
						'$set_value'('$trace',1),
 | 
				
			||||||
	'$set_value'(debug,1),
 | 
						'$set_value'(debug,1),
 | 
				
			||||||
	'$set_value'(spy_sl,0),
 | 
						'$set_value'(spy_sl,0),
 | 
				
			||||||
@@ -122,7 +152,7 @@ trace :-
 | 
				
			|||||||
notrace :- 
 | 
					notrace :- 
 | 
				
			||||||
	'$set_value'('$trace',0),
 | 
						'$set_value'('$trace',0),
 | 
				
			||||||
	'$set_value'(debug,0),
 | 
						'$set_value'(debug,0),
 | 
				
			||||||
	'$format'(user_error,"[ Trace and Debug mode off ]",[]).
 | 
						'$print_message'(informational,debug(off)).
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/*-----------------------------------------------------------------------------
 | 
					/*-----------------------------------------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@@ -133,37 +163,34 @@ notrace :-
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
leash(X) :- var(X),
 | 
					leash(X) :- var(X),
 | 
				
			||||||
	throw(error(instantiation_error,leash(X))).
 | 
						throw(error(instantiation_error,leash(X))).
 | 
				
			||||||
leash(X) :- '$leashcode'(X,Code),
 | 
					leash(X) :-
 | 
				
			||||||
 | 
						'$leashcode'(X,Code),
 | 
				
			||||||
	'$set_value'('$leash',Code),
 | 
						'$set_value'('$leash',Code),
 | 
				
			||||||
	'$show_leash'(Code), !.
 | 
						'$show_leash'(informational,Code), !.
 | 
				
			||||||
leash(X) :-
 | 
					leash(X) :-
 | 
				
			||||||
	throw(error(type_error(leash_mode,X),leash(X))).
 | 
						throw(error(type_error(leash_mode,X),leash(X))).
 | 
				
			||||||
 | 
					
 | 
				
			||||||
'$show_leash'(0) :- write(user_error,'[ No leashing ]'), nl(user_error).
 | 
					'$show_leash'(Msg,0) :-
 | 
				
			||||||
'$show_leash'(L) :-
 | 
						'$print_message'(Msg,leash([])).
 | 
				
			||||||
	'$leashcode'(Code,L),
 | 
					'$show_leash'(Msg,Code) :-
 | 
				
			||||||
	write(user_error,'[ Leashing set to '), write(user_error,Code),
 | 
						'$check_leash_bit'(Code,2'1000,L3,call,LF),
 | 
				
			||||||
	write(user_error,' ('),
 | 
						'$check_leash_bit'(Code,2'0100,L2,exit,L3),
 | 
				
			||||||
	'$show_leash_bit'(WasWritten,2'1000,L,call),
 | 
						'$check_leash_bit'(Code,2'0010,L1,redo,L2),
 | 
				
			||||||
	'$show_leash_bit'(WasWritten,2'0100,L,exit),
 | 
						'$check_leash_bit'(Code,2'0001,[],fail,L1),
 | 
				
			||||||
	'$show_leash_bit'(WasWritten,2'0010,L,redo),
 | 
						'$print_message'(Msg,leash(LF)).
 | 
				
			||||||
	'$show_leash_bit'(WasWritten,2'0001,L,fail),
 | 
					 | 
				
			||||||
	write(user_error,') ]'), nl(user_error).
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
'$show_leash_bit'(_,Bit,Code,_) :- Bit /\ Code =:= 0, !.
 | 
					'$check_leash_bit'(Code,Bit,L0,_,L0) :- Bit /\ Code =:= 0, !.
 | 
				
			||||||
'$show_leash_bit'(Was,_,_,Name) :- var(Was), !,
 | 
					'$check_leash_bit'(_,_,L0,Name,[Name|L0]).
 | 
				
			||||||
	Was = yes, write(user_error,Name).
 | 
					 | 
				
			||||||
'$show_leash_bit'(_,_,_,Name) :-
 | 
					 | 
				
			||||||
	write(user_error,','), write(user_error,Name).
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
'$leashcode'(full,2'1111) :- !.
 | 
					'$leashcode'(full,2'1111) :- !.
 | 
				
			||||||
'$leashcode'(on,2'1111) :- !.
 | 
					'$leashcode'(on,2'1111) :- !.
 | 
				
			||||||
'$leashcode'(half,2'1010) :- !.
 | 
					'$leashcode'(half,2'1010) :- !.
 | 
				
			||||||
'$leashcode'(loose,2'1000) :- !.
 | 
					'$leashcode'(loose,2'1000) :- !.
 | 
				
			||||||
'$leashcode'(off,2'0000) :- !.
 | 
					'$leashcode'(off,2'0000) :- !.
 | 
				
			||||||
 | 
					'$leashcode'(none,2'0000) :- !.
 | 
				
			||||||
%'$leashcode'([L|M],Code) :- !, '$leashcode_list'([L|M],Code).
 | 
					%'$leashcode'([L|M],Code) :- !, '$leashcode_list'([L|M],Code).
 | 
				
			||||||
'$leashcode'([L|M],Code) :- !, ( var(Code) -> '$list2Code'([L|M],Code)
 | 
					'$leashcode'([L|M],Code) :- !,
 | 
				
			||||||
					    ; '$code2List'(Code,[L|M]) ).
 | 
						'$list2Code'([L|M],Code).
 | 
				
			||||||
'$leashcode'(N,N) :- integer(N), N >= 0, N =< 2'1111.
 | 
					'$leashcode'(N,N) :- integer(N), N >= 0, N =< 2'1111.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
'$list2Code'(V,_) :- var(V), !,
 | 
					'$list2Code'(V,_) :- var(V), !,
 | 
				
			||||||
@@ -176,16 +203,6 @@ leash(X) :-
 | 
				
			|||||||
'$list2Code'([redo|L],N) :- '$list2Code'(L,N1), N is 2'0010 + N1.
 | 
					'$list2Code'([redo|L],N) :- '$list2Code'(L,N1), N is 2'0010 + N1.
 | 
				
			||||||
'$list2Code'([fail|L],N) :- '$list2Code'(L,N1), N is 2'0001 + N1.
 | 
					'$list2Code'([fail|L],N) :- '$list2Code'(L,N1), N is 2'0001 + N1.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
'$code2List'(0,[]) :- !.
 | 
					 | 
				
			||||||
'$code2List'(N,[call|L]) :- X is N /\ 2'1000, X \= 0, !,
 | 
					 | 
				
			||||||
	M is N-X, '$code2List'(M,L).
 | 
					 | 
				
			||||||
'$code2List'(N,[exit|L]) :- X is N /\ 2'0100, X \= 0, !,
 | 
					 | 
				
			||||||
	M is N-X, '$code2List'(M,L).
 | 
					 | 
				
			||||||
'$code2List'(N,[redo|L]) :- X is N /\ 2'0010, X \= 0, !,
 | 
					 | 
				
			||||||
	M is N-X, '$code2List'(M,L).
 | 
					 | 
				
			||||||
'$code2List'(N,[fail|L]) :- X is N /\ 2'0001, X \= 0, !,
 | 
					 | 
				
			||||||
	M is N-X, '$code2List'(M,L).
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
/*-----------------------------------------------------------------------------
 | 
					/*-----------------------------------------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
				debugging
 | 
									debugging
 | 
				
			||||||
@@ -193,29 +210,15 @@ leash(X) :-
 | 
				
			|||||||
-----------------------------------------------------------------------------*/
 | 
					-----------------------------------------------------------------------------*/
 | 
				
			||||||
 | 
					
 | 
				
			||||||
debugging :-
 | 
					debugging :-
 | 
				
			||||||
	'$get_value'(debug,1) ->
 | 
						( '$get_value'(debug,1) ->
 | 
				
			||||||
		write(user_error,'[ Debug mode is switched on ]') ,
 | 
						    '$print_message'(help,debug(debug))
 | 
				
			||||||
		nl(user_error),
 | 
					 | 
				
			||||||
		'$debugging_mode'
 | 
					 | 
				
			||||||
	    ;
 | 
						    ;
 | 
				
			||||||
		write(user_error,'[ Debug mode is switched off ]') ,
 | 
						    '$print_message'(help,debug(off))
 | 
				
			||||||
		nl(user_error)
 | 
						),
 | 
				
			||||||
	.
 | 
						findall(M:(N/A),('$recorded'('$spy','$spy'(T,M),_),functor(T,N,A)),L),
 | 
				
			||||||
	
 | 
						'$print_message'(help,breakpoints(L)),
 | 
				
			||||||
'$debugging_mode' :-
 | 
					 | 
				
			||||||
	( '$recorded'('$spy',_,_) -> '$show_spies' ;
 | 
					 | 
				
			||||||
		   write(user_error,'[ Warning: there are no spy-points set ]') ,
 | 
					 | 
				
			||||||
		   nl(user_error) ),
 | 
					 | 
				
			||||||
	'$get_value'('$leash',Leash),
 | 
						'$get_value'('$leash',Leash),
 | 
				
			||||||
	'$show_leash'(Leash).
 | 
						'$show_leash'(help,Leash).
 | 
				
			||||||
 | 
					 | 
				
			||||||
'$show_spies' :-
 | 
					 | 
				
			||||||
	write(user_error,'[ Spy points set on :'), nl(user_error),
 | 
					 | 
				
			||||||
	( '$recorded'('$spy','$spy'(T,M),_), functor(T,F,N),
 | 
					 | 
				
			||||||
		write(user_error,'        '),write(user_error,M:F/N),nl(user_error),
 | 
					 | 
				
			||||||
		fail ;
 | 
					 | 
				
			||||||
	  write(user_error,' ]'), nl(user_error) ).
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
/*-----------------------------------------------------------------------------
 | 
					/*-----------------------------------------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@@ -918,18 +921,18 @@ debugging :-
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
'$action_help' :-
 | 
					'$action_help' :-
 | 
				
			||||||
	format(user_error,"newline  creep       a   abort~n", []),
 | 
						'$format'(user_error,"newline  creep       a   abort~n", []),
 | 
				
			||||||
	format(user_error,"c        creep       e   exit~n", []),
 | 
						'$format'(user_error,"c        creep       e   exit~n", []),
 | 
				
			||||||
	format(user_error,"f        fail        h   help~n", []),
 | 
						'$format'(user_error,"f        fail        h   help~n", []),
 | 
				
			||||||
	format(user_error,"l        leap        r   retry~n", []),
 | 
						'$format'(user_error,"l        leap        r   retry~n", []),
 | 
				
			||||||
	format(user_error,"s        skip        t   fastskip~n", []),
 | 
						'$format'(user_error,"s        skip        t   fastskip~n", []),
 | 
				
			||||||
	format(user_error,"q        quasiskip   k   quasileap~n", []),
 | 
						'$format'(user_error,"q        quasiskip   k   quasileap~n", []),
 | 
				
			||||||
	format(user_error,"b        break       n   no debug~n", []),
 | 
						'$format'(user_error,"b        break       n   no debug~n", []),
 | 
				
			||||||
	format(user_error,"p        print       d   display~n", []),
 | 
						'$format'(user_error,"p        print       d   display~n", []),
 | 
				
			||||||
	format(user_error,"<D       depth D     <   full term~n", []),
 | 
						'$format'(user_error,"<D       depth D     <   full term~n", []),
 | 
				
			||||||
	format(user_error,"+        spy this    -   nospy this~n", []),
 | 
						'$format'(user_error,"+        spy this    -   nospy this~n", []),
 | 
				
			||||||
	format(user_error,"^        view subg   ^^  view using~n", []),
 | 
						'$format'(user_error,"^        view subg   ^^  view using~n", []),
 | 
				
			||||||
	format(user_error,"! g execute goal~n").
 | 
						'$format'(user_error,"! g execute goal~n").
 | 
				
			||||||
	
 | 
						
 | 
				
			||||||
'$ilgl'(C) :- '$skipeol'(C), write(user_error,'[ Illegal option. Use h for help. ]'),
 | 
					'$ilgl'(C) :- '$skipeol'(C), write(user_error,'[ Illegal option. Use h for help. ]'),
 | 
				
			||||||
	nl(user_error), fail.
 | 
						nl(user_error), fail.
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -53,35 +53,80 @@ print_message(Level, Mss) :-
 | 
				
			|||||||
	'$format'(user_error,"[ No handler for error ~w ]~n", [Throw]).
 | 
						'$format'(user_error,"[ No handler for error ~w ]~n", [Throw]).
 | 
				
			||||||
'$print_message'(informational,M) :-
 | 
					'$print_message'(informational,M) :-
 | 
				
			||||||
	( '$get_value'('$verbose',on) ->
 | 
						( '$get_value'('$verbose',on) ->
 | 
				
			||||||
	    '$do_print_message'(M) ;
 | 
						    '$do_informational_message'(M) ;
 | 
				
			||||||
	    true
 | 
						    true
 | 
				
			||||||
	).
 | 
						).
 | 
				
			||||||
'$print_message'(warning,M) :-
 | 
					'$print_message'(warning,M) :-
 | 
				
			||||||
	'$do_print_message'(M).
 | 
						'$format'(user_error, "[ ", []),
 | 
				
			||||||
 | 
						'$do_print_message'(M),
 | 
				
			||||||
 | 
						'$format'(user_error, " ]~n", []).
 | 
				
			||||||
'$print_message'(help,M) :-
 | 
					'$print_message'(help,M) :-
 | 
				
			||||||
	'$format'(user_error,"help on ~p",[M]).
 | 
						'$do_print_message'(M),
 | 
				
			||||||
 | 
						'$format'(user_error, "~n", []).
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
'$do_print_message'(loading(_,user)) :- !.
 | 
					'$do_informational_message'(loading(_,user)) :- !.
 | 
				
			||||||
'$do_print_message'(loading(What,AbsoluteFileName)) :- !,
 | 
					'$do_informational_message'(loading(What,AbsoluteFileName)) :- !,
 | 
				
			||||||
	'$show_consult_level'(LC),
 | 
						'$show_consult_level'(LC),
 | 
				
			||||||
	'$format'(user_error, "~*|[ ~a ~a... ]~n", [LC, What, AbsoluteFileName]).
 | 
						'$format'(user_error, "~*|[ ~a ~a... ]~n", [LC, What, AbsoluteFileName]).
 | 
				
			||||||
'$do_print_message'(loaded(_,user,_,_,_)) :- !.
 | 
					'$do_informational_message'(loaded(_,user,_,_,_)) :- !.
 | 
				
			||||||
'$do_print_message'(loaded(What,AbsoluteFileName,Mod,Time,Space)) :- !,
 | 
					'$do_informational_message'(loaded(What,AbsoluteFileName,Mod,Time,Space)) :- !,
 | 
				
			||||||
	'$show_consult_level'(LC0),
 | 
						'$show_consult_level'(LC0),
 | 
				
			||||||
	LC is LC0+1,
 | 
						LC is LC0+1,
 | 
				
			||||||
	'$format'(user_error, "~*|[ ~a ~a in module ~a, ~d msec ~d bytes ]~n", [LC, What, AbsoluteFileName,Mod,Time,Space]).
 | 
						'$format'(user_error, "~*|[ ~a ~a in module ~a, ~d msec ~d bytes ]~n", [LC, What, AbsoluteFileName,Mod,Time,Space]).
 | 
				
			||||||
 | 
					'$do_informational_message'(M) :-
 | 
				
			||||||
 | 
						'$format'("[ ", []),
 | 
				
			||||||
 | 
						'$do_print_message'(M),
 | 
				
			||||||
 | 
						'$format'(" ]~n", []).
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
 | 
					%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
 | 
				
			||||||
 | 
					'$do_print_message'(debug(debug)) :- !,
 | 
				
			||||||
 | 
						'$format'(user_error,"Debug mode on.",[]).
 | 
				
			||||||
 | 
					'$do_print_message'(debug(off)) :- !,
 | 
				
			||||||
 | 
						'$format'(user_error,"Debug mode off.",[]).
 | 
				
			||||||
'$do_print_message'(debug(trace)) :- !,
 | 
					'$do_print_message'(debug(trace)) :- !,
 | 
				
			||||||
	'$format'(user_error,"[ The debugger will first creep -- showing everything (trace) ]~n",[]).
 | 
						'$format'(user_error,"Trace mode on.",[]).
 | 
				
			||||||
'$do_print_message'('$format'(Msg, Args)) :- !,
 | 
					'$do_print_message'('$format'(Msg, Args)) :- !,
 | 
				
			||||||
	'$format'(user_error,Msg,Args).
 | 
						'$format'(user_error,Msg,Args).
 | 
				
			||||||
'$do_print_message'(import(Pred,To,From,private)) :-
 | 
					'$do_print_message'(import(Pred,To,From,private)) :- !,
 | 
				
			||||||
	'$format'(user_error,"importing private predicate ~w:~w to ~w",
 | 
						'$format'(user_error,"Importing private predicate ~w:~w to ~w.",
 | 
				
			||||||
	[From,Pred,To]).
 | 
						[From,Pred,To]).
 | 
				
			||||||
 | 
					'$do_print_message'(no_match(P)) :- !,
 | 
				
			||||||
 | 
						'$format'(user_error,"No matching predicate for ~w.",
 | 
				
			||||||
 | 
						[P]).
 | 
				
			||||||
 | 
					'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),add,already)) :- !,
 | 
				
			||||||
 | 
						'$format'(user_error,"There is already a spy point on ~w:~w/~w.",
 | 
				
			||||||
 | 
						[M,F,N]).	
 | 
				
			||||||
 | 
					'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),add,ok)) :- !,
 | 
				
			||||||
 | 
						'$format'(user_error,"Spy point set on ~w:~w/~w.",
 | 
				
			||||||
 | 
						[M,F,N]).	
 | 
				
			||||||
 | 
					'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),remove,last)) :- !,
 | 
				
			||||||
 | 
						'$format'(user_error,"Spy point on ~w:~w/~w removed.",
 | 
				
			||||||
 | 
						[M,F,N]).
 | 
				
			||||||
 | 
					'$do_print_message'(breakp(no,breakpoint_for,M:F/N)) :- !,
 | 
				
			||||||
 | 
						'$format'(user_error,"There is no spy point on ~w:~w/~w.",
 | 
				
			||||||
 | 
						[M,F,N]).
 | 
				
			||||||
 | 
					'$do_print_message'(leash([])) :- !,
 | 
				
			||||||
 | 
						'$format'(user_error,"No leashing.",
 | 
				
			||||||
 | 
						[M,F,N]).
 | 
				
			||||||
 | 
					'$do_print_message'(leash([A|B])) :- !,
 | 
				
			||||||
 | 
						'$format'(user_error,"Leashing set to ~w.",
 | 
				
			||||||
 | 
						[[A|B]]).
 | 
				
			||||||
 | 
					'$do_print_message'(breakpoints([])) :- !,
 | 
				
			||||||
 | 
						'$format'(user_error,"There are no spy-points set.",
 | 
				
			||||||
 | 
						[M,F,N]).
 | 
				
			||||||
 | 
					'$do_print_message'(breakpoints(L)) :- !,
 | 
				
			||||||
 | 
						'$format'(user_error,"Spy-points set on:", []),
 | 
				
			||||||
 | 
						'$print_list_of_preds'(L).
 | 
				
			||||||
'$do_print_message'(Messg) :-
 | 
					'$do_print_message'(Messg) :-
 | 
				
			||||||
	'$format'(user_error,"~q",Messg).
 | 
						'$format'(user_error,"~q",Messg).
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					'$print_list_of_preds'([]).
 | 
				
			||||||
 | 
					'$print_list_of_preds'([P|L]) :-
 | 
				
			||||||
 | 
						'$format'(user_error,"~n      ~w",[P]),
 | 
				
			||||||
 | 
						'$print_list_of_preds'(L).
 | 
				
			||||||
 | 
					
 | 
				
			||||||
'$output_error_message'(context_error(Goal,Who),Where) :-
 | 
					'$output_error_message'(context_error(Goal,Who),Where) :-
 | 
				
			||||||
	'$format'(user_error,"[ CONTEXT ERROR- ~w: ~w appeared in ~w ]~n",
 | 
						'$format'(user_error,"[ CONTEXT ERROR- ~w: ~w appeared in ~w ]~n",
 | 
				
			||||||
	[Goal,Who,Where]).
 | 
						[Goal,Who,Where]).
 | 
				
			||||||
@@ -142,6 +187,9 @@ print_message(Level, Mss) :-
 | 
				
			|||||||
'$output_error_message'(domain_error(operator_specifier,N), Where) :-
 | 
					'$output_error_message'(domain_error(operator_specifier,N), Where) :-
 | 
				
			||||||
	'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w invalid operator specifier ]~n",
 | 
						'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w invalid operator specifier ]~n",
 | 
				
			||||||
	[Where,N]).
 | 
						[Where,N]).
 | 
				
			||||||
 | 
					'$output_error_message'(domain_error(predicate_spec,N), Where) :-
 | 
				
			||||||
 | 
						'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w invalid predicate specifier ]~n",
 | 
				
			||||||
 | 
						[Where,N]).
 | 
				
			||||||
'$output_error_message'(domain_error(read_option,N), Where) :-
 | 
					'$output_error_message'(domain_error(read_option,N), Where) :-
 | 
				
			||||||
	'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w invalid option to read ]~n",
 | 
						'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w invalid option to read ]~n",
 | 
				
			||||||
	[Where,N]).
 | 
						[Where,N]).
 | 
				
			||||||
 
 | 
				
			|||||||
		Reference in New Issue
	
	Block a user