make system library use true file name
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1633 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
98de08022b
commit
64a70572de
1
C/init.c
1
C/init.c
@ -873,6 +873,7 @@ InitCodes(void)
|
||||
Yap_heap_regs->attributes_module = MkAtomTerm(Yap_LookupAtom("attributes"));
|
||||
Yap_heap_regs->charsio_module = MkAtomTerm(Yap_LookupAtom("charsio"));
|
||||
Yap_heap_regs->terms_module = MkAtomTerm(Yap_LookupAtom("terms"));
|
||||
Yap_heap_regs->system_module = MkAtomTerm(Yap_LookupAtom("system"));
|
||||
Yap_InitModules();
|
||||
#ifdef BEAM
|
||||
Yap_heap_regs->beam_retry_code.opc = Yap_opcode(_retry_eam);
|
||||
|
||||
@ -179,6 +179,8 @@ Yap_InitModules(void)
|
||||
CHARSIO_MODULE;
|
||||
ModuleName[5] =
|
||||
TERMS_MODULE;
|
||||
NoOfModules = 6;
|
||||
ModuleName[6] =
|
||||
SYSTEM_MODULE;
|
||||
NoOfModules = 7;
|
||||
CurrentModule = PROLOG_MODULE;
|
||||
}
|
||||
|
||||
57
C/sysbits.c
57
C/sysbits.c
@ -137,6 +137,27 @@ Yap_WinError(char *yap_error)
|
||||
(C) <= 'Z') || (C) == '_' )
|
||||
|
||||
|
||||
static int
|
||||
is_directory(char *FileName)
|
||||
{
|
||||
#ifdef _WIN32
|
||||
DWORD dwAtts = GetFileAttributes(FileName);
|
||||
if (dwAtts == INVALID_FILE_ATTRIBUTES)
|
||||
return FALSE;
|
||||
return (dwAtts & FILE_ATTRIBUTE_DIRECTORY);
|
||||
#elif HAVE_LSTAT
|
||||
struct stat buf;
|
||||
|
||||
if (lstat(FileName, &buf) == -1) {
|
||||
/* return an error number */
|
||||
return FALSE;
|
||||
}
|
||||
return S_ISDIR(buf.st_mode);
|
||||
#else
|
||||
return FALSE;
|
||||
#endif
|
||||
}
|
||||
|
||||
static int
|
||||
dir_separator (int ch)
|
||||
{
|
||||
@ -1695,7 +1716,18 @@ TrueFileName (char *source, char *result, int in_lib)
|
||||
}
|
||||
while ((*new_work++ = *next_work++)!=0);
|
||||
}
|
||||
return (TRUE);
|
||||
if (work != result && dir_separator(work[-1])) {
|
||||
/* should only do this on result being a directory */
|
||||
int ch0 = work[-1];
|
||||
work--;
|
||||
work[0] = '\0';
|
||||
if (!is_directory(result)) {
|
||||
/* put it back: */
|
||||
work[0] = ch0;
|
||||
work++;
|
||||
}
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
int
|
||||
@ -1704,6 +1736,24 @@ Yap_TrueFileName (char *source, char *result, int in_lib)
|
||||
return TrueFileName (source, result, in_lib);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_true_file_name (void)
|
||||
{
|
||||
Term t = Deref(ARG1);
|
||||
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,t,"argument to true_file_name unbound");
|
||||
return FALSE;
|
||||
}
|
||||
if (!IsAtomTerm(t)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM,t,"argument to true_file_name");
|
||||
return FALSE;
|
||||
}
|
||||
TrueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, Yap_FileNameBuf, FALSE);
|
||||
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(Yap_FileNameBuf)));
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_getcwd(void)
|
||||
{
|
||||
@ -2454,6 +2504,8 @@ p_continue_signals(void)
|
||||
void
|
||||
Yap_InitSysPreds(void)
|
||||
{
|
||||
Term cm = CurrentModule;
|
||||
|
||||
/* can only do after heap is initialised */
|
||||
InitLastWtime();
|
||||
Yap_InitCPred ("srandom", 1, p_srandom, SafePredFlag);
|
||||
@ -2475,6 +2527,9 @@ Yap_InitSysPreds(void)
|
||||
Yap_InitCPred ("$continue_signals", 0, p_continue_signals, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("file_directory_name", 2, p_file_directory_name, SafePredFlag);
|
||||
Yap_InitCPred ("$env_separator", 1, p_env_separator, SafePredFlag);
|
||||
CurrentModule = SYSTEM_MODULE;
|
||||
Yap_InitCPred ("true_file_name", 2, p_true_file_name, SyncPredFlag);
|
||||
CurrentModule = cm;
|
||||
}
|
||||
|
||||
|
||||
|
||||
6
H/Heap.h
6
H/Heap.h
@ -10,7 +10,7 @@
|
||||
* File: Heap.h *
|
||||
* mods: *
|
||||
* comments: Heap Init Structure *
|
||||
* version: $Id: Heap.h,v 1.98 2006-05-16 18:37:30 vsc Exp $ *
|
||||
* version: $Id: Heap.h,v 1.99 2006-05-17 18:38:11 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* information that can be stored in Code Space */
|
||||
@ -474,7 +474,8 @@ typedef struct various_codes {
|
||||
idb_module,
|
||||
attributes_module,
|
||||
charsio_module,
|
||||
terms_module;
|
||||
terms_module,
|
||||
system_module;
|
||||
void *last_wtime;
|
||||
struct pred_entry *pred_goal_expansion;
|
||||
struct pred_entry *pred_meta_call;
|
||||
@ -749,6 +750,7 @@ struct various_codes *Yap_heap_regs;
|
||||
#define ATTRIBUTES_MODULE Yap_heap_regs->attributes_module
|
||||
#define CHARSIO_MODULE Yap_heap_regs->charsio_module
|
||||
#define TERMS_MODULE Yap_heap_regs->terms_module
|
||||
#define SYSTEM_MODULE Yap_heap_regs->system_module
|
||||
#define PredGoalExpansion Yap_heap_regs->pred_goal_expansion
|
||||
#define PredMetaCall Yap_heap_regs->pred_meta_call
|
||||
#define PredDollarCatch Yap_heap_regs->pred_dollar_catch
|
||||
|
||||
@ -11,8 +11,11 @@
|
||||
* File: rheap.h *
|
||||
* comments: walk through heap code *
|
||||
* *
|
||||
* Last rev: $Date: 2006-04-28 15:48:33 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2006-05-17 18:38:11 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.66 2006/04/28 15:48:33 vsc
|
||||
* do locking on streams
|
||||
*
|
||||
* Revision 1.65 2006/04/28 13:23:23 vsc
|
||||
* fix number of overflow bugs affecting threaded version
|
||||
* make current_op faster.
|
||||
@ -661,6 +664,7 @@ restore_codes(void)
|
||||
Yap_heap_regs->attributes_module = AtomTermAdjust(Yap_heap_regs->attributes_module);
|
||||
Yap_heap_regs->charsio_module = AtomTermAdjust(Yap_heap_regs->charsio_module);
|
||||
Yap_heap_regs->terms_module = AtomTermAdjust(Yap_heap_regs->terms_module);
|
||||
Yap_heap_regs->system_module = AtomTermAdjust(Yap_heap_regs->system_module);
|
||||
if (Yap_heap_regs->file_aliases != NULL) {
|
||||
Yap_heap_regs->yap_streams =
|
||||
(struct stream_desc *)AddrAdjust((ADDR)Yap_heap_regs->yap_streams);
|
||||
|
||||
@ -16,6 +16,7 @@
|
||||
|
||||
<h2>Yap-5.1.2:</h2>
|
||||
<ul>
|
||||
<li> NEW: use true_file_name for file operations in system library (obs Paulo Moura).</li>
|
||||
<li> NEW: make YAP large address aware on WIN32 (should be able to
|
||||
allocate up to 3GB).</li>
|
||||
<li> FIXED: WIN32 may have a lot of fragmentation so several memory holes may be active at the same time, keep up to 32 open holes.</li>
|
||||
|
||||
@ -26,7 +26,6 @@
|
||||
file_exists/1,
|
||||
file_exists/2,
|
||||
file_property/2,
|
||||
fmode/2,
|
||||
host_id/1,
|
||||
host_name/1,
|
||||
pid/1,
|
||||
@ -86,10 +85,12 @@ check_int(I, Inp) :-
|
||||
|
||||
% file operations
|
||||
|
||||
delete_file(File) :-
|
||||
delete_file(IFile) :-
|
||||
true_file_name(IFile, File),
|
||||
delete_file(File, off, on, off).
|
||||
|
||||
delete_file(File, Opts) :-
|
||||
delete_file(IFile, Opts) :-
|
||||
true_file_name(IFile, File),
|
||||
process_delete_file_opts(Opts, Dir, Recurse, Ignore, delete_file(File,Opts)),
|
||||
delete_file(File, Dir, Recurse, Ignore).
|
||||
|
||||
@ -107,7 +108,8 @@ process_delete_file_opts([ignore|Opts], Dir, Recurse, on, T) :- !,
|
||||
process_delete_file_opts(Opts, _, _, _, T) :-
|
||||
throw(error(domain_error(delete_file_option,Opts),T)).
|
||||
|
||||
delete_file(File, Dir, Recurse, Ignore) :-
|
||||
delete_file(IFile, Dir, Recurse, Ignore) :-
|
||||
true_file_name(IFile, File),
|
||||
file_property(File, Type, _, _, _Permissions, _, Ignore),
|
||||
delete_file(Type, File, Dir, Recurse, Ignore).
|
||||
|
||||
@ -118,7 +120,8 @@ delete_file(directory, File, Dir, Recurse, Ignore) :-
|
||||
delete_file(_, File, _Dir, _Recurse, Ignore) :-
|
||||
unlink_file(File, Ignore).
|
||||
|
||||
unlink_file(File, Ignore) :-
|
||||
unlink_file(IFile, Ignore) :-
|
||||
true_file_name(IFile, File),
|
||||
unlink(File, N),
|
||||
handle_system_error(N, Ignore, delete_file(File)).
|
||||
|
||||
@ -148,7 +151,8 @@ delete_dirfiles([F|Fs], File, Ignore) :-
|
||||
delete_file(TrueF, off, on, Ignore),
|
||||
delete_dirfiles(Fs, File, Ignore).
|
||||
|
||||
directory_files(File, FileList) :-
|
||||
directory_files(IFile, FileList) :-
|
||||
true_file_name(IFile, File),
|
||||
directory_files(File, FileList, off).
|
||||
|
||||
directory_files(File, FileList, Ignore) :-
|
||||
@ -162,15 +166,20 @@ handle_system_error(Error, off, G) :-
|
||||
error_message(Error, Message),
|
||||
throw(error(system_error(Message),G)).
|
||||
|
||||
file_property(File, type(Type)) :-
|
||||
file_property(IFile, type(Type)) :-
|
||||
true_file_name(IFile, File),
|
||||
file_property(File, Type, _Size, _Date, _Permissions, _LinkName).
|
||||
file_property(File, size(Size)) :-
|
||||
file_property(IFile, size(Size)) :-
|
||||
true_file_name(IFile, File),
|
||||
file_property(File, _Type, Size, _Date, _Permissions, _LinkName).
|
||||
file_property(File, mod_time(Date)) :-
|
||||
file_property(IFile, mod_time(Date)) :-
|
||||
true_file_name(IFile, File),
|
||||
file_property(File, _Type, _Size, Date, _Permissions, _LinkName).
|
||||
file_property(File, mode(Permissions)) :-
|
||||
file_property(IFile, mode(Permissions)) :-
|
||||
true_file_name(IFile, File),
|
||||
file_property(File, _Type, _Size, _Date, Permissions, _LinkName).
|
||||
file_property(File, linkto(LinkName)) :-
|
||||
file_property(IFile, linkto(LinkName)) :-
|
||||
true_file_name(IFile, File),
|
||||
file_property(File, _Type, _Size, _Date, _Permissions, LinkName),
|
||||
atom(LinkName).
|
||||
|
||||
@ -184,7 +193,8 @@ file_exists(File) :-
|
||||
file_exists(File) :-
|
||||
\+ atom(File), !,
|
||||
throw(error(type_error(atom,File),file_exists(File))).
|
||||
file_exists(File) :-
|
||||
file_exists(IFile) :-
|
||||
true_file_name(IFile, File),
|
||||
file_property(File, _Type, _Size, _Date, _Permissions, _, Error),
|
||||
var(Error).
|
||||
|
||||
@ -194,7 +204,8 @@ file_exists(File, Permissions) :-
|
||||
file_exists(File, Permissions) :-
|
||||
\+ atom(File), !,
|
||||
throw(error(type_error(atom,File),file_exists(File, Permissions))).
|
||||
file_exists(File, Permissions) :-
|
||||
file_exists(IFile, Permissions) :-
|
||||
true_file_name(IFile, File),
|
||||
file_property(File, _Type, _Size, _Date, FPermissions, _, Error),
|
||||
var(Error),
|
||||
process_permissions(Permissions, Perms),
|
||||
@ -205,15 +216,17 @@ process_permissions(Number, Number) :- integer(Number).
|
||||
make_directory(Dir) :-
|
||||
var(Dir), !,
|
||||
throw(error(instantiation_error,mkdir(Dir))).
|
||||
make_directory(Dir) :-
|
||||
make_directory(IDir) :-
|
||||
atom(Dir), !,
|
||||
true_file_name(IDir, Dir),
|
||||
mkdir(Dir,Error),
|
||||
handle_system_error(Error, off, mkdir(Dir)).
|
||||
make_directory(Dir) :-
|
||||
throw(error(type_error(atom,Dir),make_directory(Dir))).
|
||||
|
||||
rename_file(Old, New) :-
|
||||
rename_file(IOld, New) :-
|
||||
atom(Old), atom(New), !,
|
||||
true_file_name(IOld,Old),
|
||||
rename_file(Old, New, Error),
|
||||
handle_system_error(Error, off, rename_file(Old, New)).
|
||||
rename_file(X,Y) :- (var(X) ; var(Y)), !,
|
||||
|
||||
@ -8,8 +8,12 @@
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* $Id: sys.c,v 1.26 2006-04-25 03:23:40 vsc Exp $ *
|
||||
* $Id: sys.c,v 1.27 2006-05-17 18:38:11 vsc Exp $ *
|
||||
* mods: $Log: not supported by cvs2svn $
|
||||
* mods: Revision 1.26 2006/04/25 03:23:40 vsc
|
||||
* mods: fix ! in debugger (execute_clause)
|
||||
* mods: improve system/1 and execute/1
|
||||
* mods:
|
||||
* mods: Revision 1.25 2006/01/17 14:10:42 vsc
|
||||
* mods: YENV may be an HW register (breaks some tabling code)
|
||||
* mods: All YAAM instructions are now brackedted, so Op introduced an { and EndOp introduces an }. This is because Ricardo assumes that.
|
||||
@ -347,7 +351,7 @@ dir_separator(void)
|
||||
static int
|
||||
file_property(void)
|
||||
{
|
||||
char *fd;
|
||||
const char *fd;
|
||||
#if HAVE_LSTAT
|
||||
struct stat buf;
|
||||
|
||||
|
||||
Reference in New Issue
Block a user