diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

boot

Browse Source
This commit is contained in:
Vitor Santos Costa 2018-02-14 10:37:07 +00:00
parent 311e1d697d
commit 76d0d54a34
4 changed files with 146 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
C/yap-args.c
View File

@ -20,8 +20,8 @@
#include "YapHeap.h" #include "YapHeap.h"
#include "YapInterface.h" #include "YapInterface.h"
#include "YapStreams.h" #include "YapStreams.h"
#include "iopreds.h"
#include "config.h" #include "config.h"
#include "iopreds.h"
#if HAVE_UNISTD_H #if HAVE_UNISTD_H
@ -168,22 +168,22 @@ static void consult(const char *b_file USES_REGS) {
Functor functor_compile2 = Yap_MkFunctor(Yap_LookupAtom("c_compile"), 1); Functor functor_compile2 = Yap_MkFunctor(Yap_LookupAtom("c_compile"), 1);
/* consult boot.pl */ /* consult boot.pl */
int lvl = push_text_stack(); int lvl = push_text_stack();
char *full = Malloc(YAP_FILENAME_MAX + 1); char *full = Malloc(YAP_FILENAME_MAX + 1);
full[0] = '\0'; full[0] = '\0';
/* the consult mode does not matter here, really */ /* the consult mode does not matter here, really */
if ((osno = Yap_CheckAlias(AtomLoopStream)) < 0) if ((osno = Yap_CheckAlias(AtomLoopStream)) < 0)
osno = 0; osno = 0;
c_stream = YAP_InitConsult(YAP_BOOT_MODE, b_file, full, &oactive); c_stream = YAP_InitConsult(YAP_BOOT_MODE, b_file, full, &oactive);
if (c_stream < 0) { if (c_stream < 0) {
pop_text_stack(lvl); pop_text_stack(lvl);
fprintf(stderr, "[ FATAL ERROR: could not open stream %s ]\n", b_file); fprintf(stderr, "[ FATAL ERROR: could not open stream %s ]\n", b_file);
exit(1); exit(1);
} }
if (!Yap_AddAlias(AtomLoopStream, c_stream)) { if (!Yap_AddAlias(AtomLoopStream, c_stream)) {
pop_text_stack(lvl); pop_text_stack(lvl);
return; return;
} }
do { do {
CACHE_REGS CACHE_REGS
@ -215,8 +215,8 @@ static void consult(const char *b_file USES_REGS) {
} }
} while (t != TermEof); } while (t != TermEof);
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
YAP_EndConsult(c_stream, &osno, full); YAP_EndConsult(c_stream, &osno, full);
pop_text_stack(lvl); pop_text_stack(lvl);
} }
/** @brief A simple language for detecting where YAP stuff can be found /** @brief A simple language for detecting where YAP stuff can be found
@ -247,7 +247,9 @@ typedef struct config {
#if __ANDROID__ #if __ANDROID__
const char *gd_root[] = {"@RootDir", "/assets"}; const char *gd_root[] = {"@RootDir", "/assets"};
const char *gd_lib[] = {"@LibDir", "[lib]", "(root)/lib/" "x86"}; const char *gd_lib[] = {"@LibDir", "[lib]",
"(root)/lib/"
"x86"};
const char *gd_share[] = {"@ShareDir", "(root)"}; const char *gd_share[] = {"@ShareDir", "(root)"};
const char *gd_include[] = {"@IncludeDir", "[include]", "(root)/include"}; const char *gd_include[] = {"@IncludeDir", "[include]", "(root)/include"};
const char *gd_dll[] = {"@DLLDir", "(lib)"}; const char *gd_dll[] = {"@DLLDir", "(lib)"};
@ -256,7 +258,7 @@ const char *gd_commons[] = {"@CommonsDir", "(share)/PrologCommons"};
const char *gd_ss[] = {"(dll)"}; const char *gd_ss[] = {"(dll)"};
const char *gd_oss[] = {"."}; const char *gd_oss[] = {"."};
const char *gd_bootpldir[] = {"@BootPlDir", "@PrologBootFile/..", "(pl)/pl"}; const char *gd_bootpldir[] = {"@BootPlDir", "@PrologBootFile/..", "(pl)/pl"};
const char *gd_bootpl[] = {"(bootpldir)" }; const char *gd_bootpl[] = {"(bootpldir)"};
#else #else
const char *gd_root[] = {"@RootDir", "[root]", "(execdir)/.."}; const char *gd_root[] = {"@RootDir", "[root]", "(execdir)/.."};
const char *gd_lib[] = {"@LibDir", "[lib]", "(root)/lib"}; const char *gd_lib[] = {"@LibDir", "[lib]", "(root)/lib"};
@ -294,7 +296,7 @@ char *location(YAP_init_args *iap, const char *inp) {
if (inp == NULL || inp[0] == '\0') { if (inp == NULL || inp[0] == '\0') {
return NULL; return NULL;
} }
char * out = Malloc(FILENAME_MAX+1); char *out = Malloc(FILENAME_MAX + 1);
out[0] = '\0'; out[0] = '\0';
if (inp[0] == '(') { if (inp[0] == '(') {
if (strstr(inp + 1, "root") == inp + 1 && Yap_ROOTDIR && if (strstr(inp + 1, "root") == inp + 1 && Yap_ROOTDIR &&
@ -457,22 +459,21 @@ static const char *find_directory(YAP_init_args *iap, const char *paths[],
char *out = Malloc(YAP_FILENAME_MAX + 1); char *out = Malloc(YAP_FILENAME_MAX + 1);
const char *inp; const char *inp;
if (filename) { if (filename) {
strcpy(out, filename); if (Yap_IsAbsolutePath(filename, true)) {
if (Yap_IsAbsolutePath(out, true)) { return pop_output_text_stack(lvl, filename);
out = pop_output_text_stack(lvl, out);
return out;
} }
} }
int i = 0; int i = 0;
while ((inp = paths[i++]) != NULL) { while ((inp = paths[i++]) != NULL) {
char *o = location(iap, inp); char *o = location(iap, inp);
if (filename && o) { if (filename && o) {
strcat(o, "/"); strcat(o, "/");
strcat(o, filename); strcat(o, filename);
if (o =(const char *) Yap_AbsoluteFile(o, false)) { if ((o = Yap_AbsoluteFile(o, false))) {
o = pop_output_text_stack(lvl, o); return pop_output_text_stack(lvl, o);
return o;
} }
} else if (o && Yap_isDirectory(o)) {
return pop_output_text_stack(lvl, o);
} }
} }
pop_text_stack(lvl); pop_text_stack(lvl);
@ -490,17 +491,21 @@ static void Yap_set_locations(YAP_init_args *iap) {
Yap_DLLDIR = find_directory(iap, template->dll, NULL); Yap_DLLDIR = find_directory(iap, template->dll, NULL);
Yap_PLDIR = find_directory(iap, template->pl, NULL); Yap_PLDIR = find_directory(iap, template->pl, NULL);
Yap_BOOTPLDIR = find_directory(iap, template->bootpldir, NULL); Yap_BOOTPLDIR = find_directory(iap, template->bootpldir, NULL);
if (iap->PrologBootFile == NULL) if (iap->PrologBootFile == NULL)
iap->PrologBootFile = "boot.yap"; iap->PrologBootFile = "boot.yap";
Yap_BOOTFILE = find_directory(iap, template->bootpldir,iap->PrologBootFile ); Yap_BOOTFILE = find_directory(iap, template->bootpldir, iap->PrologBootFile);
Yap_COMMONSDIR = find_directory(iap, template->commons, NULL); Yap_COMMONSDIR = find_directory(iap, template->commons, NULL);
if (iap->SavedState == NULL) if (iap->SavedState == NULL) {
iap->SavedState = "startup.yss"; if (iap->OutputSavedState)
iap->SavedState = iap->OutputSavedState;
else
iap->SavedState = "startup.yss";
}
Yap_STARTUP = find_directory(iap, template->ss, iap->SavedState); Yap_STARTUP = find_directory(iap, template->ss, iap->SavedState);
if (iap->OutputSavedState == NULL) if (iap->OutputSavedState == NULL)
iap->OutputSavedState = "startup.yss"; iap->OutputSavedState = "startup.yss";
Yap_OUTPUT_STARTUP = find_directory(iap, template->ss, iap->OutputSavedState); Yap_OUTPUT_STARTUP = find_directory(iap, template->ss, iap->OutputSavedState);
if (Yap_ROOTDIR) if (Yap_ROOTDIR)
setAtomicGlobalPrologFlag(HOME_FLAG, setAtomicGlobalPrologFlag(HOME_FLAG,
MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR))); MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR)));
if (Yap_PLDIR) if (Yap_PLDIR)

204
os/sysbits.c
View File

@ -165,7 +165,7 @@ static const char *PlExpandVars(const char *source, const char *root) {
CACHE_REGS CACHE_REGS
int lvl = push_text_stack(); int lvl = push_text_stack();
const char *src = source; const char *src = source;
char * result = Malloc(YAP_FILENAME_MAX + 1); char *result = Malloc(YAP_FILENAME_MAX + 1);
if (strlen(source) >= YAP_FILENAME_MAX) { if (strlen(source) >= YAP_FILENAME_MAX) {
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil,
@ -344,13 +344,13 @@ char virtual_cwd[YAP_FILENAME_MAX + 1];
bool Yap_ChDir(const char *path) { bool Yap_ChDir(const char *path) {
bool rc = false; bool rc = false;
int lvl = push_text_stack(); int lvl = push_text_stack();
VFS_t *v; VFS_t *v;
if ((v = vfs_owner(path))) { if ((v = vfs_owner(path))) {
rc = v->chdir(v, path); rc = v->chdir(v, path);
pop_text_stack(lvl); pop_text_stack(lvl);
return rc; return rc;
} }
const char *qpath = Yap_AbsoluteFile(path, true); const char *qpath = Yap_AbsoluteFile(path, true);
#if _WIN32 #if _WIN32
@ -362,94 +362,90 @@ bool Yap_ChDir(const char *path) {
#else #else
rc = (chdir(qpath) == 0); rc = (chdir(qpath) == 0);
#endif #endif
pop_text_stack(lvl); pop_text_stack(lvl);
return rc; return rc;
} }
static char * close_path(char *b0,char *o0, char *o ){ static char *close_path(char *b0, char *o0, char *o) {
if (b0[0] == '\0') { if (b0[0] == '\0') {
return o; return o;
} else if (!strcmp(b0, "..")) { } else if (!strcmp(b0, "..")) {
while (o-- > o0) { while (o-- > o0) {
if (dir_separator(*o)) { if (dir_separator(*o)) {
break; break;
}
} }
}
} else if (strcmp(b0, ".") != 0) { } else if (strcmp(b0, ".") != 0) {
*o++ = '/'; *o++ = '/';
strcpy(o, b0); strcpy(o, b0);
o += strlen(b0); o += strlen(b0);
} }
return o; return o;
} }
static char * clean_path(const char *path) static char *clean_path(const char *path) {
{ const char *p, *p0;
const char *p, *p0; int lvl = push_text_stack();
int lvl = push_text_stack();
__android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " looking at %s", path) ; __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " looking at %s", path);
char *o0 = Malloc(FILENAME_MAX+1),*o = o0; char *o0 = Malloc(FILENAME_MAX + 1), *o = o0;
int ch; int ch;
char *b0 = Malloc(FILENAME_MAX+1), *b = b0; char *b0 = Malloc(FILENAME_MAX + 1), *b = b0;
p = p0 = path; p = p0 = path;
while((ch = *p++)) { while ((ch = *p++)) {
if (dir_separator(ch)) { if (dir_separator(ch)) {
if (b==b0) { if (b == b0) {
o = o0; o = o0;
} else { } else {
b[0] = '\0'; b[0] = '\0';
o = close_path(b0, o0, o); o = close_path(b0, o0, o);
b = b0; b = b0;
} }
} else { } else {
*b++ = ch; *b++ = ch;
}
} }
if (!dir_separator(p[-1])) { }
b[0] = '\0'; if (!dir_separator(p[-1])) {
o = close_path(b0, o0, o); b[0] = '\0';
} o = close_path(b0, o0, o);
if (o == o0) }
*o++ = '/'; if (o == o0)
*o = '\0'; *o++ = '/';
__android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " %s at %s, %p-%p", p0, o0, o, o0) ; *o = '\0';
return pop_output_text_stack(lvl,o0); __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " %s at %s, %p-%p", p0, o0,
o, o0);
return pop_output_text_stack(lvl, o0);
} }
static const char *myrealpath(const char *path USES_REGS) { static const char *myrealpath(const char *path USES_REGS) {
int lvl = push_text_stack(); int lvl = push_text_stack();
VFS_t *v; VFS_t *v;
char *out, *o; char *out, *o;
if (Yap_IsAbsolutePath(path,true)) { if (Yap_IsAbsolutePath(path, true)) {
o = clean_path(path); o = clean_path(path);
if ((v = vfs_owner(o)) return pop_output_text_stack(lvl, o);
) {
return pop_output_text_stack(lvl, o);
} } else {
} else { out = Malloc(FILENAME_MAX + 1);
out = Malloc(FILENAME_MAX+1);
Yap_getcwd(out, FILENAME_MAX); Yap_getcwd(out, FILENAME_MAX);
strcat(out, "/"); strcat(out, "/");
strcat(out, path); strcat(out, path);
o = clean_path(out); o = clean_path(out);
if ((v = vfs_owner(o))) { if ((v = vfs_owner(o))) {
return pop_output_text_stack(lvl, o); return pop_output_text_stack(lvl, o);
} }
} }
#if _WIN32 #if _WIN32
DWORD retval = 0; DWORD retval = 0;
// notice that the file does not need to exist // notice that the file does not need to exist
retval = GetFullPathName(path, YAP_FILENAME_MAX, o, NULL); retval = GetFullPathName(path, YAP_FILENAME_MAX, o, NULL);
if (retval == 0) { if (retval == 0) {
pop_text_stack(lvl); pop_text_stack(lvl);
Yap_WinError("Generating a full path name for a file"); Yap_WinError("Generating a full path name for a file");
return NULL; return NULL;
} }
return pop_output_text_stack(lvl, o); return pop_output_text_stack(lvl, o);
@ -458,25 +454,30 @@ char *out, *o;
char *rc = realpath(path, o); char *rc = realpath(path, o);
if (rc) { if (rc) {
rc = pop_output_text_stack(lvl, rc); return pop_output_text_stack(lvl, rc);
} }
// rc = NULL; // rc = NULL;
if (errno == ENOENT || errno == EACCES) { if (errno == ENOENT || errno == EACCES) {
char *base = Malloc(FILENAME_MAX + 1); char *base = Malloc(FILENAME_MAX + 1);
strncpy(base, path, FILENAME_MAX); strncpy(base, path, FILENAME_MAX);
char *p = base+strlen(base); char *p = base + strlen(base);
while (p>base && !dir_separator(*--p)); while (p > base && !dir_separator(*--p))
if (p == base) p[1] = '\0'; ;
else p[0] = '\0'; if (p == base)
char *tmp = Malloc(FILENAME_MAX + 1); p[1] = '\0';
else
p[0] = '\0';
char *tmp = Malloc(FILENAME_MAX + 1);
rc = realpath(base, tmp); rc = realpath(base, tmp);
if (rc) { if (rc) {
// base may have been destroyed // base may have been destroyed
char *b = base+strlen(base); char *b = base + strlen(base);
while (b>base && !dir_separator(*--b)); while (b > base && !dir_separator(*--b))
if (b[0] && !dir_separator(b[0])) b++; ;
size_t e = strlen(rc); if (b[0] && !dir_separator(b[0]))
b++;
size_t e = strlen(rc);
size_t bs = strlen(b); size_t bs = strlen(b);
if (rc != out && rc != base) { if (rc != out && rc != base) {
@ -536,7 +537,7 @@ const char *Yap_AbsoluteFile(const char *spec, bool ok) {
const char *rc; const char *rc;
const char *spec1; const char *spec1;
const char *spec2; const char *spec2;
int lvl = push_text_stack(); int lvl = push_text_stack();
/// spec gothe original spec; /// spec gothe original spec;
/// rc0 may be an outout buffer /// rc0 may be an outout buffer
@ -565,7 +566,7 @@ const char *Yap_AbsoluteFile(const char *spec, bool ok) {
spec2 = spec1; spec2 = spec1;
} }
rc = myrealpath(spec2 PASS_REGS); rc = myrealpath(spec2 PASS_REGS);
return pop_output_text_stack(lvl,rc); return pop_output_text_stack(lvl, rc);
} }
static Term static Term
@ -754,15 +755,15 @@ static Int real_path(USES_REGS1) {
} }
cmd = rc; cmd = rc;
#endif #endif
int lvl = push_text_stack(); int lvl = push_text_stack();
rc0 = myrealpath(cmd PASS_REGS); rc0 = myrealpath(cmd PASS_REGS);
if (!rc0) { if (!rc0) {
PlIOError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, NULL); PlIOError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, NULL);
} }
bool out = Yap_unify(MkAtomTerm(Yap_LookupAtom(rc0)), ARG2); bool out = Yap_unify(MkAtomTerm(Yap_LookupAtom(rc0)), ARG2);
pop_output_text_stack(lvl,rc0); pop_output_text_stack(lvl, rc0);
return out; return out;
} }
#define EXPAND_FILENAME_DEFS() \ #define EXPAND_FILENAME_DEFS() \
@ -1163,8 +1164,8 @@ static Int true_file_name(USES_REGS1) {
Term t = Deref(ARG1); Term t = Deref(ARG1);
const char *s; const char *s;
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "argument to true_file_name unbound"); Yap_Error(INSTANTIATION_ERROR, t, "argument to true_file_name unbound");
return FALSE; return FALSE;
} }
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
@ -1172,14 +1173,14 @@ static Int true_file_name(USES_REGS1) {
} else if (IsStringTerm(t)) { } else if (IsStringTerm(t)) {
s = StringOfTerm(t); s = StringOfTerm(t);
} else { } else {
Yap_Error(TYPE_ERROR_ATOM, t, "argument to true_file_name"); Yap_Error(TYPE_ERROR_ATOM, t, "argument to true_file_name");
return FALSE; return FALSE;
} }
int l = push_text_stack(); int l = push_text_stack();
if (!(s = Yap_AbsoluteFile(s, true))) if (!(s = Yap_AbsoluteFile(s, true)))
return false; return false;
bool rc = Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s))); bool rc = Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
pop_text_stack(l); pop_text_stack(l);
return rc; return rc;
} }
@ -1207,30 +1208,29 @@ static Int p_expand_file_name(USES_REGS1) {
} }
static Int true_file_name3(USES_REGS1) { static Int true_file_name3(USES_REGS1) {
Term t = Deref(ARG1), t2 = Deref(ARG2); Term t = Deref(ARG1), t2 = Deref(ARG2);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "argument to true_file_name unbound"); Yap_Error(INSTANTIATION_ERROR, t, "argument to true_file_name unbound");
return FALSE; return FALSE;
} }
if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM, t, "argument to true_file_name");
return FALSE;
}
if (!IsVarTerm(t2)) {
if (!IsAtomTerm(t)) { if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM, t, "argument to true_file_name"); Yap_Error(TYPE_ERROR_ATOM, t2, "argument to true_file_name");
return FALSE; return FALSE;
} }
if (!IsVarTerm(t2)) { // root = RepAtom(AtomOfTerm(t2))->StrOfAE;
if (!IsAtomTerm(t)) { }
Yap_Error(TYPE_ERROR_ATOM, t2, "argument to true_file_name"); int lvl = push_text_stack();
return FALSE; const char *tmp = Yap_AbsoluteFile(RepAtom(AtomOfTerm(t))->StrOfAE, true);
} Atom at = NULL;
// root = RepAtom(AtomOfTerm(t2))->StrOfAE; bool rc = (tmp != NULL && (at = Yap_LookupAtom(tmp)) != NULL);
} pop_text_stack(lvl);
int lvl = push_text_stack(); return rc && Yap_unify(ARG3, MkAtomTerm(at));
const char *tmp = Yap_AbsoluteFile(RepAtom(AtomOfTerm(t))->StrOfAE, true);
Atom at = NULL;
bool rc = (tmp != NULL &&
(at = Yap_LookupAtom(tmp)) != NULL);
pop_text_stack(lvl);
return rc && Yap_unify(ARG3, MkAtomTerm(at));
} }
/* Executes $SHELL under Prolog */ /* Executes $SHELL under Prolog */

12
pl/directives.yap
View File

@ -19,13 +19,13 @@
* @file directives.yap * @file directives.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP-2.lan> * @author VITOR SANTOS COSTA <vsc@VITORs-MBP-2.lan>
* @date Thu Oct 19 11:47:38 2017 * @date Thu Oct 19 11:47:38 2017
* *
* @brief Control File Loading * @brief Control File Loading
% %
% @defgroup Directives % @defgroup Directives
@ @ingroup consult @ @ingroup consult
* *
* *
*/ */
@ -130,14 +130,14 @@
'$discontiguous'(D,M). '$discontiguous'(D,M).
/** @pred initialization /** @pred initialization
Execute the goals defined by initialization/1. Only the first answer is Execute the goals defined by initialization/1. Only the first answer is
considered. considered.
*/ */
'$exec_directive'(M:A, Status, _M, VL, Pos) :- '$exec_directive'(M:A, Status, _M, VL, Pos) :-
'$exec_directives'(A, Status, M, VL, Pos). '$exec_directives'(A, Status, M, VL, Pos).
'$exec_directive'(initialization(D), _, M, _, _) :- '$exec_directive'(initialization(D), _, M, _, _) :-
'$initialization'(M:D). '$initialization'(M:D).
'$exec_directive'(initialization(D,OPT), _, M, _, _) :- '$exec_directive'(initialization(D,OPT), _, M, _, _) :-
@ -193,7 +193,7 @@ considered.
'$exec_directive'(use_module(F, Is), _, M, _, _) :- '$exec_directive'(use_module(F, Is), _, M, _, _) :-
use_module(M:F, Is). use_module(M:F, Is).
'$exec_directive'(use_module(Mod,F,Is), _, _, _, _) :- '$exec_directive'(use_module(Mod,F,Is), _, _, _, _) :-
'$use_module'(Mod,F,Is). use_module(Mod,F,Is).
'$exec_directive'(block(BlockSpec), _, _, _, _) :- '$exec_directive'(block(BlockSpec), _, _, _, _) :-
'$block'(BlockSpec). '$block'(BlockSpec).
'$exec_directive'(wait(BlockSpec), _, _, _, _) :- '$exec_directive'(wait(BlockSpec), _, _, _, _) :-

6
pl/qly.yap
View File

@ -82,10 +82,10 @@ Saves an image of the current state of the YAP database in file
trying goal _G_. trying goal _G_.
**/ **/
qsave_program(File) :- qsave_program(File) :-
'$save_program_status'([], qsave_program(File)), '$save_program_status'([], qsave_program(File)),
open(File, write, S, [type(binary)]), open(File, write, S, [type(binary)]),
'$qsave_program'(S), '$qsave_program'(S),
close(S). close(S).
/** @pred qsave_program(+ _F_, Opts) /** @pred qsave_program(+ _F_, Opts)