643 lines
16 KiB
C
643 lines
16 KiB
C
|
/*************************************************************************
|
||
|
|
* *
|
||
|
|
* YAP Prolog *
|
||
|
|
* *
|
||
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||
|
|
* *
|
||
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||
|
|
* *
|
||
|
|
**************************************************************************
|
||
|
|
* *
|
||
|
|
* File: iopreds.c *
|
||
|
|
* Last rev: 5/2/88 *
|
||
|
|
* mods: *
|
||
|
|
* comments: Input/Output C implemented predicates *
|
||
|
|
* *
|
||
|
|
*************************************************************************/
|
||
|
|
#ifdef SCCS
|
||
|
|
static char SccsId[] = "%W% %G%";
|
||
|
|
#endif
|
||
|
|
|
||
|
|
/*
|
||
|
|
* This file includes the definition of a miscellania of standard predicates
|
||
|
|
* for yap refering to: Files and GLOBAL_Streams, Simple Input/Output,
|
||
|
|
*
|
||
|
|
*/
|
||
|
|
|
||
|
|
#include "Yap.h"
|
||
|
|
#include "Yatom.h"
|
||
|
|
#include "YapHeap.h"
|
||
|
|
#include "yapio.h"
|
||
|
|
#include "eval.h"
|
||
|
|
#include "YapText.h"
|
||
|
|
#include <stdlib.h>
|
||
|
|
#if HAVE_STDARG_H
|
||
|
|
#include <stdarg.h>
|
||
|
|
#endif
|
||
|
|
#if HAVE_CTYPE_H
|
||
|
|
#include <ctype.h>
|
||
|
|
#endif
|
||
|
|
#if HAVE_WCTYPE_H
|
||
|
|
#include <wctype.h>
|
||
|
|
#endif
|
||
|
|
#if HAVE_LIMITS_H
|
||
|
|
#include <limits.h>
|
||
|
|
#endif
|
||
|
|
#if HAVE_SYS_PARAMS_H
|
||
|
|
#include <sys/params.h>
|
||
|
|
#endif
|
||
|
|
#if HAVE_SYS_TYPES_H
|
||
|
|
#include <sys/types.h>
|
||
|
|
#endif
|
||
|
|
#ifdef HAVE_SYS_STAT_H
|
||
|
|
#include <sys/stat.h>
|
||
|
|
#endif
|
||
|
|
#if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__)
|
||
|
|
#include <sys/select.h>
|
||
|
|
#endif
|
||
|
|
#ifdef HAVE_UNISTD_H
|
||
|
|
#include <unistd.h>
|
||
|
|
#endif
|
||
|
|
#if HAVE_STRING_H
|
||
|
|
#include <string.h>
|
||
|
|
#endif
|
||
|
|
#if HAVE_LIBGEN_H
|
||
|
|
#include <libgen.h>
|
||
|
|
#endif
|
||
|
|
#if HAVE_SIGNAL_H
|
||
|
|
#include <signal.h>
|
||
|
|
#endif
|
||
|
|
#if HAVE_FCNTL_H
|
||
|
|
/* for O_BINARY and O_TEXT in WIN32 */
|
||
|
|
#include <fcntl.h>
|
||
|
|
#endif
|
||
|
|
#ifdef _WIN32
|
||
|
|
#if HAVE_IO_H
|
||
|
|
/* Windows */
|
||
|
|
#include <io.h>
|
||
|
|
#endif
|
||
|
|
#endif
|
||
|
|
#if !HAVE_STRNCAT
|
||
|
|
#define strncat(X,Y,Z) strcat(X,Y)
|
||
|
|
#endif
|
||
|
|
#if !HAVE_STRNCPY
|
||
|
|
#define strncpy(X,Y,Z) strcpy(X,Y)
|
||
|
|
#endif
|
||
|
|
#if _MSC_VER || defined(__MINGW32__)
|
||
|
|
#if HAVE_SOCKET
|
||
|
|
#include <winsock2.h>
|
||
|
|
#endif
|
||
|
|
#include <windows.h>
|
||
|
|
#ifndef S_ISDIR
|
||
|
|
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
|
||
|
|
#endif
|
||
|
|
#endif
|
||
|
|
#include "iopreds.h"
|
||
|
|
|
||
|
|
#if _MSC_VER || defined(__MINGW32__)
|
||
|
|
#define SYSTEM_STAT _stat
|
||
|
|
#else
|
||
|
|
#define SYSTEM_STAT stat
|
||
|
|
#endif
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
static Int
|
||
|
|
file_name_extension(USES_REGS1)
|
||
|
|
{
|
||
|
|
Term t1 = Deref(ARG1);
|
||
|
|
Term t2 = Deref(ARG2);
|
||
|
|
Term t3 = Deref(ARG3);
|
||
|
|
bool use_string = false;
|
||
|
|
loop:
|
||
|
|
if (!IsVarTerm((t3))) {
|
||
|
|
const char *f;
|
||
|
|
if (IsAtomTerm(t3)) {
|
||
|
|
f = AtomName( AtomOfTerm( t3 ) );
|
||
|
|
} else if (IsStringTerm( t3 )) {
|
||
|
|
f = StringOfTerm( t3 );
|
||
|
|
use_string = true;
|
||
|
|
} else if (IsApplTerm(t3) && FunctorOfTerm(t3) == FunctorSlash) {
|
||
|
|
// descend a compound term of the form a/b.
|
||
|
|
Term tn1 = MkVarTerm(), tf1;
|
||
|
|
Term ts[2];
|
||
|
|
ts[0] = ArgOfTerm(1,t3);
|
||
|
|
ts[1] = tn1;
|
||
|
|
tf1 = Yap_MkApplTerm( FunctorSlash, 2, ts );
|
||
|
|
if (!Yap_unify(ARG1, tf1)) {
|
||
|
|
return false;
|
||
|
|
}
|
||
|
|
t3 = ArgOfTerm(2, t3);
|
||
|
|
goto loop;
|
||
|
|
} else {
|
||
|
|
Yap_Error(TYPE_ERROR_ATOMIC, t3, "file_name_extension/3");
|
||
|
|
return false;
|
||
|
|
}
|
||
|
|
char *pts = strrchr(f, '/');
|
||
|
|
#if WIN32_ssss
|
||
|
|
char *pts1 = strrchr(f, '\\');
|
||
|
|
if (pts11 > pts) pts = pts1;
|
||
|
|
#endif
|
||
|
|
char *ss = strrchr(f, '.');
|
||
|
|
if (pts > ss) ss = NULL;
|
||
|
|
if (use_string) {
|
||
|
|
char *tmp;
|
||
|
|
if (!ss) {
|
||
|
|
return Yap_unify(ARG1, ARG3) &&
|
||
|
|
Yap_unify(ARG2, MkStringTerm( "" ) );
|
||
|
|
}
|
||
|
|
tmp = malloc((ss - f)+1);
|
||
|
|
strncpy(tmp, f, (ss)-f);
|
||
|
|
if (!Yap_unify(ARG1, MkStringTerm( tmp )) ) {
|
||
|
|
if (tmp != f)
|
||
|
|
free( tmp );
|
||
|
|
return false;
|
||
|
|
}
|
||
|
|
if (tmp != f)
|
||
|
|
free(tmp);
|
||
|
|
// without and with dot
|
||
|
|
if (!Yap_unify(ARG2, MkStringTerm(ss+1)))
|
||
|
|
return Yap_unify(ARG2, MkStringTerm(ss));
|
||
|
|
return true;
|
||
|
|
} else {
|
||
|
|
char *tmp;
|
||
|
|
if (!ss) {
|
||
|
|
return Yap_unify(ARG1, ARG3) &&
|
||
|
|
Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom( "" ) ));
|
||
|
|
}
|
||
|
|
tmp = malloc((ss - f)+1);
|
||
|
|
strncpy(tmp, f, (ss)-f);
|
||
|
|
if (!Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom( tmp ))) ) {
|
||
|
|
if (tmp != f)
|
||
|
|
free( tmp );
|
||
|
|
return false;
|
||
|
|
}
|
||
|
|
if (tmp != f)
|
||
|
|
free(tmp);
|
||
|
|
// without and with dot
|
||
|
|
if (!Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(ss+1))))
|
||
|
|
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(ss)));
|
||
|
|
return true;
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
char s[MAXPATHLEN+1];
|
||
|
|
const char *f1, *f2;
|
||
|
|
loop1:
|
||
|
|
if (IsVarTerm(t1)) {
|
||
|
|
Yap_Error(INSTANTIATION_ERROR, t1, "access");
|
||
|
|
return FALSE;
|
||
|
|
} else if (IsAtomTerm(t1)) {
|
||
|
|
f1 = AtomName( AtomOfTerm( t1 ) );
|
||
|
|
} else if (IsStringTerm( t1 )) {
|
||
|
|
f1 = StringOfTerm( t1 );
|
||
|
|
use_string = true;
|
||
|
|
} else if (IsApplTerm(t1) && FunctorOfTerm(t1) == FunctorSlash) {
|
||
|
|
// descend a compound term of the form a/b.
|
||
|
|
Term tn1 = MkVarTerm(), tf1;
|
||
|
|
Term ts[2];
|
||
|
|
|
||
|
|
ts[0] = ArgOfTerm(1,t1);
|
||
|
|
ts[1] = tn1;
|
||
|
|
tf1 = Yap_MkApplTerm( FunctorSlash, 2, ts );
|
||
|
|
if (!Yap_unify(ARG3, tf1)) {
|
||
|
|
return false;
|
||
|
|
}
|
||
|
|
t1 = ArgOfTerm(2, t1);
|
||
|
|
goto loop1;
|
||
|
|
} else {
|
||
|
|
Yap_Error(TYPE_ERROR_ATOMIC, t1, "file_name_extension/3");
|
||
|
|
return false;
|
||
|
|
}
|
||
|
|
|
||
|
|
if (IsVarTerm(t2)) {
|
||
|
|
Yap_Error(INSTANTIATION_ERROR, t2, "access");
|
||
|
|
return FALSE;
|
||
|
|
} else if (IsAtomTerm(t2)) {
|
||
|
|
f2 = AtomName( AtomOfTerm( t2 ) );
|
||
|
|
} else if (IsStringTerm( t1 )) {
|
||
|
|
f2 = StringOfTerm( t2 );
|
||
|
|
use_string = true;
|
||
|
|
} else {
|
||
|
|
Yap_Error(TYPE_ERROR_ATOMIC, t2, "file_name_extension/3");
|
||
|
|
return false;
|
||
|
|
}
|
||
|
|
if (f2[0] == '.') {
|
||
|
|
strncpy(s,f1,MAXPATHLEN);
|
||
|
|
strncat(s,f2,MAXPATHLEN);
|
||
|
|
if (use_string)
|
||
|
|
return Yap_unify_constant(ARG3,MkStringTerm(s));
|
||
|
|
else
|
||
|
|
return Yap_unify_constant(ARG3,MkAtomTerm(Yap_LookupAtom(s)));
|
||
|
|
} else {
|
||
|
|
strncpy(s,f1,MAXPATHLEN);
|
||
|
|
strncat(s,".",MAXPATHLEN);
|
||
|
|
strncat(s,f2,MAXPATHLEN);
|
||
|
|
if (use_string)
|
||
|
|
return Yap_unify_constant(ARG3,MkStringTerm(s));
|
||
|
|
else
|
||
|
|
return Yap_unify_constant(ARG3,MkAtomTerm(Yap_LookupAtom(s)));
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
static Int
|
||
|
|
access_path(USES_REGS1)
|
||
|
|
{
|
||
|
|
Term tname = Deref(ARG1);
|
||
|
|
char *file_name;
|
||
|
|
|
||
|
|
if (IsVarTerm(tname)) {
|
||
|
|
Yap_Error(INSTANTIATION_ERROR, tname, "access");
|
||
|
|
return FALSE;
|
||
|
|
} else if (!IsAtomTerm (tname)) {
|
||
|
|
Yap_Error(TYPE_ERROR_ATOM, tname, "access");
|
||
|
|
return FALSE;
|
||
|
|
} else {
|
||
|
|
#if HAVE_STAT
|
||
|
|
struct SYSTEM_STAT ss;
|
||
|
|
|
||
|
|
file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
|
||
|
|
if (SYSTEM_STAT(file_name, &ss) != 0) {
|
||
|
|
/* ignore errors while checking a file */
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
return TRUE;
|
||
|
|
#else
|
||
|
|
return FALSE;
|
||
|
|
#endif
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
static Int
|
||
|
|
exists_file(USES_REGS1)
|
||
|
|
{
|
||
|
|
Term tname = Deref(ARG1);
|
||
|
|
char *file_name;
|
||
|
|
|
||
|
|
if (IsVarTerm(tname)) {
|
||
|
|
Yap_Error(INSTANTIATION_ERROR, tname, "access");
|
||
|
|
return FALSE;
|
||
|
|
} else if (!IsAtomTerm (tname)) {
|
||
|
|
Yap_Error(TYPE_ERROR_ATOM, tname, "access");
|
||
|
|
return FALSE;
|
||
|
|
} else {
|
||
|
|
#if HAVE_STAT
|
||
|
|
struct SYSTEM_STAT ss;
|
||
|
|
|
||
|
|
file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
|
||
|
|
if (SYSTEM_STAT(file_name, &ss) != 0) {
|
||
|
|
/* ignore errors while checking a file */
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
return (S_ISREG(ss.st_mode));
|
||
|
|
#else
|
||
|
|
return FALSE;
|
||
|
|
#endif
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
static Int
|
||
|
|
time_file(USES_REGS1)
|
||
|
|
{
|
||
|
|
Term tname = Deref(ARG1);
|
||
|
|
|
||
|
|
if (IsVarTerm(tname)) {
|
||
|
|
Yap_Error(INSTANTIATION_ERROR, tname, "access");
|
||
|
|
return FALSE;
|
||
|
|
} else if (!IsAtomTerm (tname)) {
|
||
|
|
Yap_Error(TYPE_ERROR_ATOM, tname, "access");
|
||
|
|
return FALSE;
|
||
|
|
} else {
|
||
|
|
const char *n = RepAtom(AtomOfTerm(tname))->StrOfAE;
|
||
|
|
#if __WIN32
|
||
|
|
FILETIME ftWrite;
|
||
|
|
if ((hdl = CreateFile( n, 0, 0, NULL, OPEN_EXISTING, NULL)) == 0)
|
||
|
|
return false;
|
||
|
|
if (GetFileTime(hdl, NULL,NULL,&ftWrite))
|
||
|
|
return false;
|
||
|
|
// Convert the last-write time to local time.
|
||
|
|
// FileTimeToSystemTime(&ftWrite, &stUTC);
|
||
|
|
// SystemTimeToTzSpecificLocalTime(NULL, &stUTC, &stLocal);
|
||
|
|
CloseHandle( hdl );
|
||
|
|
return Yap_unify(ARG2, MkIntegerTerm(ftWrite));
|
||
|
|
#elif HAVE_STAT
|
||
|
|
struct SYSTEM_STAT ss;
|
||
|
|
|
||
|
|
if (SYSTEM_STAT(n, &ss) != 0) {
|
||
|
|
/* ignore errors while checking a file */
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
return Yap_unify(ARG2, MkIntegerTerm(ss.st_mtime));
|
||
|
|
#else
|
||
|
|
return FALSE;
|
||
|
|
#endif
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
static Int
|
||
|
|
file_size(USES_REGS1)
|
||
|
|
{
|
||
|
|
|
||
|
|
Int sno = Yap_CheckStream (ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "file_size/2");
|
||
|
|
if (sno < 0)
|
||
|
|
return (FALSE);
|
||
|
|
if (GLOBAL_Stream[sno]. status & Seekable_Stream_f &&
|
||
|
|
!(GLOBAL_Stream[sno]. status & (InMemory_Stream_f|Socket_Stream_f|Pipe_Stream_f))) {
|
||
|
|
// there
|
||
|
|
struct stat file_stat;
|
||
|
|
if (fstat(fileno(GLOBAL_Stream[sno].file), &file_stat) < 0) {
|
||
|
|
PlIOError( PERMISSION_ERROR_INPUT_STREAM, ARG1, "%s in file_size/2", strerror(errno));
|
||
|
|
return false;
|
||
|
|
}
|
||
|
|
// and back again
|
||
|
|
|
||
|
|
return Yap_unify_constant( ARG2, MkIntegerTerm( file_stat.st_size) );
|
||
|
|
}
|
||
|
|
return false;
|
||
|
|
}
|
||
|
|
|
||
|
|
/** @pred access_file( + Name, -
|
||
|
|
|
||
|
|
*/
|
||
|
|
static Int
|
||
|
|
access_file(USES_REGS1)
|
||
|
|
{
|
||
|
|
Term tname = Deref(ARG1);
|
||
|
|
Term tmode = Deref(ARG2);
|
||
|
|
char ares[YAP_FILENAME_MAX];
|
||
|
|
Atom atmode;
|
||
|
|
|
||
|
|
if (IsVarTerm(tmode)) {
|
||
|
|
Yap_Error(INSTANTIATION_ERROR, tmode, "access_file/2");
|
||
|
|
return FALSE;
|
||
|
|
} else if (!IsAtomTerm (tmode)) {
|
||
|
|
Yap_Error(TYPE_ERROR_ATOM, tname, "access_file/2");
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
atmode = AtomOfTerm(tmode);
|
||
|
|
if (IsVarTerm(tname)) {
|
||
|
|
Yap_Error(INSTANTIATION_ERROR, tname, "access_file/2");
|
||
|
|
return FALSE;
|
||
|
|
} else if (!IsAtomTerm (tname)) {
|
||
|
|
Yap_Error(TYPE_ERROR_ATOM, tname, "access_file/2");
|
||
|
|
return FALSE;
|
||
|
|
} else {
|
||
|
|
if (atmode == AtomNone)
|
||
|
|
return TRUE;
|
||
|
|
if (!Yap_TrueFileName (RepAtom(AtomOfTerm(tname))->StrOfAE, ares, (atmode == AtomCsult)))
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
#if HAVE_ACCESS
|
||
|
|
{
|
||
|
|
int mode;
|
||
|
|
|
||
|
|
if (atmode == AtomExist)
|
||
|
|
mode = F_OK;
|
||
|
|
else if (atmode == AtomWrite)
|
||
|
|
mode = W_OK;
|
||
|
|
else if (atmode == AtomRead)
|
||
|
|
mode = R_OK;
|
||
|
|
else if (atmode == AtomAppend)
|
||
|
|
mode = W_OK;
|
||
|
|
else if (atmode == AtomCsult)
|
||
|
|
mode = R_OK;
|
||
|
|
else if (atmode == AtomExecute)
|
||
|
|
mode = X_OK;
|
||
|
|
else {
|
||
|
|
PlIOError(DOMAIN_ERROR_IO_MODE, tmode, "access_file/2");
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
if (access(ares, mode) < 0) {
|
||
|
|
/* ignore errors while checking a file */
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
return TRUE;
|
||
|
|
}
|
||
|
|
#elif HAVE_STAT
|
||
|
|
{
|
||
|
|
struct SYSTEM_STAT ss;
|
||
|
|
|
||
|
|
if (SYSTEM_STAT(ares, &ss) != 0) {
|
||
|
|
/* ignore errors while checking a file */
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
return TRUE;
|
||
|
|
}
|
||
|
|
#else
|
||
|
|
return FALSE;
|
||
|
|
#endif
|
||
|
|
}
|
||
|
|
|
||
|
|
static Int
|
||
|
|
exists_directory(USES_REGS1)
|
||
|
|
{
|
||
|
|
Term tname = Deref(ARG1);
|
||
|
|
char *file_name;
|
||
|
|
|
||
|
|
if (IsVarTerm(tname)) {
|
||
|
|
Yap_Error(INSTANTIATION_ERROR, tname, "exists_directory/1");
|
||
|
|
return FALSE;
|
||
|
|
} else if (!IsAtomTerm (tname)) {
|
||
|
|
Yap_Error(TYPE_ERROR_ATOM, tname, "exists_directory/1");
|
||
|
|
return FALSE;
|
||
|
|
} else {
|
||
|
|
#if HAVE_STAT
|
||
|
|
struct SYSTEM_STAT ss;
|
||
|
|
|
||
|
|
file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
|
||
|
|
if (SYSTEM_STAT(file_name, &ss) != 0) {
|
||
|
|
/* ignore errors while checking a file */
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
return (S_ISDIR(ss.st_mode));
|
||
|
|
#else
|
||
|
|
return FALSE;
|
||
|
|
#endif
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
static Int
|
||
|
|
is_absolute_file_name ( USES_REGS1 )
|
||
|
|
{ /* file_base_name(Stream,N) */
|
||
|
|
Term t = Deref(ARG1);
|
||
|
|
Atom at;
|
||
|
|
if (IsVarTerm(t)) {
|
||
|
|
Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2");
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
at = AtomOfTerm(t);
|
||
|
|
if (IsWideAtom(at)) {
|
||
|
|
#if _WIN32
|
||
|
|
return PathisRelativeW(RepAtom(at)->WStrOfAE[0]);
|
||
|
|
#else
|
||
|
|
return RepAtom(at)->WStrOfAE[0] == '/';
|
||
|
|
#endif
|
||
|
|
} else {
|
||
|
|
return Yap_IsAbsolutePath( RepAtom(at)->StrOfAE );
|
||
|
|
}
|
||
|
|
return false;
|
||
|
|
}
|
||
|
|
|
||
|
|
static Int
|
||
|
|
file_base_name ( USES_REGS1 )
|
||
|
|
{ /* file_base_name(Stream,N) */
|
||
|
|
Term t = Deref(ARG1);
|
||
|
|
Atom at;
|
||
|
|
if (IsVarTerm(t)) {
|
||
|
|
Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2");
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
at = AtomOfTerm(t);
|
||
|
|
if (IsWideAtom(at)) {
|
||
|
|
wchar_t *c = RepAtom(at)->WStrOfAE;
|
||
|
|
Int i = wcslen(c);
|
||
|
|
while (i && !Yap_dir_separator((int)c[--i]));
|
||
|
|
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupWideAtom(c+i)));
|
||
|
|
} else {
|
||
|
|
char *c = RepAtom(at)->StrOfAE;
|
||
|
|
char *s;
|
||
|
|
#if HAVE_BASENAME
|
||
|
|
s = basename( c );
|
||
|
|
#else
|
||
|
|
Int i = strlen(c);
|
||
|
|
while (i && !Yap_dir_separator((int)c[--i]));
|
||
|
|
if (Yap_dir_separator((int)c[i])) {
|
||
|
|
i++;
|
||
|
|
}
|
||
|
|
s = c+i;
|
||
|
|
#endif
|
||
|
|
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
static Int
|
||
|
|
file_directory_name ( USES_REGS1 )
|
||
|
|
{ /* file_directory_name(Stream,N) */
|
||
|
|
Term t = Deref(ARG1);
|
||
|
|
Atom at;
|
||
|
|
if (IsVarTerm(t)) {
|
||
|
|
Yap_Error(INSTANTIATION_ERROR, t, "file_directory_name/2");
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
at = AtomOfTerm(t);
|
||
|
|
if (IsWideAtom(at)) {
|
||
|
|
wchar_t s[YAP_FILENAME_MAX+1];
|
||
|
|
wchar_t *c = RepAtom(at)->WStrOfAE;
|
||
|
|
Int i = wcslen(c);
|
||
|
|
while (i && !Yap_dir_separator((int)c[--i]));
|
||
|
|
if (Yap_dir_separator((int)c[i])) {
|
||
|
|
i++;
|
||
|
|
}
|
||
|
|
wcsncpy(s, c, i);
|
||
|
|
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupWideAtom(s)));
|
||
|
|
} else {
|
||
|
|
char *c = RepAtom(at)->StrOfAE;
|
||
|
|
#if HAVE_BASENAME
|
||
|
|
char *s;
|
||
|
|
s = dirname( c );
|
||
|
|
#else
|
||
|
|
char *s[YAP_FILENAME_MAX+1];
|
||
|
|
Int i = strlen(c);
|
||
|
|
while (i && !Yap_dir_separator((int)c[--i]));
|
||
|
|
if (Yap_dir_separator((int)c[i])) {
|
||
|
|
i++;
|
||
|
|
}
|
||
|
|
strncpy(s, c, i);
|
||
|
|
#endif
|
||
|
|
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
static Int
|
||
|
|
same_file( USES_REGS1 ) {
|
||
|
|
char *f1 = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
|
||
|
|
char *f2 = RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE;
|
||
|
|
|
||
|
|
if (strcmp(f1,f2) == 0)
|
||
|
|
return TRUE;
|
||
|
|
#if HAVE_LSTAT
|
||
|
|
{
|
||
|
|
int out;
|
||
|
|
struct stat *b1, *b2;
|
||
|
|
while ((char *)HR+sizeof(struct stat)*2 > (char *)(ASP-1024)) {
|
||
|
|
if (!Yap_gcl(2*sizeof(struct stat), 2, ENV, gc_P(P,CP))) {
|
||
|
|
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
b1 = (struct stat *)HR;
|
||
|
|
b2 = b1+1;
|
||
|
|
if (strcmp(f1,"user_input") == 0) {
|
||
|
|
if (fstat(fileno(GLOBAL_Stream[0].file), b1) == -1) {
|
||
|
|
/* file does not exist, but was opened? Return -1 */
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
} else if (strcmp(f1,"user_output") == 0) {
|
||
|
|
if (fstat(fileno(GLOBAL_Stream[1].file), b1) == -1) {
|
||
|
|
/* file does not exist, but was opened? Return -1 */
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
} else if (strcmp(f1,"user_error") == 0) {
|
||
|
|
if (fstat(fileno(GLOBAL_Stream[2].file), b1) == -1) {
|
||
|
|
/* file does not exist, but was opened? Return -1 */
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
} else if (stat(f1, b1) == -1) {
|
||
|
|
/* file does not exist, but was opened? Return -1 */
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
if (strcmp(f2,"user_input") == 0) {
|
||
|
|
if (fstat(fileno(GLOBAL_Stream[0].file), b2) == -1) {
|
||
|
|
/* file does not exist, but was opened? Return -1 */
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
} else if (strcmp(f2,"user_output") == 0) {
|
||
|
|
if (fstat(fileno(GLOBAL_Stream[1].file), b2) == -1) {
|
||
|
|
/* file does not exist, but was opened? Return -1 */
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
} else if (strcmp(f2,"user_error") == 0) {
|
||
|
|
if (fstat(fileno(GLOBAL_Stream[2].file), b2) == -1) {
|
||
|
|
/* file does not exist, but was opened? Return -1 */
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
} else if (stat(f2, b2) == -1) {
|
||
|
|
/* file does not exist, but was opened? Return -1 */
|
||
|
|
return FALSE;
|
||
|
|
}
|
||
|
|
out = (b1->st_ino == b2->st_ino
|
||
|
|
#ifdef __LCC__
|
||
|
|
&& memcmp((const void *)&(b1->st_dev),(const void *)&(b2->st_dev),sizeof(buf1.st_dev)) == 0
|
||
|
|
#else
|
||
|
|
&& b1->st_dev == b2->st_dev
|
||
|
|
#endif
|
||
|
|
);
|
||
|
|
return out;
|
||
|
|
}
|
||
|
|
#else
|
||
|
|
return(FALSE);
|
||
|
|
#endif
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
void
|
||
|
|
Yap_InitFiles( void )
|
||
|
|
{
|
||
|
|
Yap_InitCPred ("file_base_name", 2, file_base_name, SafePredFlag);
|
||
|
|
Yap_InitCPred ("file_directory_name", 2, file_directory_name, SafePredFlag);
|
||
|
|
Yap_InitCPred ("is_absolute_file_name", 1, is_absolute_file_name, SafePredFlag);
|
||
|
|
Yap_InitCPred ("same_file", 2, same_file, SafePredFlag|SyncPredFlag);
|
||
|
|
Yap_InitCPred ("access_file", 2, access_file, SafePredFlag|SyncPredFlag);
|
||
|
|
Yap_InitCPred ("access", 1, access_path, SafePredFlag|SyncPredFlag);
|
||
|
|
Yap_InitCPred ("exists_directory", 1, exists_directory, SafePredFlag|SyncPredFlag);
|
||
|
|
Yap_InitCPred ("exists_file", 1, exists_file, SafePredFlag|SyncPredFlag);
|
||
|
|
Yap_InitCPred ("time_file64", 2, time_file, SafePredFlag|SyncPredFlag);
|
||
|
|
Yap_InitCPred ("time_file", 2, time_file, SafePredFlag|SyncPredFlag);
|
||
|
|
Yap_InitCPred ("file_size", 2,file_size, SafePredFlag|SyncPredFlag);
|
||
|
|
Yap_InitCPred ("file_name_extension", 3, file_name_extension, SafePredFlag|SyncPredFlag);
|
||
|
|
}
|
||
|
|
|