From 17d16e0b14b8482449f14e7ee3e25ab34e268958 Mon Sep 17 00:00:00 2001
From: vsc <vsc@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Fri, 22 Feb 2008 15:08:37 +0000
Subject: [PATCH] Big update to support more SICStus/SWI like message handling
 fix YAPSHAREDIR fix yap.tex (Bernd)

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2107 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 C/cdmgr.c         |  17 +-
 C/iopreds.c       |   2 +
 C/threads.c       |   7 +
 Makefile.in       |   9 +-
 changes-5.1.html  |   5 +
 docs/yap.tex      | 116 ++++++-
 library/hacks.yap |  65 +---
 pl/boot.yap       |  24 +-
 pl/consult.yap    |  29 +-
 pl/debug.yap      |  42 +--
 pl/errors.yap     | 798 ++++------------------------------------------
 pl/hacks.yap      | 204 ++++++++++++
 pl/init.yap       |  23 +-
 pl/messages.yap   | 486 ++++++++++++++++++++++++++++
 pl/modules.yap    |   3 +-
 pl/preds.yap      |   8 +-
 pl/threads.yap    |   3 +-
 pl/utils.yap      |   4 +-
 pl/yio.yap        |   4 +-
 19 files changed, 987 insertions(+), 862 deletions(-)
 create mode 100644 pl/hacks.yap
 create mode 100644 pl/messages.yap

diff --git a/C/cdmgr.c b/C/cdmgr.c
index 3ce9c51ec..f8fdfe713 100644
--- a/C/cdmgr.c
+++ b/C/cdmgr.c
@@ -11,8 +11,12 @@
 * File:		cdmgr.c							 *
 * comments:	Code manager						 *
 *									 *
-* Last rev:     $Date: 2008-01-23 17:57:44 $,$Author: vsc $						 *
+* Last rev:     $Date: 2008-02-22 15:08:33 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.218  2008/01/23 17:57:44  vsc
+* valgrind it!
+* enable atom garbage collection.
+*
 * Revision 1.217  2007/12/26 19:50:40  vsc
 * new version of clp(fd)
 * fix deadlock with empty args facts in clause/2.
@@ -3331,16 +3335,17 @@ static Term
 all_calls(void)
 {
   Term ts[3];
-  Functor f = Yap_MkFunctor(AtomLocal,3);
+  Functor f = Yap_MkFunctor(AtomLocal,4);
 
   ts[0] = MkIntegerTerm((Int)P);
+  ts[1] = MkIntegerTerm((Int)CP);
   if (yap_flags[STACK_DUMP_ON_ERROR_FLAG]) {
-    ts[1] = all_envs(ENV);
-    ts[2] = all_cps(B);
+    ts[2] = all_envs(ENV);
+    ts[3] = all_cps(B);
   } else {
-    ts[1] = ts[2] = TermNil;
+    ts[2] = ts[3] = TermNil;
   }
-  return(Yap_MkApplTerm(f,3,ts));
+  return(Yap_MkApplTerm(f,4,ts));
 }
 
 Term
diff --git a/C/iopreds.c b/C/iopreds.c
index 31a3d812c..d9ed97857 100644
--- a/C/iopreds.c
+++ b/C/iopreds.c
@@ -1233,6 +1233,8 @@ post_process_eof(StreamDesc *s)
 static int
 console_post_process_read_char(int ch, StreamDesc *s)
 {
+  /* the character is also going to be output by the console handler */
+  console_count_output_char(ch,Stream+StdErrStream);
   if (ch == '\n') {
     ++s->linecount;
     ++s->charcount;
diff --git a/C/threads.c b/C/threads.c
index abbe3d7ed..c4785d78b 100644
--- a/C/threads.c
+++ b/C/threads.c
@@ -695,8 +695,15 @@ p_thread_runtime(void)
   return Yap_unify(ARG1,MkIntTerm(0));
 }
 
+static Int 
+p_thread_self(void)
+{				/* '$thread_runtime'(+P)	 */
+  return Yap_unify(ARG1,MkIntTerm(0));
+}
+
 void Yap_InitThreadPreds(void)
 {
+  Yap_InitCPred("$thread_self", 1, p_thread_self, SafePredFlag|HiddenPredFlag);
   Yap_InitCPred("$no_threads", 0, p_no_threads, SafePredFlag|HiddenPredFlag);
   Yap_InitCPred("$max_threads", 1, p_max_threads, SafePredFlag|HiddenPredFlag);
   Yap_InitCPred("$nof_threads", 1, p_nof_threads, SafePredFlag|HiddenPredFlag);
diff --git a/Makefile.in b/Makefile.in
index ca9625267..e71326536 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -185,10 +185,14 @@ PL_SOURCES= \
 	$(srcdir)/pl/checker.yap $(srcdir)/pl/chtypes.yap \
 	$(srcdir)/pl/consult.yap \
 	$(srcdir)/pl/corout.yap $(srcdir)/pl/debug.yap \
+	$(srcdir)/pl/depth_bound.yap \
 	$(srcdir)/pl/directives.yap \
+	$(srcdir)/pl/eam.yap \
 	$(srcdir)/pl/errors.yap	$(srcdir)/pl/grammar.yap \
-	$(srcdir)/pl/ground.yap $(srcdir)/pl/init.yap \
-	$(srcdir)/pl/depth_bound.yap $(srcdir)/pl/listing.yap \
+	$(srcdir)/pl/ground.yap
+	$(srcdir)/pl/hacks.yap
+	$(srcdir)/pl/init.yap \
+	$(srcdir)/pl/listing.yap \
 	$(srcdir)/pl/load_foreign.yap \
 	$(srcdir)/pl/modules.yap $(srcdir)/pl/preds.yap \
 	$(srcdir)/pl/profile.yap \
@@ -199,7 +203,6 @@ PL_SOURCES= \
 	$(srcdir)/pl/strict_iso.yap \
 	$(srcdir)/pl/tabling.yap $(srcdir)/pl/threads.yap \
 	$(srcdir)/pl/utils.yap \
-	$(srcdir)/pl/eam.yap \
 	$(srcdir)/pl/yapor.yap $(srcdir)/pl/yio.yap
 
 YAPDOCS=$(srcdir)/docs/yap.tex $(srcdir)/docs/chr.tex \
diff --git a/changes-5.1.html b/changes-5.1.html
index 0a903425f..b53368ed8 100644
--- a/changes-5.1.html
+++ b/changes-5.1.html
@@ -17,6 +17,11 @@ xb
 
 <h2>Yap-5.1.3:</h2>
 <ul>
+<li> FIXED: in console, count input characters as being output, as they
+  are also supposed to be displayed by the console manager.</li>
+<li> NEW: SWI/SICStus compatible messaging system.</li>
+<li> FIXED: YAPSHAREDIR was only used when creating the saved state (obs from
+Nuno Fonseca).</li>
 <li> FIXED: indexing code could not see end of static clause (obs from
 Lisa Torrey).</li>
 <li> FIXED: indexing code for dynamic predicates was broken with
diff --git a/docs/yap.tex b/docs/yap.tex
index 54dd0d31a..d54e2eca9 100644
--- a/docs/yap.tex
+++ b/docs/yap.tex
@@ -114,6 +114,7 @@ us to include his text in this document.
 Built In Predicates
 * Control:: Controlling the execution of Prolog programs
 * Undefined Procedures:: Handling calls to Undefined Procedures
+* Messages:: Message Handling in YAP
 * Testing Terms:: Predicates on Terms
 * Predicates on Atoms:: Manipulating Atoms
 * Predicates on Characters:: Manipulating Characters
@@ -2390,6 +2391,7 @@ may result in incorrect execution.
 Built-ins, Debugging, Syntax, Top
 * Control:: Controlling the Execution of Prolog Programs
 * Undefined Procedures:: Handling calls to Undefined Procedures
+* Messages:: Message Handling in YAP
 * Testing Terms:: Predicates on Terms
 * Predicates on Atoms:: Manipulating Atoms
 * Predicates on Characters:: Manipulating Characters
@@ -2835,13 +2837,13 @@ Increase stack size @var{Size} kilobytes.
 
 @end table
 
-@node Undefined Procedures, Testing Terms, Control, Top
+@node Undefined Procedures, Messages, Control, Top
 @section Handling Undefined Procedures
 
 A predicate in a module is said to be undefined if there are no clauses
 defining the predicate, and if the predicate has not been declared to be
 dynamic. What YAP does when trying to execute undefined predicates can
-be specified through three different ways:
+be specified in three different ways:
 @itemize @bullet
 @item By setting an YAP flag, through the @code{yap_flag/2} or
 @code{set_prolog_flag/2} built-ins. This solution generalizes the
@@ -2914,7 +2916,113 @@ execute @var{NG}. If  @code{user:unknown_predicate_handler/3} fails, the
 system will execute default action as specified by @code{unknown/2}.
 @end table
 
-@node Testing Terms, Predicates on Atoms, Undefined Procedures, Top
+@node Messages, Testing Terms, Undefined Procedures, Top
+@section Message Handling
+
+The interaction between YAP and the user relies on YAP's ability to
+portray messages. These messages range from prompts to error
+information. All message processing is performed through the builtin
+@code{print_message/2}, in two steps:
+
+@itemize @bullet
+@item The message is processed into a list of commands 
+@item The commands in the list are sent to the @code{format/3} builtin
+in sequence.
+@end itemize 
+
+The first argument to @code{print_message/2} specifies the importance of
+the message. The options are:
+
+@table @code
+@item error
+error handling
+@item warning
+compilation and run-time warnings,
+@item informational
+generic informational messages
+@item help 
+help messages (not currently implemented in YAP)
+@item query
+query 	used in query processing (not currently implemented in YAP)
+@item  silent
+messages that do not produce output but that can be intercepted by hooks.
+@end table
+
+The next table shows the main predicates and hooks associated to message
+handling in YAP:
+@table @code
+@item print_message(+@var{Kind}, @var{Term})
+@findex print_message/2
+@syindex print_message/2
+@cnindex print_message/2
+The predicate print_message/2 is used to print messages, notably from
+exceptions in a human-readable format. @var{Kind} is one of
+@code{informational}, @code{banner}, @code{warning}, @code{error},
+@code{help} or @code{silent}. A human-readable message is printed to
+the stream @code{user_error}.
+
+@c \index{silent}\index{quiet}%
+If the Prolog flag @code{verbose} is @code{silent}, messages with
+@var{Kind} @code{informational}, or @code{banner} are treated as
+silent.@c  See \cmdlineoption{-q}.
+
+This predicate first translates the @var{Term} into a list of `message
+lines' (see @code{print_message_lines/3} for details).  Next it will
+call the hook @code{message_hook/3} to allow the user intercepting the
+message.  If @code{message_hook/3} fails it will print the message unless
+@var{Kind} is silent.
+
+@c The print_message/2 predicate and its rules are in the file
+@c \file{<plhome>/boot/messages.pl}, which may be inspected for more
+@c information on the error messages and related error terms. 
+If you need to report errors from your own predicates, we advise you to
+stick to the existing error terms if you can; but should you need to
+invent new ones, you can define corresponding error messages by
+asserting clauses for @code{prolog:message/2}. You will need to declare
+the predicate as multifile.
+
+@c See also message_to_string/2.
+
+@item print_message_lines(+@var{Stream}, +@var{Prefix}, +@var{Lines})
+@findex print_message_lines/3
+@syindex print_message_lines/3
+@cnindex print_message_lines/3
+Print a message (see @code{print_message/2}) that has been translated to
+a list of message elements.  The elements of this list are:
+
+@table @code
+    @item @code{<Format>}-@code{<Args>}
+        Where @var{Format} is an atom and @var{Args} is a list
+	of format argument.  Handed to @code{format/3}.
+    @item @code{flush}
+	If this appears as the last element, @var{Stream} is flushed
+	(see @code{flush_output/1}) and no final newline is generated.
+    @item @code{at_same_line}
+        If this appears as first element, no prefix is printed for
+	the first line and the line-position is not forced to 0
+	(see @code{format/1}, @code{~N}).
+    @item @code{<Format>}
+        Handed to @code{format/3} as @code{format(Stream, Format, [])}.
+    @item nl
+        A new line is started and if the message is not complete
+	the @var{Prefix} is printed too.
+@end table
+
+@item user:message_hook(+@var{Term}, +@var{Kind}, +@var{Lines})
+@findex message_hook/3
+@syindex message_hook/3
+@cnindex message_hook/3
+Hook predicate that may be define in the module @code{user} to intercept
+messages from @code{print_message/2}. @var{Term} and @var{Kind} are the
+same as passed to @code{print_message/2}. @var{Lines} is a list of
+format statements as described with @code{print_message_lines/3}.
+
+This predicate should be defined dynamic and multifile to allow other
+modules defining clauses for it too.
+
+@end table
+
+@node Testing Terms, Predicates on Atoms, Messages, Top
 @section Predicates on terms
 
 @table @code
@@ -3966,7 +4074,7 @@ YAP currently ignores these options.
 @findex time_file/2
 @snindex time_file/2
 @cnindex time_file/2
-Unify the last modification time of @vaar{File} with
+Unify the last modification time of @var{File} with
 @var{Time}. @var{Time} is a floating point number expressing the seconds
 elapsed since Jan 1, 1970.
 
diff --git a/library/hacks.yap b/library/hacks.yap
index 87bbe7fba..d15b80019 100644
--- a/library/hacks.yap
+++ b/library/hacks.yap
@@ -25,64 +25,13 @@ stack_dump(Max) :-
 	length(CPs, LCPs),
 	length(Envs, LEnvs),
 	format(user_error,'~n~n~tStack Dump~t~40+~n~nAddress~tChoiceP~16+ Cur/Next Clause        Goal~n',[LCPs,LEnvs]),
-	display_stack_info(CPs,Envs,Max,ContP).
+	display_stack_info(CPs, Envs, Max, ContP, StackInfo, StackInfo, []),
+	run_formats(StackInfo, user_error).
+
+run_formats([], _).
+run_formats([Com-Args|StackInfo], Stream) :-
+	format(Stream, Com, Args),
+	run_formats(StackInfo, user_error).
 
-display_stack_info(_,_,0,_) :- !.
-display_stack_info([],[],_,_).
-display_stack_info([CP|CPs],[],I,_) :-
-	show_lone_cp(CP),
-	I1 is I-1,
-	display_stack_info(CPs,[],I1,_).
-display_stack_info([],[Env|Envs],I,Cont) :-
-	show_env(Env, Cont, NCont),
-	I1 is I-1,
-	display_stack_info([], Envs, I1, NCont).
-display_stack_info([CP|LCPs],[Env|LEnvs],I,Cont) :-
-	continuation(Env, _, NCont, CB),
-	I1 is I-1,
-	( CP == Env, CB < CP ->
-	    % if we follow choice-point and we cut to before choice-point
-	    % we are the same goal
-	   show_cp(CP, 'Cur'), %
-           display_stack_info(LCPs, LEnvs, I1, NCont)
-	;
-          CP > Env ->
-	   show_cp(CP, 'Next'),
-	   display_stack_info(LCPs,[Env|LEnvs],I1,Cont)
-	;
-	   show_env(Env,Cont,NCont),
-	   display_stack_info([CP|LCPs],LEnvs,I1,NCont)
-	).
-
-show_cp(CP, Continuation) :-
-	choicepoint(CP, Addr, Mod, Name, Arity, Goal, ClNo),
-	( Goal = (_;_)
-          ->
-	  format(user_error,'0x~16r~t*~16+ Cur~t~d~16+ ~q:~q/~d( ? ; ? )~n',
-		[Addr, ClNo, Mod, Name, Arity])
-	    ;
-	  prolog_flag( debugger_print_options, Opts),
-	  format(user_error,'0x~16r~t *~16+ ~a~t ~d~16+ ~q:~@~n',
-		[Addr, Continuation, ClNo, Mod, write_term(Goal,Opts)])
-	).
-
-show_env(Env,Cont,NCont) :-
-	continuation(Env, Addr, NCont, _),
-	cp_to_predicate(Cont, Mod, Name, Arity, ClId),
-        format(user_error,'0x~16r~t  ~16+ Cur~t ~d~16+ ~q:~q~@~n',
-		[Addr, ClId, Mod, Name, show_args(Arity)]).
-
-show_args(0) :- !.
-show_args(I) :-
-	format('(?',[]),
-	I1 is I-1,
-	show_inner_args(I1),
-	format(')',[]).
-
-show_inner_args(0) :- !.
-show_inner_args(I) :-
-	format(', ?',[]),
-	I1 is I-1,
-	show_inner_args(I1).
 
 
diff --git a/pl/boot.yap b/pl/boot.yap
index 444a527f6..8bfcdd88f 100644
--- a/pl/boot.yap
+++ b/pl/boot.yap
@@ -45,6 +45,14 @@ true :- true.
 	;
 	  true
 	),
+	(
+	 retractall(user:library_directory(_)),
+	 '$system_library_directories'(D),
+	 assert(user:library_directory(D)),
+	 fail
+	;
+	 true
+	),
 	'$stream_representation_error'(user_input, 512),
 	'$stream_representation_error'(user_output, 512),
 	'$stream_representation_error'(user_error, 512),
@@ -84,7 +92,7 @@ true :- true.
 	nb_setval('$lf_verbose',informational),
 	nb_setval('$if_level',0),
 	nb_setval('$endif',off),
-	nb_setval('$consulting_file',user_input),
+	nb_setval('$consulting_file',[]),
 	nb_setval('$consulting',false),
 	nb_setval('$included_file','').
 	
@@ -104,7 +112,7 @@ true :- true.
 '$read_vars'(Stream,T,Mod,Pos,V) :-
 	'$read'(true,T,Mod,V,Pos,Err,Stream),
 	(nonvar(Err) ->
-	 '$print_message'(error,Err), fail
+	 print_message(error,Err), fail
 	;
 	 true
 	).
@@ -135,7 +143,7 @@ true :- true.
 	;
 	 true
 	),
-	'$print_message'(informational,prompt(BreakLevel,TraceDebug)),
+	print_message(informational,prompt(BreakLevel,TraceDebug)),
 	fail.
 '$enter_top_level' :-
 	get_value('$top_level_goal',GA), GA \= [], !,
@@ -227,13 +235,13 @@ true :- true.
 
  '$version' :- 
 	 get_value('$version_name',VersionName),
-	 '$print_message'(help, version(VersionName)),
+	 print_message(help, version(VersionName)),
 	 get_value('$myddas_version_name',MYDDASVersionName),
 	 MYDDASVersionName \== [],
-	 '$print_message'(help, myddas_version(MYDDASVersionName)),
+	 print_message(help, myddas_version(MYDDASVersionName)),
 	 fail.
  '$version' :- recorded('$version',VersionName,_),
-	 '$print_message'(help, VersionName),
+	 print_message(help, VersionName),
 	 fail.
  '$version'.
 
@@ -476,7 +484,7 @@ true :- true.
 '$add_env_and_fail' :- fail.
 
 '$out_neg_answer' :-
-	 ( '$undefined'('$print_message'(_,_),prolog) -> 
+	 ( '$undefined'(print_message(_,_),prolog) -> 
 	    '$present_answer'(user_error,"no~n", [])
 	 ;
 	    print_message(help,no)
@@ -530,7 +538,7 @@ true :- true.
 	    fail
 	;
 	    C== 10 -> '$add_nl_outside_console',
-		( '$undefined'('$print_message'(_,_),prolog) -> 
+		( '$undefined'(print_message(_,_),prolog) -> 
 			format(user_error,'yes~n', [])
 	        ;
 		   print_message(help,yes)
diff --git a/pl/consult.yap b/pl/consult.yap
index 5bfaf7ae8..8fb971f75 100644
--- a/pl/consult.yap
+++ b/pl/consult.yap
@@ -234,13 +234,16 @@ use_module(M,F,Is) :-
 	    StartMsg = consulting,
 	    EndMsg = consulted
 	),
-	'$print_message'(InfLevel, loading(StartMsg, File)),
+	print_message(InfLevel, loading(StartMsg, File)),
 	( SkipUnixComments == skip_unix_comments ->
 	    '$skip_unix_comments'(Stream)
 	;
 	    true
 	),
 	'$loop'(Stream,Reconsult),
+	H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
+	'$current_module'(Mod,OldModule),
+	print_message(InfLevel, loaded(EndMsg, File, Mod, T, H)),
 	'$end_consult',
 	( 
 	    Reconsult = reconsult ->
@@ -259,12 +262,9 @@ use_module(M,F,Is) :-
 	nb_setval('$if_skip_mode',run),
 	% back to include mode!
 	nb_setval('$if_level',OldIncludeLevel),
-	'$current_module'(Mod,OldModule),
 	'$bind_module'(Mod, UseModule),
 	'$import_to_current_module'(File, ContextModule, Imports),
 	( LC == 0 -> prompt(_,'   |: ') ; true),
-	H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
-	'$print_message'(InfLevel, loaded(EndMsg, File, Mod, T, H)),
         ( OldMode == off -> '$exit_system_mode' ; true ),
 	'$exec_initialisation_goals',
 	!.
@@ -346,13 +346,13 @@ use_module(M,F,Is) :-
 	H0 is heapused, '$cputime'(T0,_),
 	'$default_encoding'(Encoding),
 	( '$open'(Y,'$csult',Stream,0,Encoding), !,
-		'$print_message'(Verbosity, loading(including, Y)),
+		print_message(Verbosity, loading(including, Y)),
 		'$loop'(Stream,Status), '$close'(Stream)
 	;
 		'$do_error'(permission_error(input,stream,Y),include(X))
 	),
 	H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
-	'$print_message'(Verbosity, loaded(included, Y, Mod, T, H)),
+	print_message(Verbosity, loaded(included, Y, Mod, T, H)),
 	nb_setval('$included_file',OY).
 
 '$do_startup_reconsult'(X) :-
@@ -470,7 +470,7 @@ remove_from_path(New) :- '$check_path'(New,Path),
 
 '$add_multifile'(File,Name,Arity,Module) :-
 	recorded('$multifile_defs','$defined'(File,Name,Arity,Module), _), !,
-	'$print_message'(warning,declaration((multifile Module:Name/Arity),ignored)).
+	print_message(warning,declaration((multifile Module:Name/Arity),ignored)).
 '$add_multifile'(File,Name,Arity,Module) :-
 	recordz('$multifile_defs','$defined'(File,Name,Arity,Module),_), !,
 	fail.
@@ -520,12 +520,6 @@ remove_from_path(New) :- '$check_path'(New,Path),
 	fail.
 '$record_loaded'(_, _).
 
-'$system_library_directories'(Dir) :-
-	getenv('YAPSHAREDIR', Dir).
-'$system_library_directories'(Dir) :-
-	get_value(system_library_directory,Dir).
-
-
 %
 % encoding stuff: what I believe SWI does.
 %
@@ -696,7 +690,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
 '$find_in_path'(library(File),Opts,NewFile, Call) :- !,
 	'$dir_separator'(D),
 	atom_codes(A,[D]),
-	'$extend_path_directory'(Name, A, File, Opts, NewFile, Call).
+	'$extend_path_directory'(library, A, File, Opts, NewFile, Call).
 '$find_in_path'(S, Opts, NewFile, Call) :-
 	S =.. [Name,File], !,
 	'$dir_separator'(D),
@@ -755,11 +749,16 @@ absolute_file_name(File,Opts,TrueFileName) :-
 	recorded('$path',Path,_),
 	atom_concat([Path,File],PFile).
 
+'$system_library_directories'(Dir) :-
+	getenv('YAPSHAREDIR', Dir).
+'$system_library_directories'(Dir) :-
+	get_value(system_library_directory,Dir).
+
+
 '$extend_path_directory'(Name, D, File, Opts, NewFile, Call) :-
 	user:file_search_path(Name, Dir),	
 	'$extend_pathd'(Dir, D, File, Opts, NewFile, Call).
 
-
 '$extend_pathd'(Dir, A, File, Opts, NewFile, Call) :-
 	atom(Dir), !,
 	atom_concat([Dir,A,File],NFile),
diff --git a/pl/debug.yap b/pl/debug.yap
index 26b0aa039..abab79763 100644
--- a/pl/debug.yap
+++ b/pl/debug.yap
@@ -57,9 +57,9 @@
 	!,
 	'$do_suspy_predicates_by_name'(NA,S,EM).
 '$suspy_predicates_by_name'(A,spy,M) :- !,
-	'$print_message'(warning,no_match(spy(M:A))).
+	print_message(warning,no_match(spy(M:A))).
 '$suspy_predicates_by_name'(A,nospy,M) :-
-	'$print_message'(warning,no_match(nospy(M:A))).
+	print_message(warning,no_match(nospy(M:A))).
 	
 '$do_suspy_predicates_by_name'(A,S,M) :-
 	current_predicate(A,M:T),
@@ -81,9 +81,9 @@
 '$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(spy(M:F/N)))
 	 ;
-	     '$print_message'(warning,no_match(nospy(M:F/N)))
+	     print_message(warning,no_match(nospy(M:F/N)))
 	 ).
 '$do_suspy'(S, F, N, T, M) :-
 	 '$system_predicate'(T,M),
@@ -97,27 +97,27 @@
 '$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(spy(M:F/N)))
 	 ;
-	     '$print_message'(warning,no_match(nospy(M:F/N)))
+	     print_message(warning,no_match(nospy(M:F/N)))
 	 ).
 '$do_suspy'(S,F,N,T,M) :-
 	'$suspy2'(S,F,N,T,M).
 
 '$suspy2'(spy,F,N,T,M) :- 
 	recorded('$spy','$spy'(T,M),_), !,
-	'$print_message'(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)).
+	print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)).
 '$suspy2'(spy,F,N,T,M) :- !,
 	recorda('$spy','$spy'(T,M),_), 
 	'$set_spy'(T,M),
-	'$print_message'(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)).
+	print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)).
 '$suspy2'(nospy,F,N,T,M) :- 
 	recorded('$spy','$spy'(T,M),R), !,
 	erase(R),
 	'$rm_spy'(T,M),
-	'$print_message'(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),remove,last)).
+	print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),remove,last)).
 '$suspy2'(nospy,F,N,_,M) :-
-	'$print_message'(informational,breakp(no,breakpoint_for,M:F/N)).
+	print_message(informational,breakp(no,breakpoint_for,M:F/N)).
 
 '$pred_being_spied'(G, M) :-
 	recorded('$spy','$spy'(G,M),_), !.
@@ -140,7 +140,7 @@ nospyall.
 
 debug :-
 	'$start_debugging'(on),
-	'$print_message'(informational,debug(debug)).
+	print_message(informational,debug(debug)).
 
 '$start_debugging'(Mode) :-
 	nb_setval('$debug',Mode),
@@ -149,7 +149,7 @@ debug :-
 nodebug :-
 	nb_setval('$debug',off),
 	nb_setval('$trace',off),
-	'$print_message'(informational,debug(off)).
+	print_message(informational,debug(off)).
 
  %
  % remove any debugging info after an abort.
@@ -160,7 +160,7 @@ trace :-
 trace :-
 	nb_setval('$trace',on),
 	'$start_debugging'(on),
-	'$print_message'(informational,debug(trace)),
+	print_message(informational,debug(trace)),
 	'$creep'.
 
 notrace :-
@@ -183,13 +183,13 @@ leash(X) :-
 	'$do_error'(type_error(leash_mode,X),leash(X)).
 
 '$show_leash'(Msg,0) :-
-	'$print_message'(Msg,leash([])).
+	print_message(Msg,leash([])).
 '$show_leash'(Msg,Code) :-
 	'$check_leash_bit'(Code,0x8,L3,call,LF),
 	'$check_leash_bit'(Code,0x4,L2,exit,L3),
 	'$check_leash_bit'(Code,0x2,L1,redo,L2),
 	'$check_leash_bit'(Code,0x1,[],fail,L1),
-	'$print_message'(Msg,leash(LF)).
+	print_message(Msg,leash(LF)).
 
 '$check_leash_bit'(Code,Bit,L0,_,L0) :- Bit /\ Code =:= 0, !.
 '$check_leash_bit'(_,_,L0,Name,[Name|L0]).
@@ -224,12 +224,12 @@ leash(X) :-
 
 debugging :-
 	( nb_getval('$debug',on) ->
-	    '$print_message'(help,debug(debug))
+	    print_message(help,debug(debug))
 	    ;
-	    '$print_message'(help,debug(off))
+	    print_message(help,debug(off))
 	),
 	findall(M:(N/A),(recorded('$spy','$spy'(T,M),_),functor(T,N,A)),L),
-	'$print_message'(help,breakpoints(L)),
+	print_message(help,breakpoints(L)),
 	get_value('$leash',Leash),
 	'$show_leash'(help,Leash).
 
@@ -667,7 +667,7 @@ debugging :-
 	(
 	  History == []
 	->
-	  '$print_message'(help, ancestors([]))
+	  print_message(help, ancestors([]))
 	;
 	  '$show_ancestors'(History,HowMany),
 	  nl(user_error)
@@ -708,8 +708,8 @@ debugging :-
 	format(user_error,'! g execute goal~n', []).
 	
 '$ilgl'(C) :-
-	'$print_message'(warning, trace_command(C)),
-	'$print_message'(help, trace_help),
+	print_message(warning, trace_command(C)),
+	print_message(help, trace_help),
 	fail.
 
 '$skipeol'(10) :- !.
diff --git a/pl/errors.yap b/pl/errors.yap
index 848327e2e..b65f8c693 100644
--- a/pl/errors.yap
+++ b/pl/errors.yap
@@ -11,8 +11,12 @@
 * File:		errors.yap						 *
 * comments:	error messages for YAP					 *
 *									 *
-* Last rev:     $Date: 2008-01-23 17:57:55 $,$Author: vsc $						 *
+* Last rev:     $Date: 2008-02-22 15:08:37 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.84  2008/01/23 17:57:55  vsc
+* valgrind it!
+* enable atom garbage collection.
+*
 * Revision 1.83  2007/11/26 23:43:10  vsc
 * fixes to support threads and assert correctly, even if inefficiently.
 *
@@ -172,8 +176,8 @@
 *************************************************************************/
 
 '$do_error'(Type,Message) :-
-	'$current_stack'(local_sp(_,Envs,CPs)),
-	throw(error(Type,[Message|local_sp(Message,Envs,CPs)])).
+	'$current_stack'(local_sp(_,CP,Envs,CPs)),
+	throw(error(Type,[Message|local_sp(Message,CP,Envs,CPs)])).
 
 '$Error'(E) :-
 	'$LoopError'(E,top).
@@ -195,741 +199,75 @@
 	throw('$abort').
 '$process_error'(error(Msg, Where), _) :- !,
 	'$set_fpu_exceptions',
-	'$print_message'(error,error(Msg, Where)).
+	print_message(error,error(Msg, Where)).
 '$process_error'(Throw, _) :-
 	print_message(error,Throw).
 
-print_message(Level, Mss) :-
-	'$print_message'(Level, Mss).
-
-'$print_message'(force(_Severity), Msg) :- !,
+print_message(force(_Severity), Msg) :- !,
 	print(user_error,Msg).
-'$print_message'(Severity, Msg) :-
+print_message(error, error(Msg,[Info|local_sp(P,CP,Envs,CPs)])) :- !,
+	nb_setval(sp_info,local_sp(P,CP,Envs,CPs)),
+	print_message(error, error(Msg, Info)),
+	nb_setval(sp_info,[]).
+print_message(Severity, Msg) :-
 	nonvar(Severity), nonvar(Msg),
-	\+ '$undefined'(portray_message(Severity, Msg), user),
-	user:portray_message(Severity, Msg), !.
-'$print_message'(error,error(Msg,Info)) :-
-	( var(Msg) ; var(Info) ), !,
-	format(user_error,'% YAP: no handler for error ~w~n', [error(Msg,Info)]).
-'$print_message'(error,error(syntax_error(A,B,C,D,E,F),_)) :- !,
-	'$output_error_message'(syntax_error(A,B,C,D,E,F), 'SYNTAX ERROR').
-'$print_message'(error,error(Msg,[Info|local_sp(Where,Envs,CPs)])) :-
-	'$output_error_location'('\% ERROR:'),
-	'$prepare_loc'(Info,Where,Location),
-	'$output_error_message'(Msg, Location), !,
-	'$do_stack_dump'(Envs, CPs).
-% old format: don't want a stack dump.
-'$print_message'(error,error(Type,Where)) :-
-	'$output_error_message'(Type, Where), !.
-'$print_message'(error,Throw) :-
-	format(user_error,'% YAP: no handler for error ~w~n', [Throw]).
-'$print_message'(informational,_) :-
-	 get_value('$verbose',off), !.				  
-'$print_message'(informational,M) :-
-	'$do_informational_message'(M).
-'$print_message'(warning,M) :-
-	'$output_error_location'('!! WARNING:'),
-	format(user_error, '!! ', []),
-	'$do_print_message'(M),
-	format(user_error, '~n', []).
-'$print_message'(silent,_).
-'$print_message'(help,M) :-
-	'$do_print_message'(M),
-	format(user_error, '~n', []).
-
-'$output_error_location'(MsgCodes) :-
-	nb_getval('$consulting_file',FileName),
-	FileName \= [], !,
-	'$start_line'(LN),
-	'$show_consult_level'(LC),
-	'$output_file_pos'(FileName,LN,LC,MsgCodes),
-	format(user_error, '~*|', [LC]).
-'$output_error_location'(_).
-	
-'$output_file_pos'(user_input,LN,LC,MsgCodes) :- !,
-	format(user_error,'~*|~a at user_input near line ~d,~n',[LC,MsgCodes,LN]).
-'$output_file_pos'(FileName,LN,LC,MsgCodes) :-
-	format(user_error,'~*|~a at file ~a, near line ~d,~n',[LC,MsgCodes,FileName,LN]).
-
-'$do_informational_message'(halt) :- !,
-	format(user_error, '% YAP execution halted~n', []).
-'$do_informational_message'('$abort') :- !,
-	format(user_error, '% YAP execution aborted~n', []).
-'$do_informational_message'(loading(_,user)) :- !.
-'$do_informational_message'(loading(What,AbsoluteFileName)) :- !,
-	'$show_consult_level'(LC),
-	format(user_error, '~*|% ~a ~a...~n', [LC, What, AbsoluteFileName]).
-'$do_informational_message'(loaded(_,user,_,_,_)) :- !.
-'$do_informational_message'(loaded(included,AbsoluteFileName,Mod,Time,Space)) :- !,
-	'$show_consult_level'(LC),
-	format(user_error, '~*|% ~a included in module ~a, ~d msec ~d bytes~n', [LC, AbsoluteFileName,Mod,Time,Space]).
-'$do_informational_message'(loaded(What,AbsoluteFileName,Mod,Time,Space)) :- !,
-	'$show_consult_level'(LC0),
-	LC is LC0+1,
-	format(user_error, '~*|% ~a ~a in module ~a, ~d msec ~d bytes~n', [LC, What, AbsoluteFileName,Mod,Time,Space]).
-'$do_informational_message'(prompt(BreakLevel,TraceDebug)) :- !,
-	(BreakLevel =:= 0 ->
-	    (
-	      var(TraceDebug) ->
-	      true
-	    ;
-	      format(user_error, '% ~a~n', [TraceDebug])
-	    )
-	;
-	    (
-	      var(TraceDebug) ->
-	      format(user_error, '% ~d~n', [BreakLevel])
-	    ;
-	      format(user_error, '% ~d,~a~n', [BreakLevel,TraceDebug])
+	'$notrace'(user:portray_message(Severity, Msg)), !.
+% This predicate has more hooks than a pirate ship!
+print_message(Severity, Term) :-
+	(
+	 (
+	  '$notrace'(user:generate_message_hook(Term, [], Lines)) ->
+	  true
+	 ;
+	  '$notrace'(prolog:message(Term, Lines, [])) ->
+	  true
+	 ;
+	 '$message':generate_message(Term, Lines, [])
+	 )
+	->  (   nonvar(Term),
+		'$notrace'(user:message_hook(Term, Severity, Lines))
+	    ->  !
+	    ;   !, '$print_system_message'(Term, Severity, Lines)
 	    )
 	).
-'$do_informational_message'(debug) :- !,
-	format(user_error, '% [debug]~n', []).
-'$do_informational_message'(trace) :- !,
-	format(user_error, '% [trace]~n', []).
-'$do_informational_message'(M) :-
-	format(user_error,'% ', []),
-	'$do_print_message'(M),
-	format(user_error,'~n', []).
+print_message(_, error(syntax_error(_,between(_,L,_),_,_,_,_),_)) :-  !,
+	format(user_error,'SYNTAX ERROR close to ~d~n',[L]).
+print_message(_, loading(A, F)) :- !,
+	format(user_error,'  % ~a ~a~n',[A,F]).
+print_message(_, loaded(A, F, _, Time, Space)) :- !,
+	format(user_error,'  % ~a ~a ~d bytes in ~d msecs~n',[F,A,Space,Time]).
+print_message(_, Term) :-
+	format(user_error,'~q~n',[Term]).
 
-%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
-'$do_print_message'(format(Msg, Args)) :- !,
-	format(user_error,Msg,Args).
-'$do_print_message'(ancestors([])) :- !,
-	format(user_error,'There are no ancestors.',
-	       []).	
-'$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'(breakpoints([])) :- !,
-	format(user_error,'There are no spy-points set.',
-	[]).
-'$do_print_message'(breakpoints(L)) :- !,
-	format(user_error,'Spy-points set on:', []),
-	'$print_list_of_preds'(L).
-'$do_print_message'(clauses_not_together(P)) :- !,
-	format(user_error, 'Discontiguous definition of ~q.',[P]).
-'$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)) :- !,
-	format(user_error,'Trace mode on.',[]).
-'$do_print_message'(declaration(Args,Action)) :- !,
-	format(user_error,'declaration ~w ~w.',	[Args,Action]).
-'$do_print_message'(defined_elsewhere(P,F)) :- !,
-	format(user_error, 'predicate ~q previously defined in file ~w',[P,F]).
-'$do_print_message'(import(Pred,To,From,private)) :- !,
-	format(user_error,'Importing private predicate ~w:~w to ~w.',
-	[From,Pred,To]).
-'$do_print_message'(leash([])) :- !,
-	format(user_error,'No leashing.',
-	[]).
-'$do_print_message'(leash([A|B])) :- !,
-	format(user_error,'Leashing set to ~w.',
-	[[A|B]]).
-'$do_print_message'(no) :- !,
-	format(user_error, 'no', []).
-'$do_print_message'(no_match(P)) :- !,
-	format(user_error,'No matching predicate for ~w.',
-	[P]).
-'$do_print_message'(leash([A|B])) :- !,
-	format(user_error,'Leashing set to ~w.',
-	[[A|B]]).
-'$do_print_message'(singletons(SVs,P,CLN)) :- !,
-	format(user_error, 'Singleton variable',[]),
-	'$write_svs'(SVs),
-	format(user_error, ' in ~q, clause ~d.',[P,CLN]).
-'$do_print_message'(trace_command(-1)) :- !,
-	format(user_error,'EOF is not a valid debugger command.', []).
-'$do_print_message'(trace_command(C)) :- !,
-	format(user_error,'~c is not a valid debugger command.', [C]).
-'$do_print_message'(trace_help) :- !,
-	format(user_error,'   Please enter a valid debugger command (h for help).', []).
-'$do_print_message'(version(Version)) :- !,
-	format(user_error,'YAP version ~a', [Version]).
-'$do_print_message'(myddas_version(Version)) :- !,
-	format(user_error,'MYDDAS version ~a', [Version]).
-'$do_print_message'(yes) :- !,
-	format(user_error, 'yes', []).
-'$do_print_message'(Messg) :-
-	format(user_error,'~q',Messg).
+%	print_system_message(+Term, +Level, +Lines)
+%
+%	Print the message if the user did not intecept the message.
+%	The first is used for errors and warnings that can be related
+%	to source-location.  Note that syntax errors have their own
+%	source-location and should therefore not be handled this way.
 
-'$write_svs'([H]) :- !, write(user_error,' '), '$write_svs1'([H]).
-'$write_svs'(SVs) :- write(user_error,'s '), '$write_svs1'(SVs).
-
-'$write_svs1'([H]) :- !,
-        '$write_str_in_stderr'(H).
-'$write_svs1'([H|T]) :- 
-        '$write_str_in_stderr'(H),
-        write(user_error,','),
-        '$write_svs1'(T).
-
-'$write_str_in_stderr'([]).
-'$write_str_in_stderr'([C|T]) :-
-	put(user_error,C),
-	'$write_str_in_stderr'(T).
+'$print_system_message'(_, silent, _) :- !.
+'$print_system_message'(_, informational, _) :-
+	current_prolog_flag(verbose, silent), !.
+'$print_system_message'(_, banner, _) :-
+	current_prolog_flag(verbose, silent), !.
+'$print_system_message'(Term, Level, Lines) :-
+	Term = error(syntax_error(_,_,_,_,_,_),_), !,
+	flush_output(user_output),
+	flush_output(user_error),
+	'$message':prefix(Level, LinePrefix, Stream, _, Lines), !,
+	% make sure we don't give a PC.
+	print_message_lines(Stream, LinePrefix, Lines).
+'$print_system_message'(Term, Level, Lines) :-
+	'$message':prefix(Level, Prefix, EndPrefix, Stream, LinePrefix, Lines),
+	'$message':file_location(Prefix, LinesF, Lines), !,
+	flush_output(user_output),
+	flush_output(user_error),
+	print_message_lines(Stream, LinePrefix, LinesF).
+'$print_system_message'(Error, Level, Lines) :-
+	flush_output(user_output),
+	flush_output(user_error),
+	'$message':prefix(Level, LinePrefix, Stream, LinesF, Lines), !,
+	print_message_lines(Stream, LinePrefix, LinesF).
 
 
-'$print_list_of_preds'([]).
-'$print_list_of_preds'([P|L]) :-
-	format(user_error,'~n      ~w',[P]),
-	'$print_list_of_preds'(L).
-
-'$do_stack_dump'(Envs, CPs) :-
-	'$preprocess_stack'(CPs,0, PCPs),
-	'$preprocess_stack'(Envs,0, PEnvs),
-	'$say_stack_dump'(PEnvs, PCPs),
-	'$show_cps'(PCPs),
-	'$show_envs'(PEnvs),
-	'$close_stack_dump'(PEnvs, PCPs).
-
-'$preprocess_stack'([], _, []).
-'$preprocess_stack'([_|_],40, [overflow]) :- !.
-'$preprocess_stack'([G|Gs],I, NGs) :-
-	'$pred_for_code'(G,Name,Arity,Mod,Clause),
-	I1 is I+1,
-	'$beautify_stack_goal'(Name,Arity,Mod,Clause,Gs,I1,NGs).
-	
-'$beautify_stack_goal'(_,_,_,0,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs,I,NGs).
-'$beautify_stack_goal'(Name,Arity,Module,Clause,Gs,I,NGs) :-
-	functor(G,Name,Arity),
-	'$hidden_predicate'(G,Module), !,
-	'$beautify_hidden_goal'(Name,Arity,Module,Clause,Gs,I,NGs).
-'$beautify_stack_goal'(Name,Arity,Module,Clause,Gs,I,[cl(Name,Arity,Module,Clause)|NGs]) :-
-	'$preprocess_stack'(Gs,I,NGs).
-
-
-'$beautify_hidden_goal'('$yes_no',_,_,_,_,_,[]) :- !.
-'$beautify_hidden_goal'('$do_yes_no',_,_,_,_,_,[]) :- !.
-'$beautify_hidden_goal'('$query',_,_,_,_,_,[]) :- !.
-'$beautify_hidden_goal'('$enter_top_level',_,_,_,_,_,[]) :- !.
-% The user should never know these exist.
-'$beautify_hidden_goal'('$csult',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$use_module',2,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$ensure_loaded',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$continue_with_command',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$spycall_stdpred',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$spycalls',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$spycall',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$do_spy',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$spy',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$do_creep_execute',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$creep_execute',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$direct_spy',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$system_catch',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$execute_command',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$process_directive',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$catch',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$loop',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$consult',3,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$reconsult',_,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$undefp',1,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$use_module',2,prolog,_,Gs,I,NGs) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$repeat',0,prolog,ClNo,Gs,I,[cl(repeat,0,prolog,ClNo)|NGs]) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$recorded_with_key',3,prolog,ClNo,Gs,I,[cl(recorded,3,prolog,ClNo)|NGs]) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$consult',3,prolog,ClNo,Gs,I,[cl(consult,1,prolog,ClNo)|NGs]) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$findall_with_common_vars',_,prolog,ClNo,Gs,I,[cl(findall,4,prolog,ClNo)|NGs]) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$findall',_,prolog,ClNo,Gs,I,[cl(findall,4,prolog,ClNo)|NGs]) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$bagof',_,prolog,ClNo,Gs,I,[cl(bagof,3,prolog,ClNo)|NGs]) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$listing',_,prolog,ClNo,Gs,I,[cl(listing,1,prolog,ClNo)|NGs]) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$call',Args,prolog,ClNo,Gs,I,[cl(call,Args,prolog,ClNo)|NGs]) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$current_predicate',Args,prolog,ClNo,Gs,I,[cl(current_predicate,Args,prolog,ClNo)|NGs]) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$list_clauses',_,prolog,ClNo,Gs,I,[cl(listing,1,prolog,ClNo)|NGs]) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'('$use_module',1,prolog,ClNo,Gs,I,[cl(use_module,1,prolog,ClNo)|NGs]) :- !,
-	'$preprocess_stack'(Gs, I, NGs).
-'$beautify_hidden_goal'(Name,Args,Mod,ClNo,Gs,I,[cl(Name,Args,Mod,ClNo)|NGs]) :-
-	'$preprocess_stack'(Gs, I, NGs).
-
-
-'$say_stack_dump'([], []) :- !.
-'$say_stack_dump'(_, _) :-
-	format(user_error,'% Stack dump for error:', []).
-	
-'$close_stack_dump'([], []) :- !.
-'$close_stack_dump'(_, _) :-
-	format(user_error,'~n', []).
-	
-'$show_cps'([]) :- !.
-'$show_cps'(List) :-
-	format(user_error,'%  ~n   choice-points (goals with alternatives left):',[]),
-        '$print_stack'(List).
-
-'$show_envs'([]) :- !.
-'$show_envs'(List) :-
-	format(user_error,'%  ~n   environments (partially executed clauses):',[]),
-        '$print_stack'(List).
-
-'$prepare_loc'(Info,Where,Location) :- integer(Where), !,
-	'$pred_for_code'(Where,Name,Arity,Mod,Clause),
-	'$construct_code'(Clause,Name,Arity,Mod,Info,Location).
-'$prepare_loc'(Info,_,Info).
-
-'$print_stack'([]).
-'$print_stack'([overflow]) :- !,
-	format(user_error,'~n%	...',[]).
-'$print_stack'([cl(Name,Arity,Mod,Clause)|List]) :-
-	'$show_goal'(Clause,Name,Arity,Mod),
-	'$print_stack'(List).
-
-'$show_goal'(-1,Name,Arity,Mod) :- !,
-	format('~n%      ~a:~a/~d at indexing code',[Mod,Name,Arity]).
-'$show_goal'(0,_,_,_) :- !.
-'$show_goal'(I,Name,Arity,Mod) :-
-	format(user_error,'~n%      ~a:~a/~d at clause ~d',[Mod,Name,Arity,I]).
-
-'$construct_code'(-1,Name,Arity,Mod,Where,Location) :- !,
-	number_codes(Arity,ArityCode),
-	atom_codes(ArityAtom,ArityCode),
-	atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' at indexing code'],Location).
-'$construct_code'(0,_,_,_,Location,Location) :- !.
-'$construct_code'(Cl,Name,Arity,Mod,Where,Location) :-
-	number_codes(Arity,ArityCode),
-	atom_codes(ArityAtom,ArityCode),
-	number_codes(Cl,ClCode),
-	atom_codes(ClAtom,ClCode),
-	atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' (clause ',ClAtom,')'],Location).
-
-'$output_error_message'(consistency_error(Who),Where) :-
-	format(user_error,'% CONSISTENCY ERROR- ~w ~w~n',
-	[Who,Where]).
-'$output_error_message'(context_error(Goal,Who),Where) :-
-	format(user_error,'% CONTEXT ERROR- ~w: ~w appeared in ~w~n',
-	[Goal,Who,Where]).
-'$output_error_message'(domain_error(array_overflow,Opt), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: invalid index ~w for array~n',
-	[Where,Opt]).
-'$output_error_message'(domain_error(array_type,Opt), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: invalid static array type ~w~n',
-	[Where,Opt]).
-'$output_error_message'(domain_error(builtin_procedure,P), P) :-
-	format(user_error,'% DOMAIN ERROR- non-iso built-in procedure  ~w~n',
-	[P]).
-'$output_error_message'(domain_error(character_code_list,Opt), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: invalid list of codes ~w~n',
-	[Where,Opt]).
-'$output_error_message'(domain_error(delete_file_option,Opt), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: invalid list of options ~w~n',
-	[Where,Opt]).
-'$output_error_message'(domain_error(encoding,Opt), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: invalid encoding ~w~n',
-	[Where,Opt]).
-'$output_error_message'(domain_error(operator_specifier,Op), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: invalid operator specifier ~w~n',
-	[Where,Op]).
-'$output_error_message'(domain_error(out_of_range,Value), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: expression ~w is out of range~n',
-	[Where,Value]).
-'$output_error_message'(domain_error(close_option,Opt), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: invalid close option ~w~n',
-	[Where,Opt]).
-'$output_error_message'(domain_error(radix,Opt), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: invalid radix ~w~n',
-	[Where,Opt]).
-'$output_error_message'(domain_error(shift_count_overflow,Opt), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: shift count overflow in ~w~n',
-	[Where,Opt]).
-'$output_error_message'(domain_error(flag_value,F+V), W) :-
-	format(user_error,'% DOMAIN ERROR- ~w: invalid value ~w for flag ~w~n',
-	[W,V,F]).
-'$output_error_message'(domain_error(io_mode,N), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: invalid io mode ~w~n',
-	[Where,N]).
-'$output_error_message'(domain_error(mutable,N), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: invalid mutable ~w~n',
-	[Where,N]).
-'$output_error_message'(domain_error(module_decl_options,N), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: expect module declaration options, found ~w~n',
-	[Where,N]).
-'$output_error_message'(domain_error(not_empty_list,_), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: found empty list~n',
-	[Where]).
-'$output_error_message'(domain_error(not_less_than_zero,N), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: number ~w less than zero~n',
-	[Where,N]).
-'$output_error_message'(domain_error(not_newline,N), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: number ~w not newline~n',
-	[Where,N]).
-'$output_error_message'(domain_error(not_zero,N), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w is not allowed in the domain ~n',
-	[Where,N]).
-'$output_error_message'(domain_error(operator_priority,N), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w invalid operator priority~n',
-	[Where,N]).
-'$output_error_message'(domain_error(operator_specifier,N), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w invalid operator specifier~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) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w invalid option to read~n',
-	[Where,N]).
-'$output_error_message'(domain_error(semantics_indicator,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected predicate indicator, got ~w~n',
-	[Where,W]).
-'$output_error_message'(domain_error(source_sink,N), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w is not a source sink term~n',
-	[Where,N]).
-'$output_error_message'(domain_error(stream,What), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream~n',
-	[Where,What]).
-'$output_error_message'(domain_error(stream_or_alias,What), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream~n',
-	[Where,What]).
-'$output_error_message'(domain_error(stream_option,What), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream option~n',
-	[Where,What]).
-'$output_error_message'(domain_error(stream_position,What), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream position~n',
-	[Where,What]).
-'$output_error_message'(domain_error(stream_property,What), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream property~n',
-	[Where,What]).
-'$output_error_message'(domain_error(syntax_error_handler,What), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w not a syntax error handler~n',
-	[Where,What]).
-'$output_error_message'(domain_error(thread_create_option,Option+Opts), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w not in ~w~n',
-	[Where,Option, Opts]).
-'$output_error_message'(domain_error(time_out_spec,What), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w not a valid specification for a time out~n',
-	[Where,What]).
-'$output_error_message'(domain_error(unimplemented_option,What), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w not yet implemented~n',
-	[Where,What]).
-'$output_error_message'(domain_error(write_option,N), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: ~w invalid option to write~n',
-	[Where,N]).
-'$output_error_message'(domain_error(table,P), Where) :-
-	format(user_error,'% DOMAIN ERROR- ~w: non-tabled procedure ~w~n',
-	[Where,P]).
-'$output_error_message'(existence_error(array,F), W) :-
-	format(user_error,'% EXISTENCE ERROR- ~w could not open array ~w~n',
-	[W,F]).
-'$output_error_message'(existence_error(file,F), W) :-
-	format(user_error,'% EXISTENCE ERROR- ~w could not open file ~w~n',
-	[W,F]).
-'$output_error_message'(existence_error(library,F), W) :-
-	format(user_error,'% EXISTENCE ERROR- ~w could not open library ~w~n',
-	[W,F]).
-'$output_error_message'(existence_error(message_queue,F), W) :-
-	format(user_error,'% EXISTENCE ERROR- ~w could not open message queue ~w~n',
-	[W,F]).
-'$output_error_message'(existence_error(mutex,F), W) :-
-	format(user_error,'% EXISTENCE ERROR- ~w could not open mutex ~w~n',
-	[W,F]).
-'$output_error_message'(existence_error(procedure,P), context(Call,Parent)) :-
-	format(user_error,'% EXISTENCE ERROR- procedure ~w is undefined, called from context  ~w~n%                  Goal was ~w~n',
-	[P,Parent,Call]).
-'$output_error_message'(existence_error(source_sink,F), W) :-
-	format(user_error,'% EXISTENCE ERROR- ~w could not find file ~w~n',
-	[W,F]).
-'$output_error_message'(existence_error(stream,Stream), Where) :-
-	format(user_error,'% EXISTENCE ERROR- ~w: ~w not an open stream~n',
-	[Where,Stream]).
-'$output_error_message'(existence_error(thread,Thread), Where) :-
-	format(user_error,'% EXISTENCE ERROR- ~w: ~w not a running thread~n',
-	[Where,Thread]).
-'$output_error_message'(evaluation_error(int_overflow), Where) :-
-	format(user_error,'% INTEGER OVERFLOW ERROR- ~w~n',
-	[Where]).
-'$output_error_message'(evaluation_error(float_overflow), Where) :-
-	format(user_error,'% FLOATING POINT OVERFLOW ERROR- ~w~n',
-	[Where]).
-'$output_error_message'(evaluation_error(undefined), Where) :-
-	format(user_error,'% UNDEFINED ARITHMETIC RESULT ERROR- ~w~n',
-	[Where]).
-'$output_error_message'(evaluation_error(underflow), Where) :-
-	format(user_error,'% UNDERFLOW ERROR- ~w~n',
-	[Where]).
-'$output_error_message'(evaluation_error(float_underflow), Where) :-
-	format(user_error,'% FLOATING POINT UNDERFLOW ERROR- ~w~n',
-	[Where]).
-'$output_error_message'(evaluation_error(zero_divisor), Where) :-
-	format(user_error,'% ZERO DIVISOR ERROR- ~w~n',
-	[Where]).
-'$output_error_message'(instantiation_error, Where) :-
-	format(user_error,'% INSTANTIATION ERROR- ~w: expected bound value~n',
-	[Where]).
-'$output_error_message'(operating_system_error, Where) :-
-	format(user_error,'% OPERATING SYSTEM ERROR- ~w~n',
-	[Where]).
-'$output_error_message'(out_of_heap_error, Where) :-
-	format(user_error,'% OUT OF DATABASE SPACE ERROR- ~w~n',
-	[Where]).
-'$output_error_message'(out_of_stack_error, Where) :-
-	format(user_error,'% OUT OF STACK SPACE ERROR- ~w~n',
-	[Where]).
-'$output_error_message'(out_of_trail_error, Where) :-
-	format(user_error,'% OUT OF TRAIL SPACE ERROR- ~w~n',
-	[Where]).
-'$output_error_message'(out_of_attvars_error, Where) :-
-	format(user_error,'% OUT OF STACK SPACE ERROR- ~w~n',
-	[Where]).
-'$output_error_message'(out_of_auxspace_error, Where) :-
-	format(user_error,'% OUT OF AUXILIARY STACK SPACE ERROR- ~w~n',
-	[Where]).
-'$output_error_message'(permission_error(access,private_procedure,P), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot see clauses for ~w~n',
-	[Where,P]).
-'$output_error_message'(permission_error(access,static_procedure,P), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot access static procedure ~w~n',
-	[Where,P]).
-'$output_error_message'(permission_error(alias,new,P), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot create alias ~w~n',
-	[Where,P]).
-'$output_error_message'(permission_error(create,array,P), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot create array ~w~n',
-	[Where,P]).
-'$output_error_message'(permission_error(create,mutex,P), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot create mutex ~a~n',
-	[Where,P]).
-'$output_error_message'(permission_error(create,message_queue,P), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot create message queue ~a~n',
-	[Where,P]).
-'$output_error_message'(permission_error(create,operator,P), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot create operator ~w~n',
-	[Where,P]).
-'$output_error_message'(permission_error(input,binary_stream,Stream), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot read from binary stream ~w~n',
-	[Where,Stream]).
-'$output_error_message'(permission_error(input,closed_stream,Stream), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: trying to read from closed stream ~w~n',
-	[Where,Stream]).
-'$output_error_message'(permission_error(input,past_end_of_stream,Stream), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: past end of stream ~w~n',
-	[Where,Stream]).
-'$output_error_message'(permission_error(input,stream,Stream), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot read from ~w~n',
-	[Where,Stream]).
-'$output_error_message'(permission_error(input,text_stream,Stream), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot read from text stream ~w~n',
-	[Where,Stream]).
-'$output_error_message'(permission_error(modify,dynamic_procedure,_), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: modifying a dynamic procedure~n',
-	[Where]).
-'$output_error_message'(permission_error(modify,flag,W), _) :-
-	format(user_error,'% PERMISSION ERROR- cannot modify flag ~w~n',
-	[W]).
-'$output_error_message'(permission_error(modify,operator,W), _) :-
-	format(user_error,'% PERMISSION ERROR- T cannot declare ~w an operator~n',
-	[W]).
-'$output_error_message'(permission_error(modify,dynamic_procedure,_), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: modifying a dynamic procedure~n',
-	[Where]).
-'$output_error_message'(permission_error(modify,static_procedure,_), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: modifying a static procedure~n',
-	[Where]).
-'$output_error_message'(permission_error(modify,static_procedure_in_use,_), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: modifying a static procedure in use~n',
-	[Where]).
-'$output_error_message'(permission_error(modify,table,P), _) :-
-	format(user_error,'% PERMISSION ERROR- cannot table procedure ~w~n',
-	[P]).
-'$output_error_message'(permission_error(module,redefined,Mod), Who) :-
-	format(user_error,'% PERMISSION ERROR ~w- redefining module ~a in a different file~n',
-	[Who,Mod]).
-'$output_error_message'(permission_error(open,source_sink,Stream), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot open file ~w~n',
-	[Where,Stream]).
-'$output_error_message'(permission_error(output,binary_stream,Stream), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot write to binary stream ~w~n',
-	[Where,Stream]).
-'$output_error_message'(permission_error(output,stream,Stream), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot write to ~w~n',
-	[Where,Stream]).
-'$output_error_message'(permission_error(output,text_stream,Stream), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot write to text stream ~w~n',
-	[Where,Stream]).
-'$output_error_message'(permission_error(resize,array,P), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot resize array ~w~n',
-	[Where,P]).
-'$output_error_message'(permission_error(unlock,mutex,P), Where) :-
-	format(user_error,'% PERMISSION ERROR- ~w: cannot unlock mutex ~w~n',
-	[Where,P]).
-'$output_error_message'(representation_error(character), Where) :-
-	format(user_error,'% REPRESENTATION ERROR- ~w: expected character~n',
-	[Where]).
-'$output_error_message'(representation_error(character_code), Where) :-
-	format(user_error,'% REPRESENTATION ERROR- ~w: expected character code~n',
-	[Where]).
-'$output_error_message'(representation_error(max_arity), Where) :-
-	format(user_error,'% REPRESENTATION ERROR- ~w: number too big~n',
-	[Where]).
-'$output_error_message'(syntax_error(G,0,Msg,[],0,0), _) :- !,
-	format(user_error,'% SYNTAX ERROR: ~a',[G,Msg]).
-'$output_error_message'(syntax_error(_,_,_,Term,Pos,Start), Where) :-
-	format(user_error,'% ~w ',[Where]),
-	'$dump_syntax_error_line'(Start,Pos),
-	'$dump_syntax_error_term'(10,Pos, Term),
-	format(user_error,'.~n',[]).
-'$output_error_message'(system_error, Where) :-
-	format(user_error,'% SYSTEM ERROR- ~w~n',
-	[Where]).
-'$output_error_message'(internal_compiler_error, Where) :-
-	format(user_error,'% INTERNAL COMPILER ERROR- ~w~n',
-	[Where]).
-'$output_error_message'(system_error(Message), Where) :-
-	format(user_error,'% SYSTEM ERROR- ~w at ~w]~n',
-	[Message,Where]).
-'$output_error_message'(type_error(T,_,Err,M), _Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected ~w, got ~w~n',
-	[T,Err,M]).
-'$output_error_message'(type_error(array,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected array, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(atom,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected atom, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(atomic,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected atomic, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(byte,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected byte, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(callable,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected callable goal, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(char,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected char, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(character,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected character, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(character_code,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected character code, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(compound,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected compound, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(db_reference,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected data base reference, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(db_term,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected data base term, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(evaluable,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected evaluable term, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(float,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected float, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(in_byte,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected byte, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(in_character,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected atom character, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(in_character_code,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected character code, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(integer,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected integer, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(key,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected database key, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(leash_mode,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected modes for leash, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(list,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected list, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(number,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected number, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(pointer,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected pointer, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(predicate_indicator,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected predicate indicator, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(unsigned_byte,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected unsigned byte, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(unsigned_char,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected unsigned char, got ~w~n',
-	[Where,W]).
-'$output_error_message'(type_error(variable,W), Where) :-
-	format(user_error,'% TYPE ERROR- ~w: expected unbound variable, got ~w~n',
-	[Where,W]).
-'$output_error_message'(unknown, Where) :-
-	format(user_error,'% EXISTENCE ERROR- procedure ~w undefined~n',
-	[Where]).
-
-
-'$dump_syntax_error_line'(Position,_) :-
-	format(user_error,', near line ~d:~n',[Position]).
-
-'$dump_syntax_error_term'(0,J,L) :- !,
-	format(user_error,'~n', []),
-	'$dump_syntax_error_term'(10,J,L).
-'$dump_syntax_error_term'(_,0,L) :- !,
-	format(user_error,'~n<==== HERE ====>~n', []),
-	'$dump_syntax_error_term'(10,-1,L).
-'$dump_syntax_error_term'(_,_,[]) :- !.
-'$dump_syntax_error_term'(I,J,[T-_P|R]) :-
-	'$dump_error_token'(T),
-	I1 is I-1,
-	J1 is J-1,
-	'$dump_syntax_error_term'(I1,J1,R).
-
-'$dump_error_token'(atom(A)) :- !,
-	format(user_error,' ~a', [A]).
-'$dump_error_token'(number(N)) :- !,
-	format(user_error,' ~w', [N]).
-'$dump_error_token'(var(_,S,_)) :- !,
-	format(user_error,' ~s ', [S]).
-'$dump_error_token'(string(S)) :- !,
-	format(user_error,' ""~s""', [S]).
-'$dump_error_token'('(') :- !,
-	format(user_error,"(", []).
-'$dump_error_token'(')') :- !,
-	format(user_error," )", []).
-'$dump_error_token'(',') :- !,
-	format(user_error," ,", []).
-'$dump_error_token'(A) :-
-	format(user_error," ~a", [A]).
-
diff --git a/pl/hacks.yap b/pl/hacks.yap
new file mode 100644
index 000000000..1741d851a
--- /dev/null
+++ b/pl/hacks.yap
@@ -0,0 +1,204 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		utilities for messing around in YAP internals.		 *
+* comments:	error messages for YAP					 *
+*									 *
+* Last rev:     $Date: 2008-02-22 15:08:37 $,$Author: vsc $						 *
+*									 *
+*									 *
+*************************************************************************/
+
+:- module('$hacks',
+	  [display_stack_info/4,
+	   display_stack_info/6,
+	   display_pc/3,
+	   code_location/3]).
+
+display_stack_info(CPs,Envs,Lim,PC) :-
+	display_stack_info(CPs,Envs,Lim,CP,Lines,[]),
+	flush_output(user_output),
+	flush_output(user_error),
+	print_message_lines(user_error, '', Lines).
+
+code_location(Info,Where,Location) :-
+	integer(Where) , !,
+	'$pred_for_code'(Where,Name,Arity,Mod,Clause),
+	construct_code(Clause,Name,Arity,Mod,Info,Location).
+code_location(Info,_,Info).
+
+construct_code(-1,Name,Arity,Mod,Where,Location) :- !,
+	number_codes(Arity,ArityCode),
+	atom_codes(ArityAtom,ArityCode),
+	atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' at indexing code'],Location).
+construct_code(0,_,_,_,Location,Location) :- !.
+construct_code(Cl,Name,Arity,Mod,Where,Location) :-
+	number_codes(Arity,ArityCode),
+	atom_codes(ArityAtom,ArityCode),
+	number_codes(Cl,ClCode),
+	atom_codes(ClAtom,ClCode),
+	atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' (clause ',ClAtom,')'],Location).
+
+'$prepare_loc'(Info,Where,Location) :- integer(Where), !,
+	'$pred_for_code'(Where,Name,Arity,Mod,Clause),
+	'$construct_code'(Clause,Name,Arity,Mod,Info,Location).
+'$prepare_loc'(Info,_,Info).
+
+display_pc(PC) -->
+	{ integer(PC) },
+	{ '$pred_for_code'(PC,Name,Arity,Mod,Clause) },
+	pc_code(Clause,Name,Arity,Mod).
+
+pc_code(-1,Name,Arity,Mod) --> !,
+	[ ' indexing code of ~a:~q/~d' - [Mod,Name,Arity] ].
+pc_code(Cl,Name,Arity,Mod) -->
+	{ Cl > 0 },
+	[ ' clause ~d of ~a:~q/~d' - [Cl,Mod,Name,Arity] ].
+
+
+display_stack_info(_,_,0,_) --> !.
+display_stack_info([],[],_,_) --> [].
+display_stack_info([CP|CPs],[],I,_) -->
+	show_lone_cp(CP),
+	{ I1 is I-1 },
+	display_stack_info(CPs,[],I1,_).
+display_stack_info([],[Env|Envs],I,Cont) -->
+	show_env(Env, Cont, NCont),
+	{ I1 is I-1 },
+	display_stack_info([], Envs, I1, NCont).
+display_stack_info([CP|LCPs],[Env|LEnvs],I,Cont) -->
+	continuation(Env, _, NCont, CB),
+	{ I1 is I-1 },
+	( { CP == Env, CB < CP } ->
+	    % if we follow choice-point and we cut to before choice-point
+	    % we are the same goal
+	   show_cp(CP, 'Cur'), %
+           display_stack_info(LCPs, LEnvs, I1, NCont)
+	;
+          { CP > Env } ->
+	   show_cp(CP, 'Next'),
+	   display_stack_info(LCPs,[Env|LEnvs],I1,Cont)
+	;
+	   show_env(Env,Cont,NCont),
+	   display_stack_info([CP|LCPs],LEnvs,I1,NCont)
+	).
+
+show_cp(CP, Continuation) -->
+	{ choicepoint(CP, Addr, Mod, Name, Arity, Goal, ClNo) },
+	( { Goal = (_;_) }
+          ->
+	  [ '0x~16r~t*~16+ Cur~t~d~16+ ~q:~q/~d( ? ; ? )~n'-
+		[Addr, ClNo, Mod, Name, Arity] ]
+	    ;
+	  { prolog_flag( debugger_print_options, Opts) },
+	  [ '0x~16r~t *~16+ ~a~t ~d~16+ ~q:' -
+		[Addr, Continuation, ClNo, Mod]]
+	),
+	{clean_goal(Goal,Mod,G)},
+	['~@.~q~n' -  write_term(G,Opts)].
+
+show_env(Env,Cont,NCont) -->
+	{
+	 continuation(Env, Addr, NCont, _),
+	 cp_to_predicate(Cont, Mod, Name, Arity, ClId)
+	},
+        [ '0x~16r~t  ~16+ Cur~t ~d~16+ ~q:' -
+		[Addr, ClId, Mod] ],
+	{scratch_goal(Name, Arity, Mod, G)},
+	['~@.~q~n' - write_term(G,Opts)].
+
+clean_goal(G,Mod,NG) :-
+	beautify_hidden_goal(G,Mod,[NG],[]), !.
+clean_goal(G,_,G).
+
+scratch_goal(N,A,Mod,NG) :-
+	list_of_qmarks(A,L),
+	G=..[N|L],
+	beautify_hidden_goal(G,Mod,[NG],[]), !.
+
+list_of_qmarks(0,[]).
+list_of_qmarks(I,[?|L]) :-
+	I1 is I-1,
+	list_of_qmarks(I1,L).
+
+
+beautify_hidden_goal('$yes_no'(G,Query), prolog) -->
+	!,
+	{ Call =.. [(?), G] },
+	[Call].
+beautify_hidden_goal('$do_yes_no'(G,Mod), prolog) -->
+	[Mod:G].
+beautify_hidden_goal('$query'(G,VarList), prolog) -->
+	[query(G,VarList)].
+beautify_hidden_goal('$enter_top_level', prolog) -->
+	['TopLevel'].
+% The user should never know these exist.
+beautify_hidden_goal('$csult'(Files,Mod),prolog) -->
+	[reconsult(Mod:Files)].
+beautify_hidden_goal('$use_module'(Files,Mod,Is),prolog) -->
+	[use_module(Mod,Files,Is)].
+beautify_hidden_goal('$continue_with_command'(reconsult,V,G,Source),prolog) -->
+	['Assert'(G,V,Source)].
+beautify_hidden_goal('$continue_with_command'(consult,V,G,Source),prolog) -->
+	['Assert'(G,V,Source)].
+beautify_hidden_goal('$continue_with_command'(top,V,G,_),prolog) -->
+	['Query'(G,V)].
+beautify_hidden_goal('$continue_with_command'(Command,V,G,Source),prolog) -->
+	['TopLevel'(Command,G,V,Source)].
+beautify_hidden_goal('$spycall'(G,M,InControl,Redo),prolog) -->
+	['DebuggerCall'(M:G, InControl, Redo)].
+beautify_hidden_goal('$do_spy'(Goal, Mod, CP, InControl),prolog) -->
+	['DebuggerCall'(Mod:Goal, InControl)].
+beautify_hidden_goal('$system_catch'(G,Mod,Exc,Handler),prolog) -->
+	[catch(Mod:G, Exc, Handler)].
+beautify_hidden_goal('$catch'(G,Exc,Handler),prolog) -->
+	[catch(G, Exc, Handler)].
+beautify_hidden_goal('$execute_command'(Query,V,Option,Source),prolog) -->
+	[toplevel_query(Query, V, Option, Source)].
+beautify_hidden_goal('$process_directive'(Gs,_,Mod),prolog) -->
+	[(:- Mod:Gs)].
+beautify_hidden_goal('$loop'(Stream,Option),prolog) -->
+	[execute_load_file(Stream, consult=Option)].
+beautify_hidden_goal('$load_files'(Files,Opts,?),prolog) -->
+	[load_files(Files,Opts)].
+beautify_hidden_goal('$load_files'(_,_,Name),prolog) -->
+	[Name].
+beautify_hidden_goal('$reconsult'(Files,Mod),prolog) -->
+	[reconsult(Mod:Files)].
+beautify_hidden_goal('$undefp'([M|G]),prolog) -->
+	['CallUndefined'(Mod:G)].
+beautify_hidden_goal('$undefp'(?),prolog) -->
+	['CallUndefined'(?:?)].
+beautify_hidden_goal(repeat,prolog) -->
+	[repeat].
+beautify_hidden_goal('$recorded_with_key'(A,B,C),prolog) -->
+	recorded(A,B,C).
+beautify_hidden_goal('$findall_with_common_vars'(Templ,Gen,Answ),prolog) -->
+	[findall(Templ,Gen,Answ)].
+beautify_hidden_goal('$bagof'(Templ,Gen,Answ),prolog) -->
+	[bagof(Templ,Gen,Answ)].
+beautify_hidden_goal('$setof'(Templ,Gen,Answ),prolog) -->
+	[setof(Templ,Gen,Answ)].
+beautify_hidden_goal('$findall'(T,G,S,A),prolog) -->
+	[findall(T,G,S,A)].
+beautify_hidden_goal('$listing'(G,M,_Stream),prolog) -->
+	[listing(M:G)].
+beautify_hidden_goal('$call'(G,CP,?,M),prolog) -->
+	[call(M:G)].
+beautify_hidden_goal('$call'(G,CP,G0,M),prolog) -->
+	[call(M:G0)].
+beautify_hidden_goal('$current_predicate'(M,Na,Ar),prolog) -->
+	[current_predicate(M,Na/Ar)].
+beautify_hidden_goal('$current_predicate_for_atom'(M,Na,Ar),prolog) -->
+	[current_predicate(M,Na/Ar)].
+beautify_hidden_goal('$list_clauses'(Stream,M,Pred),prolog) -->
+	[listing(M:Pred)].
+
+
diff --git a/pl/init.yap b/pl/init.yap
index 483f62c12..b841125ea 100644
--- a/pl/init.yap
+++ b/pl/init.yap
@@ -91,6 +91,12 @@ system_mode(verbose,off) :- set_value('$verbose',off).
 :- 	['corout.yap',
 	 'arrays.yap'].
 
+:- use_module('messages.yap').
+:- use_module('hacks.yap').
+
+'$system_module'('$message').
+'$system_module'('$hacks').
+
 yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
 
 :- '$change_type_of_char'(36,7). % Make $ a symbol character
@@ -101,15 +107,6 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
 
 :- dynamic user:library_directory/1.
 
-:-  (
-     prolog:'$system_library_directories'(D),
-     write(D),nl,
-     assert(user:library_directory(D)),
-     fail
-    ;
-     true
-    ).
-
 %
 % cleanup ensure loaded and recover some data-base space.
 %
@@ -128,6 +125,10 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
 
 :- system_mode(verbose,on).
 
+:- multifile prolog:message/3.
+
+:- dynamic prolog:message/3.
+
 :- module(user).
 
 :- multifile goal_expansion/3.
@@ -142,6 +143,10 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
 
 :- dynamic file_search_path/2.
 
+:- multifile generate_message_hook/3.
+
+:- dynamic generate_message_hook/3.
+
 file_search_path(library, Dir) :-
 	library_directory(Dir).
 file_search_path(swi, Home) :-
diff --git a/pl/messages.yap b/pl/messages.yap
new file mode 100644
index 000000000..9cee990bf
--- /dev/null
+++ b/pl/messages.yap
@@ -0,0 +1,486 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		utilities for displaying messages in YAP.		 *
+* comments:	error messages for YAP					 *
+*									 *
+* Last rev:     $Date: 2008-02-22 15:08:37 $,$Author: vsc $						 *
+*									 *
+*									 *
+*************************************************************************/
+
+:- module('$message',
+	  [system_message/4,
+	   prefix/6,
+	   prefix/5,
+	   file_location/3]).
+
+file_location(Prefix) -->
+	{
+	 nb_getval('$consulting_file',FileName),
+	 FileName \= []
+	 },
+	{ '$start_line'(LN) },
+	file_position(FileName,LN,Prefix),
+	[ nl ].
+
+file_position(user_input,LN,MsgCodes) -->
+	[ '~a at user_input near line ~d.' - [MsgCodes,LN] ].
+file_position(FileName,LN,MsgCodes) -->
+	[ '~a at file ~a, near line ~d.' - [MsgCodes,FileName,LN] ].
+
+generate_message(halt) --> !,
+	['YAP execution halted'].
+generate_message('$abort') :- !,
+	['YAP execution aborted'].
+generate_message(loading(_,user)) --> !.
+generate_message(loading(What,AbsoluteFileName)) --> !,
+	[ '~a ~a...' - [What, AbsoluteFileName] ].
+generate_message(loaded(_,user,_,_,_)) --> !.
+generate_message(loaded(included,AbsoluteFileName,Mod,Time,Space)) --> !,
+	[ '~a included in module ~a, ~d msec ~d bytes' - [AbsoluteFileName,Mod,Time,Space] ].
+generate_message(loaded(What,AbsoluteFileName,Mod,Time,Space)) --> !,
+	[ '~a ~a in module ~a, ~d msec ~d bytes' - [What, AbsoluteFileName,Mod,Time,Space] ].
+generate_message(prompt(BreakLevel,TraceDebug)) --> !,
+	( { BreakLevel =:= 0 } ->
+	    (
+	     { var(TraceDebug) } ->
+	     []
+	    ;
+	     [ '~a' - [TraceDebug] ]
+	    )
+	;
+	    (
+	     var(TraceDebug) ->
+	     [ '~d' - [BreakLevel] ]
+	    ;
+	     [ '~d ~a' - [BreakLevel, TraceDebug] ]
+	    )
+	).
+generate_message(debug) --> !,
+	[ debug ].
+generate_message(trace) --> !,
+	[ trace ].
+generate_message(M) -->
+	system_message(M),
+	stack_dump(M).
+
+stack_dump(error(_,_)) -->
+	{ nb_getval(sp_info,local_sp(P,CP,Envs,CPs)) },
+	{ Envs = [_|_] ; CPs = [_|_] }, !,
+	[nl],
+	'$hacks':display_stack_info(CPs, Envs, 20, CP).
+stack_dump(_) --> [].
+
+%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
+system_message(format(Msg, Args)) -->
+	[Msg - Args].
+system_message(ancestors([])) -->
+	[ 'There are no ancestors.' ].
+system_message(breakp(bp(debugger,_,_,M:F/N,_),add,already)) -->
+	[ 'There is already a spy point on ~w:~w/~w.' - [M,F,N]].
+system_message(breakp(bp(debugger,_,_,M:F/N,_),add,ok)) -->
+	[ 'Spy point set on ~w:~w/~w.' - [M,F,N] ].
+system_message(breakp(bp(debugger,_,_,M:F/N,_),remove,last)) -->
+	[ 'Spy point on ~w:~w/~w removed.' - [M,F,N] ].
+system_message(breakp(no,breakpoint_for,M:F/N)) -->
+	[ 'There is no spy point on ~w:~w/~w.' - [M,F,N]].
+system_message(breakpoints([])) -->
+	[ 'There are no spy-points set.' ].
+system_message(breakpoints(L)) -->
+	[ 'Spy-points set on:' ],
+	list_of_preds(L).
+system_message(clauses_not_together(P)) -->
+	[ 'Discontiguous definition of ~q.' - [P] ].
+system_message(debug(debug)) -->
+	[ 'Debug mode on.' ].
+system_message(debug(off)) -->
+	[ 'Debug mode off.' ].
+system_message(debug(trace)) -->
+	[ 'Trace mode on.' ].
+system_message(declaration(Args,Action)) -->
+	[ 'declaration ~w ~w.',	[Args,Action] ].
+system_message(defined_elsewhere(P,F)) -->
+	[  'predicate ~q previously defined in file ~w' - [P,F] ].
+system_message(import(Pred,To,From,private)) -->
+	[ 'Importing private predicate ~w:~w to ~w.' - [From,Pred,To] ].
+system_message(leash([])) -->
+	[ 'No leashing.' ].
+system_message(leash([A|B])) -->
+	[ 'Leashing set to ~w.' - [[A|B]] ].
+system_message(no) -->
+	[ 'no'  ].
+system_message(no_match(P)) -->
+	[ 'No matching predicate for ~w.' - [P] ].
+system_message(leash([A|B])) -->
+	[ 'Leashing set to ~w.' - [[A|B]] ].
+system_message(singletons([SV],P,CLN)) -->
+	[ 'Singleton variable ~s in ~q, clause ~d.' - [SV,P,CLN] ].
+system_message(singletons(SVs,P,CLN)) -->
+	[  'Singleton variables ~s in ~q, clause ~d.' - [SVsL, P, CLN] ],
+	{ svs(SVs,SVsL,[]) }.
+system_message(trace_command(-1)) -->
+	[ 'EOF is not a valid debugger command.'  ].
+system_message(trace_command(C)) -->
+	[ '~c is not a valid debugger command.' - [C] ].
+system_message(trace_help) -->
+	[ '   Please enter a valid debugger command (h for help).'  ].
+system_message(version(Version)) -->
+	[ 'YAP version ~a' - [Version] ].
+system_message(myddas_version(Version)) -->
+	[ 'MYDDAS version ~a' - [Version] ].
+system_message(yes) -->
+	[  'yes'  ].
+system_message(error,error(Msg,Info)) -->
+	( { var(Msg) } ; { var(Info)} ), !,
+	['bad error ~w' - [error(Msg,Info)]].
+system_message(error(consistency_error(Who),Where)) -->
+	[ 'CONSISTENCY ERROR- ~w ~w' - [Who,Where] ].
+system_message(error(context_error(Goal,Who),Where)) -->
+	[ 'CONTEXT ERROR- ~w: ~w appeared in ~w' - [Goal,Who,Where] ].
+system_message(error(domain_error(DomainType,Opt), Where)) -->
+	[ 'DOMAIN ERROR- ~w: ' - Where],
+	domain_error(DomainType, Opt).
+system_message(error(existence_error(procedure,P), context(Call,Parent))) --> !,
+	[ 'EXISTENCE ERROR- procedure ~w is undefined, called from context  ~w~n                 Goal was ~w' - [P,Parent,Call] ].
+system_message(error(existence_error(stream,Stream), Where)) -->
+	[ 'EXISTENCE ERROR- ~w: ~w not an open stream' - [Where,Stream] ].
+system_message(error(existence_error(thread,Thread), Where)) -->
+	[ 'EXISTENCE ERROR- ~w: ~w not a running thread' - [Where,Thread] ].
+system_message(error(existence_error(Name,F), W)) -->
+	{ object_name(Name, ObjName) },
+	[ 'EXISTENCE ERROR- ~w could not open ~a ~w' - [W,ObjName,F] ].
+system_message(error(evaluation_error(int_overflow), Where)) -->
+	[ 'INTEGER OVERFLOW ERROR- ~w' - [Where] ].
+system_message(error(evaluation_error(float_overflow), Where)) -->
+	[ 'FLOATING POINT OVERFLOW ERROR- ~w' - [Where] ].
+system_message(error(evaluation_error(undefined), Where)) -->
+	[ 'UNDEFINED ARITHMETIC RESULT ERROR- ~w' - [Where] ].
+system_message(error(evaluation_error(underflow), Where)) -->
+	[ 'UNDERFLOW ERROR- ~w' - [Where] ].
+system_message(error(evaluation_error(float_underflow), Where)) -->
+	[ 'FLOATING POINT UNDERFLOW ERROR- ~w' - [Where] ].
+system_message(error(evaluation_error(zero_divisor), Where)) -->
+	[ 'ZERO DIVISOR ERROR- ~w' - [Where] ].
+system_message(error(instantiation_error, Where)) -->
+	[ 'INSTANTIATION ERROR- ~w: expected bound value' - [Where] ].
+system_message(error(operating_system_error, Where)) -->
+	[ 'OPERATING SYSTEM ERROR- ~w' - [Where] ].
+system_message(error(out_of_heap_error, Where)) -->
+	[ 'OUT OF DATABASE SPACE ERROR- ~w' - [Where] ].
+system_message(error(out_of_stack_error, Where)) -->
+	[ 'OUT OF STACK SPACE ERROR- ~w' - [Where] ].
+system_message(error(out_of_trail_error, Where)) -->
+	[ 'OUT OF TRAIL SPACE ERROR- ~w' - [Where] ].
+system_message(error(out_of_attvars_error, Where)) -->
+	[ 'OUT OF STACK SPACE ERROR- ~w' - [Where] ].
+system_message(error(out_of_auxspace_error, Where)) -->
+	[ 'OUT OF AUXILIARY STACK SPACE ERROR- ~w' - [Where] ].
+system_message(error(permission_error(access,private_procedure,P), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot see clauses for ~w' - [Where,P] ].
+system_message(error(permission_error(access,static_procedure,P), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot access static procedure ~w' - [Where,P] ].
+system_message(error(permission_error(alias,new,P), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot create alias ~w' - [Where,P] ].
+system_message(error(permission_error(create,array,P), Where)) -->
+	{ object_name(Name, ObjName) },
+	[ 'PERMISSION ERROR- ~w: cannot create ~a ~w' - [Where,ObjName,P] ].
+system_message(error(permission_error(input,binary_stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot read from binary stream ~w' - [Where,Stream] ].
+system_message(error(permission_error(input,closed_stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: trying to read from closed stream ~w' - [Where,Stream] ].
+system_message(error(permission_error(input,past_end_of_stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: past end of stream ~w' - [Where,Stream] ].
+system_message(error(permission_error(input,stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot read from ~w' - [Where,Stream] ].
+system_message(error(permission_error(input,text_stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot read from text stream ~w' - [Where,Stream] ].
+system_message(error(permission_error(modify,dynamic_procedure,_), Where)) -->
+	[ 'PERMISSION ERROR- ~w: modifying a dynamic procedure' - [Where] ].
+system_message(error(permission_error(modify,flag,W), _)) -->
+	[ 'PERMISSION ERROR- cannot modify flag ~w' - [W] ].
+system_message(error(permission_error(modify,operator,W), _)) -->
+	[ 'PERMISSION ERROR- T cannot declare ~w an operator' - [W] ].
+system_message(error(permission_error(modify,dynamic_procedure,_), Where)) -->
+	[ 'PERMISSION ERROR- ~w: modifying a dynamic procedure' - [Where] ].
+system_message(error(permission_error(modify,static_procedure,_), Where)) -->
+	[ 'PERMISSION ERROR- ~w: modifying a static procedure' - [Where] ].
+system_message(error(permission_error(modify,static_procedure_in_use,_), Where)) -->
+	[ 'PERMISSION ERROR- ~w: modifying a static procedure in use' - [Where] ].
+system_message(error(permission_error(modify,table,P), _)) -->
+	[ 'PERMISSION ERROR- cannot table procedure ~w' - [P] ].
+system_message(error(permission_error(module,redefined,Mod), Who)) -->
+	[ 'PERMISSION ERROR ~w- redefining module ~a in a different file' - [Who,Mod] ].
+system_message(error(permission_error(open,source_sink,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot open file ~w' - [Where,Stream] ].
+system_message(error(permission_error(output,binary_stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot write to binary stream ~w' - [Where,Stream] ].
+system_message(error(permission_error(output,stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot write to ~w' - [Where,Stream] ].
+system_message(error(permission_error(output,text_stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot write to text stream ~w' - [Where,Stream] ].
+system_message(error(permission_error(resize,array,P), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot resize array ~w' - [Where,P] ].
+system_message(error(permission_error(unlock,mutex,P), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot unlock mutex ~w' - [Where,P] ].
+system_message(error(representation_error(character), Where)) -->
+	[ 'REPRESENTATION ERROR- ~w: expected character' - [Where] ].
+system_message(error(representation_error(character_code), Where)) -->
+	[ 'REPRESENTATION ERROR- ~w: expected character code' - [Where] ].
+system_message(error(representation_error(max_arity), Where)) -->
+	[ 'REPRESENTATION ERROR- ~w: number too big' - [Where] ].
+system_message(error(syntax_error(G,0,Msg,[],0,0), _)) -->
+	[ 'SYNTAX ERROR: ~a' - [G,Msg] ].
+system_message(error(syntax_error(_,_,_,Term,Pos,Start), Where)) -->
+	['~w' - [Where]],
+	syntax_error_line(Start,Pos),
+	syntax_error_term(10, Pos, Term),
+	[ '.' ].
+system_message(error(system_error, Where)) -->
+	[ 'SYSTEM ERROR- ~w' - [Where] ].
+system_message(error(internal_compiler_error, Where)) -->
+	[ 'INTERNAL COMPILER ERROR- ~w' - [Where] ].
+system_message(error(system_error(Message), Where)) -->
+	[ 'SYSTEM ERROR- ~w at ~w]' - [Message,Where] ].
+system_message(error(type_error(T,_,Err,M), _Where)) -->
+	[ 'TYPE ERROR- ~w: expected ~w, got ~w' - [T,Err,M] ].
+system_message(error(type_error(TE,W), Where)) -->
+	{ type_error(TE, M) }, !,
+	[ 'TYPE ERROR- ~w: expected ~a, got ~w' - [Where,M,W] ].
+system_message(error(type_error(TE,W), Where)) -->
+	[ 'TYPE ERROR- ~w: expected ~q, got ~w' - [Where,TE,W] ].
+system_message(error(unknown, Where)) -->
+	[ 'EXISTENCE ERROR- procedure ~w undefined' - [Where] ].
+system_message(Messg) -->
+	[ '~q' - Messg ].
+
+
+domain_error(array_overflow, Opt) --> !,
+	[ 'invalid static index ~w for array' - Opt ].
+domain_error(array_type, Opt) --> !,
+	[ 'invalid static array type ~w' - Opt ].
+domain_error(builtin_procedure, _) --> !,
+	[ 'non-iso built-in procedure'  ].
+domain_error(character_code_list, Opt) --> !,
+	[ 'invalid list of codes ~w' - [Opt] ].
+domain_error(close_option, Opt) --> !,
+	[ 'invalid close option ~w' - [Opt] ].
+domain_error(delete_file_option, Opt) --> !,
+	[ 'invalid list of options ~w' - [Opt] ].
+domain_error(encoding, Opt) --> !,
+	[ 'invalid encoding ~w' - [Opt] ].
+domain_error(flag_value, Opt) --> !,
+	[ 'invalid value ~w for flag ~w' - [Opt] ].
+domain_error(io_mode, Opt) --> !,
+	[ 'invalid io mode ~w' - [Opt] ].
+domain_error(mutable, Opt) --> !,
+	[ 'invalid id mutable ~w' - [Opt] ].
+domain_error(module_decl_options, Opt) --> !,
+	[ 'expect module declaration options, found ~w' - [Opt] ].
+domain_error(not_empty_list, Opt) --> !,
+	[ 'found empty list' - [Opt] ].
+domain_error(not_less_than_zero, Opt) --> !,
+	[ 'number ~w less than zero' - [Opt] ].
+domain_error(not_newline, Opt) --> !,
+	[ 'number ~w not newline' - [Opt] ].
+domain_error(not_zero, Opt) --> !,
+	[ '~w is not allowed in the domain' - [Opt] ].
+domain_error(operator_priority, Opt) --> !,
+	[ '~w invalid operator priority' - [Opt] ].
+domain_error(operator_specifier, Opt) --> !,
+	[ 'invalid operator specifier ~w' - [Opt] ].
+domain_error(out_of_range, Opt) --> !,
+	[ 'expression ~w is out of range' - [Opt] ].
+domain_error(predicate_spec, Opt) --> !,
+	[ '~w invalid predicate specifier' - [Opt] ].
+domain_error(radix, Opt) --> !,
+	[ 'invalid radix ~w' - [Opt] ].
+domain_error(read_option, Opt) --> !,
+	[ '~w invalid option to read_term' - [Opt] ].
+domain_error(semantics_indicatior, Opt) --> !,
+	[ '~w expected predicate indicator, got ~w' - [Opt] ].
+domain_error(shift_count_overflow, Opt) --> !,
+	[ 'shift count overflow in ~w' - [Opt] ].
+domain_error(source_sink, Opt) --> !,
+	[ '~w is not a source sink term' - [Opt] ].
+domain_error(stream, Opt) --> !,
+	[ '~w is not a stream' - [Opt] ].
+domain_error(stream_or_alias, Opt) --> !,
+	[ '~w is not a stream (or alias)' - [Opt] ].
+domain_error(stream_position, Opt) --> !,
+	[ '~w is not a stream position' - [Opt] ].
+domain_error(stream_property, Opt) --> !,
+	[ '~w is not a stream property' - [Opt] ].
+domain_error(syntax_error_handler, Opt) --> !,
+	[ '~w is not a syntax error handler' - [Opt] ].
+domain_error(table, Opt) --> !,
+	[ 'non-tabled procedure ~w' - [Opt] ].
+domain_error(thread_create_option, Opt) --> !,
+	[ '~w is not a thread_create option' - [Opt] ].
+domain_error(time_out_spec, Opt) --> !,
+	[ '~w is not valid specificatin for time_out' - [Opt] ].
+domain_error(unimplemented_option, Opt) --> !,
+	[ '~w is not yet implemented' - [Opt] ].
+domain_error(write_option, Opt) --> !,
+	[ '~w invalid write option' - [Opt] ].
+domain_error(Domain, Opt) -->
+	[ '~w not a valid element for ~w' - [Opt,Domain] ].
+
+
+object_name(array, array).
+object_name(atom, atom).
+object_name(atomic, atomic).
+object_name(byte, byte).
+object_name(callable, 'callable goal').
+object_name(char, char).
+object_name(character_code, 'character code').
+object_name(compound, 'compound term').
+object_name(db_reference, 'data base reference').
+object_name(evaluable, 'evaluable term').
+object_name(file, file).
+object_name(float, float).
+object_name(in_byte, byte).
+object_name(in_character, character).
+object_name(integer, integer).
+object_name(key, 'database key').
+object_name(leash_mode, 'leash mode').
+object_name(library, library).
+object_name(list, list).
+object_name(message_queue, 'message queue').
+object_name(mutex, mutex).
+object_name(number, number).
+object_name(operator, operator).
+object_name(pointer, pointer).
+object_name(predicate_indicator, 'predicate indicator').
+object_name(source_sink, file).
+object_name(unsigned_byte, 'unsigned byte').
+object_name(unsigned_char, 'unsigned char').
+object_name(variable, 'unbound variable').
+
+svs([H]) --> !, H.
+svs([H|L]) -->
+	H,
+	", ",
+	svs(L).
+
+list_of_preds([]) --> [].
+list_of_preds([P|L]) -->
+	['~q' - [P]],
+	list_of_preds(L).
+
+
+syntax_error_line(Position,_) -->
+	[', near line ~d:~n' - [Position]].
+
+syntax_error_term(0,J,L) -->
+	['~n' ],
+	syntax_error_term(10,J,L).
+syntax_error_term(_,0,L) --> !,
+	[ '~n<==== HERE ====>~n' ],
+	syntax_error_term(10,-1,L).
+syntax_error_term(_,_,[]) --> !.
+syntax_error_term(I,J,[T-_P|R]) -->
+	syntax_error_token(T),
+	{
+	 I1 is I-1,
+	 J1 is J-1
+	},
+	syntax_error_term(I1,J1,R).
+
+syntax_error_token(atom(A)) --> !,
+	[ ' ~a' - [A] ].
+syntax_error_token(number(N)) --> !,
+	[ ' ~w' - [N] ].
+syntax_error_token(var(_,S,_))  --> !,
+	[ ' ~s'  - [S] ].
+syntax_error_token(string(S)) --> !,
+	[ ' ""~s"' - [S] ].
+syntax_error_token('(') --> !,
+	[ '('  ].
+syntax_error_token(')') --> !,
+	[ ' )'  ].
+syntax_error_token(',') --> !,
+	[ ' ,' ].
+syntax_error_token(A) --> !,
+	[ ' ~a' - [A] ].
+
+
+%	print_message_lines(+Stream, +Prefix, +Lines)
+%
+%	Quintus/SICStus/SWI compatibility predicate to print message lines
+%       using  a prefix.
+
+prolog:print_message_lines(_, _, []) :- !.
+prolog:print_message_lines(S, P, [at_same_line|Lines]) :- !,
+	print_message_line(S, Lines, Rest),
+	prolog:print_message_lines(S, P, Rest).
+prolog:print_message_lines(S, P-Opts, Lines) :- !,
+	atom_concat('~N', P, Prefix),
+	format(S, Prefix, Opts),
+	print_message_line(S, Lines, Rest),
+	prolog:print_message_lines(S, P, Rest).
+prolog:print_message_lines(S, P, Lines) :-
+	atom_concat('~N', P, Prefix),
+	format(S, Prefix, []),
+	print_message_line(S, Lines, Rest),
+	prolog:print_message_lines(S, P, Rest).
+
+print_message_line(S, [flush], []) :- !,
+	flush_output(S).
+print_message_line(S, [], []) :- !,
+	nl(S).
+print_message_line(S, [nl|T], T) :- !,
+	nl(S).
+print_message_line(S, [Fmt-Args|T0], T) :- !,
+	format(S, Fmt, Args),
+	print_message_line(S, T0, T).
+print_message_line(S, [Fmt|T0], T) :-
+	format(S, Fmt, []),
+	print_message_line(S, T0, T).
+
+prefix(error,   '     ', '', user_error) -->
+	{ nb_getval(sp_info,local_sp(P,_,_,_)) },
+	[ 'ERROR at ' ],
+	'$hacks':display_pc(P), !,
+	[' !!', nl].
+prefix(error,   '     ', '', user_error) -->
+	[ 'ERROR!! ', nl ].
+prefix(warning, '% ', '', user_error) -->
+	[ 'Warning:', nl ].
+
+prefix(help,	      '',          user_error) --> [].
+prefix(query,	      '',          user_error) --> [].
+prefix(debug,	      '',          user_output) --> [].
+prefix(warning,	      '% ',      user_error) -->
+	{ thread_self(Id) },
+	(   { Id == main }
+	->  [ 'Warning: ', nl ]
+	;   ['Warning: [Thread ~d ]' - Id, nl ]
+	).
+prefix(error,	      '     ',   user_error) -->
+	{ nb_getval(sp_info,local_sp(P,_,_,_)) },
+	{ thread_self(Id) },
+	(   { Id == main }
+	->  [ 'ERROR at ' ]
+	;   [ 'ERROR [Thread ~d ] at ' - Id ]
+	),
+	'$hacks':display_pc(P),
+	!,
+	[' !!', nl].
+prefix(error,	      '     ',   user_error) -->
+	{ thread_self(Id) },
+	(   { Id == main }
+	->  [ 'ERROR!!', nl ]
+	;   [ 'ERROR!! [Thread ~d ]' - Id, nl ]
+	).
+prefix(banner,	      '',	   user_error) --> [].
+prefix(informational, '~*|% '-[LC],     user_error) -->
+	{ '$show_consult_level'(LC) }.
+
diff --git a/pl/modules.yap b/pl/modules.yap
index 0cbb2c923..432e10e0d 100644
--- a/pl/modules.yap
+++ b/pl/modules.yap
@@ -459,7 +459,8 @@ module(N) :-
 '$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L).
 
 current_module(Mod) :-
-	'$all_current_modules'(Mod).
+	'$all_current_modules'(Mod),
+	\+ '$system_module'(Mod).
 
 current_module(Mod,TFN) :-
 	'$all_current_modules'(Mod),
diff --git a/pl/preds.yap b/pl/preds.yap
index 90b7e3b0c..7b40c1aa8 100644
--- a/pl/preds.yap
+++ b/pl/preds.yap
@@ -665,7 +665,7 @@ abolish(X) :-
 	'$access_yap_flags'(8, 2), % only do this in sicstus mode
 	'$undefined'(G, Module),
 	functor(G,Name,Arity),
-	'$print_message'(warning,no_match(abolish(Module:Name/Arity))).
+	print_message(warning,no_match(abolish(Module:Name/Arity))).
 % I cannot allow modifying static procedures in YAPOR
 % this code has to be here because of abolish/2
 '$abolishs'(G, Module) :-
@@ -973,4 +973,8 @@ current_key(A,K) :-
 	'$current_immediate_key'(A,K).
 
 % do nothing for now.
-'$noprofile'(_, _).
\ No newline at end of file
+'$noprofile'(_, _).
+
+'$notrace'(G) :-
+	\+ '$undefined'(G, prolog),
+	call(G).
diff --git a/pl/threads.yap b/pl/threads.yap
index 886e8dabe..62857957c 100644
--- a/pl/threads.yap
+++ b/pl/threads.yap
@@ -26,7 +26,8 @@
 :- initialization('$init_thread0').
 
 '$init_thread0' :-
-	no_threads, !.
+	no_threads, !,
+	recorda('$thread_alias', [0|main], _).
 '$init_thread0' :-
 	'$record_thread_info'(0, main, [0, 0, 0], false, '$init_thread0'),
 	recorda('$thread_defaults', [0, 0, 0, false], _),
diff --git a/pl/utils.yap b/pl/utils.yap
index 39727344e..9f480592a 100644
--- a/pl/utils.yap
+++ b/pl/utils.yap
@@ -528,7 +528,7 @@ unknown(V0,V) :-
 '$unknown_warning'(Mod:Goal) :-
 	functor(Goal,Name,Arity),
 	'$program_continuation'(PMod,PName,PAr),
-	'$print_message'(error,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))),
+	print_message(error,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))),
 	fail.
 
 %%% Some "dirty" predicates
@@ -809,7 +809,7 @@ version(T) :-
 halt(X) :- '$halt'(X).
 
 halt :-
-	'$print_message'(informational, halt),
+	print_message(informational, halt),
 	'$halt'(0).
 
 halt(X) :-
diff --git a/pl/yio.yap b/pl/yio.yap
index 4052a6a54..5b9f1d893 100644
--- a/pl/yio.yap
+++ b/pl/yio.yap
@@ -387,7 +387,7 @@ told :- current_output(Stream), '$close'(Stream), set_output(user).
 read(T) :-
 	'$read'(false,T,_,_,_,Err),
 	(nonvar(Err) ->
-	    '$print_message'(error,Err), fail
+	    print_message(error,Err), fail
 	    ;
 	    true
 	).
@@ -395,7 +395,7 @@ read(T) :-
 read(Stream,T) :-
 	'$read'(false,T,_,_,_,Err,Stream),
 	(nonvar(Err) ->
-	    '$print_message'(error,Err), fail
+	    print_message(error,Err), fail
 	    ;
 	    true
 	).