18static char SccsId[] =
"%W% %G%";
24static Int p_sh(USES_REGS1);
25static Int p_shell(USES_REGS1);
26static Int p_system(USES_REGS1);
27static Int p_mv(USES_REGS1);
28static Int p_dir_sp(USES_REGS1);
29static Int p_getenv(USES_REGS1);
30static Int p_putenv(USES_REGS1);
39void Yap_WinError(
char *yap_error) {
42 FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
43 NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
45 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil,
"%s at %s", msg, yap_error);
49#define is_valid_env_char(C) \
50 (((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && (C) <= 'Z') || (C) == '_')
54bool Yap_isDirectory(
const char *FileName) {
57 if ((
vfs = vfs_owner(FileName))) {
61 DWORD dwAtts = GetFileAttributes(FileName);
62 if (dwAtts == INVALID_FILE_ATTRIBUTES)
64 return (dwAtts & FILE_ATTRIBUTE_DIRECTORY);
68 if (lstat(FileName, &buf) == -1) {
72 return S_ISDIR(buf.st_mode);
74 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
75 "stat not available in this configuration");
80bool Yap_Exists(
const char *f) {
83 if ((
vfs = vfs_owner(f))) {
87 if (_access(f, 0) == 0)
89 if (errno == EINVAL) {
90 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"bad flags to access");
94 if (access(f, F_OK) == 0) {
97 if (errno == EINVAL) {
98 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"bad flags to access");
102 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
103 "access not available in this configuration");
108static int dir_separator(
int ch) {
111#elif ATARI || _MSC_VER
113#elif defined(__MINGW32__) || defined(__CYGWIN__)
114 return (ch ==
'\\' || ch ==
'/');
120int Yap_dir_separator(
int ch) {
return dir_separator(ch); }
128#define isValidEnvChar(C) \
129 (((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && (C) <= 'Z') || (C) == '_')
134static char *unix2win(
const char *
source,
char *target,
int max) {
141 s = malloc(MAX_PATH + 1);
150 if (s0[0] ==
'/' && s0[1] ==
'/' && isalpha(s0[2]) && s0[3] ==
'/') {
157 while ((ch = *s1++ = *s0++)) {
164 while ((ch = *s0++) !=
'}') {
171 while (((ch = *s1++ = *s0++) >=
'A' && ch <=
'Z') ||
172 (ch >=
'a' && ch <=
'z') || (ch ==
'-') ||
173 (ch >=
'0' && ch <=
'9') || (ch ==
'_'))
182 }
else if (ch ==
'/')
190#define HAVE_BASENAME 1
191#define HAVE_REALPATH 1
194extern char *virtual_cwd;
196bool Yap_ChDir(
const char *path) {
198 int lvl = push_text_stack();
201 __android_log_print(ANDROID_LOG_INFO,
"YAPDroid",
"chdir %s", path);
203 if ((v = vfs_owner(qpath))) {
204 rc = v->chdir(v, (qpath));
210 if (qpath != NULL && qpath[0] &&
211 (rc = (SetCurrentDirectory(qpath) != 0)) == 0) {
212 Yap_WinError(
"SetCurrentDirectory failed");
215 rc = (chdir(qpath) == 0);
222Atom Yap_TemporaryFile(
const char *prefix,
int *fd) {
224 char *tmp = malloc(PATH_MAX);
229 strncpy(tmp, prefix, PATH_MAX - 1);
231 if (n >= 6 && tmp[n - 1] ==
'X' && tmp[n - 2] ==
'X' && tmp[n - 3] ==
'X' &&
232 tmp[n - 4] ==
'X' && tmp[n - 5] ==
'X' && tmp[n - 6] ==
'X')
235 strncat(tmp,
"XXXXXX", PATH_MAX - 1);
240 return Yap_LookupAtom(tmp);
245static bool initSysPath(Term tlib, Term tcommons,
bool dir_done,
249 if (!Yap_PLDIR || !Yap_unify(tlib, MkAtomTerm(Yap_LookupAtom(Yap_PLDIR))))
252 return Yap_COMMONSDIR && Yap_unify(tcommons, MkAtomTerm(Yap_LookupAtom(Yap_COMMONSDIR)));
255static Int libraries_directories(USES_REGS1) {
256 return initSysPath(ARG1, ARG2,
false,
false);
259static Int system_library(USES_REGS1) {
260 return initSysPath(ARG1, MkVarTerm(),
false,
true);
263static Int commons_library(USES_REGS1) {
264 return initSysPath(MkVarTerm(), ARG1,
true,
false);
267static Int p_dir_sp(USES_REGS1) {
268#if ATARI || _MSC_VER || defined(__MINGW32__)
269 Term t = MkIntTerm(
'\\');
270 Term t2 = MkIntTerm(
'/');
272 Term t = MkIntTerm(
'/');
273 Term t2 = MkIntTerm(
'/');
276 return Yap_unify_constant(ARG1, t) || Yap_unify_constant(ARG1, t2);
279size_t Yap_InitPageSize(
void) {
283 return si.dwPageSize;
285#if defined(__FreeBSD__) || defined(__DragonFly__)
286 return getpagesize();
288 return sysconf(_SC_PAGE_SIZE);
289#elif !defined(_SC_PAGESIZE)
290 return getpagesize();
292 return sysconf(_SC_PAGESIZE);
305static int volume_header(
char *file) {
306#if _MSC_VER || defined(__MINGW32__)
310 while ((c = ch[0]) !=
'\0') {
320int Yap_volume_header(
char *file) {
return volume_header(file); }
322const char *Yap_getcwd(
char *buf,
size_t cwdlen) {
324if (GLOBAL_cwd && GLOBAL_cwd[0]) {
328#if _WIN32 || defined(__MINGW32__)
329 if (GetCurrentDirectory(cwdlen, (
char *)cwd) == 0) {
330 Yap_WinError(
"GetCurrentDirectory failed");
335 const char *rc = NULL;
336 while ((rc=getcwd(buf, cwdlen)) == NULL && errno == ERANGE) {
338 buf = realloc(buf, cwdlen);
357static Int working_directory(USES_REGS1) {
358 int l = push_text_stack();
360 Term t1 = Deref(ARG1), t2;
361 dir =
Malloc(MAX_PATH + 1);
362 if (!IsVarTerm(t1) && !IsAtomTerm(t1)) {
363 Yap_Error(TYPE_ERROR_ATOM, t1,
"working_directory");
366 MkAtomTerm(Yap_LookupAtom(Yap_getcwd(dir, MAX_PATH))))) {
372 Yap_Error(INSTANTIATION_ERROR, t2,
"working_directory");
374 if (!IsAtomTerm(t2)) {
375 Yap_Error(TYPE_ERROR_ATOM, t2,
"working_directory");
377 if (t2 == TermEmptyAtom || t2 == TermDot) {
381 Int rc = Yap_ChDir(RepAtom(AtomOfTerm(t2))->StrOfAE);
395static Int p_sh(USES_REGS1) {
398 shell = (
char *)getenv(
"SHELL");
401 if (system(Yap_VFAlloc(shell)) < 0) {
403 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil,
"%s in sh/0",
406 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil,
"in sh/0");
413 register char *shell;
418 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
419 "sh not available in this configuration");
429static Int p_shell(USES_REGS1) {
431 Term t1 = Deref(ARG1);
433 cmd = RepAtom(AtomOfTerm(t1))->StrOfAE;
434 else if (IsStringTerm(t1))
435 cmd = StringOfTerm(t1);
438#if _MSC_VER || defined(__MINGW32__)
440 int rval = system(cmd);
449 register int bourne = FALSE;
451 shell = (
char *)getenv(
"SHELL");
452 if (!strcmp(shell,
"/bin/sh"))
458 return system(cmd) == 0;
464 if (!execl(shell, shell,
"-c", cmd, NULL)) {
470 int result = child < 0 ||
475 wait((&status)) != child ||
487 register char *shell;
493 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
494 "shell not available in this configuration");
506static Int p_system(USES_REGS1) {
508 Term t1 = Deref(ARG1);
511 Yap_Error(INSTANTIATION_ERROR, t1,
"argument to system/1 unbound");
513 }
else if (IsAtomTerm(t1)) {
514 cmd = RepAtom(AtomOfTerm(t1))->StrOfAE;
515 }
else if (IsStringTerm(t1)) {
516 cmd = StringOfTerm(t1);
518 char *cmd0 = malloc(PATH_MAX+1);
519 if (!Yap_GetName(cmd0, MAX_PATH, t1)) {
521 Yap_Error(TYPE_ERROR_ATOM, t1,
"argument to system/1");
526#if _MSC_VER || defined(__MINGW32__)
530 PROCESS_INFORMATION pi;
532 ZeroMemory(&si,
sizeof(si));
534 ZeroMemory(&pi,
sizeof(pi));
537 if (!CreateProcess(NULL,
548 Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1,
"CreateProcess failed (%d).\n",
553 WaitForSingleObject(pi.hProcess, INFINITE);
556 CloseHandle(pi.hProcess);
557 CloseHandle(pi.hThread);
569 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, t1,
"%s in system(%s)",
570 strerror(errno), cmd);
572 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, t1,
"in system(%s)", cmd);
579 register char *shell;
586 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"sh not available in this machine");
592static Int p_mv(USES_REGS1) {
595 char *oldname, *newname;
596 Term t1 = Deref(ARG1);
597 Term t2 = Deref(ARG2);
599 Yap_Error(INSTANTIATION_ERROR, t1,
"first argument to rename/2 unbound");
600 }
else if (!IsAtomTerm(t1)) {
601 Yap_Error(TYPE_ERROR_ATOM, t1,
"first argument to rename/2 not atom");
604 Yap_Error(INSTANTIATION_ERROR, t2,
"second argument to rename/2 unbound");
605 }
else if (!IsAtomTerm(t2)) {
606 Yap_Error(TYPE_ERROR_ATOM, t2,
"second argument to rename/2 not atom");
608 oldname = RepAtom(AtomOfTerm(t1))->StrOfAE;
609 newname = RepAtom(AtomOfTerm(t2))->StrOfAE;
610 if ((r = link(oldname, newname)) == 0 && (r = unlink(oldname)) != 0)
614 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, t2,
"%s in rename(%s,%s)",
615 strerror(errno), oldname, newname);
617 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, t2,
"in rename(%s,%s)", oldname,
625 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
626 "rename/2 not available in this machine");
633void Yap_SetTextFile(name)
char *name;
636 SetFileType(name,
'TEXT');
637 SetFileSignature(name,
'EDIT');
641 GetFInfo(name, 0, p);
645 p->fdCreator =
'MPS\0';
649 p->fdCreator =
'EDIT';
651 SetFInfo(name, 0, p);
658static Int p_getenv(USES_REGS1) {
660 Term t1 = Deref(ARG1), to;
664 Yap_Error(INSTANTIATION_ERROR, t1,
"first arg of getenv/2");
666 }
else if (IsStringTerm(t1)) {
667 s = StringOfTerm(t1);
668 }
else if (!IsAtomTerm(t1)) {
669 Yap_Error(TYPE_ERROR_ATOM, t1,
"first arg of getenv/2");
672 s = RepAtom(AtomOfTerm(t1))->StrOfAE;
673 if ((so = getenv(s)) == NULL)
675 to = MkAtomTerm(Yap_LookupAtom(so));
676 return (Yap_unify_constant(ARG2, to));
678 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
679 "getenv not available in this configuration");
685static Int p_putenv(USES_REGS1) {
687 Term t1 = Deref(ARG1), t2 = Deref(ARG2);
688 const char *s =
"", *s2 =
"";
692 Yap_Error(INSTANTIATION_ERROR, t1,
"first arg to putenv/2");
694 }
else if (IsStringTerm(t1)) {
695 s = StringOfTerm(t1);
696 }
else if (!IsAtomTerm(t1)) {
697 Yap_Error(TYPE_ERROR_ATOM, t1,
"first arg to putenv/2");
700 s = RepAtom(AtomOfTerm(t1))->StrOfAE;
702 Yap_Error(INSTANTIATION_ERROR, t2,
"second arg to putenv/2");
704 }
else if (IsStringTerm(t2)) {
705 s2 = StringOfTerm(t2);
706 }
else if (!IsAtomTerm(t2)) {
707 Yap_Error(TYPE_ERROR_ATOM, t2,
"second arg to putenv/2");
710 s2 = RepAtom(AtomOfTerm(t2))->StrOfAE;
711 while (!(p0 = p = Yap_AllocAtomSpace(strlen(s) + strlen(s2) + 3))) {
712 if (!Yap_growheap(FALSE, MinHeapGap, NULL)) {
713 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
717 while ((*p++ = *s++) !=
'\0')
720 while ((*p++ = *s2++) !=
'\0')
725 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil,
"in putenv(%s)",
726 strerror(errno), p0);
728 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil,
"in putenv(%s)", p0);
732 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
733 "putenv not available in this configuration");
738static Int p_host_type(USES_REGS1) {
739 Term out = MkAtomTerm(Yap_LookupAtom(HOST_ALIAS));
740 return (Yap_unify(out, ARG1));
743static Int p_yap_home(USES_REGS1) {
746 out = MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR));
747 return Yap_unify(out, ARG1);
750static Int p_yap_paths(USES_REGS1) {
751 Term out1, out2, out3;
753 out1 = MkAtomTerm(Yap_LookupAtom(Yap_LIBDIR));
754 out2 = MkAtomTerm(Yap_LookupAtom(Yap_SHAREDIR));
755 out3 = MkAtomTerm(Yap_LookupAtom(Yap_BINDIR));
757 return (Yap_unify(out1, ARG1) && Yap_unify(out2, ARG2) &&
758 Yap_unify(out3, ARG3));
761static Int p_log_event(USES_REGS1) {
762 Term in = Deref(ARG1);
774 fprintf(stderr,
"LOG %s\n", RepAtom(at)->StrOfAE);
778 LOG(
" %s ", RepAtom(at)->StrOfAE);
782static Int p_env_separator(USES_REGS1) {
784 return Yap_unify(MkIntegerTerm(
';'), ARG1);
786 return Yap_unify(MkIntegerTerm(
':'), ARG1);
794void Yap_InitSysbits(
int wid) {
798 char *pwd = getenv(
"PWD");
799 strncpy(GLOBAL_pwd, pwd, MAX_PATH);
805 Yap_InitOSSignals(worker_id);
808static Int p_unix(USES_REGS1) {
824static Int p_win32(USES_REGS1) {
836static Int p_ld_path(USES_REGS1) {
837 return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom(Yap_DLLDIR)));
840static Int p_address_bits(USES_REGS1) {
842 return Yap_unify(ARG1, MkIntTerm(32));
844 return Yap_unify(ARG1, MkIntTerm(64));
852#define wstreq(s, q) (wcscmp((s), (q)) == 0)
854static HKEY reg_open_key(
const wchar_t *which,
int create) {
855 HKEY key = HKEY_CURRENT_USER;
864 for (s = buf; *which && !(*which ==
'/' || *which ==
'\\');)
870 if (wstreq(buf, L
"HKEY_CLASSES_ROOT")) {
871 key = HKEY_CLASSES_ROOT;
873 }
else if (wstreq(buf, L
"HKEY_CURRENT_USER")) {
874 key = HKEY_CURRENT_USER;
876 }
else if (wstreq(buf, L
"HKEY_LOCAL_MACHINE")) {
877 key = HKEY_LOCAL_MACHINE;
879 }
else if (wstreq(buf, L
"HKEY_USERS")) {
884 if (RegOpenKeyExW(key, buf, 0L, KEY_READ, &tmp) == ERROR_SUCCESS) {
894 RegCreateKeyExW(key, buf, 0, L
"", 0, KEY_ALL_ACCESS, NULL, &tmp, &disp);
896 if (rval == ERROR_SUCCESS)
905#define MAXREGSTRLEN 1024
907static wchar_t *WideStringFromAtom(
Atom KeyAt USES_REGS) {
908 return Yap_AtomToWide(KeyAt);
911static Int p_win_registry_get_value(USES_REGS1) {
913 BYTE data[MAXREGSTRLEN];
914 DWORD len =
sizeof(data);
917 Term Key = Deref(ARG1);
918 Term Name = Deref(ARG2);
920 int l = push_text_stack();
922 if (IsVarTerm(Key)) {
923 Yap_Error(INSTANTIATION_ERROR, Key,
924 "argument to win_registry_get_value unbound");
928 if (!IsAtomTerm(Key)) {
929 Yap_Error(TYPE_ERROR_ATOM, Key,
"argument to win_registry_get_value");
933 KeyAt = AtomOfTerm(Key);
934 if (IsVarTerm(Name)) {
935 Yap_Error(INSTANTIATION_ERROR, Key,
936 "argument to win_registry_get_value unbound");
940 if (!IsAtomTerm(Name)) {
941 Yap_Error(TYPE_ERROR_ATOM, Key,
"argument to win_registry_get_value");
945 NameAt = AtomOfTerm(Name);
947 k = WideStringFromAtom(KeyAt PASS_REGS);
948 if (!(key = reg_open_key(k, FALSE))) {
949 Yap_Error(EXISTENCE_ERROR_KEY, Key,
"argument to win_registry_get_value");
953 name = WideStringFromAtom(NameAt PASS_REGS);
955 if (RegQueryValueExW(key, name, NULL, &type, data, &len) == ERROR_SUCCESS) {
959 ((
wchar_t *)data)[len] =
'\0';
960 Atom at = Yap_NWCharsToAtom((
wchar_t *)data, len PASS_REGS);
962 return Yap_unify(MkAtomTerm(at), ARG3);
964 DWORD *d = (DWORD *)data;
966 return Yap_unify(MkIntegerTerm((Int)d[0]), ARG3);
978char *Yap_RegistryGetString(
char *name) {
980 BYTE data[MAXREGSTRLEN];
981 DWORD len =
sizeof(data);
988 reg_open_key(L
"HKEY_LOCAL_MACHINE/SOFTWARE/YAP/Prolog64", FALSE))) {
992 if (!(key = reg_open_key(L
"HKEY_LOCAL_MACHINE/SOFTWARE/YAP/Prolog", FALSE))) {
996 if (RegQueryValueEx(key, name, NULL, &type, data, &len) == ERROR_SUCCESS) {
1000 ptr = malloc(len + 2);
1003 for (i = 0; i <= len; i++)
1005 ptr[len + 1] =
'\0';
1017static Int p_sleep(USES_REGS1) {
1019#if defined(__MINGW32__) || _MSC_VER
1021 unsigned long int secs = 0, usecs = 0, msecs;
1022 if (IsIntegerTerm(ts)) {
1023 secs = IntegerOfTerm(ts);
1024 }
else if (IsFloatTerm(ts)) {
1025 double tfl = FloatOfTerm(ts);
1029 usecs = tfl * 1000000;
1031 msecs = secs * 1000 + usecs / 1000;
1038 struct timespec req;
1041 if (IsFloatTerm(ts)) {
1042 double tfl = FloatOfTerm(ts);
1044 req.tv_nsec = (tfl - floor(tfl)) * 1000000000;
1045 req.tv_sec = rint(tfl);
1048 req.tv_sec = IntOfTerm(ts);
1050 out = nanosleep(&req, NULL);
1056 if (IsFloatTerm(ts)) {
1057 double tfl = FloatOfTerm(ts);
1059 usecs = rint(tfl * 1000000);
1061 usecs = IntegrOfTerm(ts) * 1000000;
1063 out = usleep(usecs);
1068 unsigned int secs, out;
1069 if (IsFloatTerm(ts)) {
1070 secs = rint(FloatOfTerm(ts));
1072 secs = IntOfTerm(ts);
1075 return (Yap_unify(ARG2, MkIntTerm(out)));
1078 YAP_Error(SYSTEM_ERROR, 0L,
"sleep not available in this configuration");
1091 Term t = Deref(ARG1);
1092 if (t == TermTrue) mtrace();
1093 else if (t == TermFalse) muntrace();
1099void Yap_InitSysPreds(
void) {
1100 Yap_InitCPred(
"log_event", 1, p_log_event, SafePredFlag | SyncPredFlag);
1101 Yap_InitCPred(
"sh", 0, p_sh, SafePredFlag | SyncPredFlag);
1102 Yap_InitCPred(
"$shell", 1, p_shell, SafePredFlag | SyncPredFlag);
1103 Yap_InitCPred(
"system", 1, p_system,
1104 SafePredFlag | SyncPredFlag | UserCPredFlag);
1105 Yap_InitCPred(
"$rename", 2, p_mv, SafePredFlag | SyncPredFlag);
1106 Yap_InitCPred(
"$yap_home", 1, p_yap_home, SafePredFlag);
1107 Yap_InitCPred(
"$yap_paths", 3, p_yap_paths, SafePredFlag);
1108 Yap_InitCPred(
"$dir_separator", 1, p_dir_sp, SafePredFlag);
1109 Yap_InitCPred(
"libraries_directories", 2, libraries_directories, 0);
1110 Yap_InitCPred(
"system_library", 1, system_library, 0);
1111 Yap_InitCPred(
"commons_library", 1, commons_library, 0);
1112 Yap_InitCPred(
"$getenv", 2, p_getenv, SafePredFlag);
1113 Yap_InitCPred(
"$putenv", 2, p_putenv, SafePredFlag | SyncPredFlag);
1114 Yap_InitCPred(
"$host_type", 1, p_host_type, SafePredFlag | SyncPredFlag);
1115 Yap_InitCPred(
"$env_separator", 1, p_env_separator, SafePredFlag);
1116 Yap_InitCPred(
"$unix", 0, p_unix, SafePredFlag);
1117 Yap_InitCPred(
"$win32", 0, p_win32, SafePredFlag);
1118 Yap_InitCPred(
"$ld_path", 1, p_ld_path, SafePredFlag);
1119 Yap_InitCPred(
"$address_bits", 1, p_address_bits, SafePredFlag);
1120 Yap_InitCPred(
"working_directory", 2, working_directory, SyncPredFlag);
1122 Yap_InitCPred(
"win_registry_get_value", 3, p_win_registry_get_value, 0);
1124 Yap_InitCPred(
"sleep", 1, p_sleep, SyncPredFlag);
1125 Yap_InitCPred(
"mtrace", 1, p_mtrace, SyncPredFlag);
const char * Yap_AbsoluteFile(const char *spec, bool ok)
generate absolute path, if ok first expand SICStus Prolog style
void * Malloc(size_t sz USES_REGS)
allocate a temporary text block
@ source
If true maintain the source for all clauses.
bool(* exists)(struct vfs *, const char *s)
verify whether is directory
bool(* isdir)(struct vfs *, const char *s)
obtain size, age, permissions of a file