diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
07a37b8c52
yap-6.3/os/sysbits.c
Vítor Santos Costa 15404b3835 small 
- do not call goal expansion on meta-calls (that is done by undef).
- docs updates
- fix init code
2015-12-15 09:28:43 +00:00

2298 lines
55 KiB
C
Raw Blame History

/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* PrologPathProkoh
* *
* File: sysbits.c *
* Last rev: 4/03/88 *
* mods: *
* comments: very much machine dependent routines *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
#include "sysbits.h"
/// File Error Handler
static void
Yap_FileError(yap_error_number type, Term where, const char *format,...)
{
if ( trueLocalPrologFlag(FILEERRORS_FLAG) ) {
va_list ap;
va_start (ap, format);
/* now build the error string */
Yap_Error(type, TermNil, format, ap);
va_end (ap);
}
}
static Int p_sh( USES_REGS1 );
static Int p_shell( USES_REGS1 );
static Int p_system( USES_REGS1 );
static Int p_mv( USES_REGS1 );
static Int p_dir_sp( USES_REGS1 );
static Int p_getenv( USES_REGS1 );
static Int p_putenv( USES_REGS1 );
static char *expandVars(const char *pattern, char *expanded, int maxlen);
#ifdef MACYAP
static int chdir(char *);
/* #define signal skel_signal */
#endif /* MACYAP */
void exit(int);
#ifdef __WINDOWS__
void
Yap_WinError(char *yap_error)
{
char msg[256];
/* Error, we could not read time */
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
NULL, GetLastError(),
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), msg, 256,
NULL);
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "%s at %s", msg, yap_error);
}
#endif /* __WINDOWS__ */
#define is_valid_env_char(C) ( ((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && \
(C) <= 'Z') || (C) == '_' )
#if __ANDROID__
AAssetManager * Yap_assetManager;
void *
Yap_openAssetFile( const char *path ) {
const char * p = path+8;
AAsset* asset = AAssetManager_open(Yap_assetManager, p, AASSET_MODE_UNKNOWN);
return asset;
}
bool
Yap_isAsset( const char *path )
{
if (Yap_assetManager == NULL)
return false;
return path[0] == '/'&&
path[1] == 'a'&&
path[2] == 's'&&
path[3] == 's'&&
path[4] == 'e'&&
path[5] == 't'&&
path[6] == 's'&&
(path[7] == '/' || path[7] == '\0');
}
bool
Yap_AccessAsset( const char *name, int mode )
{
AAssetManager* mgr = Yap_assetManager;
const char *bufp=name+7;
if (bufp[0] == '/')
bufp++;
if ((mode & W_OK) == W_OK) {
return false;
}
// directory works if file exists
AAssetDir *assetDir = AAssetManager_openDir(mgr, bufp);
if (assetDir) {
AAssetDir_close(assetDir);
return true;
}
return false;
}
bool
Yap_AssetIsFile( const char *name )
{
AAssetManager* mgr = Yap_assetManager;
const char *bufp=name+7;
if (bufp[0] == '/')
bufp++;
// check if file is a directory.
AAsset *asset = AAssetManager_open(mgr, bufp, AASSET_MODE_UNKNOWN);
if (!asset)
return false;
AAsset_close(asset);
return true;
}
bool
Yap_AssetIsDir( const char *name )
{
AAssetManager* mgr = Yap_assetManager;
const char *bufp=name+7;
if (bufp[0] == '/')
bufp++;
// check if file is a directory.
AAssetDir *assetDir = AAssetManager_openDir(mgr, bufp);
if (!assetDir) {
return false;
}
AAssetDir_close(assetDir);
AAsset *asset = AAssetManager_open(mgr, bufp, AASSET_MODE_UNKNOWN);
if (!asset)
return true;
AAsset_close(asset);
return false;
}
int64_t
Yap_AssetSize( const char *name )
{
AAssetManager* mgr = Yap_assetManager;
const char *bufp=name+7;
if (bufp[0] == '/')
bufp++;
AAsset *asset = AAssetManager_open(mgr, bufp, AASSET_MODE_UNKNOWN);
if (!asset)
return -1;
off64_t len = AAsset_getLength64(asset);
AAsset_close(asset);
return len;
}
#endif
/// is_directory: verifies whether an expanded file name
/// points at a readable directory
static bool
is_directory(const char *FileName)
{
#ifdef __ANDROID__
if (Yap_isAsset(FileName)) {
return Yap_AssetIsDir(FileName);
}
#endif
#ifdef __WINDOWS__
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
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"stat not available in this configuration");
return false;
#endif
}
/// has_access just calls access
/// it uses F_OK, R_OK and friend
static bool
has_access(const char *FileName, int mode)
{
#ifdef __ANDROID__
if (Yap_isAsset(FileName)) {
return Yap_AccessAsset(FileName, mode);
}
#endif
#if HAVE_ACCESS
if (access( FileName, mode ) == 0)
return true;
if (errno == EINVAL) {
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"bad flags to access");
}
return false;
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"access not available in this configuration");
return false;
#endif
}
static bool
exists( const char *f)
{
return has_access( f, F_OK );
}
static int
dir_separator (int ch)
{
#ifdef MAC
return (ch == ':');
#elif ATARI || _MSC_VER
return (ch == '\\');
#elif defined(__MINGW32__) || defined(__CYGWIN__)
return (ch == '\\' || ch == '/');
#else
return (ch == '/');
#endif
}
int
Yap_dir_separator (int ch)
{
return dir_separator (ch);
}
#if __WINDOWS__
#include <psapi.h>
char *libdir = NULL;
#endif
bool
Yap_IsAbsolutePath(const char *p0)
{
// verify first if expansion is needed: ~/ or $HOME/
char c[MAXPATHLEN+1];
char *p = expandVars( p0, c, MAXPATHLEN );
#if _WIN32 || __MINGW32__
return !PathIsRelative(p);
#else
return p[0] == '/';
#endif
}
#define isValidEnvChar(C) ( ((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && \
(C) <= 'Z') || (C) == '_' )
// this is necessary because
// support for ~expansion at the beginning
// systems like Android do not do this.
static char *
yapExpandVars (const char *source, char *result)
{
const char *src = source;
char *res = result;
if(result == NULL)
result = malloc( YAP_FILENAME_MAX+1);
if (strlen(source) >= YAP_FILENAME_MAX) {
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "%s in true_file-name is larger than the buffer size (%d bytes)", source, strlen(source));
}
/* step 1: eating home information */
if (source[0] == '~') {
if (dir_separator(source[1]) || source[1] == '\0')
{
char *s;
src++;
#if defined(_WIN32)
s = getenv("HOMEDRIVE");
if (s != NULL)
strncpy (result, getenv ("HOMEDRIVE"), YAP_FILENAME_MAX);
//s = getenv("HOMEPATH");
#else
s = getenv ("HOME");
#endif
if (s != NULL)
strncpy (result, s, YAP_FILENAME_MAX);
strcat(result,src);
return result;
} else {
#if HAVE_GETPWNAM
struct passwd *user_passwd;
src++;
while (!dir_separator((*res = *src)) && *res != '\0')
res++, src++;
res[0] = '\0';
if ((user_passwd = getpwnam (result)) == NULL) {
Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, MkAtomTerm(Yap_LookupAtom(source)),"User %s does not exist in %s", result, source);
return NULL;
}
strncpy (result, user_passwd->pw_dir, YAP_FILENAME_MAX);
strcat(result, src);
#else
Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, MkAtomTerm(Yap_LookupAtom(source)),"User %s cannot be found in %s, missing getpwnam", result, source);
return NULL;
#endif
}
return result;
}
// do VARIABLE expansion
else if (source[0] == '$') {
/* follow SICStus expansion rules */
char v[YAP_FILENAME_MAX+1];
int ch;
char *s;
src = source+1;
if (src[0] == '{') {
res = v;
src++;
while ((*res = (ch = *src++)) && isValidEnvChar (ch) && ch != '}') {
res++;
}
if (ch == '}') {
// {...}
// done
res[0] = '\0';
}
} else {
res = v;
while ((*res = (ch = *src++)) && isValidEnvChar (ch) && ch != '}') {
res++;
}
src--;
res[0] = '\0';
}
if ((s = (char *) getenv (v))) {
strcpy (result, s);
strcat (result, src);
} else
strcpy( result, src);
}
else {
strncpy (result, source, YAP_FILENAME_MAX);
}
return result;
}
static char *
expandVars(const char *pattern, char *expanded, int maxlent)
{
return yapExpandVars(pattern, expanded);
}
#if _WIN32 || defined(__MINGW32__)
// straightforward conversion from Unix style to WIN style
// check cygwin path.cc for possible improvements
static char *
unix2win( const char *source, char *target, int max)
{
char *s = target;
const char *s0 = source;
char *s1;
int ch;
if (s == NULL)
s = malloc(YAP_FILENAME_MAX+1);
s1 = s;
// win32 syntax
// handle drive notation, eg //a/
if (s0[0] == '\0') {
s[0] = '.';
s[1] = '\0';
return s;
}
if (s0[0] == '/' && s0[1] == '/' && isalpha(s0[2]) && s0[3] == '/')
{
s1[0] = s0[2];
s1[1] = ':';
s1[2] = '\\';
s0+=4;
s1+=3;
}
while ((ch = *s1++ = *s0++)) {
if (ch == '$') {
s1[-1] = '%';
ch = *s0;
// handle $(....)
if (ch == '{') {
s0++;
while ((ch = *s0++) != '}') {
*s1++ = ch;
if (ch == '\0') return FALSE;
}
*s1++ = '%';
} else {
while (((ch = *s1++ = *s0++) >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') || (ch == '-') || (ch >= '0' && ch <= '9') || (ch == '_'));
s1[-1] = '%';
*s1++ = ch;
if (ch == '\0') { s1--; s0--; }
}
} else if (ch == '/')
s1[-1] = '\\';
}
return s;
}
#endif
static char *
OsPath(const char *p, char *buf)
{
return (char *)p;
}
static char *
PrologPath(const char *Y, char *X) {
return (char *)Y ;
}
#if _WIN32
#define HAVE_BASENAME 1
#define HAVE_REALPATH 1
#endif
static bool ChDir(const char *path) {
bool rc = false;
char *qpath = Yap_AbsoluteFile(path, NULL, true);
#ifdef __ANDROID__
if (GLOBAL_AssetsWD) {
free( GLOBAL_AssetsWD );
GLOBAL_AssetsWD = NULL;
}
if (Yap_isAsset(qpath) ) {
AAssetManager* mgr = Yap_assetManager;
const char *ptr = qpath+8;
AAssetDir* d;
if (ptr[0] == '/')
ptr++;
d = AAssetManager_openDir(mgr, ptr);
if (d) {
GLOBAL_AssetsWD = malloc( strlen(qpath) + 1 );
strcpy( GLOBAL_AssetsWD, qpath );
AAssetDir_close( d );
return true;
}
return false;
} else {
GLOBAL_AssetsWD = NULL;
}
#endif
#if _WIN32 || defined(__MINGW32__)
if ((rc = (SetCurrentDirectory(qpath) != 0)) == 0)
{
Yap_WinError("SetCurrentDirectory failed" );
}
#else
rc = (chdir(qpath) == 0);
#endif
free( qpath );
return rc;
}
#if _WIN32 || defined(__MINGW32__)
char *
BaseName(const char *X) {
char *qpath = unix2win(X, NULL, YAP_FILENAME_MAX);
char base[YAP_FILENAME_MAX], ext[YAP_FILENAME_MAX];
_splitpath(qpath, NULL, NULL, base, ext);
strcpy(qpath, base);
strcat(qpath, ext);
return qpath;
}
char *
DirName(const char *X) {
char dir[YAP_FILENAME_MAX];
char drive[YAP_FILENAME_MAX];
char *o = unix2win(X, NULL, YAP_FILENAME_MAX);
int err;
if (!o)
return NULL;
if (( err = _splitpath_s(o, drive, YAP_FILENAME_MAX-1, dir, YAP_FILENAME_MAX-1,NULL, 0, NULL, 0) ) != 0) {
Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not perform _splitpath %s: %s", X, strerror(errno));
return NULL;
}
strncpy(o, drive, YAP_FILENAME_MAX-1);
strncat(o, dir, YAP_FILENAME_MAX-1);
return o;
}
#endif
static char *myrealpath( const char *path, char *out)
{
#if _WIN32 || defined(__MINGW32__)
DWORD retval=0;
// notice that the file does not need to exist
retval = GetFullPathName(path,
YAP_FILENAME_MAX,
out,
NULL);
if (retval == 0)
{
Yap_WinError("Generating a full path name for a file" );
return NULL;
}
return out;
#elif HAVE_REALPATH
{
char *rc = realpath(path,out);
char *s0;
if (rc == NULL && (errno == ENOENT|| errno == EACCES)) {
char *s = basename((char *)path);
s0 = malloc(strlen(s)+1);
strcpy(s0, s);
if ((rc = myrealpath(dirname((char *)path), out))==NULL) {
Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not find file %s: %s", path, strerror(errno));
return NULL;
}
if(rc[strlen(rc)-1] != '/' )
strcat(rc, "/");
strcat(rc, s0);
free(s0);
}
return rc;
}
#else
return NULL;
#endif
}
static char *
PrologExpandVars(const char *spec, char *tmp0, bool ok_to)
{
char *tmp;
#if _WIN32 || defined(__MINGW32__)
char u[YAP_FILENAME_MAX+1];
// first pass, remove Unix style stuff
if (unix2win(spec, u, YAP_FILENAME_MAX) == NULL)
return NULL;
spec = u;
#endif
if (tmp0 == NULL) {
tmp = malloc(YAP_FILENAME_MAX+1);
if (tmp == NULL) {
return NULL;
}
} else {
tmp = tmp0;
}
if ( ok_to )
{
tmp=expandVars(spec,tmp,YAP_FILENAME_MAX);
}
else {
if (tmp != tmp0) {
free(tmp);
}
tmp = (char *)spec;
}
return tmp;
}
/**
* generate absolute path, if ok first expand SICStus Prolog style
*
* @param spec the file path, including ~ and $
* @param tmp where to store the file
* @param ok where to process ~and $
*
* @return tmp, or NULL
*/
char *
Yap_AbsoluteFile(const char *spec, char *tmp, bool ok)
{
char *t1 = NULL;
t1 = PrologExpandVars(spec, t1, ok);
if (!t1)
return NULL;
char *rc = myrealpath(t1, tmp);
return rc;
}
/**
* @pred prolog_expanded_file_system_path( +PrologPath, +ExpandVars, -OSPath )
*
* Apply basic transformations to paths, and conidtionally apply
* traditional SICStus-style variable expansion.
*
* @param PrologPath the source, may be atom or string
* @param ExpandVars expand initial occurrence of ~ or $
* @param ExpandVars expand initial occurrence of ~ or $
* @param Prefix add this path before _PrologPath_
* @param OSPath pathname.
*
* @return
*/
static Int
prolog_expanded_file_system_path( USES_REGS1 )
{
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
Term t3 = Deref(ARG3);
char *o = LOCAL_FileNameBuf;
bool flag;
const char *cmd, *p0;
if (IsAtomTerm(t1)) {
cmd = RepAtom(AtomOfTerm(t1))->StrOfAE;
} else if (IsStringTerm(t1)) {
cmd = StringOfTerm(t1);
} else {
return FALSE;
}
if (t2 == TermTrue)
flag = true;
else if (t2 == TermFalse)
flag = false;
else
return false;
if (IsAtomTerm(t3)) {
p0 = RepAtom(AtomOfTerm(t3))->StrOfAE;
} else if (IsStringTerm(t3)) {
p0 = StringOfTerm(t3);
} else {
return FALSE;
}
const char *out = PrologExpandVars(cmd,o,flag);
if (Yap_IsAbsolutePath(out)) {
return Yap_unify(MkAtomTerm(Yap_LookupAtom(out)), ARG4);
} else if (p0[0] == '\0') {
char *rc = myrealpath(out, LOCAL_FileNameBuf2 );
return Yap_unify(MkAtomTerm(Yap_LookupAtom(rc)), ARG4);
} else {
strncpy( LOCAL_FileNameBuf2, p0, YAP_FILENAME_MAX );
char *pt = LOCAL_FileNameBuf2 + strlen( LOCAL_FileNameBuf );
if ( !dir_separator( pt[-1] )) {
#if ATARI || _MSC_VER || defined(__MINGW32__)
pt[0] = '\\';
#else
pt[0] = '/';
#endif
pt++;
}
out = strncpy( pt, out, YAP_FILENAME_MAX -(pt -LOCAL_FileNameBuf2) );
char *rc = myrealpath(out, LOCAL_FileNameBuf );
return Yap_unify(MkAtomTerm(Yap_LookupAtom(rc)), ARG4);
}
}
#define EXPAND_FILENAME_DEFS() \
PAR("parameter_expansion", isatom, EXPAND_FILENAME_PARAMETER_EXPANSION), \
PAR("commands", boolean, EXPAND_FILENAME_COMMANDS), \
PAR(NULL, ok, EXPAND_FILENAME_END)
#define PAR(x, y, z) z
typedef enum expand_filename_enum_choices {
EXPAND_FILENAME_DEFS()
} expand_filename_enum_choices_t;
#undef PAR
#define PAR(x, y, z) \
{ x, y, z }
static const param_t expand_filename_defs[] = {EXPAND_FILENAME_DEFS()};
#undef PAR
static Term
do_expand_file_name(Term t1, Term opts USES_REGS)
{
xarg *args;
expand_filename_enum_choices_t i;
bool use_glob = false;
char **ss = NULL;
char *tmp = NULL;
const char *spec;
char *tmpe = NULL;
size_t j, pathcount;
int flags = 0;
#if HAVE_WORDEXP
wordexp_t wresult;
#endif
#if HAVE_GLOB
glob_t gresult;
#endif
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, NULL);
return TermNil;
} else if (IsAtomTerm(t1)) {
spec = AtomTermName( t1 );
} else if (IsStringTerm(t1)) {
spec = StringOfTerm( t1 );
} else {
Yap_Error(TYPE_ERROR_ATOM, t1, NULL);
return TermNil;
}
args = Yap_ArgListToVector(opts, expand_filename_defs, EXPAND_FILENAME_END);
if (args == NULL) {
return TermNil;
}
for (i = 0; i < EXPAND_FILENAME_END; i++) {
if (args[i].used) {
Term t = args[i].tvalue;
switch (i) {
case EXPAND_FILENAME_PARAMETER_EXPANSION:
if (t == TermProlog) {
use_glob = true;
tmpe = malloc(YAP_FILENAME_MAX+1);
if (tmpe == NULL) {
return TermNil;
}
tmpe = expandVars( spec, tmpe, YAP_FILENAME_MAX);
#ifdef GLOB_BRACE
flags = GLOB_BRACE|GLOB_TILDE;
#endif
flags |= GLOB_NOCHECK;
spec = tmpe;
} else if (t == TermTrue) {
use_glob = false;
} else if (t == TermFalse) {
use_glob = true;
}
break;
case EXPAND_FILENAME_COMMANDS:
if (!use_glob) {
if (t == TermFalse) {
flags = WRDE_NOCMD;
}
}
case EXPAND_FILENAME_END:
break;
}
}
}
#if _WIN32 || defined(__MINGW32__)
char u[YAP_FILENAME_MAX+1];
// first pass, remove Unix style stuff
if (unix2win(spec, u, YAP_FILENAME_MAX) == NULL)
return NULL;
spec = (const char *)u;
#endif
if (tmp == NULL) {
tmp = malloc(YAP_FILENAME_MAX+1);
if (tmp == NULL) {
return TermNil;
}
}
#if ( __WIN32 || __MINGW32__ )
DWORD retval=0;
// notice that the file does not need to exist
if (ini == NULL) {
ini = malloc(strlen(w)+1);
}
retval = ExpandEnvironmentStrings(pattern,
expanded,
maxlen);
if (retval == 0)
{
Yap_WinError("Generating a full path name for a file" );
return NULL;
}
return expanded;
#elif HAVE_WORDEXP || HAVE_GLOB
/* Expand the string for the program to run. */
if (use_glob) {
#if HAVE_GLOB
switch (glob (spec, flags, NULL, &gresult))
{
case 0: /* Successful. */
ss = gresult.gl_pathv;
pathcount = gresult.gl_pathc;
if (pathcount) {
break;
}
case GLOB_NOMATCH:
globfree(&gresult);
{
Term t;
char *out = LOCAL_FileNameBuf;
t = MkAtomTerm( Yap_LookupAtom( expandVars(spec, out, YAP_FILENAME_MAX-1) ));
return MkPairTerm( t, TermNil );
}
case GLOB_ABORTED:
PlIOError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "glob aborted: %sn", strerror(errno));
globfree (&gresult);
return TermNil;
case GLOB_NOSPACE:
Yap_Error(RESOURCE_ERROR_HEAP, ARG1, "glob ran out of space: %sn", strerror(errno));
globfree (&gresult);
return TermNil;
/* If the error was WRDE_NOSPACE,
then perhaps part of the result was allocated. */
default: /* Some other error. */
return TermNil;
}
#endif
} else {
#if HAVE_WORDEXP
int rc;
switch ((rc = wordexp (spec, &wresult, flags)))
{
case 0: /* Successful. */
ss = wresult.we_wordv;
pathcount = wresult.we_wordc;
if (pathcount) {
break;
} else {
Term t;
char *out = LOCAL_FileNameBuf;
t = MkAtomTerm( Yap_LookupAtom( expandVars(spec, out, YAP_FILENAME_MAX-1) ) );
wordfree (&wresult);
return MkPairTerm( t, TermNil );
}
case WRDE_NOSPACE:
/* If the error was WRDE_NOSPACE,
then perhaps part of the result was allocated. */
Yap_Error(RESOURCE_ERROR_HEAP, ARG1, "wordexp ran out of space: %s", strerror(errno));
wordfree (&wresult);
return TermNil;
default: /* Some other error. */
; PlIOError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "wordexp failed: %s", strerror(errno));
wordfree (&wresult);
return TermNil;
}
#endif
}
Term tf = TermNil;
for (j = 0; j < pathcount; j++) {
const char *s = ss[pathcount-(j+1)];
#if HAVE_REALPATH
s = myrealpath(s, tmp);
#endif
//if (!exists(s))
// continue;
Atom a = Yap_LookupAtom(s);
tf = MkPairTerm(MkAtomTerm( a ),tf);
}
#else
// just use basic
if (expanded == NULL) {
expanded = malloc(strlen(pattern)+1);
}
strcpy(expanded, pattern);
#endif
if (tmp)
free( tmp );
if (tmpe)
free( tmpe );
#if HAVE_GLOB
if (use_glob)
globfree( &gresult );
#endif
#if HAVE_WORDEXP
if (!use_glob)
wordfree( &wresult );
#endif
return tf;
}
static Int
expand_file_name( USES_REGS1)
{
Term tf = do_expand_file_name( Deref(ARG1), TermNil PASS_REGS);
return
Yap_unify( tf, ARG2);
}
static Int
expand_file_name3( USES_REGS1)
{
Term tf = do_expand_file_name( Deref(ARG1), Deref(ARG2) PASS_REGS);
return
Yap_unify( tf, ARG3 );
}
/*
static char *canoniseFileName( char *path) {
#if HAVE_REALPATH && HAVE_BASENAME
#if _WIN32 || defined(__MINGW32__)
char *o = malloc(YAP_FILENAME_MAX+1);
if (!o)
return NULL;
// first pass, remove Unix style stuff
if (unix2win(path, o, YAP_FILENAME_MAX) == NULL)
return NULL;
path = o;
#endif
char *rc, *tmp = malloc(PATH_MAX);
if (tmp == NULL) return NULL;
rc = myrealpath(path, tmp);
if (rc != tmp)
free(tmp);
#if _WIN32 || defined(__MINGW32__)
free(o);
#endif
return rc;
#endif
}
*/
static Int
absolute_file_system_path( USES_REGS1 )
{
Term t = Deref(ARG1);
const char *fp;
bool rc;
char s[MAXPATHLEN+1];
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "absolute_file_system_path");
return false;
} else if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM, t, "absolute_file_system_path");
return false;
}
if (!(fp = Yap_AbsoluteFile( RepAtom(AtomOfTerm(t))->StrOfAE, s, true)))
return false;
rc = Yap_unify(MkAtomTerm(Yap_LookupAtom(fp)), ARG2);
if (fp != s)
free( (void *)fp );
return rc;
}
static Int
prolog_to_os_filename( USES_REGS1 )
{
Term t = Deref(ARG1), t2 = Deref(ARG2);
char *fp;
char out[MAXPATHLEN+1];
if (IsVarTerm(t)) {
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t, "prolog_to_os_filename");
return false;
} else if ( IsAtomTerm(t2) ) {
if (!(fp = PrologPath( RepAtom(AtomOfTerm(t2))->StrOfAE, out)))
return false;
return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom( fp )));
} else {
Yap_Error(TYPE_ERROR_ATOM, t2, "prolog_to_os_filename");
return false;
}
} else if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM, t, "prolog_to_os_filename");
return false;
}
if (!(fp = OsPath( RepAtom(AtomOfTerm(t))->StrOfAE, out)))
return false;
return Yap_unify(MkAtomTerm(Yap_LookupAtom(fp)), ARG2);
}
Atom Yap_TemporaryFile( const char *prefix, int *fd) {
#if HAVE_MKSTEMP
char *tmp = malloc(PATH_MAX);
int n;
int f;
if (tmp == NULL) return NIL;
strncpy(tmp, prefix, PATH_MAX-1);
n = strlen( tmp );
if (n >= 6 &&
tmp[n-1] == 'X' &&
tmp[n-2] == 'X' &&
tmp[n-3] == 'X' &&
tmp[n-4] == 'X' &&
tmp[n-5] == 'X' &&
tmp[n-6] == 'X')
f = mkstemp(tmp);
else {
strncat(tmp, "XXXXXX", PATH_MAX-1);
f = mkstemp(tmp);
}
if (fd) *fd = f;
return Yap_LookupAtom(tmp);
#else
return AtomNil;
#endif
}
/** @pred make_directory(+ _Dir_)
Create a directory _Dir_. The name of the directory must be an atom.
*/
static Int
make_directory( USES_REGS1 )
{
const char *fd = AtomName(AtomOfTerm(ARG1));
#if defined(__MINGW32__) || _MSC_VER
if (_mkdir(fd) == -1) {
#else
if (mkdir(fd, 0777) == -1) {
#endif
/* return an error number */
return false; // errno?
}
return true;
}
static Int
p_rmdir( USES_REGS1 )
{
const char *fd = AtomName(AtomOfTerm(ARG1));
#if defined(__MINGW32__) || _MSC_VER
if (_rmdir(fd) == -1) {
#else
if (rmdir(fd) == -1) {
#endif
/* return an error number */
return(Yap_unify(ARG2, MkIntTerm(errno)));
}
return true;
}
static bool
initSysPath(Term tlib, Term tcommons, bool dir_done, bool commons_done) {
CACHE_REGS
int len;
#if __WINDOWS__
{
char *dir;
if ((dir = Yap_RegistryGetString("library")) &&
is_directory(dir)) {
if (! Yap_unify( tlib,
MkAtomTerm(Yap_LookupAtom(dir))) )
return FALSE;
}
dir_done = true;
if ((dir = Yap_RegistryGetString("prolog_commons")) &&
is_directory(dir)) {
if (! Yap_unify( tcommons,
MkAtomTerm(Yap_LookupAtom(dir))) )
return FALSE;
}
commons_done = true;
}
if (dir_done && commons_done)
return TRUE;
#endif
strncpy(LOCAL_FileNameBuf, YAP_SHAREDIR, YAP_FILENAME_MAX);
strncat(LOCAL_FileNameBuf,"/", YAP_FILENAME_MAX);
len = strlen(LOCAL_FileNameBuf);
if (!dir_done) {
strncat(LOCAL_FileNameBuf, "Yap", YAP_FILENAME_MAX);
if (is_directory(LOCAL_FileNameBuf))
{
if (! Yap_unify( tlib,
MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))) )
return FALSE;
dir_done = true;
}
}
if (!commons_done) {
LOCAL_FileNameBuf[len] = '\0';
strncat(LOCAL_FileNameBuf, "PrologCommons", YAP_FILENAME_MAX);
if (is_directory(LOCAL_FileNameBuf)) {
if (! Yap_unify( tcommons,
MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))) )
return FALSE;
}
commons_done = true;
}
if (dir_done && commons_done)
return TRUE;
#if __WINDOWS__
{
size_t buflen;
char *pt;
/* couldn't find it where it was supposed to be,
let's try using the executable */
if (!GetModuleFileName( NULL, LOCAL_FileNameBuf, YAP_FILENAME_MAX)) {
Yap_WinError( "could not find executable name" );
/* do nothing */
return FALSE;
}
buflen = strlen(LOCAL_FileNameBuf);
pt = LOCAL_FileNameBuf+buflen;
while (*--pt != '\\') {
/* skip executable */
if (pt == LOCAL_FileNameBuf) {
Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not find executable name");
/* do nothing */
return FALSE;
}
}
while (*--pt != '\\') {
/* skip parent directory "bin\\" */
if (pt == LOCAL_FileNameBuf) {
Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not find executable name");
/* do nothing */
return FALSE;
}
}
/* now, this is a possible location for the ROOT_DIR, let's look for a share directory here */
pt[1] = '\0';
/* grosse */
strncat(LOCAL_FileNameBuf,"lib\\Yap",YAP_FILENAME_MAX);
libdir = Yap_AllocCodeSpace(strlen(LOCAL_FileNameBuf)+1);
strncpy(libdir, LOCAL_FileNameBuf, strlen(LOCAL_FileNameBuf)+1);
pt[1] = '\0';
strncat(LOCAL_FileNameBuf,"share",YAP_FILENAME_MAX);
}
strncat(LOCAL_FileNameBuf,"\\", YAP_FILENAME_MAX);
len = strlen(LOCAL_FileNameBuf);
strncat(LOCAL_FileNameBuf, "Yap", YAP_FILENAME_MAX);
if (!dir_done && is_directory(LOCAL_FileNameBuf)) {
if (! Yap_unify( tlib,
MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))) )
return FALSE;
}
dir_done = true;
LOCAL_FileNameBuf[len] = '\0';
strncat(LOCAL_FileNameBuf, "PrologCommons", YAP_FILENAME_MAX);
if (!commons_done && is_directory(LOCAL_FileNameBuf)) {
if (! Yap_unify( tcommons,
MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))) )
return FALSE;
}
commons_done = true;
#endif
return dir_done && commons_done;
}
static Int
libraries_directories( USES_REGS1 )
{
return initSysPath( ARG1, ARG2 , false, false );
}
static Int
system_library( USES_REGS1 )
{
return initSysPath( ARG1, MkVarTerm(), false, true );
}
static Int
commons_library( USES_REGS1 )
{
return initSysPath( MkVarTerm(), ARG1, true, false );
}
static Int
p_dir_sp ( USES_REGS1 )
{
#if ATARI || _MSC_VER || defined(__MINGW32__)
Term t = MkIntTerm('\\');
Term t2 = MkIntTerm('/');
#else
Term t = MkIntTerm('/');
Term t2 = MkIntTerm('/');
#endif
return Yap_unify_constant(ARG1,t) || Yap_unify_constant(ARG1,t2) ;
}
void
Yap_InitPageSize(void)
{
#ifdef _WIN32
SYSTEM_INFO si;
GetSystemInfo(&si);
Yap_page_size = si.dwPageSize;
#elif HAVE_UNISTD_H
#if defined(__FreeBSD__) || defined(__DragonFly__)
Yap_page_size = getpagesize();
#elif defined(_AIX)
Yap_page_size = sysconf(_SC_PAGE_SIZE);
#elif !defined(_SC_PAGESIZE)
Yap_page_size = getpagesize();
#else
Yap_page_size = sysconf(_SC_PAGESIZE);
#endif
#else
bla bla
#endif
}
/* TrueFileName -> Finds the true name of a file */
#ifdef __MINGW32__
#include <ctype.h>
#endif
static int
volume_header(char *file)
{
#if _MSC_VER || defined(__MINGW32__)
char *ch = file;
int c;
while ((c = ch[0]) != '\0') {
if (isalnum(c)) ch++;
else return(c == ':');
}
#endif
return(FALSE);
}
int
Yap_volume_header(char *file)
{
return volume_header(file);
}
const char * Yap_getcwd(const char *cwd, size_t cwdlen)
{
#if _WIN32 || defined(__MINGW32__)
if (GetCurrentDirectory(cwdlen, (char *)cwd) == 0)
{
Yap_WinError("GetCurrentDirectory failed" );
return NULL;
}
return (char *)cwd;
#elif __ANDROID__
if (GLOBAL_AssetsWD) {
return strncpy( (char *)cwd, (const char *)GLOBAL_AssetsWD, cwdlen);
}
#endif
return getcwd((char *)cwd, cwdlen);
}
static Int
working_directory(USES_REGS1)
{
char dir[YAP_FILENAME_MAX+1];
Term t1 = Deref(ARG1), t2;
if ( !IsVarTerm( t1 ) && !IsAtomTerm(t1) ) {
Yap_Error(TYPE_ERROR_ATOM, t1, "working_directory");
}
if (!Yap_unify( t1, MkAtomTerm(Yap_LookupAtom(Yap_getcwd(dir,YAP_FILENAME_MAX )))) )
return false;
t2 = Deref(ARG2);
if ( IsVarTerm( t2 ) ) {
Yap_Error(INSTANTIATION_ERROR, t2, "working_directory");
}
if ( !IsAtomTerm(t2) ) {
Yap_Error(TYPE_ERROR_ATOM, t2, "working_directory");
}
ChDir(RepAtom(AtomOfTerm(t2))->StrOfAE);
return true;
}
static char *
expandWithPrefix(const char *source, const char *root, char *result)
{
char *work;
char ares1[YAP_FILENAME_MAX+1];
work = expandVars( source, ares1, YAP_FILENAME_MAX);
// expand names first
if (root && !Yap_IsAbsolutePath( source ) ) {
char ares2[YAP_FILENAME_MAX+1];
strncpy( ares2, root, YAP_FILENAME_MAX );
strncat( ares2, "/", YAP_FILENAME_MAX );
strncat( ares2, work, YAP_FILENAME_MAX );
return Yap_AbsoluteFile( ares2, result , false);
} else {
// expand path
return myrealpath( work, result);
}
}
/** Yap_trueFileName: tries to generate the true name of file
*
*
* @param isource the proper file
* @param idef the default name fo rthe file, ie, startup.yss
* @param root the prefix
* @param result the output
* @param access verify whether the file has access permission
* @param ftype saved state, object, saved file, prolog file
* @param expand_root expand $ ~, etc
* @param in_lib library file
*
* @return
*/
bool
Yap_trueFileName (const char *isource, const char * idef, const char *iroot, char *result, bool access, file_type_t ftype, bool expand_root, bool in_lib)
{
char save_buffer[YAP_FILENAME_MAX+1];
const char *root, *source = isource;
int rc = FAIL_RESTORE;
int try = 0;
while ( rc == FAIL_RESTORE) {
bool done = false;
// { CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "try=%d %s %s", try, isource, iroot) ; }
switch (try++) {
case 0: // path or file name is given;
root = iroot;
if (iroot || isource) {
source = ( isource ? isource : idef ) ;
} else {
done = true;
}
break;
case 1: // library directory is given in command line
if ( in_lib && ftype == YAP_SAVED_STATE) {
root = iroot;
source = ( isource ? isource : idef ) ;
} else
done = true;
break;
case 2: // use environment variable YAPLIBDIR
#if HAVE_GETENV
if ( in_lib) {
if (ftype == YAP_SAVED_STATE || ftype == YAP_OBJ) {
root = getenv("YAPLIBDIR");
} else {
root = getenv("YAPSHAREDIR");
}
source = ( isource ? isource : idef ) ;
} else
done = true;
break;
#else
done = true;
#endif
break;
case 3: // use compilation variable YAPLIBDIR
if ( in_lib) {
source = ( isource ? isource : idef ) ;
if (ftype == YAP_PL || ftype == YAP_QLY) {
root = YAP_SHAREDIR;
} else {
root = YAP_LIBDIR;
}
} else
done = true;
break;
case 4: // WIN stuff: registry
#if __WINDOWS__
if ( in_lib) {
source = ( ftype == YAP_PL || ftype == YAP_QLY ? "library" : "startup" ) ;
source = Yap_RegistryGetString( source );
root = NULL;
} else
#endif
done = true;
break;
case 5: // search from the binary
{
#ifndef __ANDROID__
done = true;
break;
#endif
const char *pt = Yap_FindExecutable();
if (pt) {
source = ( ftype == YAP_SAVED_STATE || ftype == YAP_OBJ ? "../../lib/Yap" : "../../share/Yap" ) ;
if (Yap_trueFileName(source, NULL, pt, save_buffer, access, ftype, expand_root, in_lib) )
root = save_buffer;
else
done = true;
} else {
done = true;
}
source = ( isource ? isource : idef ) ;
}
break;
case 6: // default, try current directory
if (!isource && ftype == YAP_SAVED_STATE)
source = idef;
root = NULL;
break;
default:
return false;
}
if (done)
continue;
if (expand_root && root) {
root = expandWithPrefix( root, NULL, save_buffer );
}
// { CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "root= %s %s ", root, source) ; }
char *work = expandWithPrefix( source, root, result );
// expand names in case you have
// to add a prefix
if ( !access || exists( work ) )
return true; // done
}
return false;
}
int
Yap_TrueFileName (const char *source, char *result, int in_lib)
{
return Yap_trueFileName (source, NULL, NULL, result, true, YAP_PL, true, in_lib);
}
int
Yap_TruePrefixedFileName (const char *source, const char *root, char *result, int in_lib)
{
return Yap_trueFileName (source, NULL, root, result, true, YAP_PL, true, in_lib);
}
static Int
true_file_name ( USES_REGS1 )
{
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;
}
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, NULL, NULL, LOCAL_FileNameBuf, false, YAP_PL, false, false))
return FALSE;
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)));
}
static Int
p_expand_file_name ( USES_REGS1 )
{
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;
}
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, NULL, NULL, LOCAL_FileNameBuf, true, YAP_PL, true, false))
return false;
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)));
}
static Int
true_file_name3 ( USES_REGS1 )
{
Term t = Deref(ARG1), t2 = Deref(ARG2);
char *root = NULL;
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;
}
if (!IsVarTerm(t2)) {
if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM,t2,"argument to true_file_name");
return FALSE;
}
root = RepAtom(AtomOfTerm(t2))->StrOfAE;
}
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, NULL, root, LOCAL_FileNameBuf, false, YAP_PL, false, false))
return FALSE;
return Yap_unify(ARG3, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)));
}
/* Executes $SHELL under Prolog */
/** @pred sh
Creates a new shell interaction.
*/
static Int
p_sh ( USES_REGS1 )
{ /* sh */
#ifdef HAVE_SYSTEM
char *shell;
shell = (char *) getenv ("SHELL");
if (shell == NULL)
shell = "/bin/sh";
if (system (shell) < 0) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "%s in sh/0", strerror(errno));
#else
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "in sh/0");
#endif
return FALSE;
}
return TRUE;
#else
#ifdef MSH
register char *shell;
shell = "msh -i";
system (shell);
return (TRUE);
#else
Yap_Error(SYSTEM_ERROR_INTERNAL,TermNil,"sh not available in this configuration");
return(FALSE);
#endif /* MSH */
#endif
}
/** shell(+Command:text, -Status:integer) is det.
Run an external command and wait for its completion.
*/
static Int
p_shell ( USES_REGS1 )
{ /* '$shell'(+SystCommand) */
#if _MSC_VER || defined(__MINGW32__)
char *cmd;
term_t A1 = Yap_InitSlot(ARG1);
if ( PL_get_chars(A1, &cmd, CVT_ALL|REP_FN|CVT_EXCEPTION) )
{ int rval = System(cmd);
return rval == 0;
}
return FALSE;
#else
#if HAVE_SYSTEM
char *shell;
register int bourne = FALSE;
Term t1 = Deref (ARG1);
const char *cmd;
shell = (char *) getenv ("SHELL");
if (!strcmp (shell, "/bin/sh"))
bourne = TRUE;
if (shell == NIL)
bourne = TRUE;
if (IsAtomTerm(t1))
cmd = RepAtom(AtomOfTerm(t1))->StrOfAE;
else if (IsStringTerm(t1))
cmd = StringOfTerm(t1);
else
return FALSE;
/* Yap_CloseStreams(TRUE); */
if (bourne)
return system( cmd ) == 0;
else {
int status = -1;
int child = fork ();
if (child == 0) { /* let the children go */
if (!execl (shell, shell, "-c", cmd , NULL)) {
exit(-1);
}
exit(TRUE);
}
{ /* put the father on wait */
int result = child < 0 ||
/* vsc:I am not sure this is used, Stevens say wait returns an integer.
#if NO_UNION_WAIT
*/
wait ((&status)) != child ||
/*
#else
wait ((union wait *) (&status)) != child ||
#endif
*/
status == 0;
return result;
}
}
#else /* HAVE_SYSTEM */
#ifdef MSH
register char *shell;
shell = "msh -i";
/* Yap_CloseStreams(); */
system (shell);
return TRUE;
#else
Yap_Error (SYSTEM_ERROR_INTERNAL,TermNil,"shell not available in this configuration");
return FALSE;
#endif
#endif /* HAVE_SYSTEM */
#endif /* _MSC_VER */
}
/** system(+Command:text).
Run an external command.
*/
static Int
p_system ( USES_REGS1 )
{ /* '$system'(+SystCommand) */
#if _MSC_VER || defined(__MINGW32__)
char *cmd;
term_t A1 = Yap_InitSlot(ARG1);
if ( PL_get_chars(A1, &cmd, CVT_ALL|REP_FN|CVT_EXCEPTION) )
{ STARTUPINFO si;
PROCESS_INFORMATION pi;
ZeroMemory( &si, sizeof(si) );
si.cb = sizeof(si);
ZeroMemory( &pi, sizeof(pi) );
// Start the child process.
if( !CreateProcess( NULL, // No module name (use command line)
cmd, // Command line
NULL, // Process handle not inheritable
NULL, // Thread handle not inheritable
FALSE, // Set handle inheritance to FALSE
0, // No creation flags
NULL, // Use parent's environment block
NULL, // Use parent's starting directory
&si, // Pointer to STARTUPINFO structure
&pi ) // Pointer to PROCESS_INFORMATION structure
)
{
Yap_Error( SYSTEM_ERROR_INTERNAL, ARG1, "CreateProcess failed (%d).\n", GetLastError() );
return FALSE;
}
// Wait until child process exits.
WaitForSingleObject( pi.hProcess, INFINITE );
// Close process and thread handles.
CloseHandle( pi.hProcess );
CloseHandle( pi.hThread );
return TRUE;
}
return FALSE;
#elif HAVE_SYSTEM
Term t1 = Deref (ARG1);
const char *s;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR,t1,"argument to system/1 unbound");
return FALSE;
} else if (IsAtomTerm(t1)) {
s = RepAtom(AtomOfTerm(t1))->StrOfAE;
} else if (IsStringTerm(t1)) {
s = StringOfTerm(t1);
} else {
if (!Yap_GetName (LOCAL_FileNameBuf, YAP_FILENAME_MAX, t1)) {
Yap_Error(TYPE_ERROR_ATOM,t1,"argument to system/1");
return FALSE;
}
s = LOCAL_FileNameBuf;
}
/* Yap_CloseStreams(TRUE); */
#if _MSC_VER
_flushall();
#endif
if (system (s)) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t1,"%s in system(%s)", strerror(errno), s);
#else
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t1,"in system(%s)", s);
#endif
return FALSE;
}
return TRUE;
#else
#ifdef MSH
register char *shell;
shell = "msh -i";
/* Yap_CloseStreams(); */
system (shell);
return (TRUE);
#undef command
#else
Yap_Error(SYSTEM_ERROR_INTERNAL,TermNil,"sh not available in this machine");
return(FALSE);
#endif
#endif /* HAVE_SYSTEM */
}
/* Rename a file */
/** @pred rename(+ _F_,+ _G_)
Renames file _F_ to _G_.
*/
static Int
p_mv ( USES_REGS1 )
{ /* rename(+OldName,+NewName) */
#if HAVE_LINK
int r;
char oldname[YAP_FILENAME_MAX], newname[YAP_FILENAME_MAX];
Term t1 = Deref (ARG1);
Term t2 = Deref (ARG2);
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "first argument to rename/2 unbound");
} else if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1, "first argument to rename/2 not atom");
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t2, "second argument to rename/2 unbound");
} else if (!IsAtomTerm(t2)) {
Yap_Error(TYPE_ERROR_ATOM, t2, "second argument to rename/2 not atom");
}
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t1))->StrOfAE, NULL, NULL, oldname, true, YAP_STD, true, false))
return FALSE;
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t2))->StrOfAE, NULL, NULL, oldname, true, YAP_STD, true, false))
return FALSE;
if ((r = link (oldname, newname)) == 0 && (r = unlink (oldname)) != 0)
unlink (newname);
if (r != 0) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t2,"%s in rename(%s,%s)", strerror(errno),oldname,newname);
#else
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t2,"in rename(%s,%s)",oldname,newname);
#endif
return FALSE;
}
return TRUE;
#else
Yap_Error(SYSTEM_ERROR_INTERNAL,TermNil,"rename/2 not available in this machine");
return (FALSE);
#endif
}
#ifdef MAC
void
Yap_SetTextFile (name)
char *name;
{
#ifdef MACC
SetFileType (name, 'TEXT');
SetFileSignature (name, 'EDIT');
#else
FInfo f;
FInfo *p = &f;
GetFInfo (name, 0, p);
p->fdType = 'TEXT';
#ifdef MPW
if (mpwshell)
p->fdCreator = 'MPS\0';
#endif
#ifndef LIGHT
else
p->fdCreator = 'EDIT';
#endif
SetFInfo (name, 0, p);
#endif
}
#endif
/* return YAP's environment */
static Int p_getenv( USES_REGS1 )
{
#if HAVE_GETENV
Term t1 = Deref(ARG1), to;
char *s, *so;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1,
"first arg of getenv/2");
return(FALSE);
} else if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1,
"first arg of getenv/2");
return(FALSE);
} else s = RepAtom(AtomOfTerm(t1))->StrOfAE;
if ((so = getenv(s)) == NULL)
return(FALSE);
to = MkAtomTerm(Yap_LookupAtom(so));
return(Yap_unify_constant(ARG2,to));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"getenv not available in this configuration");
return (FALSE);
#endif
}
/* set a variable in YAP's environment */
static Int p_putenv( USES_REGS1 )
{
#if HAVE_PUTENV
Term t1 = Deref(ARG1), t2 = Deref(ARG2);
char *s, *s2, *p0, *p;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1,
"first arg to putenv/2");
return(FALSE);
} else if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1,
"first arg to putenv/2");
return(FALSE);
} else s = RepAtom(AtomOfTerm(t1))->StrOfAE;
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t1,
"second arg to putenv/2");
return(FALSE);
} else if (!IsAtomTerm(t2)) {
Yap_Error(TYPE_ERROR_ATOM, t2,
"second arg to putenv/2");
return(FALSE);
} else s2 = RepAtom(AtomOfTerm(t2))->StrOfAE;
while (!(p0 = p = Yap_AllocAtomSpace(strlen(s)+strlen(s2)+3))) {
if (!Yap_growheap(FALSE, MinHeapGap, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
return FALSE;
}
}
while ((*p++ = *s++) != '\0');
p[-1] = '=';
while ((*p++ = *s2++) != '\0');
if (putenv(p0) == 0)
return TRUE;
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil,
"in putenv(%s)", strerror(errno), p0);
#else
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil,
"in putenv(%s)", p0);
#endif
return FALSE;
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"putenv not available in this configuration");
return FALSE;
#endif
}
/* wrapper for alarm system call */
#if _MSC_VER || defined(__MINGW32__)
static DWORD WINAPI
DoTimerThread(LPVOID targ)
{
Int *time = (Int *)targ;
HANDLE htimer;
LARGE_INTEGER liDueTime;
htimer = CreateWaitableTimer(NULL, FALSE, NULL);
liDueTime.QuadPart = -10000000;
liDueTime.QuadPart *= time[0];
/* add time in usecs */
liDueTime.QuadPart -= time[1]*10;
/* Copy the relative time into a LARGE_INTEGER. */
if (SetWaitableTimer(htimer, &liDueTime,0,NULL,NULL,0) == 0) {
return(FALSE);
}
if (WaitForSingleObject(htimer, INFINITE) != WAIT_OBJECT_0)
fprintf(stderr,"WaitForSingleObject failed (%ld)\n", GetLastError());
Yap_signal (YAP_WINTIMER_SIGNAL);
/* now, say what is going on */
Yap_PutValue(AtomAlarm, MkAtomTerm(AtomTrue));
ExitThread(1);
#if _MSC_VER
return(0L);
#endif
}
#endif
static Int
p_host_type( USES_REGS1 ) {
Term out = MkAtomTerm(Yap_LookupAtom(HOST_ALIAS));
return(Yap_unify(out,ARG1));
}
static Int
p_yap_home( USES_REGS1 ) {
Term out = MkAtomTerm(Yap_LookupAtom(YAP_ROOTDIR));
return(Yap_unify(out,ARG1));
}
static Int
p_yap_paths( USES_REGS1 ) {
Term out1, out2, out3;
const char *env_destdir = getenv("DESTDIR");
char destdir[YAP_FILENAME_MAX+1];
if (env_destdir) {
strncat(destdir, env_destdir, YAP_FILENAME_MAX );
strncat(destdir, "/" YAP_LIBDIR, YAP_FILENAME_MAX );
out1 = MkAtomTerm(Yap_LookupAtom(destdir));
} else {
out1 = MkAtomTerm(Yap_LookupAtom(YAP_LIBDIR));
}
if (env_destdir) {
strncat(destdir, env_destdir, YAP_FILENAME_MAX );
strncat(destdir, "/" YAP_SHAREDIR, YAP_FILENAME_MAX );
out2 = MkAtomTerm(Yap_LookupAtom(destdir));
} else {
out2 = MkAtomTerm(Yap_LookupAtom(YAP_SHAREDIR));
}
if (env_destdir) {
strncat(destdir, env_destdir, YAP_FILENAME_MAX );
strncat(destdir, "/" YAP_BINDIR, YAP_FILENAME_MAX );
out3 = MkAtomTerm(Yap_LookupAtom(destdir));
} else {
out3 = MkAtomTerm(Yap_LookupAtom(YAP_BINDIR));
}
return(Yap_unify(out1,ARG1) &&
Yap_unify(out2,ARG2) &&
Yap_unify(out3,ARG3));
}
static Int
p_log_event( USES_REGS1 ) {
Term in = Deref(ARG1);
Atom at;
if (IsVarTerm(in))
return FALSE;
if (!IsAtomTerm(in))
return FALSE;
at = AtomOfTerm( in );
#if DEBUG
if (IsWideAtom(at) )
fprintf(stderr, "LOG %S\n", RepAtom(at)->WStrOfAE);
else if (IsBlob(at))
return FALSE;
else
fprintf(stderr, "LOG %s\n", RepAtom(at)->StrOfAE);
#endif
if (IsWideAtom(at) || IsBlob(at))
return FALSE;
LOG( " %s ",RepAtom(at)->StrOfAE);
return TRUE;
}
static Int
p_env_separator( USES_REGS1 ) {
#if defined(_WIN32)
return Yap_unify(MkIntegerTerm(';'),ARG1);
#else
return Yap_unify(MkIntegerTerm(':'),ARG1);
#endif
}
/*
* This is responsable for the initialization of all machine dependant
* predicates
*/
void
Yap_InitSysbits (int wid)
{
CACHE_REGS
#if __simplescalar__
{
char *pwd = getenv("PWD");
strncpy(GLOBAL_pwd,pwd,YAP_FILENAME_MAX);
}
#endif
Yap_InitWTime ();
Yap_InitRandom ();
/* let the caller control signals as it sees fit */
Yap_InitOSSignals (worker_id);
}
static Int
p_unix( USES_REGS1 )
{
#ifdef unix
return TRUE;
#else
#ifdef __unix__
return TRUE;
#else
#ifdef __APPLE__
return TRUE;
#else
return FALSE;
#endif
#endif
#endif
}
static Int
p_win32( USES_REGS1 )
{
#ifdef _WIN32
return TRUE;
#else
#ifdef __CYGWIN__
return TRUE;
#else
return FALSE;
#endif
#endif
}
static Int
p_ld_path( USES_REGS1 )
{
return Yap_unify(ARG1,MkAtomTerm(Yap_LookupAtom(YAP_LIBDIR)));
}
static Int
p_address_bits( USES_REGS1 )
{
#if SIZEOF_INT_P==4
return Yap_unify(ARG1,MkIntTerm(32));
#else
return Yap_unify(ARG1,MkIntTerm(64));
#endif
}
#ifdef _WIN32
/* This code is from SWI-Prolog by Jan Wielemaker */
#define wstreq(s,q) (wcscmp((s), (q)) == 0)
static HKEY
reg_open_key(const wchar_t *which, int create)
{ HKEY key = HKEY_CURRENT_USER;
DWORD disp;
LONG rval;
while(*which)
{ wchar_t buf[256];
wchar_t *s;
HKEY tmp;
for(s=buf; *which && !(*which == '/' || *which == '\\'); )
*s++ = *which++;
*s = '\0';
if ( *which )
which++;
if ( wstreq(buf, L"HKEY_CLASSES_ROOT") )
{ key = HKEY_CLASSES_ROOT;
continue;
} else if ( wstreq(buf, L"HKEY_CURRENT_USER") )
{ key = HKEY_CURRENT_USER;
continue;
} else if ( wstreq(buf, L"HKEY_LOCAL_MACHINE") )
{ key = HKEY_LOCAL_MACHINE;
continue;
} else if ( wstreq(buf, L"HKEY_USERS") )
{ key = HKEY_USERS;
continue;
}
if ( RegOpenKeyExW(key, buf, 0L, KEY_READ, &tmp) == ERROR_SUCCESS )
{ RegCloseKey(key);
key = tmp;
continue;
}
if ( !create )
return NULL;
rval = RegCreateKeyExW(key, buf, 0, L"", 0,
KEY_ALL_ACCESS, NULL, &tmp, &disp);
RegCloseKey(key);
if ( rval == ERROR_SUCCESS )
key = tmp;
else
return NULL;
}
return key;
}
#define MAXREGSTRLEN 1024
static void
recover_space(wchar_t *k, Atom At)
{
if (At->WStrOfAE != k)
Yap_FreeCodeSpace((char *)k);
}
static wchar_t *
WideStringFromAtom(Atom KeyAt USES_REGS)
{
if (IsWideAtom(KeyAt)) {
return KeyAt->WStrOfAE;
} else {
int len = strlen(KeyAt->StrOfAE);
int sz = sizeof(wchar_t)*(len+1);
char *chp = KeyAt->StrOfAE;
wchar_t *kptr, *k;
k = (wchar_t *)Yap_AllocCodeSpace(sz);
while (k == NULL) {
if (!Yap_growheap(FALSE, sz, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, MkIntegerTerm(sz), "generating key in win_registry_get_value/3");
return FALSE;
}
}
kptr = k;
while ((*kptr++ = *chp++));
return k;
}
}
static Int
p_win_registry_get_value( USES_REGS1 )
{
DWORD type;
BYTE data[MAXREGSTRLEN];
DWORD len = sizeof(data);
wchar_t *k, *name;
HKEY key;
Term Key = Deref(ARG1);
Term Name = Deref(ARG2);
Atom KeyAt, NameAt;
if (IsVarTerm(Key)) {
Yap_Error(INSTANTIATION_ERROR,Key,"argument to win_registry_get_value unbound");
return FALSE;
}
if (!IsAtomTerm(Key)) {
Yap_Error(TYPE_ERROR_ATOM,Key,"argument to win_registry_get_value");
return FALSE;
}
KeyAt = AtomOfTerm(Key);
if (IsVarTerm(Name)) {
Yap_Error(INSTANTIATION_ERROR,Key,"argument to win_registry_get_value unbound");
return FALSE;
}
if (!IsAtomTerm(Name)) {
Yap_Error(TYPE_ERROR_ATOM,Key,"argument to win_registry_get_value");
return FALSE;
}
NameAt = AtomOfTerm(Name);
k = WideStringFromAtom(KeyAt PASS_REGS);
if ( !(key=reg_open_key(k, FALSE)) ) {
Yap_Error(EXISTENCE_ERROR_KEY, Key, "argument to win_registry_get_value");
recover_space(k, KeyAt);
return FALSE;
}
name = WideStringFromAtom(NameAt PASS_REGS);
if ( RegQueryValueExW(key, name, NULL, &type, data, &len) == ERROR_SUCCESS ) {
RegCloseKey(key);
switch(type) {
case REG_SZ:
recover_space(k, KeyAt);
recover_space(name, NameAt);
((wchar_t *)data)[len] = '\0';
return Yap_unify(MkAtomTerm(Yap_LookupMaybeWideAtom((wchar_t *)data)),ARG3);
case REG_DWORD:
recover_space(k, KeyAt);
recover_space(name, NameAt);
{
DWORD *d = (DWORD *)data;
return Yap_unify(MkIntegerTerm((Int)d[0]),ARG3);
}
default:
recover_space(k, KeyAt);
recover_space(name, NameAt);
return FALSE;
}
}
recover_space(k, KeyAt);
recover_space(name, NameAt);
return FALSE;
}
char *
Yap_RegistryGetString(char *name)
{
DWORD type;
BYTE data[MAXREGSTRLEN];
DWORD len = sizeof(data);
HKEY key;
char *ptr;
int i;
#if SIZEOF_INT_P == 8
if ( !(key=reg_open_key(L"HKEY_LOCAL_MACHINE/SOFTWARE/YAP/Prolog64", FALSE)) ) {
return NULL;
}
#else
if ( !(key=reg_open_key(L"HKEY_LOCAL_MACHINE/SOFTWARE/YAP/Prolog", FALSE)) ) {
return NULL;
}
#endif
if ( RegQueryValueEx(key, name, NULL, &type, data, &len) == ERROR_SUCCESS ) {
RegCloseKey(key);
switch(type) {
case REG_SZ:
ptr = malloc(len+2);
if (!ptr)
return NULL;
for (i=0; i<= len; i++)
ptr[i] = data[i];
ptr[len+1] = '\0';
return ptr;
default:
return NULL;
}
}
return NULL;
}
#endif
void
Yap_InitSysPreds(void)
{
Yap_InitCPred ("log_event", 1, p_log_event, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("sh", 0, p_sh, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$shell", 1, p_shell, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("system", 1, p_system, SafePredFlag|SyncPredFlag|UserCPredFlag);
Yap_InitCPred ("rename", 2, p_mv, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$yap_home", 1, p_yap_home, SafePredFlag);
Yap_InitCPred ("$yap_paths", 3, p_yap_paths, SafePredFlag);
Yap_InitCPred ("$dir_separator", 1, p_dir_sp, SafePredFlag);
Yap_InitCPred ("libraries_directories",2, libraries_directories, 0);
Yap_InitCPred ("system_library", 1, system_library, 0);
Yap_InitCPred ("commons_library", 1, commons_library, 0);
Yap_InitCPred ("$getenv", 2, p_getenv, SafePredFlag);
Yap_InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$host_type", 1, p_host_type, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$env_separator", 1, p_env_separator, SafePredFlag);
Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag);
Yap_InitCPred ("$win32", 0, p_win32, SafePredFlag);
Yap_InitCPred ("$ld_path", 1, p_ld_path, SafePredFlag);
Yap_InitCPred ("$address_bits", 1, p_address_bits, SafePredFlag);
Yap_InitCPred ("$expand_file_name", 2, p_expand_file_name, SyncPredFlag);
Yap_InitCPred ("expand_file_name", 3, expand_file_name3, SyncPredFlag);
Yap_InitCPred ("expand_file_name", 2, expand_file_name, SyncPredFlag);
Yap_InitCPred ("working_directory", 2,working_directory, SyncPredFlag);
Yap_InitCPred ("prolog_to_os_filename", 2, prolog_to_os_filename, SyncPredFlag);
Yap_InitCPred ("prolog_to_os_filename", 2, prolog_to_os_filename, SyncPredFlag);
#ifdef _WIN32
Yap_InitCPred ("win_registry_get_value", 3, p_win_registry_get_value,0);
#endif
Yap_InitCPred ("absolute_file_system_path", 2, absolute_file_system_path, 0);
Yap_InitCPred ("prolog_expanded_file_system_path", 4, prolog_expanded_file_system_path, 0);
Yap_InitCPred ("true_file_name", 2,
true_file_name, SyncPredFlag);
Yap_InitCPred ("true_file_name", 3, true_file_name3, SyncPredFlag);
Yap_InitCPred ("rmdir", 2, p_rmdir, SyncPredFlag);
Yap_InitCPred ("make_directory", 1, make_directory, SyncPredFlag);
}
Reference in New Issue View Git Blame Copy Permalink