YAP 7.1.0
sysbits.c
1/*************************************************************************
2 * *
3 * YAP Prolog *
4 * *
5 * Yap Prolog was developed at NCCUP - Universidade do Porto *
6 * *
7 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8 * *
9 **************************************************************************
10 * *
11 * File: sysbits.c *
12 * Last rev: 4/03/88 *
13 * mods: *
14 * comments: very much machine dependent routines *
15 * *
16 *************************************************************************/
17#ifdef SCCS
18static char SccsId[] = "%W% %G%";
19#endif
20
21#include "sysbits.h"
22#include "cwalk.h"
23
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);
31#ifdef MACYAP
32
33/* #define signal skel_signal */
34#endif /* MACYAP */
35
36void exit(int);
37
38#ifdef _WIN32
39void Yap_WinError(char *yap_error) {
40 char msg[256];
41 /* Error, we could not read time */
42 FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
43 NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
44 msg, 255, NULL);
45 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "%s at %s", msg, yap_error);
46}
47#endif /* __WINDOWS__ */
48
49#define is_valid_env_char(C) \
50 (((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && (C) <= 'Z') || (C) == '_')
51
54bool Yap_isDirectory(const char *FileName) {
55
56 VFS_t *vfs;
57 if ((vfs = vfs_owner(FileName))) {
58 return vfs->isdir(vfs, FileName);
59 }
60#ifdef _WIN32
61 DWORD dwAtts = GetFileAttributes(FileName);
62 if (dwAtts == INVALID_FILE_ATTRIBUTES)
63 return false;
64 return (dwAtts & FILE_ATTRIBUTE_DIRECTORY);
65#elif HAVE_LSTAT
66 struct stat buf;
67
68 if (lstat(FileName, &buf) == -1) {
69 /* return an error number */
70 return false;
71 }
72 return S_ISDIR(buf.st_mode);
73#else
74 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
75 "stat not available in this configuration");
76 return false;
77#endif
78}
79
80bool Yap_Exists(const char *f) {
81 VFS_t *vfs;
82 f = Yap_VFAlloc(f);
83 if ((vfs = vfs_owner(f))) {
84 return vfs->exists(vfs, f);
85 }
86#if _WIN32
87 if (_access(f, 0) == 0)
88 return true;
89 if (errno == EINVAL) {
90 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "bad flags to access");
91 }
92 return false;
93#elif HAVE_ACCESS
94 if (access(f, F_OK) == 0) {
95 return true;
96 }
97 if (errno == EINVAL) {
98 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "bad flags to access");
99 }
100 return false;
101#else
102 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
103 "access not available in this configuration");
104 return false;
105#endif
106}
107
108static int dir_separator(int ch) {
109#ifdef MAC
110 return (ch == ':');
111#elif ATARI || _MSC_VER
112 return (ch == '\\');
113#elif defined(__MINGW32__) || defined(__CYGWIN__)
114 return (ch == '\\' || ch == '/');
115#else
116 return (ch == '/');
117#endif
118}
119
120int Yap_dir_separator(int ch) { return dir_separator(ch); }
121
122#if __WINDOWS__
123#include <psapi.h>
124
125char *libdir = NULL;
126#endif
127
128#define isValidEnvChar(C) \
129 (((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && (C) <= 'Z') || (C) == '_')
130
131#if _WIN32
132// straightforward conversion from Unix style to WIN style
133// check cygwin path.cc for possible improvements
134static char *unix2win(const char *source, char *target, int max) {
135 char *s = target;
136 const char *s0 = source;
137 char *s1;
138 int ch;
139
140 if (s == NULL)
141 s = malloc(MAX_PATH + 1);
142 s1 = s;
143 // win32 syntax
144 // handle drive notation, eg //a/
145 if (s0[0] == '\0') {
146 s[0] = '.';
147 s[1] = '\0';
148 return s;
149 }
150 if (s0[0] == '/' && s0[1] == '/' && isalpha(s0[2]) && s0[3] == '/') {
151 s1[0] = s0[2];
152 s1[1] = ':';
153 s1[2] = '\\';
154 s0 += 4;
155 s1 += 3;
156 }
157 while ((ch = *s1++ = *s0++)) {
158 if (ch == '$') {
159 s1[-1] = '%';
160 ch = *s0;
161 // handle $(....)
162 if (ch == '{') {
163 s0++;
164 while ((ch = *s0++) != '}') {
165 *s1++ = ch;
166 if (ch == '\0')
167 return FALSE;
168 }
169 *s1++ = '%';
170 } else {
171 while (((ch = *s1++ = *s0++) >= 'A' && ch <= 'Z') ||
172 (ch >= 'a' && ch <= 'z') || (ch == '-') ||
173 (ch >= '0' && ch <= '9') || (ch == '_'))
174 ;
175 s1[-1] = '%';
176 *s1++ = ch;
177 if (ch == '\0') {
178 s1--;
179 s0--;
180 }
181 }
182 } else if (ch == '/')
183 s1[-1] = '\\';
184 }
185 return s;
186}
187#endif
188
189#if _WIN32
190#define HAVE_BASENAME 1
191#define HAVE_REALPATH 1
192#endif
193
194extern char *virtual_cwd;
195
196bool Yap_ChDir(const char *path) {
197 bool rc = false;
198 int lvl = push_text_stack();
199
200 const char *qpath = Yap_AbsoluteFile(path, true);
201 __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "chdir %s", path);
202 VFS_t *v;
203 if ((v = vfs_owner(qpath))) {
204 rc = v->chdir(v, (qpath));
205 pop_text_stack(lvl);
206 return rc;
207 }
208#if _WIN32
209 rc = true;
210 if (qpath != NULL && qpath[0] &&
211 (rc = (SetCurrentDirectory(qpath) != 0)) == 0) {
212 Yap_WinError("SetCurrentDirectory failed");
213 }
214#else
215 rc = (chdir(qpath) == 0);
216#endif
217 pop_text_stack(lvl);
218 return rc;
219}
220
221
222Atom Yap_TemporaryFile(const char *prefix, int *fd) {
223#if HAVE_MKSTEMP
224 char *tmp = malloc(PATH_MAX);
225 int n;
226 int f;
227 if (tmp == NULL)
228 return NIL;
229 strncpy(tmp, prefix, PATH_MAX - 1);
230 n = strlen(tmp);
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')
233 f = mkstemp(tmp);
234 else {
235 strncat(tmp, "XXXXXX", PATH_MAX - 1);
236 f = mkstemp(tmp);
237 }
238 if (fd)
239 *fd = f;
240 return Yap_LookupAtom(tmp);
241#else
242 return AtomNil;
243#endif
244}
245static bool initSysPath(Term tlib, Term tcommons, bool dir_done,
246 bool commons_done) {
247 CACHE_REGS
248
249 if (!Yap_PLDIR || !Yap_unify(tlib, MkAtomTerm(Yap_LookupAtom(Yap_PLDIR))))
250 return false;
251
252 return Yap_COMMONSDIR && Yap_unify(tcommons, MkAtomTerm(Yap_LookupAtom(Yap_COMMONSDIR)));
253}
254
255static Int libraries_directories(USES_REGS1) {
256 return initSysPath(ARG1, ARG2, false, false);
257}
258
259static Int system_library(USES_REGS1) {
260 return initSysPath(ARG1, MkVarTerm(), false, true);
261}
262
263static Int commons_library(USES_REGS1) {
264 return initSysPath(MkVarTerm(), ARG1, true, false);
265}
266
267static Int p_dir_sp(USES_REGS1) {
268#if ATARI || _MSC_VER || defined(__MINGW32__)
269 Term t = MkIntTerm('\\');
270 Term t2 = MkIntTerm('/');
271#else
272 Term t = MkIntTerm('/');
273 Term t2 = MkIntTerm('/');
274#endif
275
276 return Yap_unify_constant(ARG1, t) || Yap_unify_constant(ARG1, t2);
277}
278
279size_t Yap_InitPageSize(void) {
280#ifdef _WIN32
281 SYSTEM_INFO si;
282 GetSystemInfo(&si);
283 return si.dwPageSize;
284#elif HAVE_UNISTD_H
285#if defined(__FreeBSD__) || defined(__DragonFly__)
286 return getpagesize();
287#elif defined(_AIX)
288 return sysconf(_SC_PAGE_SIZE);
289#elif !defined(_SC_PAGESIZE)
290 return getpagesize();
291#else
292 return sysconf(_SC_PAGESIZE);
293#endif
294#else
295 bla bla
296#endif
297}
298
299/* TrueFileName -> Finds the true name of a file */
300
301#ifdef __MINGW32__
302#include <ctype.h>
303#endif
304
305static int volume_header(char *file) {
306#if _MSC_VER || defined(__MINGW32__)
307 char *ch = file;
308 int c;
309
310 while ((c = ch[0]) != '\0') {
311 if (isalnum(c))
312 ch++;
313 else
314 return (c == ':');
315 }
316#endif
317 return (FALSE);
318}
319
320int Yap_volume_header(char *file) { return volume_header(file); }
321
322const char *Yap_getcwd(char *buf, size_t cwdlen) {
323#if USE_CWD_CACHE
324if (GLOBAL_cwd && GLOBAL_cwd[0]) {
325 return cwd;
326 }
327#endif
328#if _WIN32 || defined(__MINGW32__)
329 if (GetCurrentDirectory(cwdlen, (char *)cwd) == 0) {
330 Yap_WinError("GetCurrentDirectory failed");
331 return NULL;
332 }
333 return (char *)cwd;
334#endif
335 const char *rc = NULL;
336 while ((rc=getcwd(buf, cwdlen)) == NULL && errno == ERANGE) {
337 cwdlen *=2 ;
338 buf = realloc(buf, cwdlen);
339 }
340 // __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "chdir %s", rc);
341return rc;
342}
343
357static Int working_directory(USES_REGS1) {
358 int l = push_text_stack();
359 char *dir;
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");
364 }
365 if (!Yap_unify(t1,
366 MkAtomTerm(Yap_LookupAtom(Yap_getcwd(dir, MAX_PATH))))) {
367 pop_text_stack(l);
368 return false;
369 }
370 t2 = Deref(ARG2);
371 if (IsVarTerm(t2)) {
372 Yap_Error(INSTANTIATION_ERROR, t2, "working_directory");
373 }
374 if (!IsAtomTerm(t2)) {
375 Yap_Error(TYPE_ERROR_ATOM, t2, "working_directory");
376 }
377 if (t2 == TermEmptyAtom || t2 == TermDot) {
378 pop_text_stack(l);
379 return true;
380 }
381 Int rc = Yap_ChDir(RepAtom(AtomOfTerm(t2))->StrOfAE);
382 pop_text_stack(l);
383 return rc;
384
385}
386
387/* Executes $SHELL under Prolog */
395static Int p_sh(USES_REGS1) { /* sh */
396#ifdef HAVE_SYSTEM
397 char *shell;
398 shell = (char *)getenv("SHELL");
399 if (shell == NULL)
400 shell = "/bin/sh";
401 if (system(Yap_VFAlloc(shell)) < 0) {
402#if HAVE_STRERROR
403 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "%s in sh/0",
404 strerror(errno));
405#else
406 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "in sh/0");
407#endif
408 return FALSE;
409 }
410 return TRUE;
411#else
412#ifdef MSH
413 register char *shell;
414 shell = "msh -i";
415 system(shell);
416 return (TRUE);
417#else
418 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
419 "sh not available in this configuration");
420 return (FALSE);
421#endif /* MSH */
422#endif
423}
424
429static Int p_shell(USES_REGS1) { /* '$shell'(+SystCommand) */
430 const char *cmd;
431 Term t1 = Deref(ARG1);
432 if (IsAtomTerm(t1))
433 cmd = RepAtom(AtomOfTerm(t1))->StrOfAE;
434 else if (IsStringTerm(t1))
435 cmd = StringOfTerm(t1);
436 else
437 return FALSE;
438#if _MSC_VER || defined(__MINGW32__)
439 {
440 int rval = system(cmd);
441
442 return rval == 0;
443 }
444
445 return true;
446#else
447#if HAVE_SYSTEM
448 char *shell;
449 register int bourne = FALSE;
450
451 shell = (char *)getenv("SHELL");
452 if (!strcmp(shell, "/bin/sh"))
453 bourne = TRUE;
454 if (shell == NIL)
455 bourne = TRUE;
456 /* Yap_CloseStreams(TRUE); */
457 if (bourne)
458 return system(cmd) == 0;
459 else {
460 int status = -1;
461 int child = fork();
462
463 if (child == 0) { /* let the children go */
464 if (!execl(shell, shell, "-c", cmd, NULL)) {
465 exit(-1);
466 }
467 exit(TRUE);
468 }
469 { /* put the father on wait */
470 int result = child < 0 ||
471 /* vsc:I am not sure this is used, Stevens say wait returns
472 an integer.
473 #if NO_UNION_WAIT
474 */
475 wait((&status)) != child ||
476 /*
477 #else
478 wait ((union wait *) (&status)) != child ||
479 #endif
480 */
481 status == 0;
482 return result;
483 }
484 }
485#else /* HAVE_SYSTEM */
486#ifdef MSH
487 register char *shell;
488 shell = "msh -i";
489 /* Yap_CloseStreams(); */
490 system(shell);
491 return TRUE;
492#else
493 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
494 "shell not available in this configuration");
495 return FALSE;
496#endif
497#endif /* HAVE_SYSTEM */
498#endif /* _MSC_VER */
499}
500
506static Int p_system(USES_REGS1) { /* '$system'(+SystCommand) */
507 const char *cmd;
508 Term t1 = Deref(ARG1);
509
510 if (IsVarTerm(t1)) {
511 Yap_Error(INSTANTIATION_ERROR, t1, "argument to system/1 unbound");
512 return FALSE;
513 } else if (IsAtomTerm(t1)) {
514 cmd = RepAtom(AtomOfTerm(t1))->StrOfAE;
515 } else if (IsStringTerm(t1)) {
516 cmd = StringOfTerm(t1);
517 } else {
518 char *cmd0 = malloc(PATH_MAX+1);
519 if (!Yap_GetName(cmd0, MAX_PATH, t1)) {
520 //freecmd);
521 Yap_Error(TYPE_ERROR_ATOM, t1, "argument to system/1");
522 return false;
523 }
524 }
525/* Yap_CloseStreams(TRUE); */
526#if _MSC_VER || defined(__MINGW32__)
527
528 {
529 STARTUPINFO si;
530 PROCESS_INFORMATION pi;
531
532 ZeroMemory(&si, sizeof(si));
533 si.cb = sizeof(si);
534 ZeroMemory(&pi, sizeof(pi));
535
536 // Start the child process.
537 if (!CreateProcess(NULL, // No module name (use command line)
538 (LPSTR)cmd, // Command line
539 NULL, // Process handle not inheritable
540 NULL, // Thread handle not inheritable
541 FALSE, // Set handle inheritance to FALSE
542 0, // No creation flags
543 NULL, // Use parent's environment block
544 NULL, // Use parent's starting directory
545 &si, // Pointer to STARTUPINFO structure
546 &pi) // Pointer to PROCESS_INFORMATION structure
547 ) {
548 Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, "CreateProcess failed (%d).\n",
549 GetLastError());
550 return FALSE;
551 }
552 // Wait until child process exits.
553 WaitForSingleObject(pi.hProcess, INFINITE);
554
555 // Close process and thread handles.
556 CloseHandle(pi.hProcess);
557 CloseHandle(pi.hThread);
558
559 return TRUE;
560 }
561
562 return FALSE;
563#elif HAVE_SYSTEM
564#if _MSC_VER
565 _flushall();
566#endif
567 if (system(cmd)) {
568#if HAVE_STRERROR
569 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, t1, "%s in system(%s)",
570 strerror(errno), cmd);
571#else
572 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, t1, "in system(%s)", cmd);
573#endif
574 return FALSE;
575 }
576 return TRUE;
577#else
578#ifdef MSH
579 register char *shell;
580 shell = "msh -i";
581 /* Yap_CloseStreams(); */
582 system(shell);
583 return (TRUE);
584#undef command
585#else
586 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "sh not available in this machine");
587 return (FALSE);
588#endif
589#endif /* HAVE_SYSTEM */
590}
591
592static Int p_mv(USES_REGS1) { /* rename(+OldName,+NewName) */
593#if HAVE_LINK
594 int r;
595 char *oldname, *newname;
596 Term t1 = Deref(ARG1);
597 Term t2 = Deref(ARG2);
598 if (IsVarTerm(t1)) {
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");
602 }
603 if (IsVarTerm(t2)) {
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");
607 } else {
608 oldname = RepAtom(AtomOfTerm(t1))->StrOfAE;
609 newname = RepAtom(AtomOfTerm(t2))->StrOfAE;
610 if ((r = link(oldname, newname)) == 0 && (r = unlink(oldname)) != 0)
611 unlink(newname);
612 if (r != 0) {
613#if HAVE_STRERROR
614 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, t2, "%s in rename(%s,%s)",
615 strerror(errno), oldname, newname);
616#else
617 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, t2, "in rename(%s,%s)", oldname,
618 newname);
619#endif
620 return false;
621 }
622 return true;
623 }
624#else
625 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
626 "rename/2 not available in this machine");
627#endif
628 return false;
629}
630
631#ifdef MAC
632
633void Yap_SetTextFile(name) char *name;
634{
635#ifdef MACC
636 SetFileType(name, 'TEXT');
637 SetFileSignature(name, 'EDIT');
638#else
639 FInfo f;
640 FInfo *p = &f;
641 GetFInfo(name, 0, p);
642 p->fdType = 'TEXT';
643#ifdef MPW
644 if (mpwshell)
645 p->fdCreator = 'MPS\0';
646#endif
647#ifndef LIGHT
648 else
649 p->fdCreator = 'EDIT';
650#endif
651 SetFInfo(name, 0, p);
652#endif
653}
654
655#endif
656
657/* return YAP's environment */
658static Int p_getenv(USES_REGS1) {
659#if HAVE_GETENV
660 Term t1 = Deref(ARG1), to;
661 const char *s, *so;
662
663 if (IsVarTerm(t1)) {
664 Yap_Error(INSTANTIATION_ERROR, t1, "first arg of getenv/2");
665 return (FALSE);
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");
670 return (FALSE);
671 } else
672 s = RepAtom(AtomOfTerm(t1))->StrOfAE;
673 if ((so = getenv(s)) == NULL)
674 return (FALSE);
675 to = MkAtomTerm(Yap_LookupAtom(so));
676 return (Yap_unify_constant(ARG2, to));
677#else
678 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
679 "getenv not available in this configuration");
680 return (FALSE);
681#endif
682}
683
684/* set a variable in YAP's environment */
685static Int p_putenv(USES_REGS1) {
686#if HAVE_PUTENV
687 Term t1 = Deref(ARG1), t2 = Deref(ARG2);
688 const char *s = "", *s2 = "";
689 char *p0, *p;
690
691 if (IsVarTerm(t1)) {
692 Yap_Error(INSTANTIATION_ERROR, t1, "first arg to putenv/2");
693 return (FALSE);
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");
698 return (FALSE);
699 } else
700 s = RepAtom(AtomOfTerm(t1))->StrOfAE;
701 if (IsVarTerm(t2)) {
702 Yap_Error(INSTANTIATION_ERROR, t2, "second arg to putenv/2");
703 return (FALSE);
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");
708 return (FALSE);
709 } else
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);
714 return FALSE;
715 }
716 }
717 while ((*p++ = *s++) != '\0')
718 ;
719 p[-1] = '=';
720 while ((*p++ = *s2++) != '\0')
721 ;
722 if (putenv(p0) == 0)
723 return TRUE;
724#if HAVE_STRERROR
725 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "in putenv(%s)",
726 strerror(errno), p0);
727#else
728 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "in putenv(%s)", p0);
729#endif
730 return FALSE;
731#else
732 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
733 "putenv not available in this configuration");
734 return FALSE;
735#endif
736}
737
738static Int p_host_type(USES_REGS1) {
739 Term out = MkAtomTerm(Yap_LookupAtom(HOST_ALIAS));
740 return (Yap_unify(out, ARG1));
741}
742
743static Int p_yap_home(USES_REGS1) {
744 Term out;
745
746 out = MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR));
747 return Yap_unify(out, ARG1);
748}
749
750static Int p_yap_paths(USES_REGS1) {
751 Term out1, out2, out3;
752
753 out1 = MkAtomTerm(Yap_LookupAtom(Yap_LIBDIR));
754 out2 = MkAtomTerm(Yap_LookupAtom(Yap_SHAREDIR));
755 out3 = MkAtomTerm(Yap_LookupAtom(Yap_BINDIR));
756
757 return (Yap_unify(out1, ARG1) && Yap_unify(out2, ARG2) &&
758 Yap_unify(out3, ARG3));
759}
760
761static Int p_log_event(USES_REGS1) {
762 Term in = Deref(ARG1);
763 Atom at;
764
765 if (IsVarTerm(in))
766 return FALSE;
767 if (!IsAtomTerm(in))
768 return FALSE;
769 at = AtomOfTerm(in);
770#if DEBUG
771 if (IsBlob(at))
772 return FALSE;
773 else
774 fprintf(stderr, "LOG %s\n", RepAtom(at)->StrOfAE);
775#endif
776 if (IsBlob(at))
777 return false;
778 LOG(" %s ", RepAtom(at)->StrOfAE);
779 return TRUE;
780}
781
782static Int p_env_separator(USES_REGS1) {
783#if defined(_WIN32)
784 return Yap_unify(MkIntegerTerm(';'), ARG1);
785#else
786 return Yap_unify(MkIntegerTerm(':'), ARG1);
787#endif
788}
789
790/*
791 * This is responsable for the initialization of all machine dependant
792 * predicates
793 */
794void Yap_InitSysbits(int wid) {
795 CACHE_REGS
796#if __simplescalar__
797 {
798 char *pwd = getenv("PWD");
799 strncpy(GLOBAL_pwd, pwd, MAX_PATH);
800 }
801#endif
802 Yap_InitWTime();
803 Yap_InitRandom();
804 /* let the caller control signals as it sees fit */
805 Yap_InitOSSignals(worker_id);
806}
807
808static Int p_unix(USES_REGS1) {
809#ifdef unix
810 return TRUE;
811#else
812#ifdef __unix__
813 return TRUE;
814#else
815#ifdef __APPLE__
816 return TRUE;
817#else
818 return FALSE;
819#endif
820#endif
821#endif
822}
823
824static Int p_win32(USES_REGS1) {
825#ifdef _WIN32
826 return TRUE;
827#else
828#ifdef __CYGWIN__
829 return TRUE;
830#else
831 return FALSE;
832#endif
833#endif
834}
835
836static Int p_ld_path(USES_REGS1) {
837 return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom(Yap_DLLDIR)));
838}
839
840static Int p_address_bits(USES_REGS1) {
841#if SIZEOF_INT_P == 4
842 return Yap_unify(ARG1, MkIntTerm(32));
843#else
844 return Yap_unify(ARG1, MkIntTerm(64));
845#endif
846}
847
848#ifdef _WIN32
849
850/* This code is from SWI-Prolog by Jan Wielemaker */
851
852#define wstreq(s, q) (wcscmp((s), (q)) == 0)
853
854static HKEY reg_open_key(const wchar_t *which, int create) {
855 HKEY key = HKEY_CURRENT_USER;
856 DWORD disp;
857 LONG rval;
858
859 while (*which) {
860 wchar_t buf[256];
861 wchar_t *s;
862 HKEY tmp;
863
864 for (s = buf; *which && !(*which == '/' || *which == '\\');)
865 *s++ = *which++;
866 *s = '\0';
867 if (*which)
868 which++;
869
870 if (wstreq(buf, L"HKEY_CLASSES_ROOT")) {
871 key = HKEY_CLASSES_ROOT;
872 continue;
873 } else if (wstreq(buf, L"HKEY_CURRENT_USER")) {
874 key = HKEY_CURRENT_USER;
875 continue;
876 } else if (wstreq(buf, L"HKEY_LOCAL_MACHINE")) {
877 key = HKEY_LOCAL_MACHINE;
878 continue;
879 } else if (wstreq(buf, L"HKEY_USERS")) {
880 key = HKEY_USERS;
881 continue;
882 }
883
884 if (RegOpenKeyExW(key, buf, 0L, KEY_READ, &tmp) == ERROR_SUCCESS) {
885 RegCloseKey(key);
886 key = tmp;
887 continue;
888 }
889
890 if (!create)
891 return NULL;
892
893 rval =
894 RegCreateKeyExW(key, buf, 0, L"", 0, KEY_ALL_ACCESS, NULL, &tmp, &disp);
895 RegCloseKey(key);
896 if (rval == ERROR_SUCCESS)
897 key = tmp;
898 else
899 return NULL;
900 }
901
902 return key;
903}
904
905#define MAXREGSTRLEN 1024
906
907static wchar_t *WideStringFromAtom(Atom KeyAt USES_REGS) {
908 return Yap_AtomToWide(KeyAt);
909}
910
911static Int p_win_registry_get_value(USES_REGS1) {
912 DWORD type;
913 BYTE data[MAXREGSTRLEN];
914 DWORD len = sizeof(data);
915 wchar_t *k, *name;
916 HKEY key;
917 Term Key = Deref(ARG1);
918 Term Name = Deref(ARG2);
919 Atom KeyAt, NameAt;
920 int l = push_text_stack();
921
922 if (IsVarTerm(Key)) {
923 Yap_Error(INSTANTIATION_ERROR, Key,
924 "argument to win_registry_get_value unbound");
925 pop_text_stack(l);
926 return FALSE;
927 }
928 if (!IsAtomTerm(Key)) {
929 Yap_Error(TYPE_ERROR_ATOM, Key, "argument to win_registry_get_value");
930 pop_text_stack(l);
931 return FALSE;
932 }
933 KeyAt = AtomOfTerm(Key);
934 if (IsVarTerm(Name)) {
935 Yap_Error(INSTANTIATION_ERROR, Key,
936 "argument to win_registry_get_value unbound");
937 pop_text_stack(l);
938 return FALSE;
939 }
940 if (!IsAtomTerm(Name)) {
941 Yap_Error(TYPE_ERROR_ATOM, Key, "argument to win_registry_get_value");
942 pop_text_stack(l);
943 return FALSE;
944 }
945 NameAt = AtomOfTerm(Name);
946
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");
950 pop_text_stack(l);
951 return FALSE;
952 }
953 name = WideStringFromAtom(NameAt PASS_REGS);
954
955 if (RegQueryValueExW(key, name, NULL, &type, data, &len) == ERROR_SUCCESS) {
956 RegCloseKey(key);
957 switch (type) {
958 case REG_SZ:
959 ((wchar_t *)data)[len] = '\0';
960 Atom at = Yap_NWCharsToAtom((wchar_t *)data, len PASS_REGS);
961 pop_text_stack(l);
962 return Yap_unify(MkAtomTerm(at), ARG3);
963 case REG_DWORD: {
964 DWORD *d = (DWORD *)data;
965 pop_text_stack(l);
966 return Yap_unify(MkIntegerTerm((Int)d[0]), ARG3);
967 }
968 default:
969 pop_text_stack(l);
970 return FALSE;
971 }
972 }
973 pop_text_stack(l);
974 return FALSE;
975}
976
977
978char *Yap_RegistryGetString(char *name) {
979 DWORD type;
980 BYTE data[MAXREGSTRLEN];
981 DWORD len = sizeof(data);
982 HKEY key;
983 char *ptr;
984 int i;
985
986#if SIZEOF_INT_P == 8
987 if (!(key =
988 reg_open_key(L"HKEY_LOCAL_MACHINE/SOFTWARE/YAP/Prolog64", FALSE))) {
989 return NULL;
990 }
991#else
992 if (!(key = reg_open_key(L"HKEY_LOCAL_MACHINE/SOFTWARE/YAP/Prolog", FALSE))) {
993 return NULL;
994 }
995#endif
996 if (RegQueryValueEx(key, name, NULL, &type, data, &len) == ERROR_SUCCESS) {
997 RegCloseKey(key);
998 switch (type) {
999 case REG_SZ:
1000 ptr = malloc(len + 2);
1001 if (!ptr)
1002 return NULL;
1003 for (i = 0; i <= len; i++)
1004 ptr[i] = data[i];
1005 ptr[len + 1] = '\0';
1006 return ptr;
1007 default:
1008 return NULL;
1009 }
1010 }
1011 return NULL;
1012}
1013
1014#endif
1015
1016
1017static Int p_sleep(USES_REGS1) {
1018 Term ts = ARG1;
1019#if defined(__MINGW32__) || _MSC_VER
1020 {
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);
1026 if (tfl > 1.0)
1027 secs = tfl;
1028 else
1029 usecs = tfl * 1000000;
1030 }
1031 msecs = secs * 1000 + usecs / 1000;
1032 Sleep(msecs);
1033 /* no ers possible */
1034 return true;
1035 }
1036#elif HAVE_NANOSLEEP
1037 {
1038 struct timespec req;
1039 int out;
1040
1041 if (IsFloatTerm(ts)) {
1042 double tfl = FloatOfTerm(ts);
1043
1044 req.tv_nsec = (tfl - floor(tfl)) * 1000000000;
1045 req.tv_sec = rint(tfl);
1046 } else {
1047 req.tv_nsec = 0;
1048 req.tv_sec = IntOfTerm(ts);
1049 }
1050 out = nanosleep(&req, NULL);
1051 return out == 0;
1052 }
1053#elif HAVE_USLEEP
1054 {
1055 useconds_t usecs;
1056 if (IsFloatTerm(ts)) {
1057 double tfl = FloatOfTerm(ts);
1058
1059 usecs = rint(tfl * 1000000);
1060 } else {
1061 usecs = IntegrOfTerm(ts) * 1000000;
1062 }
1063 out = usleep(usecs);
1064 return;
1065 }
1066#elif HAVE_SLEEP
1067 {
1068 unsigned int secs, out;
1069 if (IsFloatTerm(ts)) {
1070 secs = rint(FloatOfTerm(ts));
1071 } else {
1072 secs = IntOfTerm(ts);
1073 }
1074 out = sleep(secs);
1075 return (Yap_unify(ARG2, MkIntTerm(out)));
1076 }
1077#else
1078 YAP_Error(SYSTEM_ERROR, 0L, "sleep not available in this configuration");
1079 return FALSE:
1080#endif
1081}
1082
1083#ifdef HAVE_MTRACE
1084#include <mcheck.h>
1085#endif
1086
1087static Int
1088 p_mtrace()
1089 {
1090#ifdef HAVE_MTRACE
1091 Term t = Deref(ARG1);
1092 if (t == TermTrue) mtrace();
1093 else if (t == TermFalse) muntrace();
1094 else return false;
1095#endif
1096 return true;
1097 }
1098
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);
1121#ifdef _WIN32
1122 Yap_InitCPred("win_registry_get_value", 3, p_win_registry_get_value, 0);
1123#endif
1124 Yap_InitCPred("sleep", 1, p_sleep, SyncPredFlag);
1125 Yap_InitCPred("mtrace", 1, p_mtrace, SyncPredFlag);
1126}
1127
const char * Yap_AbsoluteFile(const char *spec, bool ok)
generate absolute path, if ok first expand SICStus Prolog style
Definition: absf.c:145
void * Malloc(size_t sz USES_REGS)
allocate a temporary text block
Definition: alloc.c:1759
@ source
If true maintain the source for all clauses.
Definition: YapGFlagInfo.h:601
Definition: VFS.h:74
bool(* exists)(struct vfs *, const char *s)
verify whether is directory
Definition: VFS.h:105
bool(* isdir)(struct vfs *, const char *s)
obtain size, age, permissions of a file
Definition: VFS.h:104