From ee0335124fcd345dbe656b1958458b19dcad6766 Mon Sep 17 00:00:00 2001 From: V'itor Santos Costa Date: Thu, 11 Feb 2016 06:17:30 -0800 Subject: [PATCH] absolute_filename ^#%@% --- os/iopreds.c | 106 +- os/readline.c | 2 +- os/readterm.c | 64 +- os/streams.c | 17 +- os/sysbits.c | 2740 ++++++++++++++++++++++--------------------- os/yapio.h | 2 +- pl/absf.yap | 454 +++---- pl/arith.yap | 1 - pl/boot.yap | 2 +- pl/debug.yap | 17 +- pl/error.yap | 4 + pl/grammar.yap | 56 +- pl/init.yap | 11 +- pl/load_foreign.yap | 25 +- pl/messages.yap | 88 +- pl/qly.yap | 39 +- pl/yio.yap | 22 +- 17 files changed, 1904 insertions(+), 1746 deletions(-) diff --git a/os/iopreds.c b/os/iopreds.c index e32f26518..e8f45425c 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -102,6 +102,31 @@ FILE *Yap_stdin; FILE *Yap_stdout; FILE *Yap_stderr; +static Term gethdir(Term t) { + Atom aref = AtomOfTerm( t ); + char *s= RepAtom( aref )->StrOfAE; + size_t nsz; + + s = strncpy(LOCAL_FileNameBuf, RepAtom( aref )->StrOfAE, MAXPATHLEN-1); + if (!s) { + return false; + } + if (TermDot == t) { + return TermEmptyAtom; + } + nsz = strlen(s); + if (!Yap_dir_separator(s[nsz-1])) { +#if _WIN32 + s[nsz] = '\\'; +#else + s[nsz] = '/'; +#endif + s[nsz+1] = '\0'; + } + return + MkAtomTerm(Yap_LookupAtom( s ) ); +} + static bool issolutions(Term t) { if (t == TermFirst || t == TermAll) return true; @@ -1355,10 +1380,11 @@ do_open(Term file_name, Term t2, /* get options */ xarg *args = Yap_ArgListToVector(tlist, open_defs, OPEN_END); if (args == NULL) { - if (LOCAL_Error_TYPE) - Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, - "option handling in open/3"); - return FALSE; + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) + LOCAL_Error_TYPE = DOMAIN_ERROR_OPEN_OPTION; + Yap_Error( LOCAL_Error_TYPE, LOCAL_Error_Term, "option handling in open/3" ); + } } /* done */ sno = GetFreeStreamD(); @@ -1384,8 +1410,12 @@ do_open(Term file_name, Term t2, : false) || trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG); // expand file name? - fname = Yap_AbsoluteFile(fname, LOCAL_FileNameBuf, ok); + fname = Yap_AbsoluteFile(fname, ok); + if (fname) { st->name = Yap_LookupAtom(fname); + } else { + PlIOError(EXISTENCE_ERROR_SOURCE_SINK, ARG1, NULL); + } // Skip scripts that start with !#/.. or similar bool script = (args[OPEN_SCRIPT].used @@ -1432,6 +1462,9 @@ do_open(Term file_name, Term t2, } if ((fd = fopen(fname, io_mode)) == NULL || (!(flags & Binary_Stream_f) && binary_file(fname))) { + strncpy( LOCAL_FileNameBuf, fname,MAXPATHLEN); + free( (void *)fname ); + fname = LOCAL_FileNameBuf; UNLOCK(st->streamlock); if (errno == ENOENT) return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%s: %s", fname, @@ -1829,8 +1862,15 @@ static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */ } xarg *args = Yap_ArgListToVector((tlist = Deref(ARG2)), close_defs, CLOSE_END); - if (args == NULL) + if (args == NULL) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) + LOCAL_Error_TYPE = DOMAIN_ERROR_CLOSE_OPTION; + Yap_Error( LOCAL_Error_TYPE, LOCAL_Error_Term, NULL ); + } + return false; return FALSE; + } // if (args[CLOSE_FORCE].used) { // } Yap_CloseStream(sno); @@ -1854,8 +1894,8 @@ Term read_line(int sno) { PAR("access", isatom, ABSOLUTE_FILE_NAME_ACCESS), \ PAR("expand", booleanFlag, ABSOLUTE_FILE_NAME_EXPAND), \ PAR("extensions", ok, ABSOLUTE_FILE_NAME_EXTENSIONS), \ - PAR("file_type", is_file_type, ABSOLUTE_FILE_NAME_FILE_TYPE), \ PAR("file_errors", is_file_errors, ABSOLUTE_FILE_NAME_FILE_ERRORS), \ + PAR("file_type", is_file_type, ABSOLUTE_FILE_NAME_FILE_TYPE), \ PAR("glob", ok, ABSOLUTE_FILE_NAME_GLOB), \ PAR("relative_to", isatom, ABSOLUTE_FILE_NAME_RELATIVE_TO), \ PAR("solutions", issolutions, ABSOLUTE_FILE_NAME_SOLUTIONS), \ @@ -1884,19 +1924,28 @@ static Int abs_file_parameters(USES_REGS1) { /* get options */ xarg *args = Yap_ArgListToVector(tlist, absolute_file_name_search_defs, ABSOLUTE_FILE_NAME_END); - if (args == NULL) - return FALSE; + if (args == NULL) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) + LOCAL_Error_TYPE = DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION; + Yap_Error( LOCAL_Error_TYPE, LOCAL_Error_Term, NULL ); + } + return false; + } /* done */ - if (args[ABSOLUTE_FILE_NAME_EXTENSIONS].used) + if (args[ABSOLUTE_FILE_NAME_EXTENSIONS].used) { t[ABSOLUTE_FILE_NAME_EXTENSIONS] = args[ABSOLUTE_FILE_NAME_EXTENSIONS].tvalue; - else + } else { t[ABSOLUTE_FILE_NAME_EXTENSIONS] = TermNil; - if (args[ABSOLUTE_FILE_NAME_RELATIVE_TO].used) + } + if (args[ABSOLUTE_FILE_NAME_RELATIVE_TO].used) { t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = - args[ABSOLUTE_FILE_NAME_RELATIVE_TO].tvalue; - else - t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = TermEmptyAtom; + gethdir( args[ABSOLUTE_FILE_NAME_RELATIVE_TO].tvalue ); + } else { + t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = + gethdir( TermDot ); + } if (args[ABSOLUTE_FILE_NAME_FILE_TYPE].used) t[ABSOLUTE_FILE_NAME_FILE_TYPE] = args[ABSOLUTE_FILE_NAME_FILE_TYPE].tvalue; else @@ -1937,28 +1986,11 @@ static Int get_abs_file_parameter(USES_REGS1) { Term t = Deref(ARG1), topts = ARG2; /* get options */ /* done */ - if (t == TermExtensions) - return Yap_unify(ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_EXTENSIONS + 1, topts)); - if (t == TermRelativeTo) - return Yap_unify(ARG3, - ArgOfTerm(ABSOLUTE_FILE_NAME_RELATIVE_TO + 1, topts)); - if (t == TermFileType) - return Yap_unify(ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_FILE_TYPE + 1, topts)); - if (t == TermAccess) - return Yap_unify(ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_ACCESS + 1, topts)); - if (t == TermFileErrors) - return Yap_unify(ARG3, - ArgOfTerm(ABSOLUTE_FILE_NAME_FILE_ERRORS + 1, topts)); - if (t == TermSolutions) - return Yap_unify(ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_SOLUTIONS + 1, topts)); - if (t == TermGlob) - return Yap_unify(ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_GLOB + 1, topts)); - if (t == TermExpand) - return Yap_unify(ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_EXPAND + 1, topts)); - if (t == TermVerboseFileSearch) - return Yap_unify( - ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH + 1, topts)); - Yap_Error(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, ARG2, NULL); + int i = Yap_ArgKey( AtomOfTerm( t ), absolute_file_name_search_defs, + ABSOLUTE_FILE_NAME_END ); + if (i >= 0) + return Yap_unify(ARG3, ArgOfTerm(i + 1, topts)); + Yap_Error(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, ARG1, NULL); return false; } diff --git a/os/readline.c b/os/readline.c index ed7ea0bc7..2902f5d7f 100644 --- a/os/readline.c +++ b/os/readline.c @@ -205,7 +205,7 @@ bool Yap_InitReadline(Term enable) { #endif rl_outstream = stderr; using_history(); - const char *s = Yap_AbsoluteFile("~/.YAP.history", NULL, true); + const char *s = Yap_AbsoluteFile("~/.YAP.history", true); if (!read_history(s)) { FILE *f = fopen(s, "w"); if (f) { diff --git a/os/readterm.c b/os/readterm.c index afdd790ad..88f51f819 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -639,23 +639,23 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) { CurrentModule = fe->cmod; if (CurrentModule == TermProlog) CurrentModule = PROLOG_MODULE; - if (fe->vp) + if (fe->t && fe->vp) v1 = get_variables(fe, tokstart); else v1 = 0L; - if (fe->np) + if (fe->t && fe->np) v2 = get_varnames(fe, tokstart); else v2 = 0L; - if (fe->sp) + if (fe->t && fe->sp) v3 = get_singletons(fe, tokstart); else v3 = 0L; - if (fe->tcomms) + if (fe->t && fe->tcomms) vc = LOCAL_Comments; else vc = 0L; - if (fe->tp) + if (fe->t && fe->tp) tp = get_stream_position(fe, tokstart ); else tp = 0L; @@ -679,22 +679,22 @@ static bool complete_clause_processing(FEnv *fe, TokEntry CurrentModule = fe->cmod; if (CurrentModule == TermProlog) CurrentModule = PROLOG_MODULE; - if (fe->vp) + if (fe->t && fe->vp) v_vp = get_variables(fe, tokstart); else v_vp = 0L; - if (fe->np) + if (fe->t && fe->np) v_vnames = get_varnames(fe, tokstart); else v_vnames = 0L; - if (trueLocalPrologFlag(SINGLE_VAR_WARNINGS_FLAG)) { + if (fe->t && trueLocalPrologFlag(SINGLE_VAR_WARNINGS_FLAG)) { warn_singletons(fe, tokstart); } - if (fe->tcomms) + if (fe->t && fe->tcomms) v_comments = LOCAL_Comments; else v_comments = 0L; - if (fe->tp) + if (fe->t && fe->tp) v_pos = get_stream_position(fe, tokstart ); else v_pos = 0L; @@ -813,7 +813,9 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) { return YAP_PARSING; } if (LOCAL_tokptr->Tok == eot_tok && LOCAL_tokptr->TokInfo == TermNl) { - LOCAL_ErrorMessage = "Empty clause"; + char *out = malloc( strlen("Empty clause" + 1 ) ); + strcpy( out, "Empty clause" ); + LOCAL_ErrorMessage = out; LOCAL_Error_TYPE = SYNTAX_ERROR; LOCAL_Error_Term = TermEof; return YAP_PARSING_ERROR; @@ -878,7 +880,8 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) { } else { Term terr = Yap_syntax_error(fe->toklast, inp_stream); if (ParserErrorStyle == TermError) { - LOCAL_ErrorMessage = "SYNTAX ERROR"; + LOCAL_ErrorMessage = NULL; + LOCAL_Error_TYPE = SYNTAX_ERROR; Yap_Error(SYNTAX_ERROR, terr, LOCAL_ErrorMessage); return YAP_PARSING_FINISHED; } else { @@ -933,7 +936,7 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) { #endif parser_state_t state = YAP_START_PARSING; - while (state != YAP_PARSING_FINISHED) { + while (true) { switch (state) { case YAP_START_PARSING: state = initParser(opts, &fe, &re, inp_stream, nargs); @@ -951,21 +954,26 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) { state = parseError(&re, &fe, inp_stream); break; case YAP_PARSING_FINISHED: - break; + { + CACHE_REGS + bool done; + if (fe.reading_clause) + done = complete_clause_processing(&fe, LOCAL_tokptr); + else + done = complete_processing(&fe, LOCAL_tokptr); + if (!done) { + state = YAP_PARSING_ERROR; + fe.t = 0; + break; + } +#if EMACS + first_char = tokstart->TokPos; +#endif /* EMACS */ + return fe.t; + } } } - { - CACHE_REGS - if (fe.reading_clause && - !complete_clause_processing(&fe, LOCAL_tokptr)) - fe.t = 0; - else if (!fe.reading_clause && !complete_processing(&fe, LOCAL_tokptr)) - fe.t = 0; - } -#if EMACS - first_char = tokstart->TokPos; -#endif /* EMACS */ - return fe.t; + return 0; } static Int @@ -1113,11 +1121,11 @@ static Int read_clause2(USES_REGS1) { * + The `syntax_errors` flag controls response to syntactic errors, the *default is `dec10`. * -* The next two options are called implicitly:plwae +* The next two options are called implicitly: * * + The `module` option is initialized to the current source module, by *default. -* + The `tons` option is set from the single var flag +* + The `singletons` option is set from the single var flag */ static Int read_clause( USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ diff --git a/os/streams.c b/os/streams.c index c925cb3c1..d732f579a 100644 --- a/os/streams.c +++ b/os/streams.c @@ -567,6 +567,11 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */ args = Yap_ArgListToVector(Deref(ARG2), stream_property_defs, STREAM_PROPERTY_END); if (args == NULL) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) + LOCAL_Error_TYPE = DOMAIN_ERROR_STREAM_PROPERTY_OPTION; + Yap_Error( LOCAL_Error_TYPE, LOCAL_Error_Term, NULL ); + } cut_fail(); } LOCK(GLOBAL_StreamDescLock); @@ -628,8 +633,13 @@ static Int stream_property(USES_REGS1) { /* Init current_stream */ cut_fail(); } args = Yap_ArgListToVector(Deref(ARG2), stream_property_defs, - STREAM_PROPERTY_END); + STREAM_PROPERTY_END); if (args == NULL) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) + LOCAL_Error_TYPE = DOMAIN_ERROR_STREAM_PROPERTY_OPTION; + Yap_Error( LOCAL_Error_TYPE, LOCAL_Error_Term, NULL ); + } UNLOCK(GLOBAL_Stream[i].streamlock); cut_fail(); } @@ -682,6 +692,11 @@ static bool do_set_stream(int sno, args = Yap_ArgListToVector(opts, set_stream_defs, SET_STREAM_END); if (args == NULL) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) + LOCAL_Error_TYPE = DOMAIN_ERROR_SET_STREAM_OPTION; + Yap_Error( LOCAL_Error_TYPE, LOCAL_Error_Term, NULL ); + } UNLOCK(GLOBAL_Stream[sno].streamlock); return false; } diff --git a/os/sysbits.c b/os/sysbits.c index f5533fc47..2fa061f67 100644 --- a/os/sysbits.c +++ b/os/sysbits.c @@ -27,12 +27,12 @@ Yap_FileError(yap_error_number type, Term where, const char *format,...) { if ( trueLocalPrologFlag(FILEERRORS_FLAG) ) { - va_list ap; + va_list ap; - va_start (ap, format); - /* now build the error string */ - Yap_Error(type, TermNil, format, ap); - va_end (ap); + va_start (ap, format); + /* now build the error string */ + Yap_Error(type, TermNil, format, ap); + va_end (ap); } } @@ -46,32 +46,43 @@ 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); +static Term do_glob(const char *spec, bool ok_to); #ifdef MACYAP + static int chdir(char *); /* #define signal skel_signal */ #endif /* MACYAP */ - +static char * +expandVars(const char *spec); void exit(int); +static void +freeBuffer( const void *ptr ) +{ + if (ptr == NULL || + ptr == LOCAL_FileNameBuf || ptr == LOCAL_FileNameBuf2) + return; + free((void *)ptr); +} + #ifdef _WIN32 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); + 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) == '_' ) + (C) <= 'Z') || (C) == '_' ) #if __ANDROID__ @@ -80,94 +91,94 @@ 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; + 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'); + 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; + AAssetManager* mgr = Yap_assetManager; + const char *bufp=name+7; - if (bufp[0] == '/') - bufp++; - if ((mode & W_OK) == W_OK) { + 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; - } - // 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; + 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) { + 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; - } - 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; + 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 @@ -179,29 +190,29 @@ static bool is_directory(const char *FileName) { #ifdef __ANDROID__ - if (Yap_isAsset(FileName)) { - return Yap_AssetIsDir(FileName); - } + 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); + DWORD dwAtts = GetFileAttributes( FileName ); + if (dwAtts == INVALID_FILE_ATTRIBUTES) + return false; + return (dwAtts & FILE_ATTRIBUTE_DIRECTORY); #elif HAVE_LSTAT - struct stat buf; + struct stat buf; - if (lstat(FileName, &buf) == -1) { - /* return an error number */ - return false; - } - return S_ISDIR(buf.st_mode); + 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; + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "stat not available in this configuration"); + return false; #endif } @@ -211,49 +222,49 @@ static bool has_access(const char *FileName, int mode) { #ifdef __ANDROID__ - if (Yap_isAsset(FileName)) { - return Yap_AccessAsset(FileName, mode); - } + 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; + 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; + 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 ); + return has_access( f, F_OK ); } static int dir_separator (int ch) { #ifdef MAC - return (ch == ':'); + return (ch == ':'); #elif ATARI || _MSC_VER - return (ch == '\\'); + return (ch == '\\'); #elif defined(__MINGW32__) || defined(__CYGWIN__) - return (ch == '\\' || ch == '/'); + return (ch == '\\' || ch == '/'); #else - return (ch == '/'); + return (ch == '/'); #endif } int Yap_dir_separator (int ch) { - return dir_separator (ch); + return dir_separator (ch); } #if __WINDOWS__ @@ -266,116 +277,108 @@ char *libdir = NULL; bool Yap_IsAbsolutePath(const char *p0) { - // verify first if expansion is needed: ~/ or $HOME/ - char c[MAXPATHLEN+1]; - char *p = expandVars( p0, c, MAXPATHLEN ); + // verify first if expansion is needed: ~/ or $HOME/ + char *p = expandVars( p0 ); + bool nrc; #if _WIN32 || __MINGW32__ - return !PathIsRelative(p); + nrc = !PathIsRelative(p); #else - return p[0] == '/'; + nrc = ( p[0] == '/' ); #endif + return nrc; } #define isValidEnvChar(C) ( ((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && \ - (C) <= 'Z') || (C) == '_' ) + (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) +PlExpandVars (const char *source) { - const char *src = source; - char *res = result; + const char *src = source; + char *result = LOCAL_FileNameBuf; - 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 (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"); + s = getenv("HOMEDRIVE"); + if (s != NULL) + strncpy (result, getenv ("HOMEDRIVE"), YAP_FILENAME_MAX); + //s = getenv("HOMEPATH"); #else - s = getenv ("HOME"); + s = getenv ("HOME"); #endif - if (s != NULL) - strncpy (result, s, YAP_FILENAME_MAX); - strcat(result,src); - return result; - } else { + if (s != NULL) + strncpy (result, s, YAP_FILENAME_MAX); + strcat(result,src); + return result; + } else { #if HAVE_GETPWNAM - struct passwd *user_passwd; + struct passwd *user_passwd; + char *res = result; - 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); + 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; + 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, *res; + 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; - } - // 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__) @@ -384,51 +387,51 @@ expandVars(const char *pattern, char *expanded, int maxlent) static char * unix2win( const char *source, char *target, int max) { - char *s = target; - const char *s0 = source; - char *s1; - int ch; + 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; + 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; } - 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; + 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 @@ -436,12 +439,12 @@ unix2win( const char *source, char *target, int max) static char * OsPath(const char *p, char *buf) { - return (char *)p; + return (char *)p; } static char * PrologPath(const char *Y, char *X) { - return (char *)Y ; + return (char *)Y ; } @@ -451,176 +454,376 @@ PrologPath(const char *Y, char *X) { #endif static bool ChDir(const char *path) { - bool rc = false; - const char *qpath = Yap_AbsoluteFile(path, NULL, true); + bool rc = false; + const char *qpath = Yap_AbsoluteFile(path, 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; + if (GLOBAL_AssetsWD) { + freeBuffer( 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; } - return false; - } else { - GLOBAL_AssetsWD = NULL; - } #endif #if _WIN32 || defined(__MINGW32__) if ((rc = (SetCurrentDirectory(qpath) != 0)) == 0) - { - Yap_WinError("SetCurrentDirectory failed" ); - } + { + Yap_WinError("SetCurrentDirectory failed" ); + } #else - rc = (chdir(qpath) == 0); + rc = (chdir(qpath) == 0); #endif - free( (void *)qpath ); - return rc; + free((char *)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 *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; } const 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; + 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; + } + strncpy(o, drive, YAP_FILENAME_MAX-1); + strncat(o, dir, YAP_FILENAME_MAX-1); + return o; } #endif -static const char *myrealpath( const char *path, char *out) +static const char *myrealpath( const char *path) { #if _WIN32 || defined(__MINGW32__) - DWORD retval=0; + DWORD retval=0; - // notice that the file does not need to exist - retval = GetFullPathName(path, - YAP_FILENAME_MAX, - out, - NULL); + // notice that the file does not need to exist + retval = GetFullPathName(path, + YAP_FILENAME_MAX, + out, + NULL); - if (retval == 0) + if (retval == 0) { - Yap_WinError("Generating a full path name for a file" ); - return NULL; + Yap_WinError("Generating a full path name for a file" ); + return NULL; } - return out; + return out; #elif HAVE_REALPATH - { - const char *rc; - rc = ( const char *)realpath(path,out); - const char *s0, *s; + { + char * rc = realpath(path,NULL); - if (rc == NULL && (errno == ENOENT|| errno == EACCES)) { + if (rc) { + return rc; + } + // rc = NULL; + if (errno == ENOENT|| errno == EACCES) { + char base[YAP_FILENAME_MAX]; + strncpy(base, path, YAP_FILENAME_MAX-1); + rc = realpath( dirname( (char *)path ), NULL); - if ( is_directory(rc)) { - s = (const char *)path; - } else { - s = basename((char *)path); - path = dirname((char *)path); - } - s0 = malloc(strlen(s)+1); - strcpy((char *)s0, s); - if ((rc = myrealpath(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((char *)rc, "/"); - strcat((char *)rc, s0); - free((void *)s0); - } - return rc; - } + if (rc) { + const char *b = basename(base); + size_t e = strlen(rc); + size_t bs = strlen( b ); + + rc = realloc( rc , e+bs+2); +#if _WIN32 + if (rc[e-1] != '\\' && rc[e-1] != '/' ) { + rc[e]='\\'; + rc[e+1]='\0'; + } #else - return NULL; + if (rc[e-1] != '/' ) { + rc[e]='/'; + rc[e+1]='\0'; + } #endif + strcat(rc, b); + return rc; + } + } + } +#endif + char *out = malloc(strlen(path)+1); + strcpy( out, path); + return out; } static char * -PrologExpandVars(const char *spec, char *tmp0, bool ok_to) +expandVars(const char *spec) { - char *tmp; - #if _WIN32 || defined(__MINGW32__) - char u[YAP_FILENAME_MAX+1]; + char u[YAP_FILENAME_MAX+1]; - // first pass, remove Unix style stuff - if (unix2win(spec, u, YAP_FILENAME_MAX) == NULL) - return NULL; - spec = u; + // first pass, remove Unix style stuff + if ((ou=unix2win(spec, YAP_FILENAME_MAX)) == NULL) + return NULL; + spec = u; #endif - if (tmp0 == NULL) { - tmp = malloc(YAP_FILENAME_MAX+1); - if (tmp == NULL) { - return NULL; + bool ok_to = true; + if (spec == NULL) { + return NULL; } - } else { - tmp = tmp0; - } - if ( ok_to ) + if ( ok_to ) { - tmp=expandVars(spec,tmp,YAP_FILENAME_MAX); + Term t = do_glob( spec, true ); + if (IsPairTerm(t)) + return RepAtom(AtomOfTerm(HeadOfTerm(t)))->StrOfAE; + return NULL; + } else { + return PlExpandVars( spec ); } - else { - if (tmp != tmp0) { - free(tmp); - } - tmp = (char *)spec; - } - return tmp; + return (char *)spec; } /** * generate absolute path, if ok first expand SICStus Prolog style * * @param[in] spec the file path, including `~` and `$`. - * @param[out] tmp where to store the file. * @param[in] ok where to process `~` and `$`. * - * @return tmp, or NULL + * @return tmp, or NULL, in malloced memory */ const char * -Yap_AbsoluteFile(const char *spec, char *tmp, bool ok) +Yap_AbsoluteFile(const char *spec, bool ok) { - char *t1 = NULL; - t1 = PrologExpandVars(spec, t1, ok); - if (!t1) + const char*p; + const char*rc; + rc = expandVars(spec); + if (!rc) + return spec; + if ((p = myrealpath(rc) ) ) { + return p; + } else { + return NULL; + } +} + +/** + * generate absolute path and stores path in an user given buffer. If + * NULL, uses a temporary buffer that must be quickly released. + * + * if ok first expand variable names and do globbing + * + * @param[in] spec the file path, including `~` and `$`. + * @param[in] ok where to process `~` and `$`. + * + * @return tmp, or NULL, in malloced memory + */ +const char * +Yap_AbsoluteFileInBuffer(const char *spec, char *out, size_t sz, bool ok) +{ + const char*p; + const char*rc; + if (ok) { + rc = expandVars(spec); + if (!rc) + return spec; + } else { + rc = spec; + } + + if ((p = myrealpath(rc) ) ) { + if (!out) { + out = LOCAL_FileNameBuf; + sz = YAP_FILENAME_MAX-1; + } + if (p != out ) { + strncpy(out, p, sz); + freeBuffer(p); + return out; + } else { + return NULL; + } + } return NULL; - return myrealpath(t1, tmp); +} + +static Term +/* Expand the string for the program to run. */ +do_glob(const char *spec, bool glob_vs_wordexp) +{ +#if _WIN32 || defined(__MINGW32__) + { + char u[YAP_FILENAME_MAX+1]; + WIN32_FIND_DATA find; + HANDLE hFind; + CELL *dest; + + // first pass, remove Unix style stuff + if (unix2win(spec, u, YAP_FILENAME_MAX) == NULL) + return TermNil; + spec = (const char *)u; + + if (!use_system_expansion) { + return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil); + } + hFind = FindFirstFile(spec, &find); + + if (hFind == INVALID_HANDLE_VALUE) + { + return TermNil; + } + else + { + tf = AbsPair(HR); + HR[0] = MkAtomTerm(Yap_LookupAtom(find.cFileName)); + HR[1] = TermNil; + dest = HR+1; + HR += 2; + while (FindNextFile(hFind, &find)) { + *dest = AbsPair(HR); + HR[0] = MkAtomTerm(Yap_LookupAtom(find.cFileName)); + HR[1] = TermNil; + dest = HR+1; + HR += 2; + } + FindClose(hFind); + } + return tf; + } +#elif HAVE_WORDEXP || HAVE_GLOB + /* Expand the string for the program to run. */ + size_t pathcount; +#if HAVE_GLOB + glob_t gresult; +#endif +#if HAVE_WORDEXP + wordexp_t wresult; +#endif +#if HAVE_GLOB || HAVE_WORDEXP + char **ss = NULL; + int flags = 0, j; +#endif + if ( glob_vs_wordexp ) { +#if HAVE_GLOB +#ifdef GLOB_NOCHECK + flags = GLOB_NOCHECK; +#else + flags = 0; +#endif +#ifdef GLOB_BRACE + flags |= GLOB_BRACE|GLOB_TILDE; +#endif + 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); + { + return 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; + memset( &wresult,0,sizeof(wresult) ); + switch ((rc = wordexp (spec, &wresult, flags))) + { + case 0: /* Successful. */ + ss = wresult.we_wordv; + pathcount = wresult.we_wordc; + if (pathcount) { + break; + } else { + Term t; + t = MkAtomTerm( Yap_LookupAtom( expandVars(spec) ) ); + 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 + } + const char * tmp; + Term tf = TermNil; + for (j = 0; j < pathcount; j++) { + const char *s = ss[pathcount-(j+1)]; +#if HAVE_REALPATH + tmp = myrealpath(s); +#else + tmp = s; +#endif + //if (!exists(s)) + // continue; + Atom a = Yap_LookupAtom(tmp); + tf = MkPairTerm(MkAtomTerm( a ),tf); + } +#if HAVE_GLOB + if ( glob_vs_wordexp) + globfree( &gresult ); +#endif +#if HAVE_WORDEXP + if ( !glob_vs_wordexp) + wordfree( &wresult ); +#endif + if (tmp) + freeBuffer( (void *)tmp ); + return tf; +#else + // just use basic + return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil); +#endif } /** @@ -637,75 +840,45 @@ Yap_AbsoluteFile(const char *spec, char *tmp, bool ok) * @return */ static Int -prolog_expanded_file_system_path( USES_REGS1 ) +prolog_realpath( USES_REGS1 ) { - Term t1 = Deref(ARG1); - Term t2 = Deref(ARG2); - Term t3 = Deref(ARG3); - char *o = LOCAL_FileNameBuf; - bool flag; - const char *cmd, *p0; + Term t1 = Deref(ARG1); + const char *cmd; - 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') { - const char *rc = myrealpath(out, LOCAL_FileNameBuf2 ); - return Yap_unify(MkAtomTerm(Yap_LookupAtom(rc)), ARG4); - } else { - char *pt =strncpy( LOCAL_FileNameBuf2, p0, YAP_FILENAME_MAX ); - if ( !dir_separator( pt[-1] )) { -#if ATARI || _MSC_VER || defined(__MINGW32__) - pt[0] = '\\'; -#else - pt[0] = '/'; -#endif - pt++; - pt[0] = '\n'; + if (IsAtomTerm(t1)) { + cmd = RepAtom(AtomOfTerm(t1))->StrOfAE; + } else if (IsStringTerm(t1)) { + cmd = StringOfTerm(t1); + } else { + return false; } - out = strncpy( pt, out, YAP_FILENAME_MAX -(pt -LOCAL_FileNameBuf2) ); - const char *rc = myrealpath(LOCAL_FileNameBuf, LOCAL_FileNameBuf2 ); - return Yap_unify(MkAtomTerm(Yap_LookupAtom(rc)), ARG4); - } + const char *rc = myrealpath( cmd ); + if (!rc) { + PlIOError( SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, strerror(errno)); + return false; + } + bool r = Yap_unify(MkAtomTerm(Yap_LookupAtom( rc )), ARG2); + freeBuffer( (char *) rc ); + return r; + } #define EXPAND_FILENAME_DEFS() \ - PAR("parameter_expansion", isatom, EXPAND_FILENAME_PARAMETER_EXPANSION), \ + PAR("parameter_expansion", isatom, EXPAND_FILENAME_PARAMETER_EXPANSION), \ PAR("commands", booleanFlag, EXPAND_FILENAME_COMMANDS), \ - PAR(NULL, ok, EXPAND_FILENAME_END) + PAR(NULL, ok, EXPAND_FILENAME_END) #define PAR(x, y, z) z typedef enum expand_filename_enum_choices { - EXPAND_FILENAME_DEFS() + EXPAND_FILENAME_DEFS() } expand_filename_enum_choices_t; #undef PAR #define PAR(x, y, z) \ - { x, y, z } +{ x, y, z } static const param_t expand_filename_defs[] = {EXPAND_FILENAME_DEFS()}; #undef PAR @@ -713,253 +886,103 @@ static const param_t expand_filename_defs[] = {EXPAND_FILENAME_DEFS()}; static Term do_expand_file_name(Term t1, Term opts USES_REGS) { - xarg *args; - expand_filename_enum_choices_t i; - bool use_system_expansion = true, glob_vs_wordexp = true; - const char *tmp = NULL; - char *tmpe = NULL; - const char *spec; -#if HAVE_GLOB - glob_t gresult; -#endif - #if HAVE_GLOB || HAVE_WORDEXP - char **ss = NULL; - int flags = 0, j; -#endif -#if HAVE_WORDEXP - wordexp_t wresult; -#endif - Term tf; + xarg *args; + expand_filename_enum_choices_t i; + bool use_system_expansion = true; + char *tmpe = NULL; + const char *spec; + Term tf; - 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; - } - tmpe = malloc(YAP_FILENAME_MAX+1); - - 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) { - if (tmpe == NULL) { - return TermNil; - } - tmpe = expandVars( spec, tmpe, YAP_FILENAME_MAX); - spec = tmpe; - } else if (t == TermTrue) { - use_system_expansion = true; - } else if (t == TermFalse) { - use_system_expansion = false; - } - break; - case EXPAND_FILENAME_COMMANDS: - if (!use_system_expansion) { - use_system_expansion = true; -#ifdef WRDE_NOCMD - if (t == TermFalse) { - flags = WRDE_NOCMD; - } -#endif - } - case EXPAND_FILENAME_END: - break; - } + 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; + } + tmpe = malloc(YAP_FILENAME_MAX+1); + + 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) { + char *s = expandVars( spec); + if (s == NULL) { + return TermNil; + } + strcpy(tmpe, s); + } else if (t == TermTrue) { + use_system_expansion = true; + } else if (t == TermFalse) { + use_system_expansion = false; + } + break; + case EXPAND_FILENAME_COMMANDS: + if (!use_system_expansion) { + use_system_expansion = true; +#ifdef WRDE_NOCMD + if (t == TermFalse) { + flags = WRDE_NOCMD; + } +#endif + } + case EXPAND_FILENAME_END: + break; + } + } } - } -#if _WIN32 || defined(__MINGW32__) - { - char u[YAP_FILENAME_MAX+1]; - WIN32_FIND_DATA find; - HANDLE hFind; - CELL *dest; - - // first pass, remove Unix style stuff - if (unix2win(spec, u, YAP_FILENAME_MAX) == NULL) - return TermNil; - spec = (const char *)u; if (!use_system_expansion) { - return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil); + return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil); } - hFind = FindFirstFile(spec, &find); - - if (hFind == INVALID_HANDLE_VALUE) - { - return TermNil; - } - else - { - tf = AbsPair(HR); - HR[0] = MkAtomTerm(Yap_LookupAtom(find.cFileName)); - HR[1] = TermNil; - dest = HR+1; - HR += 2; - while (FindNextFile(hFind, &find)) { - *dest = AbsPair(HR); - HR[0] = MkAtomTerm(Yap_LookupAtom(find.cFileName)); - HR[1] = TermNil; - dest = HR+1; - HR += 2; - } - FindClose(hFind); - } + tf = do_glob(spec, true); return tf; - } -#elif HAVE_WORDEXP || HAVE_GLOB - if (!use_system_expansion) { - return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil); - } - /* Expand the string for the program to run. */ - size_t pathcount; - if ( glob_vs_wordexp ) { -#if HAVE_GLOB -#ifdef GLOB_NOCHECK - flags = GLOB_NOCHECK; -#else - flags = 0; -#endif -#ifdef GLOB_BRACE - flags |= GLOB_BRACE|GLOB_TILDE; -#endif - 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); - { - return 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; - memset( &wresult,0,sizeof(wresult) ); - 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 - } - tf = TermNil; - for (j = 0; j < pathcount; j++) { - const char *s = ss[pathcount-(j+1)]; -#if HAVE_REALPATH - tmp = myrealpath(s,(char *) tmp); -#else - tmp = s; -#endif - //if (!exists(s)) - // continue; - Atom a = Yap_LookupAtom(tmp); - tf = MkPairTerm(MkAtomTerm( a ),tf); - } -#if HAVE_GLOB - if (use_system_expansion && glob_vs_wordexp) - globfree( &gresult ); -#endif -#if HAVE_WORDEXP - if (use_system_expansion && !glob_vs_wordexp) - wordfree( &wresult ); -#endif - if (tmp) - free( (void *)tmp ); - if (tmpe) - free( tmpe ); -#else - // just use basic - return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil); -#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); + 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 ); + 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); + 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; + if (tmp == NULL) return NULL; + rc = myrealpath(path); + #if _WIN32 || defined(__MINGW32__) + freeBuffer(o); #endif return rc; #endif @@ -970,80 +993,80 @@ static char *canoniseFileName( char *path) { static Int absolute_file_system_path( USES_REGS1 ) { - Term t = Deref(ARG1); - const char *fp; - bool rc; - char s[MAXPATHLEN+1]; + 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; + 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, true))) + return false; + rc = Yap_unify(MkAtomTerm(Yap_LookupAtom(fp)), ARG2); + if (fp != s) + freeBuffer( (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]; + 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 (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); + 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); + 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; + return AtomNil; #endif } @@ -1055,177 +1078,177 @@ 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)); + const char *fd = AtomName(AtomOfTerm(ARG1)); #if defined(__MINGW32__) || _MSC_VER - if (_mkdir(fd) == -1) { + if (_mkdir(fd) == -1) { #else - if (mkdir(fd, 0777) == -1) { + if (mkdir(fd, 0777) == -1) { #endif - /* return an error number */ - return false; // errno? - } - return true; + /* return an error number */ + return false; // errno? + } + return true; } static Int p_rmdir( USES_REGS1 ) { - const char *fd = AtomName(AtomOfTerm(ARG1)); + const char *fd = AtomName(AtomOfTerm(ARG1)); #if defined(__MINGW32__) || _MSC_VER - if (_rmdir(fd) == -1) { + if (_rmdir(fd) == -1) { #else - if (rmdir(fd) == -1) { + if (rmdir(fd) == -1) { #endif - /* return an error number */ - return(Yap_unify(ARG2, MkIntTerm(errno))); - } - return true; + /* 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; + 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; + { + 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; } - 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; + 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) { + 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 (is_directory(LOCAL_FileNameBuf)) - { + if (!dir_done && is_directory(LOCAL_FileNameBuf)) { if (! Yap_unify( tlib, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))) ) - return FALSE; - dir_done = true; - } - } - if (!commons_done) { + return FALSE; + } + dir_done = true; 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; + if (!commons_done && 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; + return dir_done && commons_done; } static Int libraries_directories( USES_REGS1 ) { - return initSysPath( ARG1, ARG2 , false, false ); + return initSysPath( ARG1, ARG2 , false, false ); } static Int system_library( USES_REGS1 ) { - return initSysPath( ARG1, MkVarTerm(), false, true ); + return initSysPath( ARG1, MkVarTerm(), false, true ); } static Int commons_library( USES_REGS1 ) { - return initSysPath( MkVarTerm(), ARG1, true, false ); + 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('/'); + Term t = MkIntTerm('\\'); + Term t2 = MkIntTerm('/'); #else - Term t = MkIntTerm('/'); - Term t2 = MkIntTerm('/'); + Term t = MkIntTerm('/'); + Term t2 = MkIntTerm('/'); #endif - return Yap_unify_constant(ARG1,t) || Yap_unify_constant(ARG1,t2) ; + return Yap_unify_constant(ARG1,t) || Yap_unify_constant(ARG1,t2) ; } @@ -1233,115 +1256,122 @@ void Yap_InitPageSize(void) { #ifdef _WIN32 - SYSTEM_INFO si; - GetSystemInfo(&si); - Yap_page_size = si.dwPageSize; + SYSTEM_INFO si; + GetSystemInfo(&si); + Yap_page_size = si.dwPageSize; #elif HAVE_UNISTD_H #if defined(__FreeBSD__) || defined(__DragonFly__) - Yap_page_size = getpagesize(); + Yap_page_size = getpagesize(); #elif defined(_AIX) - Yap_page_size = sysconf(_SC_PAGE_SIZE); + Yap_page_size = sysconf(_SC_PAGE_SIZE); #elif !defined(_SC_PAGESIZE) - Yap_page_size = getpagesize(); + Yap_page_size = getpagesize(); #else - Yap_page_size = sysconf(_SC_PAGESIZE); + Yap_page_size = sysconf(_SC_PAGESIZE); #endif #else - bla bla -#endif - } + bla bla + #endif +} - /* TrueFileName -> Finds the true name of a file */ +/* TrueFileName -> Finds the true name of a file */ + + bool Yap_trueFileName(const char *isource, const char *idef, const char *root, + char *result, bool access, file_type_t ftype, + bool expand_root, bool in_lib); #ifdef __MINGW32__ #include #endif - static int - volume_header(char *file) - { +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 == ':'); + if (isalnum(c)) ch++; + else return(c == ':'); } #endif return(FALSE); - } +} - int - Yap_volume_header(char *file) - { +int +Yap_volume_header(char *file) +{ return volume_header(file); - } +} - const char * Yap_getcwd(const char *cwd, size_t cwdlen) - { +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; - } + { + Yap_WinError("GetCurrentDirectory failed" ); + return NULL; + } return (char *)cwd; #elif __ANDROID__ if (GLOBAL_AssetsWD) { - return strncpy( (char *)cwd, (const char *)GLOBAL_AssetsWD, cwdlen); + return strncpy( (char *)cwd, (const char *)GLOBAL_AssetsWD, cwdlen); } #endif return getcwd((char *)cwd, cwdlen); - } +} - static Int - working_directory(USES_REGS1) - { +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"); + Yap_Error(TYPE_ERROR_ATOM, t1, "working_directory"); } if (!Yap_unify( t1, MkAtomTerm(Yap_LookupAtom(Yap_getcwd(dir,YAP_FILENAME_MAX )))) ) - return false; + return false; t2 = Deref(ARG2); if ( IsVarTerm( t2 ) ) { - Yap_Error(INSTANTIATION_ERROR, t2, "working_directory"); + Yap_Error(INSTANTIATION_ERROR, t2, "working_directory"); } - if ( !IsAtomTerm(t2) ) { - Yap_Error(TYPE_ERROR_ATOM, t2, "working_directory"); + if ( !IsAtomTerm(t2) ) { + Yap_Error(TYPE_ERROR_ATOM, t2, "working_directory"); } - ChDir(RepAtom(AtomOfTerm(t2))->StrOfAE); - return true; - } + ChDir(RepAtom(AtomOfTerm(t2))->StrOfAE); + return true; +} - static const char * - expandWithPrefix(const char *source, const char *root, char *result) - { +static const char * +expandWithPrefix(const char *source, const char *root) +{ char *work; - char ares1[YAP_FILENAME_MAX+1]; - - work = expandVars( source, ares1, YAP_FILENAME_MAX); + work = expandVars( source ); // 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); + char *s = expandVars( source); + if (!s) + return source; + char *r0 = expandVars( root); + size_t sl = strlen(s); + size_t rl = strlen(r0); + char *r = malloc( sl+rl+2); + strncat( r, r0, sl+rl+2 ); + strncat( r, "/", sl+rl+2 ); + strncat( r, s , sl+rl+2); + return r; } - } + strncpy( LOCAL_FileNameBuf, work, MAXPATHLEN-1); + return LOCAL_FileNameBuf; +} - /** Yap_trueFileName: tries to generate the true name of file - * +/** Yap_trueFileName: tries to generate the true name of file + aaaaaaaaaaaaaaaaaaaaa* * * @param isource the proper file * @param idef the default name fo rthe file, ie, startup.yss @@ -1354,9 +1384,9 @@ Yap_InitPageSize(void) * * @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) - { +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; @@ -1364,205 +1394,203 @@ Yap_InitPageSize(void) 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 + 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; + 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; + 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; + 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 + 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 + if ( in_lib) { + source = ( ftype == YAP_PL || ftype == YAP_QLY ? "library" : "startup" ) ; + source = Yap_RegistryGetString( source ); + root = NULL; + } else #endif - done = true; - break; + done = true; + break; - case 5: // search from the binary - { + case 5: // search from the binary + { #ifndef __ANDROID__ - done = true; - break; + done = true; + break; #endif - const char *pt = Yap_FindExecutable(); + 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 (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) ; } - const char *work = expandWithPrefix( source, root, (char *)result ); + if (done) + continue; + // { CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "root= %s %s ", root, source) ; } + const char *work = expandWithPrefix( source, root ); - // expand names in case you have - // to add a prefix - if ( !access || exists( work ) ) - return true; // done + + // 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) - { +int +Yap_TrueFileName (const char *source, char *result, bool 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) - { +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 ) - { +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; + 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; + 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; + if (!Yap_AbsoluteFileInBuffer( RepAtom(AtomOfTerm(t))->StrOfAE, LOCAL_FileNameBuf, YAP_FILENAME_MAX-1, true)) + return FALSE; return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))); - } +} - static Int - p_expand_file_name ( USES_REGS1 ) - { +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; + 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; + 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 false; return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))); - } +} - static Int - true_file_name3 ( USES_REGS1 ) - { +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; + 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; + 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 (!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 FALSE; return Yap_unify(ARG3, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))); - } +} - /* Executes $SHELL under Prolog */ - /** @pred sh +/* Executes $SHELL under Prolog */ +/** @pred sh Creates a new shell interaction. */ - static Int - p_sh ( USES_REGS1 ) - { /* sh */ +static Int +p_sh ( USES_REGS1 ) +{ /* sh */ #ifdef HAVE_SYSTEM char *shell; shell = (char *) getenv ("SHELL"); if (shell == NULL) - shell = "/bin/sh"; + shell = "/bin/sh"; if (system (shell) < 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "%s in sh/0", strerror(errno)); + Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "%s in sh/0", strerror(errno)); #else - Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "in sh/0"); + Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "in sh/0"); #endif - return FALSE; + return FALSE; } return TRUE; #else @@ -1576,30 +1604,30 @@ Yap_InitPageSize(void) return(FALSE); #endif /* MSH */ #endif - } +} - /** shell(+Command:text, -Status:integer) is det. +/** shell(+Command:text, -Status:integer) is det. Run an external command and wait for its completion. */ - static Int - p_shell ( USES_REGS1 ) - { /* '$shell'(+SystCommand) */ - const char *cmd; - Term t1 = Deref (ARG1); - if (IsAtomTerm(t1)) - cmd = RepAtom(AtomOfTerm(t1))->StrOfAE; +static Int +p_shell ( USES_REGS1 ) +{ /* '$shell'(+SystCommand) */ + const char *cmd; + Term t1 = Deref (ARG1); + if (IsAtomTerm(t1)) + cmd = RepAtom(AtomOfTerm(t1))->StrOfAE; else if (IsStringTerm(t1)) - cmd = StringOfTerm(t1); + cmd = StringOfTerm(t1); else - return FALSE; + return FALSE; #if _MSC_VER || defined(__MINGW32__) - { int rval = system(cmd); + { int rval = system(cmd); - return rval == 0; - } + return rval == 0; + } - return true; + return true; #else #if HAVE_SYSTEM char *shell; @@ -1607,36 +1635,36 @@ Yap_InitPageSize(void) shell = (char *) getenv ("SHELL"); if (!strcmp (shell, "/bin/sh")) - bourne = TRUE; + bourne = TRUE; if (shell == NIL) - bourne = TRUE; + bourne = TRUE; /* Yap_CloseStreams(TRUE); */ if (bourne) - return system( cmd ) == 0; + return system( cmd ) == 0; else { - int status = -1; - int child = fork (); + 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; - } + 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 @@ -1651,68 +1679,68 @@ Yap_InitPageSize(void) #endif #endif /* HAVE_SYSTEM */ #endif /* _MSC_VER */ - } +} - /** system(+Command:text). +/** system(+Command:text). Run an external command. */ - static Int - p_system ( USES_REGS1 ) - { /* '$system'(+SystCommand) */ +static Int +p_system ( USES_REGS1 ) +{ /* '$system'(+SystCommand) */ const char *cmd; Term t1 = Deref (ARG1); if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR,t1,"argument to system/1 unbound"); - return FALSE; + Yap_Error(INSTANTIATION_ERROR,t1,"argument to system/1 unbound"); + return FALSE; } else if (IsAtomTerm(t1)) { - cmd = RepAtom(AtomOfTerm(t1))->StrOfAE; + cmd = RepAtom(AtomOfTerm(t1))->StrOfAE; } else if (IsStringTerm(t1)) { - cmd = StringOfTerm(t1); + cmd = StringOfTerm(t1); } else { - if (!Yap_GetName (LOCAL_FileNameBuf, YAP_FILENAME_MAX, t1)) { - Yap_Error(TYPE_ERROR_ATOM,t1,"argument to system/1"); - return false; - } - cmd = LOCAL_FileNameBuf; + if (!Yap_GetName (LOCAL_FileNameBuf, YAP_FILENAME_MAX, t1)) { + Yap_Error(TYPE_ERROR_ATOM,t1,"argument to system/1"); + return false; + } + cmd = LOCAL_FileNameBuf; } /* Yap_CloseStreams(TRUE); */ #if _MSC_VER || defined(__MINGW32__) - { STARTUPINFO si; - PROCESS_INFORMATION pi; + { STARTUPINFO si; + PROCESS_INFORMATION pi; - ZeroMemory( &si, sizeof(si) ); - si.cb = sizeof(si); - ZeroMemory( &pi, sizeof(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) - (LPSTR)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 ); + // Start the child process. + if( !CreateProcess( NULL, // No module name (use command line) + (LPSTR)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 ); + // Close process and thread handles. + CloseHandle( pi.hProcess ); + CloseHandle( pi.hThread ); - return TRUE; - } + return TRUE; + } return FALSE; #elif HAVE_SYSTEM @@ -1721,11 +1749,11 @@ Yap_InitPageSize(void) #endif if (system (cmd)) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t1,"%s in system(%s)", strerror(errno), cmd); + Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t1,"%s in system(%s)", strerror(errno), cmd); #else - Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t1,"in system(%s)", cmd); + Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t1,"in system(%s)", cmd); #endif - return FALSE; + return FALSE; } return TRUE; #else @@ -1741,264 +1769,258 @@ Yap_InitPageSize(void) 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) */ +static Int +p_mv ( USES_REGS1 ) +{ /* rename(+OldName,+NewName) */ #if HAVE_LINK int r; - char oldname[YAP_FILENAME_MAX], newname[YAP_FILENAME_MAX]; + char *oldname, *newname; Term t1 = Deref (ARG1); Term t2 = Deref (ARG2); if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "first argument to rename/2 unbound"); + 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"); + 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"); + 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) { + Yap_Error(TYPE_ERROR_ATOM, t2, "second argument to rename/2 not atom"); + } else { + oldname = (RepAtom(AtomOfTerm(t1)))->StrOfAE; + newname = (RepAtom(AtomOfTerm(t2)))->StrOfAE; + 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); + 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); + Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t2,"in rename(%s,%s)",oldname,newname); #endif - return FALSE; + return false; + } + return true; } - return TRUE; #else Yap_Error(SYSTEM_ERROR_INTERNAL,TermNil,"rename/2 not available in this machine"); - return (FALSE); #endif - } + return false; +} #ifdef MAC - void - Yap_SetTextFile (name) - char *name; - { +void +Yap_SetTextFile (name) +char *name; +{ #ifdef MACC - SetFileType (name, 'TEXT'); - SetFileSignature (name, 'EDIT'); +SetFileType (name, 'TEXT'); +SetFileSignature (name, 'EDIT'); #else - FInfo f; - FInfo *p = &f; - GetFInfo (name, 0, p); - p->fdType = 'TEXT'; +FInfo f; +FInfo *p = &f; +GetFInfo (name, 0, p); +p->fdType = 'TEXT'; #ifdef MPW - if (mpwshell) - p->fdCreator = 'MPS\0'; +if (mpwshell) +p->fdCreator = 'MPS\0'; #endif #ifndef LIGHT - else - p->fdCreator = 'EDIT'; +else +p->fdCreator = 'EDIT'; #endif - SetFInfo (name, 0, p); +SetFInfo (name, 0, p); #endif - } +} #endif - /* return YAP's environment */ - static Int p_getenv( USES_REGS1 ) - { +/* 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); + 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); + 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); + 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"); + "getenv not available in this configuration"); return (FALSE); #endif - } +} - /* set a variable in YAP's environment */ - static Int p_putenv( USES_REGS1 ) - { +/* 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); + 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); + 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); + 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); + 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; - } + 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; + return TRUE; #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, - "in putenv(%s)", strerror(errno), p0); + "in putenv(%s)", strerror(errno), p0); #else Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, - "in putenv(%s)", p0); + "in putenv(%s)", p0); #endif return FALSE; #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "putenv not available in this configuration"); + "putenv not available in this configuration"); return FALSE; #endif - } +} - static Int - p_host_type( USES_REGS1 ) { +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 ) { +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 ) { +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)); + 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)); + 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)); + 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)); + 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)); + 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)); + out3 = MkAtomTerm(Yap_LookupAtom(YAP_BINDIR)); } return(Yap_unify(out1,ARG1) && - Yap_unify(out2,ARG2) && - Yap_unify(out3,ARG3)); - } + Yap_unify(out2,ARG2) && + Yap_unify(out3,ARG3)); +} - static Int - p_log_event( USES_REGS1 ) { +static Int +p_log_event( USES_REGS1 ) { Term in = Deref(ARG1); Atom at; if (IsVarTerm(in)) - return FALSE; + return FALSE; if (!IsAtomTerm(in)) - return FALSE; + return FALSE; at = AtomOfTerm( in ); #if DEBUG if (IsWideAtom(at) ) - fprintf(stderr, "LOG %S\n", RepAtom(at)->WStrOfAE); + fprintf(stderr, "LOG %S\n", RepAtom(at)->WStrOfAE); else if (IsBlob(at)) - return FALSE; + return FALSE; else - fprintf(stderr, "LOG %s\n", RepAtom(at)->StrOfAE); + fprintf(stderr, "LOG %s\n", RepAtom(at)->StrOfAE); #endif if (IsWideAtom(at) || IsBlob(at)) - return FALSE; + return FALSE; LOG( " %s ",RepAtom(at)->StrOfAE); return TRUE; - } +} - static Int - p_env_separator( USES_REGS1 ) { +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) - { +void +Yap_InitSysbits (int wid) +{ CACHE_REGS -#if __simplescalar__ + #if __simplescalar__ { - char *pwd = getenv("PWD"); - strncpy(GLOBAL_pwd,pwd,YAP_FILENAME_MAX); + 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 ) - { +static Int +p_unix( USES_REGS1 ) +{ #ifdef unix return TRUE; #else @@ -2012,11 +2034,11 @@ Yap_InitPageSize(void) #endif #endif #endif - } +} - static Int - p_win32( USES_REGS1 ) - { +static Int +p_win32( USES_REGS1 ) +{ #ifdef _WIN32 return TRUE; #else @@ -2026,121 +2048,121 @@ Yap_InitPageSize(void) return FALSE; #endif #endif - } +} - static Int - p_ld_path( USES_REGS1 ) - { +static Int +p_ld_path( USES_REGS1 ) +{ return Yap_unify(ARG1,MkAtomTerm(Yap_LookupAtom(YAP_LIBDIR))); - } +} - static Int - p_address_bits( USES_REGS1 ) - { +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 */ +/* 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; +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; + { wchar_t buf[256]; + wchar_t *s; + HKEY tmp; - for(s=buf; *which && !(*which == '/' || *which == '\\'); ) - *s++ = *which++; - *s = '\0'; - if ( *which ) - which++; + 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 ( 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 ( RegOpenKeyExW(key, buf, 0L, KEY_READ, &tmp) == ERROR_SUCCESS ) + { RegCloseKey(key); + key = tmp; + continue; + } - if ( !create ) - return NULL; + 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; - } + 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) - { +static void +recover_space(wchar_t *k, Atom At) +{ if (At->WStrOfAE != k) - Yap_FreeCodeSpace((char *)k); - } + Yap_FreeCodeSpace((char *)k); +} - static wchar_t * - WideStringFromAtom(Atom KeyAt USES_REGS) - { +static wchar_t * +WideStringFromAtom(Atom KeyAt USES_REGS) +{ if (IsWideAtom(KeyAt)) { - return KeyAt->WStrOfAE; + return KeyAt->WStrOfAE; } else { - int len = strlen(KeyAt->StrOfAE); - int sz = sizeof(wchar_t)*(len+1); - char *chp = KeyAt->StrOfAE; - wchar_t *kptr, *k; + 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; + 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 ) - { +static Int +p_win_registry_get_value( USES_REGS1 ) +{ DWORD type; BYTE data[MAXREGSTRLEN]; DWORD len = sizeof(data); @@ -2151,61 +2173,61 @@ Yap_InitPageSize(void) Atom KeyAt, NameAt; if (IsVarTerm(Key)) { - Yap_Error(INSTANTIATION_ERROR,Key,"argument to win_registry_get_value unbound"); - return FALSE; + 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; + 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; + 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; + 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; + 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; - } + 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) - { +char * +Yap_RegistryGetString(char *name) +{ DWORD type; BYTE data[MAXREGSTRLEN]; DWORD len = sizeof(data); @@ -2215,42 +2237,42 @@ Yap_InitPageSize(void) #if SIZEOF_INT_P == 8 if ( !(key=reg_open_key(L"HKEY_LOCAL_MACHINE/SOFTWARE/YAP/Prolog64", FALSE)) ) { - return NULL; + return NULL; } #else if ( !(key=reg_open_key(L"HKEY_LOCAL_MACHINE/SOFTWARE/YAP/Prolog", FALSE)) ) { - return NULL; + 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; - } + 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) - { +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 ("$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); @@ -2275,11 +2297,11 @@ Yap_InitPageSize(void) 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 ("real_path", 2, prolog_realpath, 0); Yap_InitCPred ("true_file_name", 2, - true_file_name, SyncPredFlag); + 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); - } +} diff --git a/os/yapio.h b/os/yapio.h index ac00cd08d..c48af2472 100644 --- a/os/yapio.h +++ b/os/yapio.h @@ -114,7 +114,7 @@ int Yap_growtrail_in_parser(tr_fr_ptr *, TokEntry **, VarEntry **); bool Yap_IsAbsolutePath(const char *p); Atom Yap_TemporaryFile(const char *prefix, int *fd); -const char *Yap_AbsoluteFile(const char *spec, char *tmp, bool expand); +const char *Yap_AbsoluteFile(const char *spec, bool expand); typedef enum mem_buf_source { MEM_BUF_CODE = 1, diff --git a/pl/absf.yap b/pl/absf.yap index 2246fafe5..623cddb0d 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -170,51 +170,52 @@ absolute_file_name(File0,File) :- solutions(first), expand(true)],F,G). -'$absolute_file_name'(File, _Opts, _TrueFileName, G) :- var(File), !, - '$do_error'(instantiation_error, G). '$absolute_file_name'(File,LOpts,TrueFileName, G) :- +% must_be_of_type( atom, File ), + abs_file_parameters(LOpts,Opts), current_prolog_flag(open_expands_filename, OldF), current_prolog_flag( fileerrors, PreviousFileErrors ), current_prolog_flag( verbose_file_search, PreviousVerbose ), - abs_file_parameters(LOpts,Opts), get_abs_file_parameter( verbose_file_search, Opts, Verbose ), get_abs_file_parameter( expand, Opts, Expand ), set_prolog_flag( verbose_file_search, Verbose ), get_abs_file_parameter( file_errors, Opts, FErrors ), + get_abs_file_parameter( solutions, Opts, First ), ( FErrors == fail -> set_prolog_flag( fileerrors, false ) ; set_prolog_flag( fileerrors, true ) ), set_prolog_flag(file_name_variables, Expand), - '$absf_trace'('search for ~w with options ~w', [File, LOpts] ), - '$find_in_path'(File, Opts,TrueFileName,G), + '$absf_trace'(File), + '$absf_trace_options'(LOpts), + '$find_in_path'(File, Opts,TrueFileName), ( - get_abs_file_parameter( solutions, Opts, first ) + First == first -> - '$absf_trace'('found solution ~a', [TrueFileName] ), -% stop_lowxb( _level_trace, - set_prolog_flag( fileerrors, PreviousFileErrors ), - set_prolog_flag( open_expands_filename, OldF), - set_prolog_flag( verbose_file_search, PreviousVerbose ), - '$absf_trace'('first solution only', [] ), - ! + '$absf_trace'(' got first ~a', [TrueFileName]), +% stop_low_level_trace, + set_prolog_flag( fileerrors, PreviousFileErrors ), + set_prolog_flag( open_expands_filename, OldF), + set_prolog_flag( verbose_file_search, PreviousVerbose ), + ! ; ( - '$absf_trace'('found solution ~a', [TrueFileName] ), -% stop_low_level_trace, - set_prolog_flag( fileerrors, PreviousFileErrors ), - set_prolog_flag( file_name_variables, OldF), - set_prolog_flag( verbose_file_search, PreviousVerbose ) - ; + '$absf_trace'(' found match ~a.', [TrueFileName]), + set_prolog_flag( fileerrors, PreviousFileErrors ), + set_prolog_flag( file_name_variables, OldF), + set_prolog_flag( verbose_file_search, PreviousVerbose ) + ; + '$absf_trace'(' no more solutions.', []), set_prolog_flag( verbose_file_search, Verbose ), get_abs_file_parameter( file_errors, Opts, FErrors ), set_prolog_flag(file_name_variables, Expand), fail ) - ; - % no solution -% stop_low_level_trace, + ; + % no solution + % stop_low_level_trace, + '$absf_trace'(' failed.', []), set_prolog_flag( fileerrors, PreviousFileErrors ), set_prolog_flag( verbose_file_search, PreviousVerbose ), set_prolog_flag(file_name_variables, OldF), @@ -227,95 +228,157 @@ absolute_file_name(File0,File) :- % library(F) must check library_directories % T(F) must check file_search_path % all must try search in path -'$find_in_path'(user,_,user_input, _) :- !. -'$find_in_path'(user_input,_,user_input, _) :- !. -'$find_in_path'(S, Opts, NewFile, Call) :- - S =.. [Name,File0], - '$cat_file_name'(File0,File), !, - '$absf_trace'('~w(~w) to ~w', [Name, File0, File] ), - '$dir_separator'(D), - atom_codes(A,[D]), - '$extend_path_directory'(Name, A, File, Opts, NewFile, Call). -'$find_in_path'(File0,Opts,NewFile,_) :- - '$cat_file_name'(File0,File), !, - '$add_path'(File, Opts, PFile), - '$get_abs_file'(PFile,Opts,AbsFile), - '$absf_trace'('~w to ~w', [PFile, NewFile] ), - '$search_in_path'(AbsFile,Opts,NewFile). -'$find_in_path'(File,_,_,Call) :- - '$do_error'(domain_error(source_sink,File),Call). +'$find_in_path'(user,_,user_input) :- !. +'$find_in_path'(user_input,_,user_input) :- !. +'$find_in_path'(user_output,_,user_ouput) :- !. +'$find_in_path'(user_error,_,user_error) :- !. +'$find_in_path'(Name, Opts, File) :- +% ( atom(Name) -> true ; start_low_level_trace ), + get_abs_file_parameter( file_type, Opts, Type ), + get_abs_file_parameter( access, Opts, Access ), + get_abs_file_parameter( expand, Opts, Expand ), + '$absf_trace'('start with ~w', [Name]), + '$core_file_name'(Name, Opts, CorePath, []), + '$absf_trace'(' after name/library unfolding: ~w', [Name]), + '$prefix'(CorePath, Opts, Path , CorePath), + '$absf_trace'(' after prefix expansion: ~s', [Path]), + atom_codes( APath, Path ), + ( + Expand = true + -> + expand_file_name( APath, EPaths), + '$absf_trace'(' after variable expansion/globbing: ~w', [EPaths]), + lists:member(EPath, EPaths) + ; + EPath = APath + ), + +real_path( EPath, File), + '$absf_trace'(' after canonical path name: ~a', [File]), + '$check_file'( File, Type, Access ), + '$absf_trace'(' after testing ~a for ~a and ~a', [File,Type,Access]). % allow paths in File Name -'$cat_file_name'(File0,File) :- - atom(File0), !, - File = File0. -'$cat_file_name'(Atoms, File) :- - '$to_list_of_atoms'(Atoms, List, []), - atom_concat(List, File). +'$core_file_name'(Name, Opts) --> + '$file_name'(Name, Opts, E), + '$suffix'(E, Opts), + '$glob'(Opts). -'$to_list_of_atoms'(V, _, _) :- var(V), !, fail. -'$to_list_of_atoms'(Atom, [Atom|L], L) :- atom(Atom), !. -'$to_list_of_atoms'(Atoms, L1, LF) :- - Atoms =.. [A,As,Bs], - atom_codes(A,[D]), - '$dir_separator'(D), - '$to_list_of_atoms'(As, L1, [A|L2]), - '$to_list_of_atoms'(Bs, L2, LF). - -'$get_abs_file'(File,Opts, ExpFile) :- - '$control_for_expansion'(Opts, Expand), - get_abs_file_parameter( relative_to, Opts, RelTo ), - prolog_expanded_file_system_path( File, Expand, RelTo, ExpFile ), - '$absf_trace'('Traditional expansion: ~w', [ExpFile] ). +% +% handle library(lists) or foreign(jpl) +% +'$file_name'(Name, Opts, E) --> + { Name =.. [Lib, P0] }, + !, + { user:file_search_path(Lib, IDirs) }, + { '$paths'(IDirs, Dir ) }, + '$absf_trace'(' ~w first', [Dir]), + '$file_name'(Dir, Opts, _), + '$dir', + { '$absf_trace'(' ~w next', [P0]) }, + '$cat_file_name'(P0, E). +'$file_name'(Name, _Opts, E) --> + '$cat_file_name'(Name, E). -'$control_for_expansion'(Opts, true) :- - get_abs_file_parameter( expand, Opts, true ), - !. -'$control_for_expansion'(_Opts, Flag) :- - current_prolog_flag( open_expands_filename, Flag ). +'$cat_file_name'(A/B, E ) --> + '$cat_file_name'(A, _), + '$dir', + '$cat_file_name'(B, E). +'$cat_file_name'(File, F) --> + { atom(File), atom_codes(File, F) }, + !, + F. +'$cat_file_name'(File, S) --> + {string(File), string_to_codes(File, S) }, + !, + S. + +% / separates both unix and windows path +'$absolute_path'( [0'/|_], _Opts ) :- !. +'$absolute_path'( [0'~|_], Opts ) :- + get_abs_file_parameter( expand, Opts, true ), + !. +'$absolute_path'( [0'$|L], Opts ) :- + get_abs_file_parameter( expand, Opts, true ), + '$var'(L), + !. +% \ windows path +'$absolute_path'( [0'\\|_], _Opts ) :- + current_prolog_flag(windows, true), + !. +% windows drive +'$absolute_path'( Path, _Opts ) :- + current_prolog_flag(windows, true), + '$drive'( Path, _ ). + +'$var'(S) --> + "{", !, '$id'(S), "}". +'$var'(S) --> + '$id'(S). + +'$drive' --> + '$id'(_), + ":\\\\". + +'$id'([C|S]) --> [S], + { C >= "a", C =< "z" ; C >= "A", C =< "Z" ; + C >= "0", C =< "9" ; C =:= "_" }, + !, + '$id'(S). +'$id'([]) --> []. -'$search_in_path'(File,Opts,F) :- - get_abs_file_parameter( extensions, Opts, Extensions ), - '$absf_trace'('check extensions ~w?', [Extensions] ), - '$add_extensions'(Extensions, File, F0), - '$glob'( F0, Opts, FG), - get_abs_file_parameter( file_type, Opts, Type ), - get_abs_file_parameter( access, Opts, Access ), - '$check_file'(FG,Type, Access, F), - '$absf_trace'(' ~a ok!', [Access]). -'$search_in_path'(File,Opts,F) :- - get_abs_file_parameter( file_type, Opts, Type ), - '$absf_trace'('check type ~w', [Type] ), - '$add_type_extensions'(Type,File, F0), - get_abs_file_parameter( access, Opts, Access ), - '$glob'( F0, Opts, FG), - '$check_file'(FG, Type, Access, F), - '$absf_trace'(' ~w ok!', [Access]). +% always verify if a directory +'$check_file'(F, directory, _) :- + !, + exists_directory(F). +'$check_file'(_F, _Type, none) :- !. +'$check_file'(F, _Type, Access) :- + '$access_file'(F, Access), + \+ exists_directory(F). % if it has a type cannot be a directory.. -'$glob'( File1, Opts, ExpFile) :- - '$control_for_expansion'(Opts, Expand), - get_abs_file_parameter( glob, Opts, Glob ), - (Glob \== '' - -> - '$dir_separator'(D), - atom_codes(DA,[D]), - atom_concat( [File1, DA, Glob], File2 ), - expand_file_name(File2, ExpFiles), - % glob is not very much into failing - %[File2] \== ExpFiles, - '$enumerate_glob'(File2, ExpFiles, ExpFile) - ; - Expand == true - -> - expand_file_name(File1, ExpFiles), - '$enumerate_glob'(File1, ExpFiles, ExpFile) +'$suffix'(Last, _Opts) --> + { lists:append(_, [0'.|Alphas], Last), '$id'(Alphas, _, [] ) }, + '$absf_trace'(' suffix in ~s', [Last]), + !. +'$suffix'(_, Opts) --> + { + ( + get_abs_file_parameter( extensions, Opts, Exts ), + Exts \= [] + -> + lists:member(Ext, Exts), + '$absf_trace'(' trying suffix ~a from ~w', [Ext,Exts]) ; - File1 = ExpFile + get_abs_file_parameter( file_type, Opts, Type ), + ( Type == source -> NType = prolog ; NType = Type ), + user:prolog_file_type(Ext, NType) ), - '$absf_trace'(' With globbing (glob=~q;expand=~a): ~w', [Glob,Expand,ExpFile] ). + '$absf_trace'(' trying suffix ~a from type ~a', [Ext, NType]), + atom_codes(Ext, Cs) + }, + '$add_suffix'(Cs). +'$suffix'(_,_Opts) --> + '$absf_trace'(' try no suffix', []). +'$add_suffix'(Cs) --> + { Cs = [0'. |_Codes] } + -> + Cs + ; + ".", Cs. + +'$glob'(Opts) --> + { + get_abs_file_parameter( glob, Opts, G ), + G \= '', + atom_codes( G, Gs ) + }, + '$dir', + Gs. +'$glob'(_Opts) --> + []. '$enumerate_glob'(_File1, [ExpFile], ExpFile) :- !. @@ -325,55 +388,45 @@ absolute_file_name(File0,File) :- Base \= '.', Base \='..'. +'$prefix'( CorePath, Opts) --> + { '$absolute_path'( CorePath, Opts ) }, + '$absf_trace'(' rooted ~s', [CorePath]), + !. +'$prefix'( _, Opts) --> + { get_abs_file_parameter( relative_to, Opts, Prefix ), + Prefix \= '', + '$absf_trace'(' relative_to ~a', [Prefix]), + sub_atom(Prefix, _, 1, 0, Last), + atom_codes(Prefix, S) + }, + !, + S, + '$dir'(Last). +'$prefix'( _ , _) --> + { + recorded('$path',Prefix,_), + '$absf_trace'(' try YAP path database ~a', [Prefix]), + sub_atom(Prefix, _, _, 1, Last), + atom_codes(Prefix, S) }, + S, + '$dir'(Last). +'$prefix'(_,_ ) --> + '$absf_trace'(' empty prefix', []). -% always verify if a directory -'$check_file'(F, directory, _, F) :- - !, - exists_directory(F). -'$check_file'(F, _Type, none, F) :- !. -'$check_file'(F0, _Type, Access, F0) :- - access_file(F0, Access), - \+ exists_directory(F0). % if it has a type cannot be a directory.. -'$add_extensions'([Ext|_], File,F) :- - '$absf_trace'(' extension ~w', [Ext] ), - '$mk_sure_true_ext'(Ext,NExt), - atom_concat([File,NExt],F). -'$add_extensions'([_|Extensions],File,F) :- - '$add_extensions'(Extensions,File,F). +'$dir' --> { current_prolog_flag(windows, true) }, + !, + "\\". +'$dir' --> "/". -'$mk_sure_true_ext'(Ext,NExt) :- - atom_codes(Ext,[C|L]), - C \= 0'., - !, - atom_codes(NExt,[0'.,C|L]). -'$mk_sure_true_ext'(Ext,Ext). - -'$add_type_extensions'(Type,File,F) :- - ( Type == source -> NType = prolog ; NType = Type ), - user:prolog_file_type(Ext, NType), - atom_concat([File,'.',Ext],F), - '$absf_trace'(' extension ~w?', [F] ). -'$add_type_extensions'(_,File,File) :- - '$absf_trace'(' wo extension ~w?', [File] ). - -'$add_path'(File, _, File) :- - is_absolute_file_name(File), !. -'$add_path'(File, Opts, File) :- - ( get_abs_file_parameter( relative_to, Opts, Dir ) -> - true - ; - working_directory(Dir, Dir) - ), - '$dir_separator'( D ), - atom_codes( DSep, [D] ), - atomic_concat([Dir, DSep,File],PFile), - '$absf_trace'(' try . or ~a: ~a', [Dir,PFile] ). -'$add_path'(File, PFile) :- - recorded('$path',Path,_), - atom_concat([Path,File],PFile), - '$absf_trace'(' try ~a from path-data base: ~a', [Path, PFile] ). +'$dir'('/') --> !. +'$dir'('\\') --> { current_prolog_flag(windows, true) }, + !. +'$dir'(_) --> '$dir'. +% +% +% '$system_library_directories'(library, Dir) :- user:library_directory( Dir ). % '$split_by_sep'(0, 0, Dirs, Dir). @@ -384,73 +437,44 @@ absolute_file_name(File0,File) :- '$system_library_directories'(commons, Dir) :- commons_directory( Dir ). -'$split_by_sep'(Start, Next, Dirs, Dir) :- - current_prolog_flag(windows, true), - '$split_by_sep'(Start, Next, Dirs, ';', Dir), !. -'$split_by_sep'(Start, Next, Dirs, Dir) :- - '$split_by_sep'(Start, Next, Dirs, ':', Dir). -'$split_by_sep'(Start, Next, Dirs, Sep, Dir) :- - sub_atom(Dirs, Next, 1, _, Let), !, - '$continue_split_by_sep'(Let, Start, Next, Dirs, Sep, Dir). -'$split_by_sep'(Start, Next, Dirs, _Sep, Dir) :- - Next > Start, - Len is Next-Start, - sub_atom(Dirs, Start, Len, _, Dir). - - -% closed a directory -'$continue_split_by_sep'(Sep, Start, Next, Dirs, Sep, Dir) :- - Sz is Next-Start, - Sz > 0, - sub_atom(Dirs, Start, Sz, _, Dir). -% next dir -'$continue_split_by_sep'(Sep , _Start, Next, Dirs, Sep, Dir) :- !, - N1 is Next+1, - '$split_by_sep'(N1, N1, Dirs, Dir). -% same dir -'$continue_split_by_sep'(_Let, Start, Next, Dirs, Sep, Dir) :- - N1 is Next+1, - '$split_by_sep'(Start, N1, Dirs, Sep, Dir). - - -'$extend_path_directory'(_Name, _D, File, _Opts, File, _Call) :- - is_absolute_file_name(File), !. -'$extend_path_directory'(Name, D, File, Opts, NewFile, Call) :- - user:file_search_path(Name, IDirs), - '$absf_trace'('file_search_path ~a is ~w', [Name, IDirs] ), - ground(IDirs), - ( - '$extend_path_directory'(IDirs, D, File, Opts, NewFile, Call) - ; - atom(IDirs) -> - '$split_by_sep'(0, 0, IDirs, Dir) - ; - Dir = IDirs - ), - '$extend_pathd'(Dir, D, File, Opts, NewFile, Call). - -'$extend_pathd'(Dir, A, File, Opts, NewFile, Goal) :- - atom(Dir), !, - '$add_file_to_dir'(Dir,A,File,NFile), - '$absf_trace'(' try ~a', [NFile] ), - '$find_in_path'(NFile, Opts, NewFile, Goal), !. -'$extend_pathd'(Name, A, File, Opts, OFile, Goal) :- - nonvar(Name), - Name =.. [N,P0], - '$add_file_to_dir'(P0,A,File,NFile), - NewName =.. [N,NFile], - '$absf_trace'(' try ~q', [NewName] ), - '$find_in_path'(NewName, Opts, OFile, Goal). - -'$add_file_to_dir'(P0,A,Atoms,NFile) :- - atom_concat([P0,A,Atoms],NFile). +% enumerate all paths separated by a path_separator. +'$paths'(Cs, C) :- + atom(Cs), + ( current_prolog_flag(windows, true) -> Sep = ';' ; Sep = ':' ), + sub_atom(Cs, N0, 1, N, Sep), + !, + ( + sub_atom(Cs,0,N0,_,C) + ; + sub_atom(Cs,_,N,0,RC), + '$paths'(RC, C) + ). +'$paths'(S, S). + +'$absf_trace'(Msg, Args ) --> + { current_prolog_flag( verbose_file_search, true ) }, + !, + { print_message( informational, absolute_file_path( Msg, Args ) ) }. +'$absf_trace'(_Msg, _Args ) --> []. '$absf_trace'(Msg, Args ) :- + current_prolog_flag( verbose_file_search, true ), + !, + print_message( informational, absolute_file_path( Msg, Args ) ). +'$absf_trace'(_Msg, _Args ). + +'$absf_trace'( File ) :- current_prolog_flag( verbose_file_search, true ), !, - print_message( informational, absolute_file_path( Msg, Args ) ). -'$absf_trace'(_Msg, _Args ). + print_message( informational, absolute_file_path( File ) ). +'$absf_trace'( _File ). + +'$absf_trace_options'(Args ) :- + current_prolog_flag( verbose_file_search, true ), + !, + print_message( informational, arguments( Args ) ). +'$absf_trace_options'( _Args ). /** @pred prolog_file_name( +File, -PrologFileaNme) @@ -560,14 +584,11 @@ system_library/1. % % 1. honor YAPSHAREDIR user:library_directory( Dir ) :- - getenv( 'YAPSHAREDIR', Dir0), - absolute_file_name( Dir0, [file_type(directory), expand(true),file_errors(fail)], Dir ). + getenv( 'YAPSHAREDIR', Dir). %% 2. honor user-library -user:library_directory( Dir ) :- - absolute_file_name( '~/share/Yap', [file_type(directory), expand(true),file_errors(fail)], Dir ). +user:library_directory( '~/share/Yap' ). %% 3. honor current directory -user:library_directory( Dir ) :- - absolute_file_name( '.', [file_type(directory), expand(true),file_errors(fail)], Dir ). +user:library_directory( '.' ). %% 4. honor default location. user:library_directory( Dir ) :- system_library( Dir ). @@ -663,7 +684,7 @@ file_search_path(swi, Home) :- current_prolog_flag(home, Home). file_search_path(yap, Home) :- current_prolog_flag(home, Home). -file_search_path,(system, Dir) :- +file_search_path(system, Dir) :- prolog_flag(host_type, Dir). file_search_path(foreign, Dir) :- foreign_directory(Dir). @@ -698,8 +719,7 @@ user:file_search_path(yap, Home) :- current_prolog_flag(home, Home). user:file_search_path(system, Dir) :- prolog_flag(host_type, Dir). -user:file_search_path(foreign, Dir) :- - working_directory(Dir,Dir). +user:file_search_path(foreign, '.'). user:file_search_path(foreign, yap('lib/Yap')). user:file_search_path(path, C) :- ( getenv('PATH', A), @@ -711,4 +731,4 @@ user:file_search_path(path, C) :- ). -%% @} \ No newline at end of file +%% @} diff --git a/pl/arith.yap b/pl/arith.yap index e788c060d..e78de29c9 100644 --- a/pl/arith.yap +++ b/pl/arith.yap @@ -129,7 +129,6 @@ do_c_built_in(Mod:G, _, H, OUT) :- '$yap_strip_module'(Mod:G, M1, G1), var(G1), !, do_c_built_metacall(G1, M1, H, OUT). -do_c_built_in('C'(A,B,C), _, _, (A=[B|C])) :- !. do_c_built_in('$do_error'( Error, Goal), M, Head, (clause_location(Call, Caller), strip_module(M:Goal,M1,NGoal), diff --git a/pl/boot.yap b/pl/boot.yap index ce3d4c355..ea7bd82b2 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -373,7 +373,7 @@ true :- true. get_value('$consult_on_boot',X), ( X \= [] - -> + -> bootstrap(X), module( user ), qsave_program( 'startup.yss') diff --git a/pl/debug.yap b/pl/debug.yap index ee7885842..4a809df38 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -307,7 +307,6 @@ be lost. %'$do_spy'(V, M, CP, Flag) :- % writeln('$do_spy'(V, M, CP, Flag)), fail. '$do_spy'(V, M, CP, Flag) :- -'$stop_low_level_trace', '$stop_creeping'(_), var(V), !, '$do_spy'(call(V), M, CP, Flag). @@ -521,15 +520,15 @@ be lost. '$spycall'(G, M, _, _) :- current_prolog_flag( debug, false), !, - '$execute_nonstop'(G,M). + '$execute_nonstop'(G,M). '$spycall'(G, M, _, _) :- '__NB_getval__'('$debug_jump',true, fail), !, ( '$is_metapredicate'(G, M) -> - '$expand_meta_call'(M:G, [], G1) + '$expand_meta_call'(M:G, [], G1) ; - G = G1 + G = G1 ), '$execute_nonstop'(G1,M). '$spycall'(G, M, _, _) :- @@ -542,8 +541,8 @@ be lost. '$do_spy'(NG, NM, CP, spy). '$spycall'(G, M, _, _) :- ( '$is_system_predicate'(G,M) ; '$tabled_predicate'(G,M) ), - !, - '$continue_debugging_goal'(no, '$execute_nonstop'(G,M)). + !, + '$continue_debugging_goal'(yes, '$execute_nonstop'(G,M)). '$spycall'(G, M, CalledFromDebugger, InRedo) :- '$spycall_expanded'(G, M, CalledFromDebugger, InRedo). @@ -568,13 +567,13 @@ be lost. *-> '$stop_creeping'(_), ( - '$continue_debugging_goal'(no, '$execute_clause'(G, M, R, CP)) + '$continue_debugging_goal'(yes, '$execute_clause'(G, M, R, CP)) ; InRedo = true ) ) ; - ( '$continue_debugging_goal'(no, '$execute_nonstop'(G,M) ) ; InRedo = true ) + ( '$continue_debugging_goal'(yes, '$execute_nonstop'(G,M) ) ; InRedo = true ) ). % I may backtrack to here from far away @@ -786,7 +785,7 @@ be lost. '$action'(0'n,_,_,_,_,off) :- !, % 'n nodebug '$skipeol'(0'n), % ' % tell debugger never to stop. - '__NB_setval__'('$debug_run', -1), + '__NB_setval__'('$debug_run', -1), '__NB_setval__'('$debug_jump',true), nodebug. '$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry diff --git a/pl/error.yap b/pl/error.yap index a958a18ae..0f7f0a80f 100644 --- a/pl/error.yap +++ b/pl/error.yap @@ -105,6 +105,9 @@ must_be(Type, X, Comment) :- must_be_of_type(callable, X) :- !, is_callable(X, _). +must_be_of_type(atom, X) :- + !, + is_atom(X, _). must_be_of_type(predicate_indicator, X) :- !, is_predicate_indicator(X, _). @@ -115,6 +118,7 @@ must_be_of_type(Type, X) :- ). inline(must_be_of_type( callable, X ), error:is_callable(X, _) ). +inline(must_be_of_type( callable, X ), error:is_callable(X, _) ). must_be_of_type(predicate_indicator, X, Comment) :- !, diff --git a/pl/grammar.yap b/pl/grammar.yap index cbec31924..ea39feb83 100644 --- a/pl/grammar.yap +++ b/pl/grammar.yap @@ -70,7 +70,7 @@ Grammar related built-in predicates: */ -:- module( system('$_grammar'), [!/2, +:- system_module( '$_grammar', [!/2, (',')/4, (->)/4, ('.')/4, @@ -82,14 +82,12 @@ Grammar related built-in predicates: phrase/2, phrase/3, {}/3, - ('|')/4]). - -:- use_system_module( '$_errors', ['$do_error'/2]). + ('|')/4], ['$do_error'/2]). :- use_module( library( expand_macros ) ). % :- meta_predicate ^(?,0,?). - % ^(Xs, Goal, Xs) :- call(Goal). +% ^(Xs, Goal, Xs) :- call(Goal). % :- meta_predicate ^(?,1,?,?). % ^(Xs0, Goal, Xs0, Xs) :- call(Goal, Xs). @@ -101,17 +99,17 @@ Grammar related built-in predicates: */ prolog:'$translate_rule'(Rule, (NH :- B) ) :- - source_module( SM ), - '$yap_strip_module'( SM:Rule, M0, (LP-->RP) ), - t_head(LP, NH0, NGs, S, SR, (LP-->SM:RP)), - '$yap_strip_module'( M0:NH0, M, NH1 ), - ( M == SM -> NH = NH1 ; NH = M:NH1 ), - (var(NGs) -> - t_body(RP, _, last, S, SR, B1) - ; - t_body((RP,{NGs}), _, last, S, SR, B1) - ), - t_tidy(B1, B). + source_module( SM ), + '$yap_strip_module'( SM:Rule, M0, (LP-->RP) ), + t_head(LP, NH0, NGs, S, SR, (LP-->SM:RP)), + '$yap_strip_module'( M0:NH0, M, NH1 ), + ( M == SM -> NH = NH1 ; NH = M:NH1 ), + (var(NGs) -> + t_body(RP, _, last, S, SR, B1) + ; + t_body((RP,{NGs}), _, last, S, SR, B1) + ), + t_tidy(B1, B). t_head(V, _, _, _, _, G0) :- var(V), !, @@ -232,9 +230,24 @@ prolog:phrase(PhraseDef, WordList) :- This predicate succeeds when the difference list ` _L_- _R_` is a phrase of type _P_. */ +prolog:phrase(V, S0, S) :- + var(V), + !, + '$do_error'(instantiation_error,phrase(V,S0,S)). +prolog:phrase([H|T], S0, S) :- + !, + S0 = [H|S1], + '$phrase_list'(T, S1, S). +prolog:phrase([], S0, S) :- + !, + S0 = S. prolog:phrase(P, S0, S) :- call(P, S0, S). +'$phrase_list'([], S, S). +'$phrase_list'([H|T], [H|S1], S0) :- + '$phrase_list'(T, S1, S0). + prolog:!(S, S). prolog:[](S, S). @@ -306,19 +319,16 @@ prolog:'$goal_expansion_allowed'. NewGoal = '$execute_in_mod'(NewGoal3,M) ). -allowed_module(phrase(_,_),_). -allowed_module(phrase(_,_,_),_). +do_c_built_in('C'(A,B,C), _, _, (A=[B|C])) :- !. - -system:goal_expansion(Mod:phrase(NT,Xs0, Xs),Mod:NewGoal) :- +do_c_built_in(phrase(NT,Xs0, Xs),Mod, _, NewGoal) :- nonvar(NT), nonvar(Mod), !, '$goal_expansion_allowed', '$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal). -system:goal_expansion(Mod:phrase(NT,Xs),Mod:NewGoal) :- +do_c_built_in(phrase(NT,Xs),Mod,_,NewGoal) :- nonvar(NT), nonvar(Mod), - '$goal_expansion_allowed', - '$c_built_in_phrase'(NT, [], Xs, Mod, NewGoal). + '$c_built_in_phrase'(NT, Xs, [], Mod, NewGoal). /** @} diff --git a/pl/init.yap b/pl/init.yap index bc39d57be..2f65e39a1 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -120,7 +120,7 @@ otherwise. '$early_print_message'(Level, Msg) :- source_location(F0, L), !, - format(user_error, '~a:~d: unprocessed ~a ~w ~n', [F0, L,Level,Msg]). + format(user_error, '~a:~d:0: unprocessed ~a ~w ~n', [F0, L,Level,Msg]). '$early_print_message'(Level, Msg) :- format(user_error, 'unprocessed ~a ~w ~n', [Level,Msg]). @@ -135,6 +135,9 @@ print_message(Level, Msg) :- :- bootstrap('arith.yap'). + +:- compile_expressions. + :- bootstrap('lists.yap'). :- bootstrap('consult.yap'). :- bootstrap('preddecls.yap'). @@ -145,14 +148,12 @@ print_message(Level, Msg) :- :- bootstrap('atoms.yap'). :- bootstrap('os.yap'). +:- bootstrap('grammar.yap'). :- bootstrap('absf.yap'). -:- set_prolog_flag(verbose, normal). %:-set_prolog_flag(gc_trace, verbose). %:- set_prolog_flag( verbose_file_search, true ). -:- compile_expressions. - :- dynamic prolog:'$parent_module'/2. :- [ @@ -162,8 +163,6 @@ print_message(Level, Msg) :- ]. :- use_module('error.yap'). -:- use_module('grammar.yap'). - :- [ 'errors.yap', diff --git a/pl/load_foreign.yap b/pl/load_foreign.yap index 72ab8b8b2..f9425e3b8 100644 --- a/pl/load_foreign.yap +++ b/pl/load_foreign.yap @@ -51,7 +51,7 @@ variable: if defined, or in the default library. -YAP also supports the SWI-Prolog interface to loading foreign code: +YAP supports the SWI-Prolog interface to loading foreign code, the shlib package. */ load_foreign_files(Objs,Libs,Entry) :- @@ -73,6 +73,29 @@ load_foreign_files(Objs,Libs,Entry) :- ; true ), + !. + +/** @pred load_absolute_foreign_files( _Files_, _Libs_, _InitRoutine_) + +Loads object files produced by the C compiler. It is useful when no search should be performed and instead one has the full paths to the _Files_ and _Libs_. + +*/ +load_absolute_foreign_files(Objs,Libs,Entry) :- + source_module(M), + ( + recordzifnot( '$foreign', M:'$foreign'(Objs,Libs,Entry), _) + -> + '$load_foreign_files'(Objs,Libs,Entry), + ( + prolog_load_context(file, F) + -> + ignore( recordzifnot( '$load_foreign_done', [F, M], _) ) + ; + true + ) + ; + true + ), !. '$check_objs_for_load_foreign_files'(V,_,G) :- var(V), !, diff --git a/pl/messages.yap b/pl/messages.yap index 5d8422bc1..863b141af 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -105,10 +105,18 @@ compose_message( Term, _Level ) --> prolog:message(Term), !. compose_message( query(_QueryResult,_), _Level) --> []. +compose_message( absolute_file_path(File), _Level) --> + [ '~N~n absolute_file of ~w' - [File] ]. compose_message( absolute_file_path(Msg, Args), _Level) --> - [ ' absolute_file_path: ' - [], + [ ' : ' - [], Msg - Args, nl ]. +compose_message( arguments([]), _Level) --> + []. +compose_message( arguments([A|As]), Level) --> + [ ' ~w' - [A], + nl ], + compose_message( arguments(As), Level). compose_message( ancestors([]), _Level) --> [ 'There are no ancestors.' ]. compose_message( breakp(bp(debugger,_,_,M:F/N,_),add,already), _Level) --> @@ -195,7 +203,8 @@ compose_message(Term, Level) --> [nl,nl]. compose_message(Term, Level) --> { Level == error -> true ; Level == warning }, - main_message( Term, Level ), + { '$show_consult_level'(LC) }, + main_message( Term, Level, LC ), [nl,nl]. location(error(syntax_error(syntax_error(_,between(_,LN,_),FileName,_))), _ ) --> @@ -209,75 +218,72 @@ location( error(_,Term), Level ) --> { source_location(F0, L), stream_property(_Stream, alias(loop_stream)) }, !, { lists:memberchk([p|p(M,Na,Ar,_File,_FilePos)], Term ) }, - [ '~a:~d:0 ~a in ~a:~q/~d:'-[F0, L,Level,M,Na,Ar] ], + [ '~a:~d:0: ~a in ~a:~q/~d:'-[F0, L,Level,M,Na,Ar] ], [nl]. location( error(_,Term), Level ) --> { lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) }, !, - [ '~a:~d:0 ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ], + [ '~a:~d:0: ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ], [nl]. %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, -main_message(error(Msg,Info), _) --> {var(Info)}, !, - [ nl, '~*|!!! uninstantiated message ~w~n.' - [8,Msg], nl ]. -main_message( error(syntax_error(syntax_error(Msg,between(L0,LM,LF),_Stream,Term)),_), _ ) --> +main_message(error(Msg,Info), _, LC) --> {var(Info)}, !, + [ nl, '~*|!!! uninstantiated message ~w~n.' - [LC,Msg], nl ]. +main_message( error(syntax_error(syntax_error(Msg,between(L0,LM,LF),_Stream,Term)),_), _, LC ) --> !, - ['~*|!!! syntax error: ~s' - [10,Msg]], + ['~*|!!! syntax error: ~s' - [LC,Msg]], [nl], % [prefix(' ')], ( syntax_error_term( between(L0,LM,LF), Term ) -> [] ; - ['failed_processing syntax error term ~q' - [Term]], + ['~*|!!! failed_processing syntax error term ~q' - [LC,Term]], [nl] ). -main_message(error(style_check(style_check(singleton(SVs),_Pos,_File,P)),_), _) --> +main_message(error(style_check(style_check(singleton(SVs),_Pos,_File,P)),_), _, LC) --> !, { clause_to_indicator(P, I) }, - [ '~*|!!! singleton variable~*c ~s in ~q.' - [ 10, NVs, 0's, SVsL, I] ], + [ '~*|!!! singleton variable~*c ~s in ~q.' - [ LC, NVs, 0's, SVsL, I] ], { svs(SVs,SVs,SVsL), ( SVs = [_] -> NVs = 0 ; NVs = 1 ) }. -main_message(error(style_check(style_check(multiple(N,A,Mod,I0),_Pos,File,_P)),_),_) --> +main_message(error(style_check(style_check(multiple(N,A,Mod,I0),_Pos,File,_P)),_),_, LC) --> !, - { '$show_consult_level'(LC) }, [ '~*|!!! ~a redefines ~q from ~a.' - [LC,File, Mod:N/A, I0] ]. -main_message(error(style_check(style_check(discontiguous(N,A,Mod),_S,_W,_P)),_) ,_)--> +main_message(error(style_check(style_check(discontiguous(N,A,Mod),_S,_W,_P)),_,LC) ,_)--> !, - { '$show_consult_level'(LC) }, - [ '~*|!!! !!! discontiguous definition for ~p.' - [LC,Mod:N/A] ]. -main_message(error(consistency_error(Who)), _Source) --> + [ '~*|!!! discontiguous definition for ~p.' - [LC,Mod:N/A] ]. +main_message(error(consistency_error(Who)), _Source, LC) --> !, - { '$show_consult_level'(LC) }, [ '~*|!!! has argument ~a not consistent with type.'-[LC,Who] ]. -main_message(error(domain_error(Who , Type), _Where), _Source) --> +main_message(error(domain_error(Who , Type), _Where), _Source, LC) --> !, - [ '~*|!!! ~q does not belong to domain ~a,' - [8,Who,Type], nl ]. -main_message(error(evaluation_error(What, Who), _Where), _Source) --> + [ '~*|!!! ~q does not belong to domain ~a,' - [LC,Type,Who], nl ]. +main_message(error(evaluation_error(What, Who), _Where), _Source, LC) --> + !, + [ '~*|!!! ~w caused ~a during evaluation of arithmetic expressions,' - [LC,Who,What], nl ]. +main_message(error(existence_error(Type , Who), _Where), _Source, LC) --> !, - [ '~*|!!! ~w caused ~a during evaluation of arithmetic expressions,' - [8,Who,What], nl ]. -main_message(error(existence_error(Type , Who), _Where), _Source) --> - !, - [ '~*|!!! ~q ~q could not be found,' - [8,Type, Who], nl ]. -main_message(error(permission_error(Op, Type, Id), _Where), _Source) --> - [ '~*|!!! ~q is not allowed in ~a ~q,' - [8, Op, Type,Id], nl ]. -main_message(error(instantiation_error, _Where), _Source) --> - [ '~*|!!! unbound variable' - [8], nl ]. -main_message(error(representation_error), _Source) --> - [ '~*|!!! unbound variable' - [8], nl ]. -main_message(error(type_error(Type,Who), _What), _Source) --> - [ '~*|!!! ~q should be of type ~a' - [8,Who,Type]], + [ '~*|!!! ~q ~q could not be found,' - [LC,Type, Who], nl ]. +main_message(error(permission_error(Op, Type, Id), _Where), _Source, LC) --> + [ '~*|!!! ~q is not allowed in ~a ~q,' - [LC, Op, Type,Id], nl ]. +main_message(error(instantiation_error, _Where), _Source, LC) --> + [ '~*|!!! unbound variable' - [LC], nl ]. +main_message(error(representation_error), _Source, LC) --> + [ '~*|!!! unbound variable' - [LC], nl ]. +main_message(error(type_error(Type,Who), _What), _Source, LC) --> + [ '~*|!!! ~q should be of type ~a' - [LC,Who,Type]], [ nl ]. -main_message(error(system_error(Who), _What), _Source) --> - [ '~*|!!! ~q error' - [8,Who]], +main_message(error(system_error(Who), _What), _Source, LC) --> + [ '~*|!!! ~q error' - [LC,Who]], [ nl ]. -main_message(error(uninstantiation_error(T),_), _Source) --> - [ '~*|!!! found ~q, expected unbound variable ' - [8,T], nl ]. +main_message(error(uninstantiation_error(T),_), _Source, LC) --> + [ '~*|!!! found ~q, expected unbound variable ' - [LC,T], nl ]. display_consulting(_Level) --> { source_location(F0, L), stream_property(_Stream, alias(loop_stream)) }, !, - [ '~a:~d:0 found while compiling this file.'-[F0,L], nl ]. + [ '~a:~d:0: found while compiling this file.'-[F0,L], nl ]. display_consulting(_) --> []. caller( error(_,Term), _) --> @@ -286,12 +292,12 @@ caller( error(_,Term), _) --> !, ['~*|goal was ~q' - [10,Call]], [nl], - ['~*|exception raised from ~a:~q:~d, ~a:~d:0. '-[10,M,Na,Ar,File, FilePos]], + ['~*|exception raised from ~a:~q:~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]], [nl]. caller( error(_,Term), _) --> { lists:memberchk([e|p(M,Na,Ar,File,FilePos)], Term ) }, !, - ['~*|exception raised from ~a:~q/~d, ~a:~d:0. '-[10,M,Na,Ar,File, FilePos]], + ['~*|exception raised from ~a:~q/~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]], [nl]. caller( error(_,Term), _) --> { lists:memberchk([g|g(Call)], Term) }, @@ -304,7 +310,7 @@ caller( _, _) --> c_goal( error(_,Term), Level ) --> { lists:memberchk([c|c(File, Line, Func)], Term ) }, !, - ['~*|~a raised at C-function ~a() in ~a/~d:0. '-[10, Level, Func, File, Line]], + ['~*|~a raised at C-function ~a() in ~a:~d:0: '-[10, Level, Func, File, Line]], [nl]. c_goal( _, _Level ) --> []. diff --git a/pl/qly.yap b/pl/qly.yap index e4a39ccd3..7bda1ab75 100755 --- a/pl/qly.yap +++ b/pl/qly.yap @@ -243,12 +243,19 @@ qend_program :- '$init_state' :- once('$handle_throw'(_,_,_)), - fail. -'$init_state' :- - recorded('$program_state', _P, _), !, - '$do_init_state'. -'$init_state'. + ( + recorded('$program_state', _P, R) + -> + erase(R), + '$do_init_state' + ; + true + ). +'$do_init_state' :- + set_value('$user_module',user), + '$protect', + fail. '$do_init_state' :- compile_expressions, '$init_preds', @@ -262,10 +269,6 @@ qend_program :- '$do_init_state' :- '$reinit_thread0', fail. -'$do_init_state' :- - set_value('$user_module',user), - '$protect', - fail. '$do_init_state' :- '$current_module'(prolog), module(user), @@ -280,10 +283,13 @@ qend_program :- % % first, recover what we need from the saved state... -% +%' '$init_from_saved_state_and_args' :- '$init_path_extensions', fail. +'$init_from_saved_state_and_args' :- + '$protect', + fail. % use if we come from a save_program and we have SWI's shlib '$init_from_saved_state_and_args' :- current_prolog_flag(hwnd, _HWND), @@ -320,15 +326,12 @@ qend_program :- '$init_from_saved_state_and_args' :- '$startup_goals', fail. -'$init_from_saved_state_and_args' :- +'$init_from_saved' :- recorded('$restore_goal',G,R), erase(R), prompt(_,'| '), catch(once(user:G),Error,user:'$Error'(Error)), fail. -'$init_from_saved_state_and_args' :- - '$protect', - fail. '$init_from_saved_state_and_args'. '$init_path_extensions' :- @@ -343,9 +346,9 @@ qend_program :- module(user), fail. '$startup_goals' :- - recorded('$startup_goal',G,_), - catch(once(user:G),Error,user:'$Error'(Error)), - fail. + recorded('$startup_goal',G,_), + catch(once(user:G),Error,user:'$Error'(Error)), + fail. '$startup_goals' :- get_value('$init_goal',GA), GA \= [], @@ -793,4 +796,4 @@ qload_file( F0 ) :- '$process_directives'( _FilePl ) :- abolish(user:'$file_property'/1). -%% @} \ No newline at end of file +%% @} diff --git a/pl/yio.yap b/pl/yio.yap index 6890bb719..ff48fd8a6 100644 --- a/pl/yio.yap +++ b/pl/yio.yap @@ -46,6 +46,7 @@ ttynl/0, ttyput/1, ttyskip/1, + rename/2, write_depth/2], ['$default_expand'/1, '$extend_file_search_path'/1, '$set_default_expand'/1]). @@ -438,8 +439,25 @@ The atom _File_ corresponds to an existing file or directory. */ file_exists(IFile) :- - true_file_name(IFile, File), - '$file_exists'(File). + absolute_file_name(IFile, _File, [expand(true), solutions(first), access(exist)]). + +/** @pred rename(+F , +G) + + Renames the single file _F_ to _G_. +*/ +rename(IFile, OFile) :- + absolute_file_name(IFile, IF, [access(read),expand(true)]), + absolute_file_name(OFile, OF, [expand(true)]), + '$rename'(IF, OF). + +/** @pred access_file(+F , +G) + + Verify whether file F respects property _G_. The file is processed + with absolute_file_name. +*/ +access_file(IFile, Access) :- + absolute_file_name(IFile, _IF, [access(Access),expand(true)]). + /** @}