diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h old mode 100644 new mode 100755 index b8d0420f0..e8807cd1b --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -456,6 +456,7 @@ UNICODE file functions. /* Make IOSTREAM known to Prolog */ PL_EXPORT(int) PL_open_stream(term_t t, IOSTREAM *s); PL_EXPORT(int) PL_unify_stream(term_t t, IOSTREAM *s); +#define PL_open_stream PL_unify_stream PL_EXPORT(int) PL_get_stream_handle(term_t t, IOSTREAM **s); PL_EXPORT(int) PL_release_stream(IOSTREAM *s); diff --git a/include/SWI-Stream.h b/include/SWI-Stream.h old mode 100644 new mode 100755 index dd1e1762c..1b86bf1d8 --- a/include/SWI-Stream.h +++ b/include/SWI-Stream.h @@ -50,8 +50,8 @@ typedef __int64 int64_t; #if (_MSC_VER < 1300) && !defined(__MINGW32__) typedef long intptr_t; typedef unsigned long uintptr_t; -#endif typedef intptr_t ssize_t; /* signed version of size_t */ +#endif #else #include #include /* more portable than stdint.h */ diff --git a/packages/PLStream/Makefile.in b/packages/PLStream/Makefile.in old mode 100644 new mode 100755 index fc2d39fc4..0de37abc9 --- a/packages/PLStream/Makefile.in +++ b/packages/PLStream/Makefile.in @@ -44,19 +44,19 @@ HEADERS=$(srcdir)/atoms.h $(srcdir)/pl-buffer.h $(srcdir)/pl-ctype.h \ $(srcdir)/pl-stream.h \ $(srcdir)/pl-table.h \ $(srcdir)/pl-text.h $(srcdir)/pl-utf8.h \ - $(srcdir)/pl-yap.h @ENABLE_WINCONSOLE@ $(srcdir)/uxnt/dirent.h $(srcdir)/uxnt/utf8.h $(srcdir)/uxnt/uxnt.h + $(srcdir)/pl-yap.h @ENABLE_WINCONSOLE@ $(srcdir)/uxnt/dirent.h $(srcdir)/uxnt/utf8.h $(srcdir)/pl-utf8.c $(srcdir)/uxnt/uxnt.h C_SOURCES=$(srcdir)/pl-buffer.c $(srcdir)/pl-ctype.c \ $(srcdir)/pl-error.c $(srcdir)/pl-feature.c \ - $(srcdir)/pl-file.c $(srcdir)/pl-os.c \ + $(srcdir)/pl-file.c $(srcdir)/pl-files.c $(srcdir)/pl-os.c \ $(srcdir)/pl-privitf.c \ $(srcdir)/pl-stream.c $(srcdir)/pl-string.c \ $(srcdir)/pl-table.c \ - $(srcdir)/pl-text.c $(srcdir)/pl-utf8.c \ - $(srcdir)/pl-yap.c @ENABLE_WINCONSOLE@ $(srcdir)/popen.c $(srcdir)/uxnt/utf8.c $(srcdir)/uxnt/uxnt.c + $(srcdir)/pl-text.c \ + $(srcdir)/pl-yap.c @ENABLE_WINCONSOLE@ $(srcdir)/popen.c $(srcdir)/uxnt/uxnt.c OBJS=pl-buffer.o pl-ctype.o pl-error.o pl-feature.o \ - pl-file.o pl-os.o pl-privitf.o \ + pl-file.o pl-files.o pl-os.o pl-privitf.o \ pl-stream.o pl-string.o pl-table.o pl-text.o pl-utf8.o \ - pl-yap.o @ENABLE_WINCONSOLE@ utf8.o uxnt.o + pl-yap.o @ENABLE_WINCONSOLE@ uxnt.o SOBJS=plstream@SHLIB_SUFFIX@ #in some systems we just create a single object, in others we need to @@ -67,9 +67,6 @@ all: $(SOBJS) uxnt.o: $(srcdir)/uxnt/uxnt.c $(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/uxnt/uxnt.c -o uxnt.o -utf8.o: $(srcdir)/uxnt/utf8.c - $(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/uxnt/utf8.c -o utf8.o - # default rule %.o : $(srcdir)/%.c $(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $< -o $@ diff --git a/packages/PLStream/pl-file.c b/packages/PLStream/pl-file.c old mode 100644 new mode 100755 index 5734b1e27..1a690525c --- a/packages/PLStream/pl-file.c +++ b/packages/PLStream/pl-file.c @@ -73,7 +73,6 @@ static int bad_encoding(atom_t name); static int noprotocol(void); static int streamStatus(IOSTREAM *s); -static int reportStreamError(IOSTREAM *s); #if __YAP_PROLOG__ INIT_DEF(atom_t, standardStreams, 6) @@ -313,7 +312,6 @@ static void init_yap_extras(void); #endif - void initIO() { GET_LD @@ -642,7 +640,7 @@ that ignores the error. This might get hairy if the user is playing with these streams too. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -#ifdef __WINDOWS__ +#if defined(__WINDOWS__) || defined(__MINGW32__) static int isConsoleStream(IOSTREAM *s) { int i = standardStreamIndexFromStream(s); @@ -654,7 +652,7 @@ isConsoleStream(IOSTREAM *s) #endif -static int +int reportStreamError(IOSTREAM *s) { if ( GD->cleaning == CLN_NORMAL && !isConsoleStream(s) && @@ -4313,4 +4311,27 @@ init_yap_extras() fileerrors = TRUE; SinitStreams(); } + +#ifdef _WIN32 + +#include + +int WINAPI PROTO(win_plstream, (HANDLE, DWORD, LPVOID)); + +int WINAPI win_plstream(HANDLE hinst, DWORD reason, LPVOID reserved) +{ + switch (reason) + { + case DLL_PROCESS_ATTACH: + break; + case DLL_PROCESS_DETACH: + break; + case DLL_THREAD_ATTACH: + break; + case DLL_THREAD_DETACH: + break; + } + return 1; +} +#endif #endif diff --git a/packages/PLStream/pl-files.c b/packages/PLStream/pl-files.c new file mode 100755 index 000000000..2344a6b86 --- /dev/null +++ b/packages/PLStream/pl-files.c @@ -0,0 +1,956 @@ +/* $Id$ + + Part of SWI-Prolog + + Author: Jan Wielemaker + E-mail: J.Wielemaker@uva.nl + WWW: http://www.swi-prolog.org + Copyright (C): 1985-2008, University of Amsterdam + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*/ + +#include "pl-incl.h" +#include + +/**** stuff from uxnt ****/ +#ifdef O_XOS +#include "uxnt/uxnt.h" +#endif + +#ifdef HAVE_SYS_STAT_H +#include +#endif + +#ifdef O_XOS +#define statstruct struct _stat +#else +#define statstruct struct stat +#define statfunc stat +#endif + +#undef LD +#define LD LOCAL_LD + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +General file operations and binding to Prolog +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + + /******************************* + * OS STUFF * + *******************************/ + +/** time_t LastModifiedFile(const char *file) + +Return the last modification time of file as a POSIX timestamp. Returns +(time_t)-1 on failure. +*/ + + +time_t +LastModifiedFile(const char *file) +{ char tmp[MAXPATHLEN]; + statstruct buf; + + if ( statfunc(OsPath(file, tmp), &buf) < 0 ) + return (time_t)-1; + + return buf.st_mtime; +} + + +/** static int64_t SizeFile(const char *path) + +Return the size of the file path in bytes. Returns -1 if the file cannot +be accessed. +*/ + +static int64_t +SizeFile(const char *path) +{ char tmp[MAXPATHLEN]; + statstruct buf; + + if ( statfunc(OsPath(path, tmp), &buf) < 0 ) + return -1; + + return buf.st_size; +} + + +/** int AccessFile(const char *path, int mode) + +TRUE if path can be accessed in the specified modes. Mode is a bitwise +or created from one or more of the constants ACCESS_EXIST, ACCESS_READ, +ACCESS_WRITE and ACCESS_EXECUTE. +*/ + +#ifndef F_OK +#define F_OK 0 +#endif + +int +AccessFile(const char *path, int mode) +{ char tmp[MAXPATHLEN]; +#ifdef HAVE_ACCESS + int m = 0; + + if ( mode == ACCESS_EXIST ) + m = F_OK; + else + { if ( mode & ACCESS_READ ) m |= R_OK; + if ( mode & ACCESS_WRITE ) m |= W_OK; +#ifdef X_OK + if ( mode & ACCESS_EXECUTE ) m |= X_OK; +#endif + } + + return access(OsPath(path, tmp), m) == 0 ? TRUE : FALSE; +#else +#error "No implementation for AccessFile()" +#endif +} + + +int +ExistsFile(const char *path) +{ +#ifdef O_XOS + return _xos_exists(path, _XOS_FILE); +#else + char tmp[MAXPATHLEN]; + statstruct buf; + + if ( statfunc(OsPath(path, tmp), &buf) == -1 || !S_ISREG(buf.st_mode) ) + { DEBUG(2, perror(tmp)); + return FALSE; + } + return TRUE; +#endif +} + + +int +ExistsDirectory(const char *path) +{ +#ifdef O_XOS + return _xos_exists(path, _XOS_DIR); +#else + char tmp[MAXPATHLEN]; + char *ospath = OsPath(path, tmp); + statstruct buf; + + if ( statfunc(ospath, &buf) < 0 ) + return FALSE; + + if ( S_ISDIR(buf.st_mode) ) + return TRUE; + + return FALSE; +#endif /*O_XOS*/ +} + + +static char * +ReadLink(const char *f, char *buf) +{ +#ifdef HAVE_READLINK + int n; + + if ( (n=readlink(f, buf, MAXPATHLEN-1)) > 0 ) + { buf[n] = EOS; + return buf; + } +#endif + + return NULL; +} + + +static char * +DeRefLink1(const char *f, char *lbuf) +{ char buf[MAXPATHLEN]; + char *l; + + if ( (l=ReadLink(f, buf)) ) + { if ( l[0] == '/' ) /* absolute path */ + { strcpy(lbuf, buf); + return lbuf; + } else + { char *q; + + strcpy(lbuf, f); + q = &lbuf[strlen(lbuf)]; + while(q>lbuf && q[-1] != '/') + q--; + strcpy(q, l); + + canoniseFileName(lbuf); + + return lbuf; + } + } + + return NULL; +} + + +/** char *DeRefLink(const char *link, char *buf) + +Dereference a symbolic link, returning its final destination. The +returned filename is canonical (i.e., references to ./ and ../ are +removed). Returns NULL if more than 20 links have been followed. +*/ + +char * +DeRefLink(const char *link, char *buf) +{ char tmp[MAXPATHLEN]; + char *f; + int n = 20; /* avoid loop! */ + + while((f=DeRefLink1(link, tmp)) && n-- > 0) + link = f; + + if ( n > 0 ) + { strcpy(buf, link); + return buf; + } else + return NULL; +} + + +static int +SameFile(const char *f1, const char *f2) +{ GET_LD + + if ( truePrologFlag(PLFLAG_FILE_CASE) ) + { if ( streq(f1, f2) ) + return TRUE; + } else + { if ( strcasecmp(f1, f2) == 0 ) + return TRUE; + } + +#ifdef __unix__ /* doesn't work on most not Unix's */ + { statstruct buf1; + statstruct buf2; + char tmp[MAXPATHLEN]; + + if ( statfunc(OsPath(f1, tmp), &buf1) != 0 || + statfunc(OsPath(f2, tmp), &buf2) != 0 ) + return FALSE; + if ( buf1.st_ino == buf2.st_ino && buf1.st_dev == buf2.st_dev ) + return TRUE; + } +#endif +#ifdef O_XOS + return _xos_same_file(f1, f2); +#endif /*O_XOS*/ + /* Amazing! There is no simple way to check two files for identity. */ + /* stat() and fstat() both return dummy values for inode and device. */ + /* this is fine as OS'es not supporting symbolic links don't need this */ + + return FALSE; +} + + +/** int RemoveFile(const char *path) + +Remove a file from the filesystem. Returns TRUE on success and FALSE +otherwise. +*/ + +int +RemoveFile(const char *path) +{ char tmp[MAXPATHLEN]; + +#ifdef HAVE_REMOVE + return remove(OsPath(path, tmp)) == 0 ? TRUE : FALSE; +#else + return unlink(OsPath(path, tmp)) == 0 ? TRUE : FALSE; +#endif +} + + +static int +RenameFile(const char *old, const char *new) +{ char oldbuf[MAXPATHLEN]; + char newbuf[MAXPATHLEN]; + char *osold, *osnew; + + osold = OsPath(old, oldbuf); + osnew = OsPath(new, newbuf); + +#ifdef HAVE_RENAME + return rename(osold, osnew) == 0 ? TRUE : FALSE; +#else +{ int rval; + + unlink(osnew); + if ( (rval = link(osold, osnew)) == 0 + && (rval = unlink(osold)) != 0) + unlink(osnew); + + if ( rval == 0 ) + return TRUE; + + return FALSE; +} +#endif /*HAVE_RENAME*/ +} + + +static int +MarkExecutable(const char *name) +{ +#if (defined(HAVE_STAT) && defined(HAVE_CHMOD)) || defined(__unix__) + statstruct buf; + mode_t um; + + um = umask(0777); + umask(um); + if ( statfunc(name, &buf) == -1 ) + { GET_LD + term_t file = PL_new_term_ref(); + + PL_put_atom_chars(file, name); + return PL_error(NULL, 0, OsError(), ERR_FILE_OPERATION, + ATOM_stat, ATOM_file, file); + } + + if ( (buf.st_mode & 0111) == (~um & 0111) ) + return TRUE; + + buf.st_mode |= 0111 & ~um; + if ( chmod(name, buf.st_mode) == -1 ) + { GET_LD + term_t file = PL_new_term_ref(); + + PL_put_atom_chars(file, name); + return PL_error(NULL, 0, OsError(), ERR_FILE_OPERATION, + ATOM_chmod, ATOM_file, file); + } +#endif /* defined(HAVE_STAT) && defined(HAVE_CHMOD) */ + + return TRUE; +} + + + /******************************** + * FIND FILES FROM C * + *********************************/ + +int +unifyTime(term_t t, time_t time) +{ return PL_unify_float(t, (double)time); +} + + +static void +add_option(term_t options, functor_t f, atom_t val) +{ GET_LD + term_t head = PL_new_term_ref(); + + PL_unify_list(options, head, options); + PL_unify_term(head, PL_FUNCTOR, f, PL_ATOM, val); + + PL_reset_term_refs(head); +} + +#define CVT_FILENAME (CVT_ATOM|CVT_STRING|CVT_LIST) + +int +PL_get_file_name(term_t n, char **namep, int flags) +{ GET_LD + char *name; + char tmp[MAXPATHLEN]; + char ospath[MAXPATHLEN]; + + if ( flags & PL_FILE_SEARCH ) + { predicate_t pred = PL_predicate("absolute_file_name", 3, "system"); + term_t av = PL_new_term_refs(3); + term_t options = PL_copy_term_ref(av+2); + int cflags = ((flags&PL_FILE_NOERRORS) ? PL_Q_CATCH_EXCEPTION + : PL_Q_PASS_EXCEPTION); + + PL_put_term(av+0, n); + + if ( flags & PL_FILE_EXIST ) + add_option(options, FUNCTOR_access1, ATOM_exist); + if ( flags & PL_FILE_READ ) + add_option(options, FUNCTOR_access1, ATOM_read); + if ( flags & PL_FILE_WRITE ) + add_option(options, FUNCTOR_access1, ATOM_write); + if ( flags & PL_FILE_EXECUTE ) + add_option(options, FUNCTOR_access1, ATOM_execute); + + PL_unify_nil(options); + + if ( !PL_call_predicate(NULL, cflags, pred, av) ) + return FALSE; + + return PL_get_chars_ex(av+1, namep, CVT_ATOMIC|BUF_RING|REP_FN); + } + + if ( flags & PL_FILE_NOERRORS ) + { if ( !PL_get_chars(n, &name, CVT_FILENAME|REP_FN) ) + return FALSE; + } else + { if ( !PL_get_chars_ex(n, &name, CVT_FILENAME|REP_FN) ) + return FALSE; + } + + if ( truePrologFlag(PLFLAG_FILEVARS) ) + { if ( !(name = ExpandOneFile(name, tmp)) ) + return FALSE; + } + + if ( !(flags & PL_FILE_NOERRORS) ) + { atom_t op = 0; + + if ( (flags&PL_FILE_READ) && !AccessFile(name, ACCESS_READ) ) + op = ATOM_read; + if ( !op && (flags&PL_FILE_WRITE) && !AccessFile(name, ACCESS_WRITE) ) + op = ATOM_write; + if ( !op && (flags&PL_FILE_EXECUTE) && !AccessFile(name, ACCESS_EXECUTE) ) + op = ATOM_execute; + + if ( op ) + return PL_error(NULL, 0, NULL, ERR_PERMISSION, ATOM_file, op, n); + + if ( (flags & PL_FILE_EXIST) && !AccessFile(name, ACCESS_EXIST) ) + return PL_error(NULL, 0, NULL, ERR_EXISTENCE, ATOM_file, n); + } + + if ( flags & PL_FILE_ABSOLUTE ) + { if ( !(name = AbsoluteFile(name, tmp)) ) + return FALSE; + } + + if ( flags & PL_FILE_OSPATH ) + { if ( !(name = OsPath(name, ospath)) ) + return FALSE; + } + + *namep = buffer_string(name, BUF_RING); + return TRUE; +} + + + /******************************* + * QUERY FILES * + *******************************/ + +static +PRED_IMPL("time_file", 2, time_file, 0) +{ char *fn; + + if ( PL_get_file_name(A1, &fn, 0) ) + { time_t time; + + if ( (time = LastModifiedFile(fn)) == (time_t)-1 ) + return PL_error(NULL, 0, NULL, ERR_FILE_OPERATION, + ATOM_time, ATOM_file, A1); + + return unifyTime(A2, time); + } + + return FALSE; +} + + +static +PRED_IMPL("size_file", 2, size_file, 0) +{ char *n; + + if ( PL_get_file_name(A1, &n, 0) ) + { int64_t size; + + if ( (size = SizeFile(n)) < 0 ) + return PL_error("size_file", 2, OsError(), ERR_FILE_OPERATION, + ATOM_size, ATOM_file, A1); + + return PL_unify_int64(A2, size); + } + + return FALSE; +} + + +static +PRED_IMPL("access_file", 2, access_file, 0) +{ PRED_LD + char *n; + int md; + atom_t m; + + term_t name = A1; + term_t mode = A2; + + if ( !PL_get_atom(mode, &m) ) + return PL_error("access_file", 2, NULL, ERR_TYPE, ATOM_atom, mode); + if ( !PL_get_file_name(name, &n, 0) ) + return FALSE; + + if ( m == ATOM_none ) + return TRUE; + + if ( m == ATOM_write || m == ATOM_append ) + md = ACCESS_WRITE; + else if ( m == ATOM_read ) + md = ACCESS_READ; + else if ( m == ATOM_execute ) + md = ACCESS_EXECUTE; + else if ( m == ATOM_exist ) + md = ACCESS_EXIST; + else + return PL_error("access_file", 2, NULL, ERR_DOMAIN, ATOM_io_mode, mode); + + if ( AccessFile(n, md) ) + return TRUE; + + if ( md == ACCESS_WRITE && !AccessFile(n, ACCESS_EXIST) ) + { char tmp[MAXPATHLEN]; + char *dir = DirName(n, tmp); + + if ( dir[0] ) + { if ( !ExistsDirectory(dir) ) + return FALSE; + } + if ( AccessFile(dir[0] ? dir : ".", md) ) + return TRUE; + } + + return FALSE; +} + + +static +PRED_IMPL("read_link", 3, read_link, 0) +{ char *n, *l, *t; + char buf[MAXPATHLEN]; + + term_t file = A1; + term_t link = A2; + term_t to = A3; + + if ( !PL_get_file_name(file, &n, 0) ) + return FALSE; + + if ( (l = ReadLink(n, buf)) && + PL_unify_atom_chars(link, l) && + (t = DeRefLink(n, buf)) && + PL_unify_atom_chars(to, t) ) + return TRUE; + + return FALSE; +} + + +static +PRED_IMPL("exists_file", 1, exists_file, 0) +{ char *n; + + if ( !PL_get_file_name(A1, &n, 0) ) + return FALSE; + + return ExistsFile(n); +} + + +static +PRED_IMPL("exists_directory", 1, exists_directory, 0) +{ char *n; + + if ( !PL_get_file_name(A1, &n, 0) ) + return FALSE; + + return ExistsDirectory(n); +} + + +static +PRED_IMPL("is_absolute_file_name", 1, is_absolute_file_name, 0) +{ char *n; + + if ( PL_get_file_name(A1, &n, 0) && + IsAbsolutePath(n) ) + return TRUE; + + return FALSE; +} + + +static +PRED_IMPL("same_file", 2, same_file, 0) +{ char *n1, *n2; + + if ( PL_get_file_name(A1, &n1, 0) && + PL_get_file_name(A2, &n2, 0) ) + return SameFile(n1, n2); + + return FALSE; +} + + +static +PRED_IMPL("file_base_name", 2, file_base_name, 0) +{ char *n; + + if ( !PL_get_chars_ex(A1, &n, CVT_ALL|REP_FN) ) + return FALSE; + + return PL_unify_chars(A2, PL_ATOM|REP_FN, -1, BaseName(n)); +} + + +static +PRED_IMPL("file_directory_name", 2, file_directory_name, 0) +{ char *n; + char tmp[MAXPATHLEN]; + + if ( !PL_get_chars_ex(A1, &n, CVT_ALL|REP_FN) ) + return FALSE; + + return PL_unify_chars(A2, PL_ATOM|REP_FN, -1, DirName(n, tmp)); +} + + + /******************************* + * TEMPORARY FILES * + *******************************/ + +static +PRED_IMPL("tmp_file", 2, tmp_file, 0) +{ PRED_LD + char *n; + + term_t base = A1; + term_t name = A2; + + if ( !PL_get_chars(base, &n, CVT_ALL) ) + return PL_error("tmp_file", 2, NULL, ERR_TYPE, ATOM_atom, base); + + return PL_unify_atom(name, TemporaryFile(n)); +} + + + /******************************* + * CHANGE FILESYSTEM * + *******************************/ + + +static +PRED_IMPL("delete_file", 1, delete_file, 0) +{ char *n; + + if ( !PL_get_file_name(A1, &n, 0) ) + return FALSE; + + if ( RemoveFile(n) ) + return TRUE; + + return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, + ATOM_delete, ATOM_file, A1); +} + + +static +PRED_IMPL("delete_directory", 1, delete_directory, 0) +{ char *n; + + if ( !PL_get_file_name(A1, &n, 0) ) + return FALSE; + + if ( rmdir(n) == 0 ) + return TRUE; + else + return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, + ATOM_delete, ATOM_directory, A1); +} + + +static +PRED_IMPL("make_directory", 1, make_directory, 0) +{ char *n; + + if ( !PL_get_file_name(A1, &n, 0) ) + return FALSE; + + if ( mkdir(n, 0777) == 0 ) + return TRUE; + else + return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, + ATOM_create, ATOM_directory, A1); +} + + +static +PRED_IMPL("rename_file", 2, rename_file, 0) +{ PRED_LD + char *o, *n; + + term_t old = A1; + term_t new = A2; + + if ( PL_get_file_name(old, &o, 0) && + PL_get_file_name(new, &n, 0) ) + { if ( SameFile(o, n) ) + { if ( truePrologFlag(PLFLAG_FILEERRORS) ) + return PL_error("rename_file", 2, "same file", ERR_PERMISSION, + ATOM_rename, ATOM_file, old); + return FALSE; + } + + if ( RenameFile(o, n) ) + return TRUE; + + if ( truePrologFlag(PLFLAG_FILEERRORS) ) + return PL_error("rename_file", 2, OsError(), ERR_FILE_OPERATION, + ATOM_rename, ATOM_file, old); + return FALSE; + } + + return FALSE; +} + + +static +PRED_IMPL("$absolute_file_name", 2, absolute_file_name, 0) +{ char *n; + char tmp[MAXPATHLEN]; + + term_t name = A1; + term_t expanded = A2; + + if ( PL_get_file_name(name, &n, 0) && + (n = AbsoluteFile(n, tmp)) ) + return PL_unify_chars(expanded, PL_ATOM|REP_FN, -1, n); + + return FALSE; +} + + +static +PRED_IMPL("working_directory", 2, working_directory, 0) +{ PRED_LD + const char *wd; + + term_t old = A1; + term_t new = A2; + + if ( !(wd = PL_cwd()) ) + return FALSE; + + if ( PL_unify_chars(old, PL_ATOM|REP_FN, -1, wd) ) + { if ( PL_compare(old, new) != 0 ) + { char *n; + + if ( PL_get_file_name(new, &n, 0) ) + { if ( ChDir(n) ) + return TRUE; + + if ( truePrologFlag(PLFLAG_FILEERRORS) ) + return PL_error(NULL, 0, NULL, ERR_FILE_OPERATION, + ATOM_chdir, ATOM_directory, new); + return FALSE; + } + } + + return TRUE; + } + + return FALSE; +} + + +static int +has_extension(const char *name, const char *ext) +{ GET_LD + const char *s = name + strlen(name); + + if ( ext[0] == EOS ) + return TRUE; + + while(*s != '.' && *s != '/' && s > name) + s--; + if ( *s == '.' && s > name && s[-1] != '/' ) + { if ( ext[0] == '.' ) + ext++; + if ( truePrologFlag(PLFLAG_FILE_CASE) ) + return strcmp(&s[1], ext) == 0; + else + return strcasecmp(&s[1], ext) == 0; + } + + return FALSE; +} + + +static int +name_too_long() +{ return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length); +} + + +static +PRED_IMPL("file_name_extension", 3, file_name_extension, 0) +{ PRED_LD + char *b = NULL, *e = NULL, *f; + char buf[MAXPATHLEN]; + + term_t base = A1; + term_t ext = A2; + term_t full = A3; + + if ( !PL_is_variable(full) ) + { if ( PL_get_chars(full, &f, CVT_ALL|CVT_EXCEPTION|REP_FN) ) + { char *s = f + strlen(f); /* ?base, ?ext, +full */ + + while(*s != '.' && *s != '/' && s > f) + s--; + if ( *s == '.' ) + { if ( PL_get_chars(ext, &e, CVT_ALL|REP_FN) ) + { if ( e[0] == '.' ) + e++; + if ( truePrologFlag(PLFLAG_FILE_CASE) ) + { TRY(strcmp(&s[1], e) == 0); + } else + { TRY(strcasecmp(&s[1], e) == 0); + } + } else + { TRY(PL_unify_chars(ext, PL_ATOM|REP_FN, -1, &s[1])); + } + if ( s-f > MAXPATHLEN ) + return name_too_long(); + strncpy(buf, f, s-f); + buf[s-f] = EOS; + + return PL_unify_chars(base, PL_ATOM|REP_FN, -1, buf); + } + if ( PL_unify_atom_chars(ext, "") && + PL_unify(full, base) ) + PL_succeed; + } + PL_fail; + } + + if ( PL_get_chars_ex(base, &b, CVT_ALL|BUF_RING|REP_FN) && + PL_get_chars_ex(ext, &e, CVT_ALL|REP_FN) ) + { char *s; + + if ( e[0] == '.' ) /* +Base, +Extension, -full */ + e++; + if ( has_extension(b, e) ) + return PL_unify(base, full); + if ( strlen(b) + 1 + strlen(e) + 1 > MAXPATHLEN ) + return name_too_long(); + strcpy(buf, b); + s = buf + strlen(buf); + *s++ = '.'; + strcpy(s, e); + + return PL_unify_chars(full, PL_ATOM|REP_FN, -1, buf); + } else + return FALSE; +} + + +static +PRED_IMPL("prolog_to_os_filename", 2, prolog_to_os_filename, 0) +{ PRED_LD + + term_t pl = A1; + term_t os = A2; + +#ifdef O_XOS + wchar_t *wn; + + if ( !PL_is_variable(pl) ) + { char *n; + wchar_t buf[MAXPATHLEN]; + + if ( PL_get_chars_ex(pl, &n, CVT_ALL|REP_UTF8) ) + { if ( !_xos_os_filenameW(n, buf, MAXPATHLEN) ) + return name_too_long(); + + return PL_unify_wchars(os, PL_ATOM, -1, buf); + } + return FALSE; + } + + if ( PL_get_wchars(os, NULL, &wn, CVT_ALL) ) + { wchar_t lbuf[MAXPATHLEN]; + char buf[MAXPATHLEN]; + + _xos_long_file_nameW(wn, lbuf, MAXPATHLEN); + _xos_canonical_filenameW(lbuf, buf, MAXPATHLEN, 0); + + return PL_unify_chars(pl, PL_ATOM|REP_UTF8, -1, buf); + } + + return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, pl); +#else /*O_XOS*/ + return PL_unify(pl, os); +#endif /*O_XOS*/ +} + + +static +PRED_IMPL("mark_executable", 1, mark_executable, 0) +{ char *name; + + if ( !PL_get_file_name(A1, &name, 0) ) + return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_source_sink, A1); + + return MarkExecutable(name); +} + + + /******************************* + * INIT * + *******************************/ + +void +initFiles(void) +{ +} + + + /******************************* + * PUBLISH PREDICATES * + *******************************/ + +BeginPredDefs(files) + PRED_DEF("working_directory", 2, working_directory, 0) + PRED_DEF("access_file", 2, access_file, 0) + PRED_DEF("time_file", 2, time_file, 0) + PRED_DEF("size_file", 2, size_file, 0) + PRED_DEF("read_link", 3, read_link, 0) + PRED_DEF("exists_file", 1, exists_file, 0) + PRED_DEF("exists_directory", 1, exists_directory, 0) + PRED_DEF("tmp_file", 2, tmp_file, 0) + PRED_DEF("delete_file", 1, delete_file, 0) + PRED_DEF("delete_directory", 1, delete_directory, 0) + PRED_DEF("make_directory", 1, make_directory, 0) + PRED_DEF("same_file", 2, same_file, 0) + PRED_DEF("rename_file", 2, rename_file, 0) + PRED_DEF("is_absolute_file_name", 1, is_absolute_file_name, 0) + PRED_DEF("file_base_name", 2, file_base_name, 0) + PRED_DEF("file_directory_name", 2, file_directory_name, 0) + PRED_DEF("file_name_extension", 3, file_name_extension, 0) + PRED_DEF("prolog_to_os_filename", 2, prolog_to_os_filename, 0) + PRED_DEF("$mark_executable", 1, mark_executable, 0) + PRED_DEF("$absolute_file_name", 2, absolute_file_name, 0) +EndPredDefs diff --git a/packages/PLStream/pl-incl.h b/packages/PLStream/pl-incl.h old mode 100644 new mode 100755 index c26d6865a..41798211f --- a/packages/PLStream/pl-incl.h +++ b/packages/PLStream/pl-incl.h @@ -3,6 +3,10 @@ #define PL_KERNEL 1 +#ifdef __MINGW32__ +#define O_XOS 1 +#endif + #include typedef int bool; @@ -529,7 +533,8 @@ word pl_noprotocol(void); IOSTREAM *PL_current_input(void); IOSTREAM *PL_current_output(void); -PL_EXPORT(int) PL_open_stream(term_t t, IOSTREAM *s); +int reportStreamError(IOSTREAM *s); + PL_EXPORT(int) PL_unify_stream(term_t t, IOSTREAM *s); PL_EXPORT(int) PL_unify_stream_or_alias(term_t t, IOSTREAM *s); PL_EXPORT(int) PL_get_stream_handle(term_t t, IOSTREAM **s); @@ -576,6 +581,9 @@ extern atom_t lookupUCSAtom(const pl_wchar_t *s, size_t len); extern int toIntegerNumber(Number n, int flags); extern int get_atom_ptr_text(Atom a, PL_chars_t *text); +/**** stuff from pl-files.c ****/ +void initFiles(void); + /* empty stub */ void setPrologFlag(const char *name, int flags, ...); void PL_set_prolog_flag(const char *name, int flags, ...); diff --git a/packages/PLStream/pl-os.c b/packages/PLStream/pl-os.c old mode 100644 new mode 100755 index ebe83a46e..62dabd7b3 --- a/packages/PLStream/pl-os.c +++ b/packages/PLStream/pl-os.c @@ -475,6 +475,8 @@ FreeMemory(void) manpage. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ +__stdcall unsigned long GetTickCount(void); + void setRandom(unsigned int *seedp) { unsigned int seed; diff --git a/packages/PLStream/pl-os.h b/packages/PLStream/pl-os.h old mode 100644 new mode 100755 index 5fa9c7de5..669f897a1 --- a/packages/PLStream/pl-os.h +++ b/packages/PLStream/pl-os.h @@ -36,6 +36,10 @@ #include #endif +#ifdef __MINGW32__ +__stdcall unsigned long GetTickCount(void); +#endif + /******************************** * MEMORY MANAGEMENT * @@ -240,7 +244,7 @@ extern bool AccessFile(const char *path, int mode); extern char *OsPath(const char *plpath, char *path); extern char *Getenv(const char *, char *buf, size_t buflen); extern char *BaseName(const char *f); -extern intptr_t LastModifiedFile(char *f); +extern time_t LastModifiedFile(const char *f); extern int64_t SizeFile(const char *path); extern bool ExistsFile(const char *path); extern atom_t TemporaryFile(const char *id); diff --git a/packages/PLStream/uxnt/utf8.c b/packages/PLStream/uxnt/utf8.c old mode 100644 new mode 100755 index c6e730e43..46d1dba45 --- a/packages/PLStream/uxnt/utf8.c +++ b/packages/PLStream/uxnt/utf8.c @@ -31,7 +31,7 @@ UTF-8 Decoding, based on http://www.cl.cam.ac.uk/~mgk25/unicode.html #define CONT(i) ISUTF8_CB(in[1]) #define VAL(i, s) ((in[i]&0x3f) << s) -static char * +char * _xos_utf8_get_char(const char *in, int *chr) { /* 2-byte, 0x80-0x7ff */ if ( (in[0]&0xe0) == 0xc0 && CONT(1) ) @@ -65,7 +65,7 @@ _xos_utf8_get_char(const char *in, int *chr) } -static char * +char * _xos_utf8_put_char(char *out, int chr) { if ( chr < 0x80 ) { *out++ = chr;