diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Theofrastos Mantadelis 2010-09-24 16:02:19 +02:00
commit 3f604d6d81
19 changed files with 162 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
C/agc.c
View File

@ -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)

7
C/c_interface.c
View File

@ -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)
{

37
C/init.c
View File

@ -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("PROFILING");
remove("PROFPREDS");
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);
}

10
H/YapHeap.h
View File

@ -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;

2
H/dhstruct.h
View File

@ -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

2
H/hstruct.h
View File

@ -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;

2
H/ihstruct.h
View File

@ -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;

12
H/rheap.h
View File

@ -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)
{

2
H/rhstruct.h
View File

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

10
H/sshift.h
View File

@ -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 *

38
docs/yap.tex
View File

@ -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

3
include/YapInterface.h
View File

@ -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));

2
include/yap_structs.h
View File

@ -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

1
library/yap2swi/yap2swi.c
View File

@ -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);

3
misc/HEAPFIELDS
View File

@ -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

20
pl/consult.yap
View File

@ -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) :-
'$add_extensions'(Extensions,File,F),
access_file(F,Access).
'$search_in_path'(File,opts(Extensions,_,Type,Access,_,_,_),F) :-
'$add_extensions'(Extensions, File, F0),
'$check_file'(F0, Type, Access, F).
'$search_in_path'(File,opts(_,_,Type,Access,_,_,_),F) :-
'$add_type_extensions'(Type,File,F),
access_file(F,Access).
'$add_type_extensions'(Type, File, F0),
'$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),

15
pl/corout.yap
View File

@ -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),
'$recorded'('$blocking_code','$code'(G,OldConds),R), !,
extract_head_for_block(Conds, G),
recorded('$blocking_code','$code'(G,OldConds),R), !,
erase(R),
functor(G, Na, Ar),
'$current_module'(M),

20
pl/preds.yap
View File

@ -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)
->

14
pl/signals.yap
View File

@ -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