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

bootstrapping

Browse Source
This commit is contained in:
Vitor Santos Costa 2018-01-22 13:53:17 +00:00
parent fdf7bb516f
commit 9fce1e9ba2
23 changed files with 1479 additions and 3330 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
C/c_interface.c
View File

@ -2191,10 +2191,10 @@ X_API Term YAP_ReadFromStream(int sno) {
return o;
}
X_API Term YAP_ReadClauseFromStream(int sno, Term vs) {
X_API Term YAP_ReadClauseFromStream(int sno, Term vs, Term pos) {
BACKUP_MACHINE_REGS();
Term t = Yap_read_term(sno, t = MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames,1),1,&vs), TermNil), true);
Term t = Yap_read_term(sno,MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames,1),1,&vs), MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition,1),1,&pos), TermNil)), true);
RECOVER_MACHINE_REGS();
return t;
}

12
C/cdmgr.c
View File

@ -47,7 +47,7 @@ static void assertz_dynam_clause(PredEntry *, yamop *);
static void expand_consult(void);
static int not_was_reconsulted(PredEntry *, Term, int);
static int RemoveIndexation(PredEntry *);
static Int p_number_of_clauses(USES_REGS1);
static Int number_of_clauses(USES_REGS1);
static Int p_compile(USES_REGS1);
static Int p_purge_clauses(USES_REGS1);
static Int p_setspy(USES_REGS1);
@ -1490,7 +1490,9 @@ PredEntry *Yap_PredFromClause(Term t USES_REGS) {
t = ArgOfTerm(2, t);
} else if (f == FunctorAssert) {
t = ArgOfTerm(1, t);
} else if (f == FunctorComma && extra_arity == 2) {
} else if (f == FunctorComma
&& extra_arity == 2) {
t = ArgOfTerm(1, t);
} else if (f == FunctorDoubleArrow) {
extra_arity = 2;
@ -2379,7 +2381,7 @@ static Int p_rmspy(USES_REGS1) { /* '$rm_spy'(+T,+Mod) */
******************************************************************/
static Int
p_number_of_clauses(USES_REGS1) { /* '$number_of_clauses'(Predicate,M,N) */
number_of_clauses(USES_REGS1) { /* '$number_of_clauses'(Predicate,M,N) */
Term t = Deref(ARG1);
Term mod = Deref(ARG2);
int ncl = 0;
@ -2405,7 +2407,7 @@ static Int
return (Yap_unify_constant(ARG3, MkIntegerTerm(ncl)));
}
/* @pred '$new_multifile'(+N,+Ar,+Mod)
/* @pred '$new_multifile'(+G,+Mod)
* sets the multi-file flag
* */
static Int new_multifile(USES_REGS1) {
@ -4709,7 +4711,7 @@ void Yap_InitCdMgr(void) {
Yap_InitCPred("$mk_dynamic", 2, mk_dynamic, SafePredFlag);
Yap_InitCPred("$sys_export", 2, p_sys_export, TestPredFlag | SafePredFlag);
Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag);
Yap_InitCPred("$numb er_of_clauses", 3, p_number_of_clauses,
Yap_InitCPred("$number_of_clauses", 3, number_of_clauses,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$undefined", 2, p_undefined, SafePredFlag | TestPredFlag);
Yap_InitCPred("$undefp_handler", 2, undefp_handler,

10
C/compiler.c
View File

@ -3513,14 +3513,20 @@ yamop *Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod,
LOCAL_ErrorMessage = "clause head should be atom or compound term";
return (0);
} else {
loop:
/* find out which predicate we are compiling for */
if (IsAtomTerm(head)) {
Atom ap = AtomOfTerm(head);
cglobs.cint.CurrentPred = RepPredProp(PredPropByAtom(ap, mod));
} else {
Functor f = FunctorOfTerm(head);
if (f == FunctorModule) {
mod = ArgOfTerm(1,head);
head = ArgOfTerm(2,head);
goto loop;
}
cglobs.cint.CurrentPred =
RepPredProp(PredPropByFunc(FunctorOfTerm(head), mod));
RepPredProp(PredPropByFunc(f, mod));
}
/* insert extra instructions to count calls */
PELOCK(52, cglobs.cint.CurrentPred);

86
C/scanner.c
View File

@ -534,19 +534,18 @@ static struct stream_desc *inp0;
// standard get char, uses conversion table
// and converts to wide
static inline int getchr(struct stream_desc *inp)
{
if (inp != inp0) { fprintf(stderr,"\n %s **********************************\n", AtomName(inp->name));
inp0 = inp;
}
static inline int getchr(struct stream_desc *inp) {
/* if (inp != inp0) { fprintf(stderr,"\n %s
* **********************************\n", AtomName(inp->name)); */
/* inp0 = inp; */
/* } */
int ch = inp->stream_wgetc_for_read(inp - GLOBAL_Stream);
// fprintf(stderr,"%c", ch);
return ch;
}
// get char for quoted data, eg, quoted atoms and so on
// converts to wide
static inline int getchrq(struct stream_desc *inp)
{
static inline int getchrq(struct stream_desc *inp) {
int ch = inp->stream_wgetc(inp - GLOBAL_Stream);
return ch;
}
@ -614,7 +613,7 @@ static char *AllocScannerMemory(unsigned int size) {
if (LOCAL_ScannerExtraBlocks) {
struct scanner_extra_alloc *ptr;
if (!(ptr = (struct scanner_extra_alloc *)malloc(
if (!(ptr = (struct scanner_extra_alloc *)Malloc(
size + sizeof(ScannerExtraBlock)))) {
return NULL;
}
@ -629,7 +628,7 @@ static char *AllocScannerMemory(unsigned int size) {
if (!Yap_growtrail(alloc_size, TRUE)) {
struct scanner_extra_alloc *ptr;
if (!(ptr = (struct scanner_extra_alloc *)malloc(
if (!(ptr = (struct scanner_extra_alloc *)Malloc(
size + sizeof(ScannerExtraBlock)))) {
return NULL;
}
@ -885,7 +884,7 @@ static int num_send_error_message(char s[]) {
char *nbuf; \
\
if (buf == buf0) { \
nbuf = malloc(nsz); \
nbuf = Malloc(nsz); \
} else { \
nbuf = realloc(buf, nsz); \
} \
@ -1133,8 +1132,8 @@ Term Yap_scan_num(StreamDesc *inp, bool error_on) {
;
#endif
TokEntry *tokptr = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
tokptr->TokLine = GetCurInpLine(inp);
tokptr->TokPos = GetCurInpPos(inp);
tokptr->TokLine = GetCurInpLine(inp);
tokptr->TokPos = GetCurInpPos(inp);
if (ch == '-') {
sign = -1;
ch = getchr(inp);
@ -1247,16 +1246,16 @@ const char *Yap_tokText(void *tokptre) {
return "<QQ>";
case Number_tok:
if (IsIntegerTerm(info)) {
char *s = malloc(36);
char *s = Malloc(36);
snprintf(s, 35, Int_FORMAT, IntegerOfTerm(info));
return s;
} else if (IsFloatTerm(info)) {
char *s = malloc(64);
char *s = Malloc(64);
snprintf(s, 63, "%6g", FloatOfTerm(info));
return s;
} else {
size_t len = Yap_gmp_to_size(info, 10);
char *s = malloc(len + 2);
char *s = Malloc(len + 2);
return Yap_gmp_to_string(info, s, len + 1, 10);
}
break;
@ -1286,7 +1285,7 @@ static void open_comment(int ch, StreamDesc *st USES_REGS) {
h0[1] = Yap_StreamPosition(st - GLOBAL_Stream);
h0[2] = TermNil;
LOCAL_CommentsNextChar = h0 + 2;
LOCAL_CommentsBuff = (wchar_t *)malloc(1024 * sizeof(wchar_t));
LOCAL_CommentsBuff = (wchar_t *)Malloc(1024 * sizeof(wchar_t));
LOCAL_CommentsBuffLim = 1024;
LOCAL_CommentsBuff[0] = ch;
LOCAL_CommentsBuffPos = 1;
@ -1305,7 +1304,7 @@ static void extend_comment(int ch USES_REGS) {
static void close_comment(USES_REGS1) {
LOCAL_CommentsBuff[LOCAL_CommentsBuffPos] = '\0';
*LOCAL_CommentsNextChar = Yap_WCharsToString(LOCAL_CommentsBuff PASS_REGS);
free(LOCAL_CommentsBuff);
Free(LOCAL_CommentsBuff);
LOCAL_CommentsBuff = NULL;
LOCAL_CommentsBuffLim = 0;
}
@ -1364,8 +1363,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
while (chtype(ch) == BS) {
ch = getchr(st);
}
t->TokPos = GetCurInpPos(st);
t->TokLine = GetCurInpLine(st);
t->TokPos = GetCurInpPos(st);
t->TokLine = GetCurInpLine(st);
switch (chtype(ch)) {
@ -1413,7 +1412,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
int32_t och = ch;
ch = getchr(st);
size_t sz = 512;
TokImage = malloc(sz PASS_REGS);
TokImage = Malloc(sz PASS_REGS);
scan_name:
charp = (unsigned char *)TokImage;
isvar = (chtype(och) != LC);
@ -1426,7 +1425,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
if (TokImage == NULL) {
return CodeSpaceError(t, p, l);
}
charp = TokImage - (charp - p0);
charp = TokImage + (charp - p0);
}
add_ch_to_buff(ch);
}
@ -1443,7 +1442,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
Atom ae;
/* don't do this in iso */
ae = Yap_ULookupAtom(TokImage);
free(TokImage);
Free(TokImage);
if (ae == NIL) {
return CodeSpaceError(t, p, l);
}
@ -1453,7 +1452,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->Tok = Ord(kind = Name_tok);
} else {
VarEntry *ve = Yap_LookupVar((const char *)TokImage);
free(TokImage);
Free(TokImage);
t->TokInfo = Unsigned(ve);
if (cur_qq) {
ve->refs++;
@ -1484,8 +1483,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
if (cherr) {
TokEntry *e;
t->Tok = Number_tok;
t->TokPos = GetCurInpPos(st);
t->TokLine = GetCurInpLine(st);
t->TokPos = GetCurInpPos(st);
t->TokLine = GetCurInpLine(st);
e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e == NULL) {
return TrailSpaceError(p, l);
@ -1500,7 +1499,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
case 'e':
case 'E':
och = cherr;
TokImage = malloc(1024 PASS_REGS);
TokImage = Malloc(1024 PASS_REGS);
goto scan_name;
break;
case '=':
@ -1511,8 +1510,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->Tok = Ord(Var_tok);
t->TokInfo = (Term)Yap_LookupVar("E");
t->TokPos = GetCurInpPos(st);
t->TokLine = GetCurInpLine(st);
t->TokPos = GetCurInpPos(st);
t->TokLine = GetCurInpLine(st);
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e2 == NULL) {
return TrailSpaceError(p, l);
@ -1545,8 +1544,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
if (ch == '(')
solo_flag = FALSE;
t->TokInfo = MkAtomTerm(AtomE);
t->TokLine = GetCurInpLine(st);
t->TokPos = GetCurInpPos(st);
t->TokLine = GetCurInpLine(st);
t->TokPos = GetCurInpPos(st);
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e2 == NULL) {
return TrailSpaceError(p, l);
@ -1569,7 +1568,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
case QT:
case DC:
quoted_string:
TokImage = malloc(1048);
TokImage = Malloc(1048);
charp = TokImage;
quote = ch;
len = 0;
@ -1633,7 +1632,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
if (!(t->TokInfo)) {
return CodeSpaceError(t, p, l);
}
free(TokImage);
Free(TokImage);
t->Tok = Ord(kind = Name_tok);
if (ch == '(')
solo_flag = false;
@ -1746,7 +1745,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
} else {
Atom ae;
sz = 1024;
TokImage = malloc(sz);
TokImage = Malloc(sz);
charp = TokImage;
add_ch_to_buff(och);
for (; chtype(ch) == SY; ch = getchr(st)) {
@ -1767,7 +1766,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
if (t->TokInfo == (CELL)NIL) {
return CodeSpaceError(t, p, l);
}
free(TokImage);
Free(TokImage);
t->Tok = Ord(kind = Name_tok);
if (ch == '(')
solo_flag = false;
@ -1827,7 +1826,6 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
qq_t *qq = (qq_t *)calloc(sizeof(qq_t), 1);
if (!qq) {
LOCAL_ErrorMessage = "not enough heap space to read in quasi quote";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
return l;
@ -1837,7 +1835,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
free(qq);
Free(qq);
return l;
} else {
cur_qq = qq;
@ -1871,7 +1869,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
if (!qq) {
LOCAL_ErrorMessage = "quasi quoted's || without {|";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
free(cur_qq);
Free(cur_qq);
cur_qq = NULL;
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermError;
@ -1890,7 +1888,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->Tok = Ord(kind = QuasiQuotes_tok);
ch = getchr(st);
sz = 1024;
TokImage = malloc(sz);
TokImage = Malloc(sz);
if (!TokImage) {
LOCAL_ErrorMessage =
"not enough heap space to read in a quasi quoted atom";
@ -1914,7 +1912,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
break;
}
} else if (chtype(ch) == EF) {
free(TokImage);
Free(TokImage);
mark_eof(st);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
@ -1930,7 +1928,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
}
}
len = charp - (unsigned char *)TokImage;
mp = malloc(len + 1);
mp = Malloc(len + 1);
if (mp == NULL) {
LOCAL_ErrorMessage = "not enough heap space to read in quasi quote";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
@ -1982,8 +1980,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
p->TokNext = e;
e->Tok = Error_tok;
e->TokInfo = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
e->TokPos = GetCurInpPos(st);
e->TokLine = GetCurInpLine(st);
e->TokPos = GetCurInpPos(st);
e->TokLine = GetCurInpLine(st);
e->TokNext = NULL;
LOCAL_ErrorMessage = NULL;
p = e;
@ -1999,14 +1997,14 @@ void Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable,
struct scanner_extra_alloc *ptr = LOCAL_ScannerExtraBlocks;
while (ptr) {
struct scanner_extra_alloc *next = ptr->next;
free(ptr);
Free(ptr);
ptr = next;
}
TR = (tr_fr_ptr)tokstart;
LOCAL_Comments = TermNil;
LOCAL_CommentsNextChar = LOCAL_CommentsTail = NULL;
if (LOCAL_CommentsBuff) {
free(LOCAL_CommentsBuff);
Free(LOCAL_CommentsBuff);
LOCAL_CommentsBuff = NULL;
}
LOCAL_ScannerStack = NULL;

210
C/yap-args.c
View File

@ -154,7 +154,6 @@ static void start_modules(void) {
CurrentModule = cm;
}
const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR,
*Yap_PLDIR, *Yap_BOOTPLDIR, *Yap_BOOTSTRAPPLDIR, *Yap_COMMONSDIR,
*Yap_STARTUP, *Yap_BOOTFILE;
@ -166,7 +165,7 @@ static void consult(const char *b_file USES_REGS) {
Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1);
Functor functor_command1 = Yap_MkFunctor(Yap_LookupAtom(":-"), 1);
Functor functor_compile2 = Yap_MkFunctor(Yap_LookupAtom("c_compile"), 1);
Functor functor_bc = Yap_MkFunctor(Yap_LookupAtom("$bc"), 2);
Functor functor_bc = Yap_MkFunctor(Yap_LookupAtom("$bc"), 3);
/* consult boot.pl */
char *full = malloc(YAP_FILENAME_MAX + 1);
@ -178,43 +177,29 @@ static void consult(const char *b_file USES_REGS) {
exit(1);
}
do {
do {
CACHE_REGS
YAP_Reset(YAP_FULL_RESET, false);
YAP_Reset(YAP_FULL_RESET, false);
Yap_StartSlots();
Term vs = YAP_MkVarTerm();
t = YAP_ReadClauseFromStream(boot_stream, vs);
//Yap_GetNèwSlot(t);
Term vs = YAP_MkVarTerm(), pos = MkVarTerm();
t = YAP_ReadClauseFromStream(boot_stream, vs, pos);
// Yap_GetNèwSlot(t);
if (t == 0) {
fprintf(stderr,
"[ SYNTAX ERROR: while parsing stream %s at line %ld ]\n",
fprintf(stderr, "[ SYNTAX ERROR: while parsing stream %s at line %ld ]\n",
b_file, GLOBAL_Stream[boot_stream].linecount);
} else if (IsVarTerm(t) || t == TermNil) {
fprintf(stderr, "[ line %d: term cannot be compiled ]", GLOBAL_Stream[boot_stream].linecount);
fprintf(stderr, "[ line %d: term cannot be compiled ]",
GLOBAL_Stream[boot_stream].linecount);
} else if (IsApplTerm(t) && (FunctorOfTerm(t) == functor_query ||
FunctorOfTerm(t) == functor_command1)) {
t = ArgOfTerm(1, t);
if (IsApplTerm(t) && FunctorOfTerm(t) == functor_compile2) {
consult( RepAtom(AtomOfTerm(ArgOfTerm(1,t)))->StrOfAE);
consult(RepAtom(AtomOfTerm(ArgOfTerm(1, t)))->StrOfAE);
} else {
YAP_Term ts[2];
ts[0] = t;
ts[1] = vs;
t = YAP_MkApplTerm(functor_bc, 2, ts);
YAP_RunGoalOnce(t);
}
} else {
Term ts[2];
char *ErrorMessage;
Functor fun = Yap_MkFunctor(Yap_LookupAtom("$prepare_clause"), 2);
PredEntry *pe = RepPredProp(PredPropByFunc(fun, PROLOG_MODULE));
if (pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE) {
ts[0] = t;
RESET_VARIABLE(ts + 1);
if (YAP_RunGoal(Yap_MkApplTerm(fun, 2, ts)))
t = ts[1];
}
ErrorMessage = YAP_CompileClause(t);
if (ErrorMessage) {
fprintf(stderr, "%s", ErrorMessage);
@ -243,30 +228,29 @@ do {
*
*/
typedef struct config {
char *name;
const char * *root;
const char * *lib;
const char * *share;
const char * *include;
const char * *pl;
const char * *commons;
const char * *dll;
const char * *ss;
const char * *bootpl;
char *name;
const char **root;
const char **lib;
const char **share;
const char **include;
const char **pl;
const char **commons;
const char **dll;
const char **ss;
const char **bootpl;
} config_t;
const char *gd_root[] = {"@RootDir","[root]", "(execdir).."};
const char *gd_lib[] = {"@LibDir","[lib]", "(root)lib"};
const char *gd_share[] = {"@ShareDir","[share]", "(root)share"};
const char *gd_include[] = {"@IncludeDir","[include]", "(root)include"};
const char *gd_dll[] = {"@DLLDir","(lib)Yap"};
const char *gd_pl[] = {"@PlDir","(share)Yap"};
const char *gd_commons[] = {"@CommonsDir","(share)PrologCommons"};
const char *gd_ss[] = {"@SavedState","(dll)startup.yss"};
const char *gd_bootpl[] = {"@PrologBootFile","(pl)pl/boot.yap"};
const char *gd_root[] = {"@RootDir", "[root]", "(execdir).."};
const char *gd_lib[] = {"@LibDir", "[lib]", "(root)lib"};
const char *gd_share[] = {"@ShareDir", "[share]", "(root)share"};
const char *gd_include[] = {"@IncludeDir", "[include]", "(root)include"};
const char *gd_dll[] = {"@DLLDir", "(lib)Yap"};
const char *gd_pl[] = {"@PlDir", "(share)Yap"};
const char *gd_commons[] = {"@CommonsDir", "(share)PrologCommons"};
const char *gd_ss[] = {"@SavedState", "(dll)startup.yss"};
const char *gd_bootpl[] = {"@PrologBootFile", "(pl)pl/boot.yap"};
static config_t *gnu(config_t *i)
{
static config_t *gnu(config_t *i) {
i->root = gd_root;
i->lib = gd_lib;
i->share = gd_share;
@ -280,33 +264,30 @@ static config_t *gnu(config_t *i)
return i;
}
const char *build_root[] = {"."};
const char *build_lib[] = {"."};
const char *build_share[] = {"(src)"};
const char *build_include[] = {"(src/include]"};
const char *build_dll[] = {"."};
const char *build_pl[] = {"pl"};
const char *build_commons[] = {"PrologCommons"};
const char *build_ss[] = {NULL};
const char *build_bootpl[] = {"(pl)boot.yap"};
const char *build_root[] = {"."};
const char *build_lib[] = {"."};
const char *build_share[] = {"(src)"};
const char *build_include[] = {"(src/include]"};
const char *build_dll[] = {"."};
const char *build_pl[] = {"pl"};
const char *build_commons[] = {"PrologCommons"};
const char *build_ss[] = {NULL};
const char *build_bootpl[] = {"(pl)boot.yap"};
static config_t *build(config_t *i)
{
i->root = build_root;
i->lib = build_lib;
i->share = build_share;
i->include = build_include;
i->dll = build_dll;
i->pl = build_pl;
i->commons = build_commons;
i->ss = build_ss;
i->bootpl = build_bootpl;
return i;
static config_t *build(config_t *i) {
i->root = build_root;
i->lib = build_lib;
i->share = build_share;
i->include = build_include;
i->dll = build_dll;
i->pl = build_pl;
i->commons = build_commons;
i->ss = build_ss;
i->bootpl = build_bootpl;
return i;
}
/**
/**
* Search
*/
char *location(YAP_init_args *iap, const char *inp, char *out) {
@ -342,7 +323,7 @@ char *location(YAP_init_args *iap, const char *inp, char *out) {
strcat(out, inp + strlen("(pl)"));
} else if (strstr(inp + 1, "execdir") == inp + 1) {
char *buf = Malloc(YAP_FILENAME_MAX + 1);
const char *ex = Yap_AbsoluteFile(Yap_FindExecutable(), buf, false);
const char *ex = Yap_AbsoluteFile(Yap_FindExecutable(), buf, false);
if (ex != NULL) {
strcpy(out, dirname((char *)ex));
strcat(out, "/");
@ -356,23 +337,23 @@ char *location(YAP_init_args *iap, const char *inp, char *out) {
if (tmp && tmp[0])
strcpy(out, tmp);
} else if (strstr(inp + 1, "LibDir") == inp + 1) {
const char *tmp = iap->LibDir;
const char *tmp = iap->LibDir;
if (tmp && tmp[0])
strcpy(out, tmp);
} else if (strstr(inp + 1, "IncludeDir") == inp + 1) {
const char *tmp = iap->IncludeDir;
} else if (strstr(inp + 1, "IncludeDir") == inp + 1) {
const char *tmp = iap->IncludeDir;
if (tmp && tmp[0])
strcpy(out, tmp);
} else if (strstr(inp + 1, "SharedDir") == inp + 1) {
const char *tmp = iap->SharedDir;
const char *tmp = iap->SharedDir;
if (tmp && tmp[0])
strcpy(out, tmp);
} else if (strstr(inp + 1, "DLLDir") == inp + 1) {
const char *tmp = iap->DLLDir;
const char *tmp = iap->DLLDir;
if (tmp && tmp[0])
strcpy(out, tmp);
} else if (strstr(inp + 1, "PlDir") == inp + 1) {
const char *tmp = iap->SavedState;
const char *tmp = iap->SavedState;
if (tmp && tmp[0])
strcpy(out, tmp);
} else if (strstr(inp + 1, "PrologBootFile") == inp + 1) {
@ -460,35 +441,27 @@ char *location(YAP_init_args *iap, const char *inp, char *out) {
* @return
*/
static const char *find_directory(YAP_init_args *iap, const char *paths[],
const char *names[]) {
char *filename) {
int lvl = push_text_stack();
char *out = Malloc(YAP_FILENAME_MAX + 1);
const char *inp;
char *full;
if (names) {
if (filename) {
full = Malloc(YAP_FILENAME_MAX + 1);
}
int i = 0;
while ((inp = paths[i++]) != NULL) {
out[0] = '\0';
char *o = location(iap, inp, out), *no;
if (o && o[0] && Yap_Exists(o)) {
if (names) {
size_t s = strlen(o);
o[s++] = '/';
const char *p;
int j = 0;
while ((p = names[j++])) {
char *io = o + s;
if ((no = location(iap, p, io)) && io[0] != '\0' && Yap_Exists(o)) {
o = pop_output_text_stack(lvl, o);
o = realpath(o, full);
return o;
}
}
if (o && o[0] && Yap_isDirectory(o)) {
if (filename) {
o = realpath(o, full);
strcat(o, "/");
strcat(o, filename);
return o;
} else {
return pop_output_text_stack(lvl, o);
o = pop_output_text_stack(lvl, o);
return o;
}
}
}
@ -499,17 +472,16 @@ static const char *find_directory(YAP_init_args *iap, const char *paths[],
static void Yap_set_locations(YAP_init_args *iap) {
config_t t, *template;
template= gnu(&t);
Yap_ROOTDIR = find_directory(iap, template->root, NULL);
template = gnu(&t);
Yap_ROOTDIR = find_directory(iap, template->root, NULL);
Yap_LIBDIR = find_directory(iap, template->lib, NULL);
//Yap_BINDIR = find_directory(iap, template->bin, NULL);
// Yap_BINDIR = find_directory(iap, template->bin, NULL);
Yap_SHAREDIR = find_directory(iap, template->share, NULL);
Yap_DLLDIR = find_directory(iap, template->dll, NULL);
Yap_PLDIR = find_directory(iap, template->pl, NULL);
Yap_COMMONSDIR = find_directory(iap, template->commons, NULL);
Yap_STARTUP = find_directory(iap, template->ss, NULL);
Yap_BOOTFILE = find_directory(iap, template->bootpl, NULL);
Yap_BOOTFILE = find_directory(iap, template->bootpl, NULL);
if (Yap_ROOTDIR)
setAtomicGlobalPrologFlag(HOME_FLAG,
MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR)));
@ -942,17 +914,22 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
if (!strcmp("-nosignals", p)) {
iap->PrologCannotHandleInterrupts = true;
break;
} else if (!strncmp("-output-saved-state=", p, strlen("-output-saved-state="))) {
} else if (!strncmp("-output-saved-state=", p,
strlen("-output-saved-state="))) {
iap->OutputSavedState = p + strlen("-output-saved-state=");
} else if (!strncmp("-home=", p, strlen("-home="))) {
iap->RootDir = p + strlen("-home=");
} else if (!strncmp("-system-library-directory=", p, strlen("-system-library-directory="))) {
} else if (!strncmp("-system-library-directory=", p,
strlen("-system-library-directory="))) {
iap->LibDir = p + strlen("-system-library-directory=");
} else if (!strncmp("-system-shared-directory=", p, strlen("-system-shared-directory="))) {
} else if (!strncmp("-system-shared-directory=", p,
strlen("-system-shared-directory="))) {
iap->SharedDir = p + strlen("-system-shared-directory=");
} else if (!strncmp("-prolog-library-directory=", p, strlen("-prolog-library-directory="))) {
} else if (!strncmp("-prolog-library-directory=", p,
strlen("-prolog-library-directory="))) {
iap->PlDir = p + strlen("-prolog-library-directory=");
} else if (!strncmp("-dll-library-directory=", p, strlen("-dll-library-directory="))) {
} else if (!strncmp("-dll-library-directory=", p,
strlen("-dll-library-directory="))) {
iap->DLLDir = p + strlen("-dll-library-directory=");
} else if (!strncmp("-home=", p, strlen("-home="))) {
iap->RootDir = p + strlen("-home=");
@ -977,7 +954,7 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
ssize = &(iap->HeapSize);
p += strlen("-heap=");
goto GetSize;
} else if (!strncmp("-max-stack=", p, strlen("-max-stack="))) {
} else if (!strncmp("-max-stack=", p, strlen("-max-stack="))) {
ssize = &(iap->MaxStackSize);
p += strlen("-max-stack=");
goto GetSize;
@ -1140,7 +1117,7 @@ static void init_hw(YAP_init_args *yap_init, struct ssz_t *spt) {
static YAP_file_type_t end_init(YAP_init_args *yap_init, YAP_file_type_t rc) {
YAP_initialized = true;
LOCAL_PrologMode &= ~BootMode;
LOCAL_PrologMode &= ~BootMode;
return rc;
}
@ -1188,18 +1165,24 @@ X_API YAP_file_type_t YAP_Init(YAP_init_args *yap_init) {
Yap_Restore(Yap_STARTUP)) {
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true);
CurrentModule = LOCAL_SourceModule = USER_MODULE;
init_globals(yap_init);
init_globals(yap_init);
start_modules();
return end_init(yap_init, YAP_QLY);
start_modules();
return end_init(yap_init, YAP_QLY);
} else {
init_globals(yap_init);
start_modules();
consult(Yap_BOOTFILE PASS_REGS);
setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG,
MkAtomTerm(Yap_LookupAtom(Yap_BOOTFILE)));
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false);
if (yap_init->install) {
Term t = MkAtomTerm(Yap_LookupAtom(YAP_STARTUP));
Term g = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("qsave_program"), 1),
1, &t);
YAP_RunGoalOnce(g);
}
setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG,
MkAtomTerm(Yap_LookupAtom(Yap_BOOTFILE)));
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false);
return end_init(yap_init, YAP_BOOT_PL);
}
}
@ -1227,7 +1210,6 @@ X_API YAP_file_type_t YAP_FastInit(char *saved_state, int argc, char *argv[]) {
YAP_init_args init_args;
YAP_file_type_t out;
if ((out = Yap_InitDefaults(&init_args, saved_state, argc, argv)) !=
YAP_FOUND_BOOT_ERROR)
out = YAP_Init(&init_args);

1
H/ATOMS
View File

@ -397,6 +397,7 @@ A SystemLibraryDir N "system_library_directory"
A T N "t"
A Term N "term"
A TermExpansion N "term_expansion"
A TermPosition N "term_position"
A Terms N "terms"
A Text N "text"
A TextStream N "text_stream"

1
H/generated/iatoms.h
View File

@ -392,6 +392,7 @@
AtomT = Yap_LookupAtom("t"); TermT = MkAtomTerm(AtomT);
AtomTerm = Yap_LookupAtom("term"); TermTerm = MkAtomTerm(AtomTerm);
AtomTermExpansion = Yap_LookupAtom("term_expansion"); TermTermExpansion = MkAtomTerm(AtomTermExpansion);
AtomTermPosition = Yap_LookupAtom("term_position"); TermTermPosition = MkAtomTerm(AtomTermPosition);
AtomTerms = Yap_LookupAtom("terms"); TermTerms = MkAtomTerm(AtomTerms);
AtomText = Yap_LookupAtom("text"); TermText = MkAtomTerm(AtomText);
AtomTextStream = Yap_LookupAtom("text_stream"); TermTextStream = MkAtomTerm(AtomTextStream);

1
H/generated/ratoms.h
View File

@ -392,6 +392,7 @@
AtomT = AtomAdjust(AtomT); TermT = MkAtomTerm(AtomT);
AtomTerm = AtomAdjust(AtomTerm); TermTerm = MkAtomTerm(AtomTerm);
AtomTermExpansion = AtomAdjust(AtomTermExpansion); TermTermExpansion = MkAtomTerm(AtomTermExpansion);
AtomTermPosition = AtomAdjust(AtomTermPosition); TermTermPosition = MkAtomTerm(AtomTermPosition);
AtomTerms = AtomAdjust(AtomTerms); TermTerms = MkAtomTerm(AtomTerms);
AtomText = AtomAdjust(AtomText); TermText = MkAtomTerm(AtomText);
AtomTextStream = AtomAdjust(AtomTextStream); TermTextStream = MkAtomTerm(AtomTextStream);

1
H/generated/tatoms.h
View File

@ -392,6 +392,7 @@ X_API EXTERNAL Atom AtomSystemLibraryDir; X_API EXTERNAL Term TermSystemLibraryD
X_API EXTERNAL Atom AtomT; X_API EXTERNAL Term TermT;
X_API EXTERNAL Atom AtomTerm; X_API EXTERNAL Term TermTerm;
X_API EXTERNAL Atom AtomTermExpansion; X_API EXTERNAL Term TermTermExpansion;
X_API EXTERNAL Atom AtomTermPosition; X_API EXTERNAL Term TermTermPosition;
X_API EXTERNAL Atom AtomTerms; X_API EXTERNAL Term TermTerms;
X_API EXTERNAL Atom AtomText; X_API EXTERNAL Term TermText;
X_API EXTERNAL Atom AtomTextStream; X_API EXTERNAL Term TermTextStream;

2
include/YapInterface.h
View File

@ -400,7 +400,7 @@ extern X_API YAP_Term YAP_ReadFromStream(int s);
/// read a Prolog clause from a Prolog opened stream $s$. Similar to
/// YAP_ReadFromStream() but takes /// default options from read_clause/3.
extern X_API YAP_Term YAP_ReadClauseFromStream(int s, YAP_Term varNames);
extern X_API YAP_Term YAP_ReadClauseFromStream(int s, YAP_Term varNames, YAP_Term);
extern X_API void YAP_Write(YAP_Term t, FILE *s, int);

3
pl/CMakeLists.txt
View File

@ -52,6 +52,7 @@ set(PL_BOOT_SOURCES
swi.yap
tabling.yap
threads.yap
top.yap
udi.yap
undefined.yap
utils.yap
@ -90,5 +91,3 @@ else(CMAKE_CROSSCOMPILING)
endif()

4
pl/absf.yap
View File

@ -260,13 +260,13 @@ absolute_file_name(File0,File) :-
'$absf_trace'(' after testing ~a for ~a and ~a', [File,Type,Access]),
(First == first -> ! ; true ).
% allow paths in File Name
% allow paths in File Name
'$core_file_name'(Name, Opts) -->
'$file_name'(Name, Opts, E),
'$suffix'(E, Opts),
'$glob'(Opts).
%
%
% handle library(lists) or foreign(jpl)
%
'$file_name'(Name, Opts, E) -->

1239
pl/boot.yap
View File

File diff suppressed because it is too large Load Diff

21
pl/builtins.yap
View File

@ -337,10 +337,25 @@ call(G) :- '$execute'(G).
/** @pred incore( 0:P )
The same as call/1.
*/
incore(G) :- '$execute'(G).
/** @pred once( 0 G) is iso
Execute the goal _G_ only once. The predicate is defined by:
~~~~~{.prolog}
once(G) :- call(G), !.
~~~~~
Note that cuts inside once/1 can only cut the other goals inside
once/1.
*/
once(G) :-
strip_module(G, M, C),
'$meta_call'(C, M),
!.
(:- G) :- '$execute'(G), !.

15
pl/consult.yap
View File

@ -472,7 +472,8 @@ load_files(Files,Opts) :-
'$reexport'( TOpts, ParentF, Reexport, Imports, File ).
'$start_lf'(_, Mod, PlStream, TOpts, _UserFile, File, Reexport, ImportList) :-
% check if there is a qly file
% start_low_level_trace,
% start_low_level_trace,
'$pred_exists'('$absolute_file_name'(File,[],F),prolog),
'$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F),
open( F, read, Stream , [type(binary)] ),
(
@ -1090,6 +1091,18 @@ make_library_index(_Directory).
exists_source(File) :-
'$full_filename'(File, _AbsFile).
'$full_filename'(F0, F) :-
'$undefined'('$absolute_file_name'(F0,[],F),prolog_complete),
!,
absolute_file_system_path(F0, F).
'$full_filename'(F0, F) :-
'$absolute_file_name'(F0,[access(read),
file_type(prolog),
file_errors(fail),
solutions(first),
expand(true)],F).
% reload_file(File) :-
% ' $source_base_name'(File, Compile),
% findall(M-Opts,

20
pl/control.yap
View File

@ -87,26 +87,6 @@
*/
/** @pred once(: _G_) is iso
Execute the goal _G_ only once. The predicate is defined by:
~~~~~{.prolog}
once(G) :- call(G), !.
~~~~~
Note that cuts inside once/1 can only cut the other goals inside
once/1.
*/
once(G) :-
strip_module(G, M, C),
'$meta_call'(C, M),
!.
/** @pred forall(: _Cond_,: _Action_)

4
pl/directives.yap
View File

@ -69,7 +69,9 @@
'$directive'(G).
%:- '$multifile'( '$directive'/1, prolog ).
:- multifile prolog:'$exec_directive'/5, prolog:'$directive'/1.
%:- multifile prolog:'$exec_directive'/5, prolog:'$directive'/1.
:- '$new_multifile'('$exec_directive'(_,_,_,_,_), prolog).
:- '$new_multifile'('$directive'(_), prolog).

2051
pl/errors.yap
View File

File diff suppressed because it is too large Load Diff

9
pl/grammar.yap
View File

@ -67,7 +67,7 @@ right hand side of a grammar rule
Grammar related built-in predicates:
*/
/*
:- system_module( '$_grammar', [!/2,
(',')/4,
(->)/4,
@ -81,6 +81,7 @@ Grammar related built-in predicates:
phrase/3,
{}/3,
('|')/4], ['$do_error'/2]).
*/
% :- meta_predicate ^(?,0,?).
% ^(Xs, Goal, Xs) :- call(Goal).
@ -276,11 +277,11 @@ prolog:'\\+'(A, S0, S) :-
t_body(\+ A, _, last, S0, S, Goal),
'$execute'(Goal).
:- multifile system:goal_expansion/2.
:- dynamic system:goal_expansion/2.
:- '$new_multifile'( goal_expansion(_,_), prolog).
:- '$mk_dynamic'( goal_expansion(_,_), prolog).
'$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal) :-
nonvar(NT),
catch(prolog:'$translate_rule'(
(pseudo_nt --> Mod:NT), Rule),
error(Pat,ImplDep),

1
pl/messages.yap
View File

@ -105,6 +105,7 @@ In YAP, the info field describes:
prefix/5,
file_location/3]).
:- abolish(prolog:print_message/2).
:- use_system_module( user, [message_hook/3]).

2
pl/modules.yap
View File

@ -285,7 +285,7 @@ use_module(F,Is) :-
recorded('$module','$module'(HostF, HostM, _, AllExports, _Line), R), erase(R),
'$convert_for_export'(Exports, DonorExports, DonorM, HostM, _TranslationTab, AllReExports, reexport(DonorF, Exports)),
lists:append( AllReExports, AllExports, Everything0 ),
sort( Everything0, Everything ),
'$sort'( Everything0, Everything ),
( source_location(_, Line) -> true ; Line = 0 ),
recorda('$module','$module'(HostF,HostM,SourceF, Everything, Line),_).

2
pl/newmod.yap
View File

@ -124,7 +124,7 @@ set_module_property(Mod, class(Class)) :-
( recorded('$module','$module'( HostF, HostM, _, _, _, _),_) -> true ; HostF = user_input ),
% first build the initial export table
'$convert_for_export'(all, Exports, DonorM, HostM, TranslationTab, AllExports0, load_files),
sort( AllExports0, AllExports ),
'$sort'( AllExports0, AllExports ),
'$add_to_imports'(TranslationTab, DonorM, DonorM), % insert ops, at least for now
% last, export everything to the host: if the loading crashed you didn't actually do
% no evil.

1106
pl/top.yap Normal file
View File

File diff suppressed because it is too large Load Diff