take care of the case where two files have different names but
are the same (at least for Unix/Linux). recover $loaded space after initialisation. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@488 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
03231bef34
commit
38f07b67de
25
C/sysbits.c
25
C/sysbits.c
@ -2052,6 +2052,30 @@ p_host_type(void) {
|
||||
return(unify(out,ARG1));
|
||||
}
|
||||
|
||||
static Int
|
||||
p_same_file(void) {
|
||||
char *f1 = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
|
||||
char *f2 = RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE;
|
||||
#if HAVE_LSTAT
|
||||
struct stat buf1, buf2;
|
||||
if (stat(f1, &buf1) == -1) {
|
||||
/* file does not exist, but was opened? Return -1 */
|
||||
return(FALSE);
|
||||
}
|
||||
if (stat(f2, &buf2) == -1) {
|
||||
/* file does not exist, but was opened? Return -1 */
|
||||
return(FALSE);
|
||||
}
|
||||
if (strcmp(f1,f2) == 0) {
|
||||
printf("Here I go with %s and %s\n", f1, f2);
|
||||
}
|
||||
return(buf1.st_ino == buf2.st_ino &&
|
||||
buf1.st_dev == buf2.st_dev);
|
||||
#else
|
||||
return(strcmp(f1,f2) == 0);
|
||||
#endif
|
||||
}
|
||||
|
||||
/*
|
||||
* This is responsable for the initialization of all machine dependant
|
||||
* predicates
|
||||
@ -2101,6 +2125,7 @@ InitSysPreds(void)
|
||||
InitCPred ("$file_age", 2, p_file_age, SafePredFlag|SyncPredFlag);
|
||||
InitCPred ("$set_fpu_exceptions", 0, p_set_fpu_exceptions, SafePredFlag|SyncPredFlag);
|
||||
InitCPred ("$host_type", 1, p_host_type, SafePredFlag|SyncPredFlag);
|
||||
InitCPred ("$same_file", 2, p_same_file, SafePredFlag|SyncPredFlag);
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -891,13 +891,15 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
|
||||
'$consult'(X) :-
|
||||
'$find_in_path'(X,Y,consult(X)),
|
||||
'$open'(Y,'$csult',Stream,0), !,
|
||||
'$record_loaded'(Stream),
|
||||
'$consult'(X,Stream),
|
||||
'$close'(Stream).
|
||||
'$consult'(X) :-
|
||||
throw(error(permission_error(input,stream,X),consult(X))).
|
||||
|
||||
|
||||
'$consult'(_,Stream) :-
|
||||
'$record_loaded'(Stream),
|
||||
fail.
|
||||
'$consult'(F,Stream) :-
|
||||
'$access_yap_flags'(8, 2), % SICStus Prolog compatibility
|
||||
!,
|
||||
@ -944,7 +946,7 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
|
||||
'$record_loaded'(user).
|
||||
'$record_loaded'(user_input).
|
||||
'$record_loaded'(Stream) :-
|
||||
'$loaded'(Stream), !.
|
||||
'$loaded'(Stream,_), !.
|
||||
'$record_loaded'(Stream) :-
|
||||
'$file_name'(Stream,F),
|
||||
'$file_age'(F,Age),
|
||||
|
||||
@ -32,15 +32,13 @@ ensure_loaded(V) :-
|
||||
'$ensure_loaded'(X) :-
|
||||
'$find_in_path'(X,Y,ensure_loaded(X)),
|
||||
'$open'(Y, '$csult', Stream, 0), !,
|
||||
( '$loaded'(Stream) ->
|
||||
( '$consulting_file_name'(Stream,TFN),
|
||||
'$recorded'('$module','$module'(TFN,M,P),_) ->
|
||||
( '$loaded'(Stream,TFN) ->
|
||||
( '$recorded'('$module','$module'(TFN,M,P),_) ->
|
||||
'$current_module'(T), '$import'(P,M,T)
|
||||
;
|
||||
true
|
||||
)
|
||||
;
|
||||
'$record_loaded'(Stream),
|
||||
'$reconsult'(X,Stream)
|
||||
),
|
||||
'$close'(Stream).
|
||||
@ -86,12 +84,14 @@ reconsult(Fs) :-
|
||||
'$reconsult'(X) :-
|
||||
'$find_in_path'(X,Y,reconsult(X)),
|
||||
'$open'(Y,'$csult',Stream,0), !,
|
||||
'$record_loaded'(Stream),
|
||||
'$reconsult'(X,Stream),
|
||||
'$close'(Stream).
|
||||
'$reconsult'(X) :-
|
||||
throw(error(permission_error(input,stream,X),reconsult(X))).
|
||||
|
||||
'$reconsult'(F,Stream) :-
|
||||
'$record_loaded'(Stream),
|
||||
fail.
|
||||
'$reconsult'(F,Stream) :-
|
||||
'$getcwd'(OldD),
|
||||
'$get_value'('$consulting_file',OldF),
|
||||
@ -189,7 +189,6 @@ reconsult(Fs) :-
|
||||
),
|
||||
( '$find_in_path'(X,Y,reconsult(X)),
|
||||
'$open'(Y,'$csult',Stream,0) ->
|
||||
'$record_loaded'(Stream),
|
||||
( '$access_yap_flags'(15, 0) -> true ; '$skip_unix_comments'(Stream) ),
|
||||
'$reconsult'(X,Stream), '$close'(Stream)
|
||||
;
|
||||
@ -234,9 +233,10 @@ prolog_load_context(term_position, Position) :-
|
||||
stream_position(Stream, Position).
|
||||
|
||||
|
||||
'$loaded'(Stream) :-
|
||||
'$loaded'(Stream,F1) :-
|
||||
'$file_name'(Stream,F), %
|
||||
'$recorded'('$loaded','$loaded'(F,Age),R), !,
|
||||
'$recorded'('$loaded','$loaded'(F1,Age),R),
|
||||
'$same_file'(F1,F), !,
|
||||
'$file_age'(F,CurrentAge),
|
||||
((CurrentAge = Age ; Age = -1) -> true; erase(R), fail).
|
||||
|
||||
|
||||
@ -107,6 +107,11 @@ system_mode(verbose,off) :- '$set_value'('$verbose',off).
|
||||
'$set_pred_module'(acyclic_term(_,_), terms),
|
||||
'$set_pred_module'(variable_in_term(_,_), terms).
|
||||
|
||||
%
|
||||
% cleanup ensure loaded and recover some data-base space.
|
||||
%
|
||||
:- ( recorded('$loaded','$loaded'(_,_),R), erase(R), fail ; true ).
|
||||
|
||||
:- '$set_value'('$user_module',user), '$protect'.
|
||||
|
||||
:- style_check([]).
|
||||
|
||||
@ -60,11 +60,10 @@ use_module(M,I) :-
|
||||
'$current_module'(M),
|
||||
'$find_in_path'(File,X,use_module(File,Imports)), !,
|
||||
'$open'(X,'$csult',Stream,0), !,
|
||||
'$consulting_file_name'(Stream,TrueFileName),
|
||||
( '$loaded'(Stream) -> true
|
||||
( '$loaded'(Stream,TrueFileName) -> true
|
||||
;
|
||||
'$record_loaded'(Stream),
|
||||
% the following avoids import of all public predicates
|
||||
'$consulting_file_name'(Stream,TrueFileName),
|
||||
'$recorda'('$importing','$importing'(TrueFileName),R),
|
||||
'$reconsult'(File,Stream)
|
||||
),
|
||||
@ -91,14 +90,14 @@ use_module(Mod,F,I) :-
|
||||
'$use_module'(Module,File,Imports) :-
|
||||
'$find_in_path'(File,X,use_module(Module,File,Imports)),
|
||||
'$open'(X,'$csult',Stream,0), !,
|
||||
'$consulting_file_name'(Stream,TrueFileName),
|
||||
'$current_module'(M),
|
||||
'$file_name'(Stream,FName),
|
||||
(
|
||||
'$loaded'(Stream)
|
||||
'$loaded'(Stream, TrueFileName)
|
||||
->
|
||||
true
|
||||
;
|
||||
'$record_loaded'(Stream),
|
||||
'$consulting_file_name'(Stream,TrueFileName),
|
||||
% the following avoids import of all public predicates
|
||||
'$recorda'('$importing','$importing'(TrueFileName),R),
|
||||
'$reconsult'(File,Stream)
|
||||
|
||||
Reference in New Issue
Block a user