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