Merge branch 'master' of gitosis@yap.dcc.fc.up.pt:yap-6

C/agc.c

@@ -187,6 +187,7 @@ AtomAdjust(Atom a)
 #define HoldEntryAdjust(P) (P)
 #define CodeCharPAdjust(P) (P)
 #define CodeVoidPAdjust(P) (P)
+#define HaltHookAdjust(P) (P)
 
 #define recompute_mask(dbr)
 

C/c_interface.c

@@ -505,6 +505,7 @@ X_API Term     STD_PROTO(YAP_TermNil,(void));
 X_API int      STD_PROTO(YAP_AtomGetHold,(Atom));
 X_API int      STD_PROTO(YAP_AtomReleaseHold,(Atom));
 X_API Agc_hook STD_PROTO(YAP_AGCRegisterHook,(Agc_hook));
+X_API int      STD_PROTO(YAP_HaltRegisterHook,(HaltHookFunc, void *));
 X_API char    *STD_PROTO(YAP_cwd,(void));
 X_API Term     STD_PROTO(YAP_OpenList,(int));
 X_API Term     STD_PROTO(YAP_ExtendList,(Term, Term));
@@ -2957,6 +2958,12 @@ YAP_AGCRegisterHook(Agc_hook hook)
   return old;
 } 
 
+X_API int
+YAP_HaltRegisterHook(HaltHookFunc hook, void * closure)
+{
+  return Yap_HaltRegisterHook(hook, closure);
+} 
+
 X_API char *
 YAP_cwd(void)
 {

C/init.c

@@ -1333,6 +1333,33 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s
   }
 }
 
+int
+Yap_HaltRegisterHook (HaltHookFunc f, void * env)
+{
+  struct halt_hook *h;
+
+  if (!(h = (struct halt_hook *)Yap_AllocCodeSpace(sizeof(struct halt_hook))))
+    return FALSE;
+  h->environment = env;
+  h->hook = f;
+  LOCK(BGL);
+  h->next = Yap_HaltHooks;
+  Yap_HaltHooks = h;
+  UNLOCK(BGL);
+  return TRUE;
+}
+
+static void
+run_halt_hooks(int code)
+{
+  struct halt_hook *hooke = Yap_HaltHooks;
+
+  while (hooke) {
+    hooke->hook(code, hooke->environment);
+    hooke = hooke->next;
+  }
+}
+
 void
 Yap_exit (int value)
 {
@@ -1340,15 +1367,17 @@ Yap_exit (int value)
   unmap_memory();
 #endif /* YAPOR */
 
+  if (! (Yap_PrologMode & BootMode) ) {
 #ifdef LOW_PROF
-  remove("PROFPREDS");
+    remove("PROFPREDS");
-  remove("PROFILING");
+    remove("PROFILING");
 #endif
 #if defined MYDDAS_MYSQL || defined MYDDAS_ODBC
-  Yap_MYDDAS_delete_all_myddas_structs();
+    Yap_MYDDAS_delete_all_myddas_structs();
 #endif
-  if (! (Yap_PrologMode & BootMode) )
+    run_halt_hooks(value);
     Yap_ShutdownLoadForeign();
+  }
   exit(value);
 }
 

H/YapHeap.h

@@ -62,6 +62,16 @@ typedef struct gc_ma_hash_entry_struct {
   struct gc_ma_hash_entry_struct *next;
 } gc_ma_hash_entry;
 
+typedef void (*HaltHookFunc)(int, void *);
+
+typedef struct halt_hook {
+  void * environment;
+  HaltHookFunc hook;
+  struct halt_hook *next;
+} halt_hook_entry;
+
+int	STD_PROTO(Yap_HaltRegisterHook,(HaltHookFunc, void *));
+
 typedef struct atom_hash_entry {
 #if defined(YAPOR) || defined(THREADS)
   rwlock_t AERWLock;

H/dhstruct.h

@@ -263,6 +263,8 @@
 
 #define Stream Yap_heap_regs->yap_streams
 
+#define Yap_HaltHooks Yap_heap_regs->yap_halt_hook
+
 #define NOfFileAliases Yap_heap_regs->n_of_file_aliases
 #define SzOfFileAliases Yap_heap_regs->sz_of_file_aliases
 #define FileAliases Yap_heap_regs->file_aliases

H/hstruct.h

@@ -263,6 +263,8 @@
 
   struct stream_desc  *yap_streams;
 
+  struct halt_hook  *yap_halt_hook;
+
   UInt  n_of_file_aliases;
   UInt  sz_of_file_aliases;
   struct AliasDescS  *file_aliases;

H/ihstruct.h

@@ -263,6 +263,8 @@
 
   Yap_heap_regs->yap_streams = NULL;
 
+  Yap_heap_regs->yap_halt_hook = NULL;
+
   Yap_heap_regs->n_of_file_aliases = 0;
   Yap_heap_regs->sz_of_file_aliases = 0;
   Yap_heap_regs->file_aliases = NULL;

H/rheap.h

@@ -899,6 +899,18 @@ RestoreDBErasedIList(void)
   }
 }
 
+static void
+RestoreHaltHooks(void)
+{
+  struct halt_hook *hooke = Yap_HaltHooks = HaltHookAdjust(Yap_HaltHooks);
+
+  while (hooke) {
+    hooke->next = HaltHookAdjust(hooke->next);
+    hooke = hooke->next;
+  }
+}
+
+
 static void
 RestoreStreams(void)
 {

H/rhstruct.h

@@ -263,6 +263,8 @@
 
   RestoreStreams();
 
+  RestoreHaltHooks();
+
 
 
   RestoreAliases();

H/sshift.h

@@ -610,7 +610,15 @@ CodeVoidPAdjust (void * addr)
   return addr + HDiff;
 }
 
+inline EXTERN struct halt_hook *HaltHookAdjust (struct halt_hook *);
 
+inline EXTERN struct halt_hook *
+HaltHookAdjust (struct halt_hook * addr)
+{
+  if (!addr)
+    return NULL;
+  return  (struct halt_hook *) (CharP (addr) + HDiff);
+}
 
 inline EXTERN BlockHeader *BlockAdjust (BlockHeader *);
 
@@ -620,8 +628,6 @@ BlockAdjust (BlockHeader * addr)
   return (BlockHeader *) ((BlockHeader *) (CharP (addr) + HDiff));
 }
 
-
-
 inline EXTERN yamop *PtoOpAdjust (yamop *);
 
 inline EXTERN yamop *

docs/yap.tex

@@ -1384,7 +1384,7 @@ anonymous variables.
 
 Punctuation tokens consist of one of the following characters:
 @example
-@center ( ) , [ ] @{ @} |
+( ) , [ ] @{ @} |
 @end example
 
 These characters are used to group terms.
@@ -3346,7 +3346,7 @@ Also refer to @code{copy_term/2}.
 True when @var{List} is a proper list. That is, @var{List}
 is bound to the empty list (nil) or a term with functor '.' and arity 2.
 
-@item ?@var{Term1} =@= ?@var{Term2}
+@item ?@var{Term1} =@@= ?@var{Term2}
 @findex  =@=/2
 @syindex =@=/2
 @cnindex =@=/2
@@ -4084,6 +4084,8 @@ Integer bitwise conjunction.
 Integer bitwise disjunction.
 
 @item @var{X} # @var{Y}
+@item @var{X} >< @var{Y}
+@item xor(@var{X} , @var{Y})
 Integer bitwise exclusive disjunction.
 
 @item @var{X} << @var{Y}
@@ -4467,7 +4469,9 @@ Defines extensions. Current mapping: @code{txt} implies @code{['']},
 @code{['.so', '']}, @code{qlf} implies @code{['.qlf', '']} and
 @code{directory} implies @code{['']}.  The file-type @code{source}
 is an alias for @code{prolog} for compatibility to SICStus Prolog.
-See also @code{prolog_file_type/2}.
+See also @code{prolog_file_type/2}. Notice also that this predicate only
+returns non-directories, unless the option @code{file_type(directory)} is
+specified, or unless @code{access(none)}.
 
     @item file_errors(@code{fail}/@code{error})
 If @code{error} (default), throw and @code{existence_error} exception
@@ -9515,16 +9519,6 @@ matrices are multi-dimensional and compact. In contrast to static
 arrays. these arrays are allocated in the stack. Matrices are available
 by loading the library @code{library(matrix)}.
 
-Accessing the matlab dynamic libraries can be complicated. In Linux
-machines, to use this interface, you may have to set the environment
-variable @t{LD_LIBRARY_PATH}. Next, follows an example using bash in a
-64-bit Linux PC:
-@example
-export LD_LIBRARY_PATH=''$MATLAB_HOME"/sys/os/glnxa64:''$MATLAB_HOME"/bin/glnxa64:''$LD_LIBRARY_PATH"
-@end example
-where @code{MATLAB_HOME} is the directory where matlab is installed
-at. Please replace @code{ax64} for @code{x86} on a 32-bit PC.
-
 Notice that the functionality in this library is only partial. Please
 contact the YAP maintainers if you require extra functionality.
 
@@ -9829,6 +9823,16 @@ actually use it, you need to install YAP calling @code{configure} with
 the @code{--with-matlab=DIR} option, and you need to call
 @code{use_module(library(lists))} command.
 
+Accessing the matlab dynamic libraries can be complicated. In Linux
+machines, to use this interface, you may have to set the environment
+variable @t{LD_LIBRARY_PATH}. Next, follows an example using bash in a
+64-bit Linux PC:
+@example
+export LD_LIBRARY_PATH=''$MATLAB_HOME"/sys/os/glnxa64:''$MATLAB_HOME"/bin/glnxa64:''$LD_LIBRARY_PATH"
+@end example
+where @code{MATLAB_HOME} is the directory where matlab is installed
+at. Please replace @code{ax64} for @code{x86} on a 32-bit PC.
+
 @table @code
 
 @item start_matlab(+@var{Options})
@@ -16691,6 +16695,14 @@ only two boolean flags are accepted: @code{YAPC_ENABLE_GC} and
 @code{YAPC_ENABLE_AGC}.  The first enables/disables the standard garbage
 collector, the second does the same for the atom garbage collector.`
 
+@item  @code{int} YAP_HaltRegisterHook(@code{YAP_halt_hook f, void *closure})
+@findex YAP_HaltRegisterHook (C-Interface function)
+
+Register the function @var{f} to be called if YAP is halted. The
+function is called with two arguments: the exit code of the process (@code{0}
+if this cannot be determined on your operating system) and the closure
+argument @var{closure}. 
+@c See also @code{at_halt/1}.
 @end table
 
 

include/YapInterface.h

@@ -470,6 +470,9 @@ extern X_API int  PROTO(YAP_AtomReleaseHold,(YAP_Atom));
 /*  void  YAP_AtomReleaseHold(YAP_Atom)  */
 extern X_API YAP_agc_hook  PROTO(YAP_AGCRegisterHook,(YAP_agc_hook));
 
+/*  void  YAP_AtomReleaseHold(YAP_Atom)  */
+extern X_API int  PROTO(YAP_HaltRegisterHook,(YAP_halt_hook, void *));
+
 /*  char *YAP_cwd(void)  */
 extern X_API char *  PROTO(YAP_cwd,(void));
 

include/yap_structs.h

@@ -176,6 +176,8 @@ typedef struct {
 
 typedef int  (*YAP_agc_hook)(void *_Atom);
 
+typedef void  (*YAP_halt_hook)(int exit_code, void *closure);
+
 /********* execution mode ***********************/
 
 typedef enum

library/yap2swi/yap2swi.c

@@ -3249,6 +3249,7 @@ X_API void (*PL_signal(int sig, void (*func)(int)))(int)
 
 X_API void PL_on_halt(void (*f)(int, void *), void *closure)
 {
+  Yap_HaltRegisterHook((HaltHookFunc)f,closure);
 }
 
 void Yap_swi_install(void);

misc/HEAPFIELDS

@@ -295,6 +295,9 @@ struct operator_entry	*op_list	OpList			=NULL OpListAdjust
 /* stream array */
 struct stream_desc *yap_streams		Stream			=NULL RestoreStreams()
 
+/* halt hooks */
+struct halt_hook *yap_halt_hook		Yap_HaltHooks		=NULL RestoreHaltHooks()
+
 /* stream aliases */
 UInt		n_of_file_aliases	NOfFileAliases		=0 void
 UInt		sz_of_file_aliases	SzOfFileAliases		=0 void

pl/consult.yap

@@ -834,12 +834,22 @@ absolute_file_name(File,Opts,TrueFileName) :-
 '$get_abs_file'(File,opts(_,D0,_,_,_,_,_),AbsFile) :-
 	operating_system_support:true_file_name(File,D0,AbsFile).
 
-'$search_in_path'(File,opts(Extensions,_,_,Access,_,_,_),F) :-
+'$search_in_path'(File,opts(Extensions,_,Type,Access,_,_,_),F) :-
-	'$add_extensions'(Extensions,File,F),
+	'$add_extensions'(Extensions, File, F0),
-	access_file(F,Access).
+	'$check_file'(F0, Type, Access, F).
 '$search_in_path'(File,opts(_,_,Type,Access,_,_,_),F) :-
-	'$add_type_extensions'(Type,File,F),
+	'$add_type_extensions'(Type, File, F0),
-	access_file(F,Access).
+	'$check_file'(F0, Type, Access, F).
+
+'$check_file'(F, Type, none, F) :- !.
+'$check_file'(F0, Type, Access, F0) :-
+	access_file(F0, Access),
+	(Type == directory
+	->
+	 exists_directory(F0)
+	;
+	 true
+	).
 
 '$add_extensions'([Ext|_],File,F) :-
 	'$mk_sure_true_ext'(Ext,NExt),

pl/corout.yap

@@ -60,15 +60,20 @@ attgoal_for_delay(redo_dif(Done, X, Y), V) -->
 	[prolog:dif(X,Y)].
 attgoal_for_delay(redo_freeze(Done, V, Goal), V) -->
 	{ var(Done) },  !,
-	[prolog:freeze(V,Goal)].
+	{ remove_when_declarations(Goal, NoWGoal) },
+	[ prolog:freeze(V,NoWGoal) ].
 attgoal_for_delay(redo_eq(Done, X, Y, Goal), V) -->
 	{ var(Done), first_att(Goal, V) }, !,
-	[prolog:when(X=Y,Goal)].
+	[ prolog:when(X=Y,Goal) ].
 attgoal_for_delay(redo_ground(Done, X, Goal), V) -->
 	{ var(Done) },  !,
-	[prolog:when(ground(X),Goal)].
+	[ prolog:when(ground(X),Goal) ].
 attgoal_for_delay(_, V) --> [].
 
+remove_when_declarations(when(Cond,Goal,_), when(Cond,NoWGoal)) :- !,
+	remove_when_declarations(Goal, NoWGoal).
+remove_when_declarations(Goal, Goal).
+
 				%
 % operators defined in this module:
 %
@@ -357,8 +362,8 @@ prolog:'$block'(Conds) :-
 prolog:'$block'(_).
 
 generate_blocking_code(Conds, G, Code) :-
-	'$extract_head_for_block'(Conds, G),
+	extract_head_for_block(Conds, G),
-	'$recorded'('$blocking_code','$code'(G,OldConds),R), !,
+	recorded('$blocking_code','$code'(G,OldConds),R), !,
 	erase(R),
 	functor(G, Na, Ar),
 	'$current_module'(M),

pl/preds.yap

@@ -234,7 +234,7 @@ assertz_static(C) :-
 
 '$erase_all_mf_dynamic'(Na,A,M) :-
 	get_value('$consulting_file',F),
-	'$recorded'('$multifile_dynamic'(_,_,_), '$mf'(Na,A,M,F,R), R1),
+	recorded('$multifile_dynamic'(_,_,_), '$mf'(Na,A,M,F,R), R1),
 	erase(R1),
 	erase(R),
 	fail.
@@ -649,12 +649,6 @@ abolish(X) :-
 	'$undefined'(G, Module),
 	functor(G,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) :-
-% 	'$has_yap_or', !,
-%         functor(G,A,N),
-% 	'$do_error'(permission_error(modify,static_procedure,A/N),abolish(Module:G)).
 '$abolishs'(G, M) :-
 	'$is_multifile'(G,M), !,
 	functor(G,Name,Arity),
@@ -927,7 +921,8 @@ current_predicate(A,T) :-
 current_predicate(A) :-
 	'$current_predicate_inside'(A).
 
-'$current_predicate_inside'(F) :-	var(F), !,		% only for the predicate
+'$current_predicate_inside'(F) :-
+	var(F), !,		% only for the predicate
 	'$current_module'(M),
 	'$current_predicate3'(M,F).
 '$current_predicate_inside'(M:F) :-			% module specified
@@ -955,7 +950,14 @@ system_predicate(P) :-
 	'$ifunctor'(T,A,Arity),
 	'$pred_exists'(T,M).
 
-'$current_predicate3'(M,A/Arity) :- nonvar(A), nonvar(Arity), !,
+'$current_predicate3'(M,A/Arity) :-
+	nonvar(M),
+	nonvar(A),
+	nonvar(Arity), !,
+	'$ifunctor'(Pred,A,Arity),
+	'$pred_exists'(Pred,M).
+'$current_predicate3'(M,A/Arity) :-
+	nonvar(A), nonvar(Arity), !,
 	(
 	 '$current_predicate'(M,A,Arity)
 	->

pl/signals.yap

@@ -210,6 +210,18 @@
 '$signal_def'(sig_alarm, true). 
 
 
+'$signal'(sig_hup).
+'$signal'(sig_usr1).
+'$signal'(sig_usr2).
+'$signal'(sig_pipe).
+'$signal'(sig_alarm).
+'$signal'(sig_vtalarm).
+
+on_signal(Signal,OldAction,NewAction) :-
+	var(Signal), !,
+	(nonvar(OldAction) -> throw(error(instantiation_error,on_signal/3)) ; true),
+        '$signal'(Signal),
+	on_signal(Signal, OldAction, NewAction).
 on_signal(Signal,OldAction,default) :-
 	'$reset_signal'(Signal, OldAction).
 on_signal(Signal,OldAction,Action) :-
@@ -219,7 +231,7 @@ on_signal(Signal,OldAction,Action) :-
 	Action = (_:Goal),
 	var(Goal), !,
 	'$check_signal'(Signal, OldAction),
-	Action = OldAction.
+	Goal = OldAction.
 on_signal(Signal,OldAction,Action) :-
 	'$reset_signal'(Signal, OldAction),
         % 13211-2 speaks only about callable