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

android debugging plus clean-ups

Browse Source
This commit is contained in:
Vítor Santos Costa 2015-04-13 13:28:17 +01:00
parent d1a230eb56
commit ef586e264e
77 changed files with 2346 additions and 4054 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/absmi.c
View File

@ -3,7 +3,7 @@
* Yap Prolog * * Yap Prolog *
* * * *
* Yap Prolog was developed at NCCUP - Universidade do Porto * * Yap Prolog was developed at NCCUP - Universidade do Porto *
* * * \z *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* * * *
************************************************************************** **************************************************************************

395
C/cdmgr.c
View File

File diff suppressed because it is too large Load Diff

6
C/fli_absmi_insts.h
View File

@ -14,13 +14,13 @@
char *s; Atom name; char *s; Atom name;
if (PREG->y_u.Osbpp.p->ArityOfPE) { if (PREG->y_u.Osbpp.p->ArityOfPE) {
Functor f = PREG->y_u.Osbpp.p->FunctorOfPred; Functor f = PREG->y_u.Osbpp.p->FunctorOfPred;
name = f->NameOfFE; name = f->NameOfFE;
} else { } else {
name = (Atom)(PREG->y_u.Osbpp.p->FunctorOfPred); name = (Atom)(PREG->y_u.Osbpp.p->FunctorOfPred);
} }
s = name->StrOfAE; s = name->StrOfAE;
__android_log_print(ANDROID_LOG_INFO, "YAP", " %s ", s); LOG( " %s ", s);
#endif #endif
check_trail(TR); check_trail(TR);
if (!(PREG->y_u.Osbpp.p->PredFlags & (SafePredFlag|NoTracePredFlag|HiddenPredFlag))) { if (!(PREG->y_u.Osbpp.p->PredFlags & (SafePredFlag|NoTracePredFlag|HiddenPredFlag))) {

16
C/iopreds.c
View File

@ -574,7 +574,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
rd->varnames = 0; rd->varnames = 0;
rd->singles = 0; rd->singles = 0;
return Yap_unify_constant( Yap_GetFromSlot( t0 PASS_REGS), MkAtomTerm (AtomEof)); return Yap_unify_constant( Yap_GetFromSlot( t0), MkAtomTerm (AtomEof));
} }
} }
repeat_cycle: repeat_cycle:
@ -620,7 +620,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
rd->has_exception = TRUE; rd->has_exception = TRUE;
rd->exception = Yap_InitSlot(terror PASS_REGS); rd->exception = Yap_InitSlot(terror);
CurrentModule = OCurrentModule; CurrentModule = OCurrentModule;
return FALSE; return FALSE;
} }
@ -630,9 +630,9 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
break; break;
} }
} }
if (!Yap_unify(t, Yap_GetFromSlot( t0 PASS_REGS))) if (!Yap_unify(t, Yap_GetFromSlot( t0)))
return FALSE; return FALSE;
if (store_comments && !Yap_unify(LOCAL_Comments, Yap_GetFromSlot( rd->comments PASS_REGS))) if (store_comments && !Yap_unify(LOCAL_Comments, Yap_GetFromSlot( rd->comments )))
return FALSE; return FALSE;
if (rd->varnames) { if (rd->varnames) {
Term v; Term v;
@ -656,7 +656,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
} }
} }
LOCAL_VarNames = v; LOCAL_VarNames = v;
if (!Yap_unify(v, Yap_GetFromSlot( rd->varnames PASS_REGS ))) { if (!Yap_unify(v, Yap_GetFromSlot( rd->varnames ))) {
CurrentModule = OCurrentModule; CurrentModule = OCurrentModule;
return FALSE; return FALSE;
} }
@ -683,7 +683,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
TR = old_TR; TR = old_TR;
} }
} }
if (!Yap_unify(v, Yap_GetFromSlot( rd->variables PASS_REGS ) )) { if (!Yap_unify(v, Yap_GetFromSlot( rd->variables ) )) {
CurrentModule = OCurrentModule; CurrentModule = OCurrentModule;
return FALSE; return FALSE;
} }
@ -711,11 +711,11 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
} }
if (rd->singles == 1) { if (rd->singles == 1) {
if (IsPairTerm(v)) if (IsPairTerm(v))
rd->singles = Yap_InitSlot( v PASS_REGS); rd->singles = Yap_InitSlot( v );
else else
rd->singles = FALSE; rd->singles = FALSE;
} else if (rd->singles) { } else if (rd->singles) {
if (!Yap_unify( v, Yap_GetFromSlot( rd->singles PASS_REGS ))) { if (!Yap_unify( v, Yap_GetFromSlot( rd->singles ))) {
CurrentModule = OCurrentModule; CurrentModule = OCurrentModule;
return FALSE; return FALSE;
} }

8
C/parser.c
View File

@ -848,7 +848,7 @@ case Var_tok:
tn = Yap_MkNewApplTerm(SWIFunctorToFunctor(FUNCTOR_quasi_quotation4), 4); tn = Yap_MkNewApplTerm(SWIFunctorToFunctor(FUNCTOR_quasi_quotation4), 4);
tnp = RepAppl(tn) + 1; tnp = RepAppl(tn) + 1;
tnp[0] = MkAtomTerm(at); tnp[0] = MkAtomTerm(at);
if (!get_quasi_quotation(Yap_InitSlot(ArgOfTerm(2, tn) PASS_REGS), if (!get_quasi_quotation(Yap_InitSlot(ArgOfTerm(2, tn)),
&qq->text, &qq->text,
qq->text + strlen((const char *)qq->text), rd)) qq->text + strlen((const char *)qq->text), rd))
FAIL; FAIL;
@ -857,7 +857,7 @@ case Var_tok:
intptr_t qqend = qq->end.charno; intptr_t qqend = qq->end.charno;
// set_range_position(positions, -1, qqend PASS_LD); // set_range_position(positions, -1, qqend PASS_LD);
if (!PL_unify_term(Yap_InitSlot(ArgOfTerm(2, t) PASS_REGS), PL_FUNCTOR, if (!PL_unify_term(Yap_InitSlot(ArgOfTerm(2, t) ), PL_FUNCTOR,
FUNCTOR_minus2, PL_INTPTR, FUNCTOR_minus2, PL_INTPTR,
qq->mid.charno + 2, /* end of | token */ qq->mid.charno + 2, /* end of | token */
PL_INTPTR, qqend - 2)) /* end minus "|}" */ PL_INTPTR, qqend - 2)) /* end minus "|}" */
@ -865,12 +865,12 @@ case Var_tok:
} }
tnp[2] = tnp[2] =
Yap_GetFromSlot(rd->varnames PASS_REGS); /* Arg 3: the var dictionary */ Yap_GetFromSlot(rd->varnames); /* Arg 3: the var dictionary */
/* Arg 4: the result */ /* Arg 4: the result */
t = ArgOfTerm(4, tn); t = ArgOfTerm(4, tn);
if (!(to = PL_new_term_ref()) || if (!(to = PL_new_term_ref()) ||
!PL_unify_list(rd->qq_tail, to, rd->qq_tail) || !PL_unify_list(rd->qq_tail, to, rd->qq_tail) ||
!PL_unify(to, Yap_InitSlot(tn PASS_REGS))) !PL_unify(to, Yap_InitSlot(tn )))
FAIL; FAIL;
} }
NextToken; NextToken;

107
C/pl-yap.c
View File

@ -72,7 +72,7 @@ codeToAtom(int chrcode)
if ( !(pv=GD->atoms.for_code[page]) ) if ( !(pv=GD->atoms.for_code[page]) )
{ pv = PL_malloc(256*sizeof(atom_t)); { pv = PL_malloc(256*sizeof(atom_t));
memset(pv, 0, 256*sizeof(atom_t)); memset(pv, 0, 256*sizeof(atom_t));
GD->atoms.for_code[page] = pv; GD->atoms.for_code[page] = pv;
} }
@ -83,7 +83,7 @@ codeToAtom(int chrcode)
} else } else
{ a = uncachedCodeToAtom(chrcode); { a = uncachedCodeToAtom(chrcode);
} }
return a; return a;
} }
@ -142,9 +142,9 @@ callProlog(module_t module, term_t goal, int flags, term_t *ex )
fail; fail;
} }
proc = PL_pred(fd, module); proc = PL_pred(fd, module);
{ int arity = arityFunctor(fd); { int arity = arityFunctor(fd);
term_t args = PL_new_term_refs(arity); term_t args = PL_new_term_refs(arity);
qid_t qid; qid_t qid;
@ -196,7 +196,7 @@ PL_qualify(term_t raw, term_t qualified)
if ( !(mname = PL_new_term_ref()) || if ( !(mname = PL_new_term_ref()) ||
!PL_strip_module(raw, &m, qualified) ) !PL_strip_module(raw, &m, qualified) )
return FALSE; return FALSE;
/* modules are terms in YAP */ /* modules are terms in YAP */
Yap_PutInSlot(mname, (Term)m PASS_REGS); Yap_PutInSlot(mname, (Term)m PASS_REGS);
@ -208,7 +208,7 @@ int
valueExpression(term_t t, Number r ARG_LD) valueExpression(term_t t, Number r ARG_LD)
{ {
REGS_FROM_LD REGS_FROM_LD
YAP_Term t0 = Yap_Eval(Yap_GetFromSlot(t PASS_REGS) PASS_REGS); YAP_Term t0 = Yap_Eval(Yap_GetFromSlot(t ) PASS_REGS);
if (YAP_IsIntTerm(t0)) { if (YAP_IsIntTerm(t0)) {
r->type = V_INTEGER; r->type = V_INTEGER;
r->value.i = YAP_IntOfTerm(t0); r->value.i = YAP_IntOfTerm(t0);
@ -263,7 +263,7 @@ double_in_int64_range(double x)
int int
toIntegerNumber(Number n, int flags) toIntegerNumber(Number n, int flags)
{ {
switch(n->type) switch(n->type)
{ case V_INTEGER: { case V_INTEGER:
succeed; succeed;
@ -283,12 +283,12 @@ switch(n->type)
if ( (flags & TOINT_CONVERT_FLOAT) ) if ( (flags & TOINT_CONVERT_FLOAT) )
{ if ( double_in_int64_range(n->value.f) ) { if ( double_in_int64_range(n->value.f) )
{ int64_t l = (int64_t)n->value.f; { int64_t l = (int64_t)n->value.f;
if ( (flags & TOINT_TRUNCATE) || if ( (flags & TOINT_TRUNCATE) ||
(double)l == n->value.f ) (double)l == n->value.f )
{ n->value.i = l; { n->value.i = l;
n->type = V_INTEGER; n->type = V_INTEGER;
return TRUE; return TRUE;
} }
return FALSE; return FALSE;
@ -296,7 +296,7 @@ switch(n->type)
} else } else
{ mpz_init_set_d(n->value.mpz, n->value.f); { mpz_init_set_d(n->value.mpz, n->value.f);
n->type = V_MPZ; n->type = V_MPZ;
return TRUE; return TRUE;
#endif #endif
} }
@ -305,7 +305,7 @@ switch(n->type)
} }
assert(0); assert(0);
fail; fail;
} }
int int
@ -313,15 +313,15 @@ _PL_unify_atomic(term_t t, PL_atomic_t a)
{ {
GET_LD GET_LD
if (IsApplTerm(a) || IsAtomTerm(a)) if (IsApplTerm(a) || IsAtomTerm(a))
return Yap_unify(Yap_GetFromSlot(t PASS_REGS), a); return Yap_unify(Yap_GetFromSlot(t ), a);
return PL_unify_atom(t, a); return PL_unify_atom(t, a);
} }
int int
_PL_unify_string(term_t t, word w) _PL_unify_string(term_t t, word w)
{ {
CACHE_REGS CACHE_REGS
return Yap_unify(Yap_GetFromSlot(t PASS_REGS), w); return Yap_unify(Yap_GetFromSlot(t ), w);
} }
Atom lookupAtom(const char *s, size_t len) Atom lookupAtom(const char *s, size_t len)
@ -395,7 +395,7 @@ typedef union
int int
get_atom_ptr_text(Atom a, PL_chars_t *text) get_atom_ptr_text(Atom a, PL_chars_t *text)
{ {
if (IsWideAtom(a)) { if (IsWideAtom(a)) {
pl_wchar_t *name = (pl_wchar_t *)a->WStrOfAE; pl_wchar_t *name = (pl_wchar_t *)a->WStrOfAE;
text->text.w = name; text->text.w = name;
@ -467,7 +467,7 @@ patch used localeconv() to find the decimal point, but this is both
complicated and not thread-safe. complicated and not thread-safe.
Finally, with help of Richard we decided to replace the first character Finally, with help of Richard we decided to replace the first character
that is not a digit nor [eE], as this must be the decimal point. that is not a digit nor [eE], as this must be the decimal point.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define isDigit(c) ((c) >= '0' && (c) <= '9') #define isDigit(c) ((c) >= '0' && (c) <= '9')
@ -582,7 +582,7 @@ int
priorityOperator(Module m, atom_t atom) priorityOperator(Module m, atom_t atom)
{ {
YAP_Term mod = (YAP_Term)m; YAP_Term mod = (YAP_Term)m;
if (!m) if (!m)
mod = YAP_CurrentModule(); mod = YAP_CurrentModule();
return YAP_MaxOpPriority(YAP_AtomFromSWIAtom(atom), mod); return YAP_MaxOpPriority(YAP_AtomFromSWIAtom(atom), mod);
} }
@ -593,7 +593,7 @@ currentOperator(Module m, atom_t name, int kind, int *type, int *priority)
YAP_Term mod = (YAP_Term)m; YAP_Term mod = (YAP_Term)m;
int opkind, yap_type; int opkind, yap_type;
if (!m) if (!m)
mod = YAP_CurrentModule(); mod = YAP_CurrentModule();
switch (kind) { switch (kind) {
case OP_PREFIX: case OP_PREFIX:
@ -630,7 +630,7 @@ currentOperator(Module m, atom_t name, int kind, int *type, int *priority)
break; break;
case 7: case 7:
*type = OP_FX; *type = OP_FX;
break; break;
default: default:
*type = OP_FY; *type = OP_FY;
break; break;
@ -861,9 +861,9 @@ Yap_TermToString(Term t, char *s, size_t sz, size_t *length, int *encoding, int
Int l; Int l;
Int myASP = LCL0-ASP; Int myASP = LCL0-ASP;
yhandle_t CurSlot = Yap_StartSlots(); yhandle_t CurSlot = Yap_StartSlots();
Yap_StartSlots( ); Yap_StartSlots( );
l = Yap_InitSlot(t PASS_REGS ); l = Yap_InitSlot(t );
{ IOENC encodings[3]; { IOENC encodings[3];
IOENC *enc; IOENC *enc;
@ -874,7 +874,7 @@ Yap_TermToString(Term t, char *s, size_t sz, size_t *length, int *encoding, int
encodings[2] = ENC_UNKNOWN; encodings[2] = ENC_UNKNOWN;
for(enc = encodings; *enc != ENC_UNKNOWN; enc++) for(enc = encodings; *enc != ENC_UNKNOWN; enc++)
{ {
int64_t size; int64_t size;
IOSTREAM *fd; IOSTREAM *fd;
@ -891,10 +891,10 @@ Yap_TermToString(Term t, char *s, size_t sz, size_t *length, int *encoding, int
{ *encoding = *enc; { *encoding = *enc;
size = Stell64(fd); size = Stell64(fd);
if ( *enc == ENC_ISO_LATIN_1 ) if ( *enc == ENC_ISO_LATIN_1 )
{ {
*length = size-1; *length = size-1;
} else } else
{ {
*length = (size/sizeof(pl_wchar_t))-1; *length = (size/sizeof(pl_wchar_t))-1;
} }
/* found, just check if using local space */ /* found, just check if using local space */
@ -935,23 +935,16 @@ Yap_HandleToString(term_t l, size_t sz, size_t *length, int *encoding, int flags
size_t size = 4096, total = size; size_t size = 4096, total = size;
IOSTREAM *fd; IOSTREAM *fd;
total = size; total = size+1;
buf = malloc(total); buf = malloc(total);
#ifdef DEBUG buf[0]='\0';
{CACHE_REGS
__android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "text %p \n", buf);}
#endif
while ( (fd = Sopenmem(&buf, &size, "w")) == NULL || while ( (fd = Sopenmem(&buf, &size, "w")) == NULL ||
(( fd->encoding = ENC_UTF8) && FALSE) || (( fd->encoding = ENC_UTF8) && FALSE) ||
(PL_write_term(fd, l, 1200, flags) == 0) || (PL_write_term(fd, l, 1200, flags) == 0) ||
Sputcode(EOS, fd) < 0 || Sputcode(EOS, fd) < 0 ||
Sflush(fd) < 0 ) /* failure */ Sflush(fd) < 0 ) /* failure */
{ {
#ifdef DEBUG Sclose(fd);
{CACHE_REGS
__android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "fd %p, %x buf=%s\n", fd, LOCAL_SlotBase[28], buf);}
#endif
Sclose(fd);
if (!fd) if (!fd)
return NULL; return NULL;
total += size; total += size;
@ -960,11 +953,7 @@ Yap_HandleToString(term_t l, size_t sz, size_t *length, int *encoding, int flags
return NULL; return NULL;
Sclose(fd); Sclose(fd);
} }
#ifdef DEBUG Sclose(fd);
{CACHE_REGS
__android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "text done %s", buf);}
#endif
Sclose(fd);
/* success */ /* success */
return buf; return buf;
} }
@ -988,9 +977,9 @@ char *
PL_prompt_string(int fd) PL_prompt_string(int fd)
{ if ( fd == 0 ) { if ( fd == 0 )
{ atom_t a = PrologPrompt(); /* TBD: deal with UTF-8 */ { atom_t a = PrologPrompt(); /* TBD: deal with UTF-8 */
if ( a ) if ( a )
{ {
Atom at = YAP_AtomFromSWIAtom(a); Atom at = YAP_AtomFromSWIAtom(a);
if (!IsWideAtom(at) && !IsBlob(at)) { if (!IsWideAtom(at) && !IsBlob(at)) {
return RepAtom(at)->StrOfAE; return RepAtom(at)->StrOfAE;
@ -1082,7 +1071,7 @@ PL_dispatch(int fd, int wait)
X_API int _PL_get_arg__LD(int index, term_t ts, term_t a ARG_LD) X_API int _PL_get_arg__LD(int index, term_t ts, term_t a ARG_LD)
{ {
REGS_FROM_LD REGS_FROM_LD
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS); YAP_Term t = Yap_GetFromSlot(ts);
if ( !YAP_IsApplTerm(t) ) { if ( !YAP_IsApplTerm(t) ) {
if (YAP_IsPairTerm(t)) { if (YAP_IsPairTerm(t)) {
if (index == 1){ if (index == 1){
@ -1098,13 +1087,13 @@ X_API int _PL_get_arg__LD(int index, term_t ts, term_t a ARG_LD)
Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS); Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS);
return 1; return 1;
} }
/* SWI: int PL_get_atom(term_t t, YAP_Atom *a) /* SWI: int PL_get_atom(term_t t, YAP_Atom *a)
YAP: YAP_Atom YAP_AtomOfTerm(Term) */ YAP: YAP_Atom YAP_AtomOfTerm(Term) */
int PL_get_atom__LD(term_t ts, atom_t *a ARG_LD) int PL_get_atom__LD(term_t ts, atom_t *a ARG_LD)
{ {
REGS_FROM_LD REGS_FROM_LD
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS); YAP_Term t = Yap_GetFromSlot(ts);
if ( !IsAtomTerm(t)) if ( !IsAtomTerm(t))
return 0; return 0;
*a = YAP_SWIAtomFromAtom(AtomOfTerm(t)); *a = YAP_SWIAtomFromAtom(AtomOfTerm(t));
@ -1121,61 +1110,61 @@ X_API int PL_put_atom__LD(term_t t, atom_t a ARG_LD)
int PL_put_term__LD(term_t d, term_t s ARG_LD) int PL_put_term__LD(term_t d, term_t s ARG_LD)
{ {
REGS_FROM_LD REGS_FROM_LD
Yap_PutInSlot(d,Yap_GetFromSlot(s PASS_REGS) PASS_REGS); Yap_PutInSlot(d,Yap_GetFromSlot(s) PASS_REGS);
return 1; return 1;
} }
term_t PL_new_term_ref__LD(ARG1_LD) term_t PL_new_term_ref__LD(ARG1_LD)
{ {
REGS_FROM_LD REGS_FROM_LD
term_t to = Yap_NewSlots(1 PASS_REGS); term_t to = Yap_NewSlots(1);
return to; return to;
} }
int PL_is_atom__LD(term_t ts ARG_LD) int PL_is_atom__LD(term_t ts ARG_LD)
{ {
REGS_FROM_LD REGS_FROM_LD
Term t = Yap_GetFromSlot(ts PASS_REGS); Term t = Yap_GetFromSlot(ts);
return !IsVarTerm(t) && IsAtomTerm(t); return !IsVarTerm(t) && IsAtomTerm(t);
} }
int PL_is_variable__LD(term_t ts ARG_LD) int PL_is_variable__LD(term_t ts ARG_LD)
{ {
REGS_FROM_LD REGS_FROM_LD
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS); YAP_Term t = Yap_GetFromSlot(ts);
return IsVarTerm(t); return IsVarTerm(t);
} }
X_API int PL_unify__LD(term_t t1, term_t t2 ARG_LD) X_API int PL_unify__LD(term_t t1, term_t t2 ARG_LD)
{ {
REGS_FROM_LD REGS_FROM_LD
return Yap_unify(Yap_GetFromSlot(t1 PASS_REGS),Yap_GetFromSlot(t2 PASS_REGS)); return Yap_unify(Yap_GetFromSlot(t1),Yap_GetFromSlot(t2));
} }
int PL_unify_atom__LD(term_t t, atom_t at ARG_LD) int PL_unify_atom__LD(term_t t, atom_t at ARG_LD)
{ {
REGS_FROM_LD REGS_FROM_LD
YAP_Term cterm = MkAtomTerm(YAP_AtomFromSWIAtom(at)); YAP_Term cterm = MkAtomTerm(YAP_AtomFromSWIAtom(at));
return YAP_Unify(Yap_GetFromSlot(t PASS_REGS),cterm); return YAP_Unify(Yap_GetFromSlot(t),cterm);
} }
/* SWI: int PL_unify_integer(term_t ?t, long n) /* SWI: int PL_unify_integer(term_t ?t, long n)
YAP long int unify(YAP_Term* a, Term* b) */ YAP long int unify(YAP_Term* a, Term* b) */
int PL_unify_integer__LD(term_t t, intptr_t i ARG_LD) int PL_unify_integer__LD(term_t t, intptr_t i ARG_LD)
{ {
REGS_FROM_LD REGS_FROM_LD
Term iterm = MkIntegerTerm(i); Term iterm = MkIntegerTerm(i);
return Yap_unify(Yap_GetFromSlot(t PASS_REGS),iterm); return Yap_unify(Yap_GetFromSlot(t),iterm);
} }
/* SWI: int PL_unify_integer(term_t ?t, long n) /* SWI: int PL_unify_integer(term_t ?t, long n)
YAP long int unify(YAP_Term* a, Term* b) */ YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_int64__LD(term_t t, int64_t n ARG_LD) X_API int PL_unify_int64__LD(term_t t, int64_t n ARG_LD)
{ {
REGS_FROM_LD REGS_FROM_LD
#if SIZEOF_INT_P==8 #if SIZEOF_INT_P==8
Term iterm = MkIntegerTerm(n); Term iterm = MkIntegerTerm(n);
return Yap_unify(Yap_GetFromSlot(t PASS_REGS),iterm); return Yap_unify(Yap_GetFromSlot(t),iterm);
#elif USE_GMP #elif USE_GMP
YAP_Term iterm; YAP_Term iterm;
char s[64]; char s[64];
@ -1190,7 +1179,7 @@ X_API int PL_unify_int64__LD(term_t t, int64_t n ARG_LD)
#endif #endif
mpz_init_set_str (&rop, s, 10); mpz_init_set_str (&rop, s, 10);
iterm = YAP_MkBigNumTerm((void *)&rop); iterm = YAP_MkBigNumTerm((void *)&rop);
return YAP_Unify(Yap_GetFromSlot(t PASS_REGS),iterm); return YAP_Unify(Yap_GetFromSlot(t),iterm);
#else #else
if ((long)n == n) if ((long)n == n)
return PL_unify_integer(t, n); return PL_unify_integer(t, n);
@ -1238,12 +1227,12 @@ PL_w32thread_raise(DWORD id, int sig)
if ( sig < 0 || sig > MAXSIGNAL ) if ( sig < 0 || sig > MAXSIGNAL )
return FALSE; /* illegal signal */ return FALSE; /* illegal signal */
PL_LOCK(L_PLFLAG); PL_LOCK(L_PLFLAG);
for(i = 0; i <= thread_highest_id; i++) for(i = 0; i <= thread_highest_id; i++)
{ PL_thread_info_t *info = GD->thread.threads[i]; { PL_thread_info_t *info = GD->thread.threads[i];
if ( info && info->w32id == id && info->thread_data ) if ( info && info->w32id == id && info->thread_data )
{ {
Sfprintf(GLOBAL_stderr, "post %d %d\n\n\n",i, sig); Sfprintf(GLOBAL_stderr, "post %d %d\n\n\n",i, sig);
Yap_external_signal(i, sig); //raiseSignal(info->thread_data, sig); Yap_external_signal(i, sig); //raiseSignal(info->thread_data, sig);
if ( info->w32id ) if ( info->w32id )
@ -1254,7 +1243,7 @@ PL_w32thread_raise(DWORD id, int sig)
} }
} }
PL_UNLOCK(L_PLFLAG); PL_UNLOCK(L_PLFLAG);
return FALSE; /* can't find thread */ return FALSE; /* can't find thread */
} }

75
C/qlyr.c
View File

@ -77,14 +77,15 @@ Yap_AlwaysAllocCodeSpace(UInt size)
static void static void
QLYR_ERROR(qlfr_err_t my_err) QLYR_ERROR(qlfr_err_t my_err)
{ {
Yap_Error(SAVED_STATE_ERROR,TermNil,"error %s in saved state %s",GLOBAL_RestoreFile, qlyr_error[my_err]); // __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %s in saved state %s",GLOBAL_RestoreFile, qlyr_error[my_err]);
Yap_Error(SAVED_STATE_ERROR,TermNil,"error %s in saved state %s",GLOBAL_RestoreFile, qlyr_error[my_err]);
Yap_exit(1); Yap_exit(1);
} }
static Atom static Atom
LookupAtom(Atom oat) LookupAtom(Atom oat)
{ {
CACHE_REGS CACHE_REGS
CELL hash = (CELL)(oat) % LOCAL_ImportAtomHashTableSize; CELL hash = (CELL)(oat) % LOCAL_ImportAtomHashTableSize;
import_atom_hash_entry_t *a; import_atom_hash_entry_t *a;
@ -95,6 +96,7 @@ LookupAtom(Atom oat)
} }
a = a->next; a = a->next;
} }
// __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %p in saved state ", oat);
QLYR_ERROR(UNKNOWN_ATOM); QLYR_ERROR(UNKNOWN_ATOM);
return NIL; return NIL;
} }
@ -459,12 +461,12 @@ TermToGlobalOrAtomAdjust(Term t)
#define CharP(X) ((char *)(X)) #define CharP(X) ((char *)(X))
#define REINIT_LOCK(P) #define REINIT_LOCK(P)
#define REINIT_RWLOCK(P) #define REINIT_RWLOCK(P)
#define BlobTypeAdjust(P) (P) #define BlobTypeAdjust(P) (P)
#define NoAGCAtomAdjust(P) (P) #define NoAGCAtomAdjust(P) (P)
#define OrArgAdjust(P) #define OrArgAdjust(P)
#define TabEntryAdjust(P) #define TabEntryAdjust(P)
#define IntegerAdjust(D) (D) #define IntegerAdjust(D) (D)
#define AddrAdjust(P) (P) #define AddrAdjust(P) (P)
#define MFileAdjust(P) (P) #define MFileAdjust(P) (P)
@ -480,8 +482,8 @@ CodeVarAdjust__ (Term var USES_REGS)
#define ConstantAdjust(P) (P) #define ConstantAdjust(P) (P)
#define ArityAdjust(P) (P) #define ArityAdjust(P) (P)
#define DoubleInCodeAdjust(P) #define DoubleInCodeAdjust(P)
#define IntegerInCodeAdjust(Pxb) #define IntegerInCodeAdjust(Pxb)
static inline PredEntry * static inline PredEntry *
PtoPredAdjust(PredEntry *p) PtoPredAdjust(PredEntry *p)
@ -706,7 +708,7 @@ checkChars(IOSTREAM *stream, char s[])
{ {
int ch, c; int ch, c;
char *p = s; char *p = s;
while ((ch = *p++)) { while ((ch = *p++)) {
if ((c = read_byte(stream)) != ch ) { if ((c = read_byte(stream)) != ch ) {
return false; return false;
@ -773,7 +775,7 @@ ReadHash(IOSTREAM *stream)
Atom oat = (Atom)read_UInt(stream); Atom oat = (Atom)read_UInt(stream);
Atom at; Atom at;
qlf_tag_t tg = read_tag(stream); qlf_tag_t tg = read_tag(stream);
if (tg == QLY_ATOM_WIDE) { if (tg == QLY_ATOM_WIDE) {
wchar_t *rep = (wchar_t *)AllocTempSpace(); wchar_t *rep = (wchar_t *)AllocTempSpace();
UInt len; UInt len;
@ -833,7 +835,7 @@ ReadHash(IOSTREAM *stream)
UInt arity = read_UInt(stream); UInt arity = read_UInt(stream);
Atom omod = (Atom)read_UInt(stream); Atom omod = (Atom)read_UInt(stream);
Term mod; Term mod;
if (omod) { if (omod) {
mod = MkAtomTerm(AtomAdjust(omod)); mod = MkAtomTerm(AtomAdjust(omod));
if (mod == TermProlog) mod = 0; if (mod == TermProlog) mod = 0;
@ -889,7 +891,7 @@ ReadHash(IOSTREAM *stream)
UInt nrefs = read_UInt(stream); UInt nrefs = read_UInt(stream);
LogUpdClause *ncl = (LogUpdClause *)Yap_AlwaysAllocCodeSpace(sz); LogUpdClause *ncl = (LogUpdClause *)Yap_AlwaysAllocCodeSpace(sz);
if (!ncl) { if (!ncl) {
QLYR_ERROR(OUT_OF_CODE_SPACE); QLYR_ERROR(OUT_OF_CODE_SPACE);
} }
ncl->Id = FunctorDBRef; ncl->Id = FunctorDBRef;
ncl->ClRefCount = nrefs; ncl->ClRefCount = nrefs;
@ -900,9 +902,9 @@ ReadHash(IOSTREAM *stream)
} }
static void static void
read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) { read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) {
CACHE_REGS CACHE_REGS
if (pp->PredFlags & LogUpdatePredFlag) { if (flags & LogUpdatePredFlag) {
/* first, clean up whatever was there */ /* first, clean up whatever was there */
if (pp->cs.p_code.NOfClauses) { if (pp->cs.p_code.NOfClauses) {
LogUpdClause *cl; LogUpdClause *cl;
@ -934,7 +936,7 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
RestoreLUClause(cl, pp PASS_REGS); RestoreLUClause(cl, pp PASS_REGS);
Yap_AssertzClause(pp, cl->ClCode); Yap_AssertzClause(pp, cl->ClCode);
} }
} else if (pp->PredFlags & MegaClausePredFlag) { } else if (flags & MegaClausePredFlag) {
CACHE_REGS CACHE_REGS
char *base = (void *)read_UInt(stream); char *base = (void *)read_UInt(stream);
UInt mask = read_UInt(stream); UInt mask = read_UInt(stream);
@ -952,26 +954,26 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
cl->ClCode; cl->ClCode;
pp->PredFlags |= MegaClausePredFlag; pp->PredFlags |= MegaClausePredFlag;
/* enter index mode */ /* enter index mode */
if (mask & ExoMask) { if (mask & ExoMask) {
struct index_t **icl = (struct index_t **)(cl->ClCode); struct index_t **icl = (struct index_t **)(cl->ClCode);
pp->OpcodeOfPred = Yap_opcode(_enter_exo); pp->OpcodeOfPred = Yap_opcode(_enter_exo);
icl[0] = NULL; icl[0] = NULL;
icl[1] = NULL; icl[1] = NULL;
} else { } else {
pp->OpcodeOfPred = INDEX_OPCODE; pp->OpcodeOfPred = INDEX_OPCODE;
} }
pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = (yamop *)(&(pp->OpcodeOfPred)); pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = (yamop *)(&(pp->OpcodeOfPred));
/* This must be set for restoremegaclause */ /* This must be set for restoremegaclause */
pp->cs.p_code.NOfClauses = nclauses; pp->cs.p_code.NOfClauses = nclauses;
RestoreMegaClause(cl PASS_REGS); RestoreMegaClause(cl PASS_REGS);
} else if (pp->PredFlags & DynamicPredFlag) { } else if (flags & DynamicPredFlag) {
UInt i; UInt i;
for (i = 0; i < nclauses; i++) { for (i = 0; i < nclauses; i++) {
char *base = (void *)read_UInt(stream); char *base = (void *)read_UInt(stream);
UInt size = read_UInt(stream); UInt size = read_UInt(stream);
DynamicClause *cl = (DynamicClause *)Yap_AlwaysAllocCodeSpace(size); DynamicClause *cl = (DynamicClause *)Yap_AlwaysAllocCodeSpace(size);
LOCAL_HDiff = (char *)cl-base; LOCAL_HDiff = (char *)cl-base;
read_bytes(stream, cl, size); read_bytes(stream, cl, size);
INIT_LOCK(cl->ClLock); INIT_LOCK(cl->ClLock);
@ -983,9 +985,9 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
UInt i; UInt i;
if (pp->PredFlags & SYSTEM_PRED_FLAGS) { if (flags & SYSTEM_PRED_FLAGS) {
if (nclauses) { if (nclauses) {
QLYR_ERROR(INCONSISTENT_CPRED); QLYR_ERROR(INCONSISTENT_CPRED);
} }
return; return;
} }
@ -1005,8 +1007,8 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
static void static void
read_pred(IOSTREAM *stream, Term mod) { read_pred(IOSTREAM *stream, Term mod) {
UInt flags; pred_flags_t flags, fl1;
UInt nclauses, fl1; UInt nclauses;
PredEntry *ap; PredEntry *ap;
ap = LookupPredEntry((PredEntry *)read_UInt(stream)); ap = LookupPredEntry((PredEntry *)read_UInt(stream));
@ -1015,17 +1017,24 @@ read_pred(IOSTREAM *stream, Term mod) {
if (ap->PredFlags & IndexedPredFlag) { if (ap->PredFlags & IndexedPredFlag) {
Yap_RemoveIndexation(ap); Yap_RemoveIndexation(ap);
} }
/* if (ap->ArityOfPE && ap->ModuleOfPred != IDB_MODULE) */ #if 0
if (ap->ArityOfPE && ap->ModuleOfPred != IDB_MODULE)
__android_log_print(ANDROID_LOG_INFO, "YAP ", " %s/%ld %lx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, flags);
/* printf(" %s/%ld %lx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, flags); */ /* printf(" %s/%ld %lx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, flags); */
/* else if (ap->ModuleOfPred != IDB_MODULE) */ else if (ap->ModuleOfPred != IDB_MODULE)
__android_log_print(ANDROID_LOG_INFO, "YAP "," %s/%ld %lx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags);
/* printf(" %s/%ld %lx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags); */ /* printf(" %s/%ld %lx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags); */
fl1 = flags & ((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS); else
__android_log_print(ANDROID_LOG_INFO, "YAP "," number\n");
#endif
fl1 = flags & ((pred_flags_t)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS); ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
ap->PredFlags |= fl1; ap->PredFlags |= fl1;
if (flags & NumberDBPredFlag) { if (flags & NumberDBPredFlag) {
ap->src.IndxId = read_UInt(stream); ap->src.IndxId = read_UInt(stream);
} else { } else {
ap->src.OwnerFile = (Atom)read_UInt(stream); ap->src.OwnerFile = (Atom)read_UInt(stream);
if (ap->src.OwnerFile) { if (ap->src.OwnerFile) {
ap->src.OwnerFile = AtomAdjust(ap->src.OwnerFile); ap->src.OwnerFile = AtomAdjust(ap->src.OwnerFile);
} }
@ -1035,8 +1044,10 @@ read_pred(IOSTREAM *stream, Term mod) {
if (flags & MultiFileFlag && ap->ModuleOfPred == PROLOG_MODULE) { if (flags & MultiFileFlag && ap->ModuleOfPred == PROLOG_MODULE) {
ap->ModuleOfPred = TermProlog; ap->ModuleOfPred = TermProlog;
} }
read_clauses(stream, ap, nclauses, flags); if (nclauses)
if (flags & HiddenPredFlag) { read_clauses(stream, ap, nclauses, flags);
if (flags & HiddenPredFlag) {
Yap_HidePred(ap); Yap_HidePred(ap);
} }
} }
@ -1134,11 +1145,11 @@ p_read_program( USES_REGS1 )
return TRUE; return TRUE;
} }
int int
Yap_Restore(char *s, char *lib_dir) Yap_Restore(char *s, char *lib_dir)
{ {
IOSTREAM *stream = Yap_OpenRestore(s, lib_dir); IOSTREAM *stream = Yap_OpenRestore(s, lib_dir);
if (!stream) if (!stream)
return -1; return -1;
GLOBAL_RestoreFile = s; GLOBAL_RestoreFile = s;
if (get_header( stream ) == NIL) if (get_header( stream ) == NIL)
@ -1146,6 +1157,7 @@ Yap_Restore(char *s, char *lib_dir)
read_module(stream); read_module(stream);
Sclose( stream ); Sclose( stream );
GLOBAL_RestoreFile = NULL; GLOBAL_RestoreFile = NULL;
CurrentModule = USER_MODULE;
return DO_ONLY_CODE; return DO_ONLY_CODE;
} }
@ -1160,4 +1172,3 @@ void Yap_InitQLYR(void)
restore_codes(); restore_codes();
} }
} }

13
C/save.c
View File

@ -249,19 +249,6 @@ open_file(char *my_file, int flag)
char flags[6]; char flags[6];
int i=0; int i=0;
#if __ANDROID__
if (strstr(my_file, "/assets/") == my_file) {
if (flag == O_RDONLY) {
my_file += strlen("/assets/");
AAsset* asset = AAssetManager_open(GLOBAL_assetManager, my_file, AASSET_MODE_UNKNOWN);
if (!asset)
return NULL;
AAsset_close( asset );
return NULL; // usually the file will be compressed, so there is no point in actually trying to open it.
}
return NULL;
}
#endif
if (flag & O_RDONLY) { if (flag & O_RDONLY) {
flags[i++] = 'r'; flags[i++] = 'r';
} }

138
C/stdpreds.c Normal file → Executable file
View File

@ -877,61 +877,69 @@ static Int
return TRUE; return TRUE;
} }
static PropEntry *
fetchPredFromListOfProps (PropEntry *p)
{
while (p) {
if (p->KindOfPE == PEProp) {
// found our baby..
return p;
} else if (p->KindOfPE == FunctorProperty) {
// go to list of properties in functor..
PropEntry *q;
FunctorEntry *f = RepFunctorProp(p);
if ((q = fetchPredFromListOfProps( f->PropsOfFE ))) {
return q;
}
}
p = p->NextOfPE;
}
return NIL;
}
static PropEntry *
nextPredForAtom (PropEntry *p)
{
PredEntry *pe;
if (p == NIL)
return NIL;
pe = RepPredProp(p);
if (pe->ArityOfPE == 0) {
// if atom prop, search atom list
return fetchPredFromListOfProps(p->NextOfPE);
} else {
FunctorEntry *f = pe->FunctorOfPred;
// first search remainder of functor list
if ((p = fetchPredFromListOfProps(p->NextOfPE))) {
return p;
}
// if that fails, follow the functor
return fetchPredFromListOfProps( f->NextOfPE );
}
}
static Int cont_current_predicate(USES_REGS1) { static Int cont_current_predicate(USES_REGS1) {
PredEntry *pp = NULL; PredEntry *pp = NULL;
PropEntry *n;
UInt Arity; UInt Arity;
Term name; Term name;
Term t1 = Deref(ARG1), t2 = Deref(ARG2), t3; Term t1 = Deref(ARG1), t2 = Deref(ARG2), t3;
bool is_det = false, rc; bool rc;
Functor f; Functor f;
if (IsNonVarTerm(t1)) { if (IsNonVarTerm(t1)) {
// current_pred(A, M, P)
PropEntry *p = AddressOfTerm(EXTRA_CBACK_ARG(4, 1)); PropEntry *p = AddressOfTerm(EXTRA_CBACK_ARG(4, 1));
PropEntry *q = AddressOfTerm(EXTRA_CBACK_ARG(4, 2));
// restart inner loop // restart inner loop
for (; q; q = q->NextOfPE) { pp = RepPredProp(p);
if (q->KindOfPE == PEProp) { n = nextPredForAtom (p);
pp = RepPredProp(q); if (n == NIL) {
q = q->NextOfPE; YAP_cut_up();
if (q == NIL) } else {
p = p->NextOfPE; EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(n);
if (!p)
is_det = true;
// we are done with this loop.
break;
}
}
if (!pp && p) {
// try using outer loop
for (; p; p = p->NextOfPE) {
if (p->KindOfPE == PEProp) {
q = NULL;
pp = RepPredProp(p);
p = p->NextOfPE;
if (!p)
is_det = true;
break;
} else if (p->KindOfPE == FunctorProperty) {
// looping on p/n
for (q = RepFunctorProp(p)->PropsOfFE; q; q = q->NextOfPE) {
if (q->KindOfPE == PEProp) {
pp = RepPredProp(q);
q = q->NextOfPE;
if (!q && !p->NextOfPE)
is_det = true;
break;
}
}
break;
}
}
}
if (pp == NULL) // nothing more
cut_fail();
if (!is_det) {
EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(p);
EXTRA_CBACK_ARG(4, 2) = MkAddressTerm(q);
B->cp_h = HR; B->cp_h = HR;
} }
} else if (IsNonVarTerm(t2)) { } else if (IsNonVarTerm(t2)) {
// operating within the same module. // operating within the same module.
@ -945,8 +953,8 @@ static Int cont_current_predicate(USES_REGS1) {
if (npp) { if (npp) {
EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(npp); EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(npp);
B->cp_h = HR; B->cp_h = HR;
} else { } else {
is_det = true; YAP_cut_up();
} }
} else { } else {
pp = AddressOfTerm(EXTRA_CBACK_ARG(4, 1)); pp = AddressOfTerm(EXTRA_CBACK_ARG(4, 1));
@ -964,10 +972,12 @@ static Int cont_current_predicate(USES_REGS1) {
} // we found a new answer } // we found a new answer
if (!pp) if (!pp)
cut_fail(); cut_fail();
else else {
EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(pp->NextPredOfModule); EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(pp->NextPredOfModule);
B->cp_h = HR; B->cp_h = HR;
}
} }
if (pp->ModuleOfPred != IDB_MODULE) { if (pp->ModuleOfPred != IDB_MODULE) {
f = pp->FunctorOfPred; f = pp->FunctorOfPred;
Arity = pp->ArityOfPE; Arity = pp->ArityOfPE;
@ -996,15 +1006,11 @@ static Int cont_current_predicate(USES_REGS1) {
t3 = name; t3 = name;
} }
rc = (!(pp->PredFlags & HiddenPredFlag)) && rc = (!(pp->PredFlags & HiddenPredFlag)) &&
Yap_unify(ARG2, ModToTerm(pp->ModuleOfPred)) && Yap_unify(ARG1, name) && Yap_unify(ARG2, ModToTerm(pp->ModuleOfPred)) &&
Yap_unify(ARG3, t3) && Yap_unify(ARG4, MkIntegerTerm(pp->PredFlags)); Yap_unify(ARG1, name) &&
if (is_det) { Yap_unify(ARG3, t3) &&
if (rc) Yap_unify(ARG4, MkIntegerTerm(pp->PredFlags));
cut_succeed(); return rc;
else
cut_fail();
}
return rc;
} }
static Int init_current_predicate(USES_REGS1) { static Int init_current_predicate(USES_REGS1) {
@ -1015,6 +1021,9 @@ static Int init_current_predicate(USES_REGS1) {
PredEntry *pp = NULL; PredEntry *pp = NULL;
ModEntry *m = NULL; ModEntry *m = NULL;
t1 = Yap_StripModule(t1, &t2);
t3 = Yap_StripModule(t3, &t2);
// check term // check term
if (!IsVarTerm(t3)) { if (!IsVarTerm(t3)) {
t3 = Yap_StripModule(t3, &t2); t3 = Yap_StripModule(t3, &t2);
@ -1076,15 +1085,10 @@ static Int init_current_predicate(USES_REGS1) {
Yap_Error(TYPE_ERROR_ATOM, t1, "current_predicate/2"); Yap_Error(TYPE_ERROR_ATOM, t1, "current_predicate/2");
cut_fail(); cut_fail();
} else { } else {
PropEntry *p = RepAtom(AtomOfTerm(t1))->PropsOfAE, *q = NIL; PropEntry *p = fetchPredFromListOfProps(RepAtom(AtomOfTerm(t1))->PropsOfAE);
while (p && p->KindOfPE == FunctorProperty &&
(q = RepFunctorProp(p)->PropsOfFE) == NIL) {
p = p->NextOfPE;
}
if (!p) if (!p)
cut_fail(); cut_fail();
EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(p); EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(p);
EXTRA_CBACK_ARG(4, 2) = MkAddressTerm(q);
B->cp_h = HR; B->cp_h = HR;
} }
} }
@ -1130,7 +1134,7 @@ int Yap_IsOpMaxPrio(Atom at) {
CACHE_REGS CACHE_REGS
OpEntry *op = NextOp(RepOpProp((Prop)(RepAtom(at)->PropsOfAE)) PASS_REGS); OpEntry *op = NextOp(RepOpProp((Prop)(RepAtom(at)->PropsOfAE)) PASS_REGS);
int max; int max;
if (EndOfPAEntr(op)) if (EndOfPAEntr(op))
return 0; return 0;
max = (op->Prefix & 0xfff); max = (op->Prefix & 0xfff);
@ -1162,7 +1166,7 @@ static Int cont_current_op(USES_REGS1) {
READ_UNLOCK(op->OpRWLock); READ_UNLOCK(op->OpRWLock);
if (next) { if (next) {
EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next); EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next);
B->cp_h = HR; B->cp_h = HR;
return TRUE; return TRUE;
} else { } else {
cut_succeed(); cut_succeed();
@ -1171,7 +1175,7 @@ static Int cont_current_op(USES_REGS1) {
READ_UNLOCK(op->OpRWLock); READ_UNLOCK(op->OpRWLock);
if (next) { if (next) {
EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next); EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next);
B->cp_h = HR; B->cp_h = HR;
return FALSE; return FALSE;
} else { } else {
cut_fail(); cut_fail();
@ -1187,7 +1191,7 @@ static Int init_current_op(USES_REGS1) { /* current_op(-Precedence,-Type,-Atom)
static Int cont_current_atom_op(USES_REGS1) { static Int cont_current_atom_op(USES_REGS1) {
OpEntry *op = (OpEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(5, 1)), *next; OpEntry *op = (OpEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(5, 1)), *next;
READ_LOCK(op->OpRWLock); READ_LOCK(op->OpRWLock);
next = NextOp(RepOpProp(op->NextOfPE) PASS_REGS); next = NextOp(RepOpProp(op->NextOfPE) PASS_REGS);
if (unify_op(op PASS_REGS)) { if (unify_op(op PASS_REGS)) {

467
C/sysbits.c
View File

@ -107,13 +107,14 @@ static char SccsId[] = "%W% %G%";
#include <readline/readline.h> #include <readline/readline.h>
#endif #endif
/// File Error Handler
static void static void
Yap_FileError(yap_error_number type, Term where, const char *format,...) Yap_FileError(yap_error_number type, Term where, const char *format,...)
{ {
GET_LD GET_LD
if ( truePrologFlag(PLFLAG_FILEERRORS) ) { if ( truePrologFlag(PLFLAG_FILEERRORS) ) {
va_list ap; va_list ap;
va_start (ap, format); va_start (ap, format);
/* now build the error string */ /* now build the error string */
Yap_Error(type, TermNil, format, ap); Yap_Error(type, TermNil, format, ap);
@ -123,6 +124,7 @@ Yap_FileError(yap_error_number type, Term where, const char *format,...)
} }
static void InitTime(int); static void InitTime(int);
static void InitWTime(void); static void InitWTime(void);
static Int p_sh( USES_REGS1 ); static Int p_sh( USES_REGS1 );
@ -141,24 +143,6 @@ static int chdir(char *);
/* #define signal skel_signal */ /* #define signal skel_signal */
#endif /* MACYAP */ #endif /* MACYAP */
#if DEBUG
void
LOG(const char *fmt, ...);
void
LOG(const char *fmt, ...)
{
FILE * fd;
va_list ap;
fd = fopen("c:\\cygwin\\Log.txt", "a");
va_start(ap, fmt);
vfprintf(fd, fmt, ap);
va_end(ap);
fclose( fd );
}
#endif
void exit(int); void exit(int);
@ -180,12 +164,118 @@ Yap_WinError(char *yap_error)
#define is_valid_env_char(C) ( ((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && \ #define is_valid_env_char(C) ( ((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && \
(C) <= 'Z') || (C) == '_' ) (C) <= 'Z') || (C) == '_' )
#if __ANDROID__
AAssetManager * Yap_assetManager;
void *
Yap_openAssetFile( const char *path ) {
AAssetDir *d;
LOG("openA %s %p", path, path);
const char * p = path+8;
AAsset* asset = AAssetManager_open(Yap_assetManager, p, AASSET_MODE_UNKNOWN);
return asset;
}
bool
Yap_isAsset( const char *path )
{
return path[0] == '/'&&
path[1] == 'a'&&
path[2] == 's'&&
path[3] == 's'&&
path[4] == 'e'&&
path[5] == 't'&&
path[6] == 's'&&
(path[7] == '/' || path[7] == '\0');
}
bool
Yap_AccessAsset( const char *name, int mode )
{
AAssetManager* mgr = Yap_assetManager;
const char *bufp=name+7;
if (bufp[0] == '/')
bufp++;
if ((mode & W_OK) == W_OK) {
return false;
}
// check if file is a directory.
AAssetDir *assetDir = AAssetManager_openDir(mgr, bufp);
if (assetDir) {
AAssetDir_close(assetDir);
return true;
}
return false;
}
bool
Yap_AssetIsFile( const char *name )
{
AAssetManager* mgr = Yap_assetManager;
const char *bufp=name+7;
if (bufp[0] == '/')
bufp++;
// check if file is a directory.
AAsset *asset = AAssetManager_open(mgr, bufp, AASSET_MODE_UNKNOWN);
if (!asset)
return false;
AAsset_close(asset);
return true;
}
bool
Yap_AssetIsDir( const char *name )
{
AAssetManager* mgr = Yap_assetManager;
const char *bufp=name+7;
if (bufp[0] == '/')
bufp++;
// check if file is a directory.
AAssetDir *assetDir = AAssetManager_openDir(mgr, bufp);
if (!assetDir) {
return false;
}
AAssetDir_close(assetDir);
AAsset *asset = AAssetManager_open(mgr, bufp, AASSET_MODE_UNKNOWN);
if (!asset)
return true;
AAsset_close(asset);
return false;
}
int64_t
Yap_AssetSize( const char *name )
{
AAssetManager* mgr = Yap_assetManager;
const char *bufp=name+7;
if (bufp[0] == '/')
bufp++;
AAsset *asset = AAssetManager_open(mgr, bufp, AASSET_MODE_UNKNOWN);
if (!asset)
return -1;
off64_t len = AAsset_getLength64(asset);
AAsset_close(asset);
return len;
}
#endif
/// is_directory: verifies whether an expanded file name /// is_directory: verifies whether an expanded file name
/// points at a readable directory /// points at a readable directory
static bool static bool
is_directory(const char *FileName) is_directory(const char *FileName)
{ {
#ifdef __ANDROID__
if (Yap_isAsset(FileName)) {
return Yap_AssetIsDir(FileName);
}
#endif
#ifdef __WINDOWS__ #ifdef __WINDOWS__
DWORD dwAtts = GetFileAttributes( FileName ); DWORD dwAtts = GetFileAttributes( FileName );
if (dwAtts == INVALID_FILE_ATTRIBUTES) if (dwAtts == INVALID_FILE_ATTRIBUTES)
@ -200,8 +290,8 @@ is_directory(const char *FileName)
} }
return S_ISDIR(buf.st_mode); return S_ISDIR(buf.st_mode);
#else #else
Yap_Error(SYSTEM_ERROR, TermNil, Yap_Error(SYSTEM_ERROR, TermNil,
"stat not available in this configuration"); "stat not available in this configuration");
return false; return false;
#endif #endif
} }
@ -211,17 +301,22 @@ is_directory(const char *FileName)
static bool static bool
has_access(const char *FileName, int mode) has_access(const char *FileName, int mode)
{ {
#if HAS_ACCESS #ifdef __ANDROID__
if (Yap_isAsset(FileName)) {
return Yap_AccessAsset(FileName, mode);
}
#endif
#if HAVE_ACCESS
if (access( FileName, mode ) == 0) if (access( FileName, mode ) == 0)
return true; return true;
if (errno == EINVAL) { if (errno == EINVAL) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_Error(SYSTEM_ERROR, TermNil,
"bad flags to access"); "bad flags to access");
} }
return false; return false;
#else #else
Yap_Error(SYSTEM_ERROR, TermNil, Yap_Error(SYSTEM_ERROR, TermNil,
"access not available in this configuration"); "access not available in this configuration");
return false; return false;
#endif #endif
} }
@ -269,25 +364,125 @@ IsAbsolutePath(const char *p)
#endif #endif
} }
#define isValidEnvChar(C) ( ((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && \
(C) <= 'Z') || (C) == '_' )
// this is necessary because
// support for ~expansion at the beginning
// systems like Android do not do this.
static char *
yapExpandVars (const char *source, char *result)
{
const char *src = source;
char *res = result;
if (strlen(source) >= YAP_FILENAME_MAX) {
Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "%s in true_file-name is larger than the buffer size (%d bytes)", source, strlen(source));
}
/* step 1: eating home information */
if (source[0] == '~') {
if (dir_separator(source[1]) || source[1] == '\0')
{
char *s;
src++;
#if defined(_WIN32)
s = getenv("HOMEDRIVE");
if (s != NULL)
strncpy (result, getenv ("HOMEDRIVE"), YAP_FILENAME_MAX);
s = getenv("HOMEPATH");
if (s != NULL)
strncpy (result, s, YAP_FILENAME_MAX);
#else
s = getenv ("HOME");
if (s != NULL)
strncpy (result, s, YAP_FILENAME_MAX);
#endif
} else {
#if HAVE_GETPWNAM
struct passwd *user_passwd;
src++;
while (!dir_separator((*res = *src)) && *res != '\0')
res++, src++;
res[0] = '\0';
if ((user_passwd = getpwnam (result)) == NULL) {
Yap_FileError(OPERATING_SYSTEM_ERROR, MkAtomTerm(Yap_LookupAtom(source)),"User %s does not exist in %s", result, source);
return NULL;
}
strncpy (result, user_passwd->pw_dir, YAP_FILENAME_MAX);
#else
Yap_FileError(OPERATING_SYSTEM_ERROR, MkAtomTerm(Yap_LookupAtom(source)),"User %s cannot be found in %s, missing getpwnam", result, source);
return NULL;
#endif
}
strncat (result, src, YAP_FILENAME_MAX);
return result;
}
#if !HAVE_WORDEXP
// do VARIABLE expansion
else if (source[0] == '$') {
/* follow SICStus expansion rules */
int ch;
char *s;
src = source+1;
if (src[0] == '{') {
src++;
while ((*res++ = (ch = *src++)) && isValidEnvChar (ch) && ch != '}') {
res++;
}
if (ch == '}') {
// {...}
// done
}
} else {
while ((*res++ = (ch = *src++)) && isValidEnvChar (ch) && ch != '}') {
res++;
}
src--;
}
res[0] = '\0';
if ((s = (char *) getenv (result))) {
strncpy (result, s, YAP_FILENAME_MAX);
} else {
result[0] = '\0';
}
strncat (result, src, YAP_FILENAME_MAX);
}
#endif
else {
strncpy (result, source, YAP_FILENAME_MAX);
}
return result;
}
char * char *
expandVars(const char *pattern, char *expanded, int maxlen) expandVars(const char *pattern, char *expanded, int maxlen)
{ {
char tmp[YAP_FILENAME_MAX+1];
if ((pattern = yapExpandVars(pattern, tmp)) == NULL) {
return NULL;
}
#if __WIN32 || __MINGW32__ #if __WIN32 || __MINGW32__
DWORD retval=0; DWORD retval=0;
// notice that the file does not need to exist1 // notice that the file does not need to exist1
if (ini == NULL) {
ini = malloc(strlen(w)+1);
}
retval = ExpandEnvironmentStrings(pattern, retval = ExpandEnvironmentStrings(pattern,
expanded, expanded,
maxlen); maxlen);
if (retval == 0) if (retval == 0)
{ {
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 expanded; return expanded;
#elif HAVE_WORDEXP #elif HAVE_WORDEXP
wordexp_t result; wordexp_t result;
/* Expand the string for the program to run. */ /* Expand the string for the program to run. */
switch (wordexp (pattern, &result, 0)) switch (wordexp (pattern, &result, 0))
{ {
@ -297,6 +492,9 @@ wordexp_t result;
return NULL; return NULL;
} else { } else {
char *w = result.we_wordv[0]; char *w = result.we_wordv[0];
if (expanded == NULL) {
expanded = malloc(strlen(w)+1);
}
strncpy( expanded, w, maxlen ); strncpy( expanded, w, maxlen );
wordfree (&result); wordfree (&result);
return expanded; return expanded;
@ -309,8 +507,15 @@ wordexp_t result;
default: /* Some other error. */ default: /* Some other error. */
return NULL; return NULL;
} }
#else
// just use basic
if (expanded == NULL) {
expanded = malloc(strlen(pattern)+1);
}
strcpy(expanded, pattern);
#endif #endif
return NULL; return expanded;
} }
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
@ -378,15 +583,17 @@ PrologPath(const char *p, char *buf, size_t len)
char * char *
OsPath(const char *p, char *buf) OsPath(const char *p, char *buf)
{ strcpy(buf, p); {
if()z
trcpy(buf, p);
return buf; return buf;
} }
#else #else
char * char *
OsPath(const char *X, char *Y) { OsPath(const char *X, char *Y) {
if (X!=Y && Y) strcpy(Y,X); //if (X!=Y && Y) strcpy(Y,X);
return Y; return (char *)X ;
} }
#endif /* O_XOS */ #endif /* O_XOS */
@ -398,10 +605,33 @@ OsPath(const char *X, char *Y) {
bool ChDir(const char *path) { bool ChDir(const char *path) {
bool rc = false; bool rc = false;
char *qpath = AbsoluteFile(path, NULL); char *qpath = AbsoluteFile(path, NULL);
#ifdef __ANDROID__
if (GLOBAL_AssetsWD) {
free( GLOBAL_AssetsWD );
GLOBAL_AssetsWD = NULL;
}
if (Yap_isAsset(qpath) ) {
AAssetManager* mgr = Yap_assetManager;
const char *ptr = qpath+8;
AAssetDir* d;
if (ptr[0] == '/')
ptr++;
d = AAssetManager_openDir(mgr, ptr);
if (d) {
GLOBAL_AssetsWD = malloc( strlen(qpath) + 1 );
strcpy( GLOBAL_AssetsWD, qpath );
AAssetDir_close( d );
return true;
}
return false;
} else {
GLOBAL_AssetsWD = NULL;
}
#endif
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
GET_LD GET_LD
if ((rc = (SetCurrentDirectory(qpath) != 0)) == 0) if ((rc = (SetCurrentDirectory(qpath) != 0)) == 0)
{ {
Yap_WinError("SetCurrentDirectory failed" ); Yap_WinError("SetCurrentDirectory failed" );
@ -415,7 +645,7 @@ bool ChDir(const char *path) {
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
char * char *
BaseName(const char *X) { BaseName(const char *X) {
char *qpath = unix2win(X, NULL, YAP_FILENAME_MAX); char *qpath = unix2win(X, NULL, YAP_FILENAME_MAX);
char base[YAP_FILENAME_MAX], ext[YAP_FILENAME_MAX]; char base[YAP_FILENAME_MAX], ext[YAP_FILENAME_MAX];
_splitpath(qpath, NULL, NULL, base, ext); _splitpath(qpath, NULL, NULL, base, ext);
strcpy(qpath, base); strcpy(qpath, base);
@ -425,16 +655,16 @@ BaseName(const char *X) {
char * char *
DirName(const char *X) { DirName(const char *X) {
char dir[YAP_FILENAME_MAX]; char dir[YAP_FILENAME_MAX];
char drive[YAP_FILENAME_MAX]; char drive[YAP_FILENAME_MAX];
char *o = unix2win(X, NULL, YAP_FILENAME_MAX); char *o = unix2win(X, NULL, YAP_FILENAME_MAX);
int err; int err;
if (!o) if (!o)
return NULL; return NULL;
if (( err = _splitpath_s(o, drive, YAP_FILENAME_MAX-1, dir, YAP_FILENAME_MAX-1,NULL, 0, NULL, 0) ) != 0) { if (( err = _splitpath_s(o, drive, YAP_FILENAME_MAX-1, dir, YAP_FILENAME_MAX-1,NULL, 0, NULL, 0) ) != 0) {
Yap_FileError(OPERATING_SYSTEM_ERROR, TermNil, "could not perform _splitpath %s: %s", X, strerror(errno)); Yap_FileError(OPERATING_SYSTEM_ERROR, TermNil, "could not perform _splitpath %s: %s", X, strerror(errno));
return NULL; return NULL;
} }
strncpy(o, drive, YAP_FILENAME_MAX-1); strncpy(o, drive, YAP_FILENAME_MAX-1);
strncat(o, dir, YAP_FILENAME_MAX-1); strncat(o, dir, YAP_FILENAME_MAX-1);
@ -451,8 +681,8 @@ static char *myrealpath( const char *path, char *out)
YAP_FILENAME_MAX, YAP_FILENAME_MAX,
out, out,
NULL); NULL);
if (retval == 0) if (retval == 0)
{ {
Yap_WinError("Generating a full path name for a file" ); Yap_WinError("Generating a full path name for a file" );
return NULL; return NULL;
@ -462,25 +692,25 @@ static char *myrealpath( const char *path, char *out)
{ {
char *rc = realpath(path,out); char *rc = realpath(path,out);
char *s0; char *s0;
if (rc == NULL && (errno == ENOENT|| errno == EACCES)) { if (rc == NULL && (errno == ENOENT|| errno == EACCES)) {
char *s = basename((char *)path); char *s = basename((char *)path);
s0 = malloc(strlen(s)+1); s0 = malloc(strlen(s)+1);
strcpy(s0, s); strcpy(s0, s);
if ((rc = myrealpath(dirname((char *)path), out))==NULL) { if ((rc = myrealpath(dirname((char *)path), out))==NULL) {
Yap_FileError(OPERATING_SYSTEM_ERROR, TermNil, "could not find file %s: %s", path, strerror(errno)); Yap_FileError(OPERATING_SYSTEM_ERROR, TermNil, "could not find file %s: %s", path, strerror(errno));
return NULL; return NULL;
} }
if(rc[strlen(rc)-1] != '/' ) if(rc[strlen(rc)-1] != '/' )
strcat(rc, "/"); strcat(rc, "/");
strcat(rc, s0); strcat(rc, s0);
free(s0); free(s0);
} }
return rc; return rc;
} }
#else #else
return NULL; return NULL;
#endif #endif
} }
char * char *
@ -488,57 +718,44 @@ char *
{ {
GET_LD GET_LD
char *rc; char *rc;
char *qpath0; #if HAVE_WORDEXP
char o[YAP_FILENAME_MAX+1];
#if _WIN32 || defined(__MINGW32__) #elif _WIN32 || defined(__MINGW32__)
char *o = malloc(YAP_FILENAME_MAX+1); char u[YAP_FILENAME_MAX+1];
if (!o) // first pass, remove Unix style stuff
return NULL; if (unix2win(spec, u, YAP_FILENAME_MAX) == NULL)
// first pass, remove Unix style stuff return NULL;
if (unix2win(spec, o, YAP_FILENAME_MAX) == NULL) spec = (const char *)u;
return NULL; #endif
spec = (const char *)o;
#endif
if (tmp == NULL) { if (tmp == NULL) {
tmp = malloc(YAP_FILENAME_MAX+1); tmp = malloc(YAP_FILENAME_MAX+1);
if (tmp == NULL) { if (tmp == NULL) {
return NULL; return NULL;
} }
} }
if ( truePrologFlag(PLFLAG_FILEVARS) ) if ( truePrologFlag(PLFLAG_FILEVARS) )
{ {
qpath0 = malloc(YAP_FILENAME_MAX+1); #if HAVE_WORDEXP
#if HAVE_WORDEXP spec=expandVars(spec,o,YAP_FILENAME_MAX);
qpath0=expandVars(spec,qpath0,YAP_FILENAME_MAX);
#endif #endif
#if _WIN32 || defined(__MINGW32__)
free((char *)spec);
#endif
spec = qpath0;
} }
#if HAVE_REALPATH #if HAVE_REALPATH
rc = myrealpath(spec, tmp); rc = myrealpath(spec, tmp);
#endif #endif
if (spec == qpath0
#if _WIN32 || defined(__MINGW32__)
|| true
#endif
)
free((char *)spec);
return rc; return rc;
} }
char *canoniseFileName( char *path) { char *canoniseFileName( char *path) {
#if HAVE_REALPATH && HAVE_BASENAME #if HAVE_REALPATH && HAVE_BASENAME
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
char *o = malloc(YAP_FILENAME_MAX+1); char *o = malloc(YAP_FILENAME_MAX+1);
if (!o) if (!o)
return NULL; return NULL;
// first pass, remove Unix style stuff // first pass, remove Unix style stuff
if (unix2win(path, o, YAP_FILENAME_MAX) == NULL) if (unix2win(path, o, YAP_FILENAME_MAX) == NULL)
return NULL; return NULL;
path = o; path = o;
#endif #endif
char *rc, *tmp = malloc(PATH_MAX); char *rc, *tmp = malloc(PATH_MAX);
if (tmp == NULL) return NULL; if (tmp == NULL) return NULL;
rc = myrealpath(path, tmp); rc = myrealpath(path, tmp);
@ -882,7 +1099,7 @@ void Yap_systime_interval(Int *now,Int *interval)
The problem is that mingw32 does not seem to have acces to div */ The problem is that mingw32 does not seem to have acces to div */
#ifndef do_div #ifndef do_div
#define do_div(n,base) ({ \ #define do_div(n,base) ({ \
unsigned long __upper, __low, __high, __mod; \ unsigned long __upper, __low, __high, __mod; \
asm("":"=a" (__low), "=d" (__high):"A" (n)); \ asm("":"=a" (__low), "=d" (__high):"A" (n)); \
__upper = __high; \ __upper = __high; \
if (__high) { \ if (__high) { \
@ -1492,8 +1709,8 @@ Yap_random (void)
#elif HAVE_RAND #elif HAVE_RAND
return (((double) (rand ()) / RAND_MAX)); return (((double) (rand ()) / RAND_MAX));
#else #else
Yap_Error(SYSTEM_ERROR, TermNil, Yap_Error(SYSTEM_ERROR, TermNil,
"random not available in this configuration"); "random not available in this configuration");
return (0.0); return (0.0);
#endif #endif
} }
@ -2035,7 +2252,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
} }
#endif #endif
/* SIGINT can cause problems, if caught before full initialization */ /* SIGINT can cause problems, if caught before full initialization */
static void static void
InitSignals (void) InitSignals (void)
@ -2103,11 +2320,11 @@ Yap_volume_header(char *file)
char * PL_cwd(char *cwd, size_t cwdlen) char * PL_cwd(char *cwd, size_t cwdlen)
{ {
return Yap_getcwd( cwd, cwdlen ); return (char *)Yap_getcwd( (const char *)cwd, cwdlen );
} }
char * Yap_getcwd(const char *cwd, size_t cwdlen) const char * Yap_getcwd(const char *cwd, size_t cwdlen)
{ {
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
if (GetCurrentDirectory(cwdlen, (char *)cwd) == 0) if (GetCurrentDirectory(cwdlen, (char *)cwd) == 0)
{ {
@ -2116,7 +2333,13 @@ Yap_volume_header(char *file)
} }
return (char *)cwd; return (char *)cwd;
#else #else
return getcwd(cwd, cwdlen); #if __ANDROID__
if (GLOBAL_AssetsWD) {
return strncpy( (char *)cwd, (const char *)GLOBAL_AssetsWD, cwdlen);
}
#endif
return getcwd((char *)cwd, cwdlen);
#endif #endif
} }
@ -2126,15 +2349,16 @@ Yap_volume_header(char *file)
{ {
char *work; char *work;
char ares1[YAP_FILENAME_MAX+1]; char ares1[YAP_FILENAME_MAX+1];
work = expandVars( source, ares1, YAP_FILENAME_MAX);
// expand names first work = expandVars( source, ares1, YAP_FILENAME_MAX);
if (root && !IsAbsolutePath( source ) ) { // expand names first
char ares2[YAP_FILENAME_MAX+1]; if (root && !IsAbsolutePath( source ) ) {
strncpy( ares2, root, YAP_FILENAME_MAX ); char ares2[YAP_FILENAME_MAX+1];
strncat( ares2, "/", YAP_FILENAME_MAX ); strncpy( ares2, root, YAP_FILENAME_MAX );
strncat( ares2, work, YAP_FILENAME_MAX ); strncat( ares2, "/", YAP_FILENAME_MAX );
return AbsoluteFile( ares2, result ); strncat( ares2, work, YAP_FILENAME_MAX );
return AbsoluteFile( ares2, result );
} else { } else {
// expand path // expand path
return myrealpath( work, result); return myrealpath( work, result);
@ -2146,25 +2370,24 @@ Yap_volume_header(char *file)
TrueFileName (char *isource, char *root, char *result, int in_lib, int expand_root) TrueFileName (char *isource, char *root, char *result, int in_lib, int expand_root)
{ {
CACHE_REGS CACHE_REGS
char *work; char *work;
const char *source = isource; const char *source = isource;
// expand names in case you have // expand names in case you have
// to add a prefix // to add a prefix
if (!expand_root) if (!expand_root)
root = NULL; root = NULL;
if (exists((work = expandWithPrefix( source, root, result )))) if (exists((work = expandWithPrefix( source, root, result ))))
return true; // done return true; // done
if (in_lib) { if (in_lib) {
if (Yap_LibDir != NULL) { if (Yap_LibDir != NULL) {
strncpy(LOCAL_FileNameBuf, Yap_LibDir, YAP_FILENAME_MAX); strncpy(LOCAL_FileNameBuf, Yap_LibDir, YAP_FILENAME_MAX);
} }
#if HAVE_GETENV #if HAVE_GETENV
{ {
char *yap_env = getenv("YAPLIBDIR"); char *yap_env = getenv("YAPLIBDIR");
if (yap_env && if (yap_env && exists((work = expandWithPrefix( source, yap_env, result ))))
exists((work = expandWithPrefix( source, yap_env, result ))))
return true; // done return true; // done
} }
#endif #endif
@ -2181,7 +2404,7 @@ TrueFileName (char *isource, char *root, char *result, int in_lib, int expand_ro
} }
return false; return false;
} }
int int
Yap_TrueFileName (char *source, char *result, int in_lib) Yap_TrueFileName (char *source, char *result, int in_lib)
{ {
@ -2287,14 +2510,14 @@ p_sh ( USES_REGS1 )
/** shell(+Command:text, -Status:integer) is det. /** shell(+Command:text, -Status:integer) is det.
Run an external command and wait for its completion. Run an external command and wait for its completion.
*/ */
static Int static Int
p_shell ( USES_REGS1 ) p_shell ( USES_REGS1 )
{ /* '$shell'(+SystCommand) */ { /* '$shell'(+SystCommand) */
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
char *cmd; char *cmd;
term_t A1 = Yap_InitSlot(ARG1 PASS_REGS); term_t A1 = Yap_InitSlot(ARG1);
if ( PL_get_chars(A1, &cmd, CVT_ALL|REP_FN|CVT_EXCEPTION) ) if ( PL_get_chars(A1, &cmd, CVT_ALL|REP_FN|CVT_EXCEPTION) )
{ int rval = System(cmd); { int rval = System(cmd);
@ -2373,7 +2596,7 @@ p_system ( USES_REGS1 )
{ /* '$system'(+SystCommand) */ { /* '$system'(+SystCommand) */
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
char *cmd; char *cmd;
term_t A1 = Yap_InitSlot(ARG1 PASS_REGS); term_t A1 = Yap_InitSlot(ARG1);
if ( PL_get_chars(A1, &cmd, CVT_ALL|REP_FN|CVT_EXCEPTION) ) if ( PL_get_chars(A1, &cmd, CVT_ALL|REP_FN|CVT_EXCEPTION) )
{ STARTUPINFO si; { STARTUPINFO si;
PROCESS_INFORMATION pi; PROCESS_INFORMATION pi;
@ -2745,7 +2968,7 @@ p_virtual_alarm( USES_REGS1 )
Yap_Error(INSTANTIATION_ERROR, t, "alarm/2"); Yap_Error(INSTANTIATION_ERROR, t, "alarm/2");
return(FALSE); return(FALSE);
} }
if (!IsIntegerTerm(t)) { if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER, t, "alarm/2"); Yap_Error(TYPE_ERROR_INTEGER, t, "alarm/2");
return(FALSE); return(FALSE);
} }
@ -2935,11 +3158,7 @@ p_yap_paths( USES_REGS1 ) {
strncat(destdir, "/" YAP_SHAREDIR, YAP_FILENAME_MAX ); strncat(destdir, "/" YAP_SHAREDIR, YAP_FILENAME_MAX );
out2 = MkAtomTerm(Yap_LookupAtom(destdir)); out2 = MkAtomTerm(Yap_LookupAtom(destdir));
} else { } else {
#if __ANDROID__
out2 = MkAtomTerm(Yap_LookupAtom("/assets/share/Yap"));
#else
out2 = MkAtomTerm(Yap_LookupAtom(YAP_SHAREDIR)); out2 = MkAtomTerm(Yap_LookupAtom(YAP_SHAREDIR));
#endif
} }
if (env_destdir) { if (env_destdir) {
strncat(destdir, env_destdir, YAP_FILENAME_MAX ); strncat(destdir, env_destdir, YAP_FILENAME_MAX );
@ -2973,9 +3192,7 @@ p_log_event( USES_REGS1 ) {
#endif #endif
if (IsWideAtom(at) || IsBlob(at)) if (IsWideAtom(at) || IsBlob(at))
return FALSE; return FALSE;
#if __ANDROID__ LOG( " %s ",RepAtom(at)->StrOfAE);
__android_log_print(ANDROID_LOG_INFO, "YAP", " %s ",RepAtom(at)->StrOfAE);
#endif
return TRUE; return TRUE;
} }

73
C/text.c
View File

@ -89,7 +89,7 @@ get_string_from_list( Term t, seq_tv_t *inp, char *s, int atoms USES_REGS)
int i = RepAtom(at)->WStrOfAE[0]; int i = RepAtom(at)->WStrOfAE[0];
if (i <= 0) { if (i <= 0) {
LOCAL_Error_TYPE = REPRESENTATION_ERROR_CHARACTER_CODE; LOCAL_Error_TYPE = REPRESENTATION_ERROR_CHARACTER_CODE;
return NULL; return NULL;
} }
*s++ = i; *s++ = i;
} else } else
@ -105,7 +105,7 @@ get_string_from_list( Term t, seq_tv_t *inp, char *s, int atoms USES_REGS)
Int i = IntOfTerm(HeadOfTerm(t)); Int i = IntOfTerm(HeadOfTerm(t));
if (i <= 0 || i > 255) { if (i <= 0 || i > 255) {
LOCAL_Error_TYPE = REPRESENTATION_ERROR_CHARACTER_CODE; LOCAL_Error_TYPE = REPRESENTATION_ERROR_CHARACTER_CODE;
return NULL; return NULL;
} }
*s++ = i; *s++ = i;
if (--max == 0) { if (--max == 0) {
@ -165,7 +165,7 @@ get_wide_from_list( Term t, seq_tv_t *inp, wchar_t *s, int atoms USES_REGS)
*s++ = code = IntOfTerm(HeadOfTerm(t)); *s++ = code = IntOfTerm(HeadOfTerm(t));
if (code <= 0) { if (code <= 0) {
LOCAL_Error_TYPE = REPRESENTATION_ERROR_CHARACTER_CODE; LOCAL_Error_TYPE = REPRESENTATION_ERROR_CHARACTER_CODE;
return NULL; return NULL;
} }
if (--max == 0) { if (--max == 0) {
*s++ = 0; *s++ = 0;
@ -232,7 +232,7 @@ SkipListCodes(Term *l, Term **tailp, Int *atoms, int *wide)
return length; return length;
} }
} }
l = RepPair(*l)+1; l = RepPair(*l)+1;
do_derefa(v,l,derefa2_unk,derefa2_nonvar); do_derefa(v,l,derefa2_unk,derefa2_nonvar);
} while ( *l != *s && IsPairTerm(*l) ); } while ( *l != *s && IsPairTerm(*l) );
} }
@ -370,7 +370,7 @@ Yap_ListToBuffer(void *buf, Term t, seq_tv_t *inp, int *widep, size_t *lenp USES
} }
} }
static yap_error_number static yap_error_number
gen_type_error(int flags) { gen_type_error(int flags) {
if ((flags & (YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_ATOMS_CODES|YAP_STRING_BIG)) == if ((flags & (YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_ATOMS_CODES|YAP_STRING_BIG)) ==
(YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_ATOMS_CODES|YAP_STRING_BIG)) (YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_ATOMS_CODES|YAP_STRING_BIG))
@ -378,7 +378,7 @@ gen_type_error(int flags) {
if ((flags & (YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG)) == if ((flags & (YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG)) ==
(YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG)) (YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG))
return TYPE_ERROR_ATOMIC; return TYPE_ERROR_ATOMIC;
if ((flags & (YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG)) == if ((flags & (YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG)) ==
(YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG)) (YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG))
return TYPE_ERROR_NUMBER; return TYPE_ERROR_NUMBER;
if (flags & YAP_STRING_ATOM ) if (flags & YAP_STRING_ATOM )
@ -403,12 +403,12 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
if (IsVarTerm(inp->val.t)) { if (IsVarTerm(inp->val.t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = inp->val.t; LOCAL_Error_Term = inp->val.t;
return 0L; return 0L;
} }
if (!IsStringTerm(inp->val.t)) { if (!IsStringTerm(inp->val.t)) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING; LOCAL_Error_TYPE = TYPE_ERROR_STRING;
LOCAL_Error_Term = inp->val.t; LOCAL_Error_Term = inp->val.t;
return 0L; return 0L;
} }
s = StringOfTerm( inp->val.t ); s = StringOfTerm( inp->val.t );
if ( s == NULL ) { if ( s == NULL ) {
@ -461,11 +461,11 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
if (IsVarTerm(inp->val.t)) { if (IsVarTerm(inp->val.t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = inp->val.t; LOCAL_Error_Term = inp->val.t;
return 0L; return 0L;
} else if (!IsAtomTerm(inp->val.t)) { } else if (!IsAtomTerm(inp->val.t)) {
LOCAL_Error_TYPE = TYPE_ERROR_ATOM; LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
LOCAL_Error_Term = inp->val.t; LOCAL_Error_Term = inp->val.t;
return NULL; return NULL;
} else { } else {
Atom at = AtomOfTerm(inp->val.t); Atom at = AtomOfTerm(inp->val.t);
if (IsWideAtom(at)) { if (IsWideAtom(at)) {
@ -527,7 +527,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
*lengp = wcslen(inp->val.w); *lengp = wcslen(inp->val.w);
return (void *)inp->val.w; return (void *)inp->val.w;
case YAP_STRING_LITERAL: case YAP_STRING_LITERAL:
{ {
yhandle_t CurSlot = Yap_StartSlots( ); yhandle_t CurSlot = Yap_StartSlots( );
if (buf) s = buf; if (buf) s = buf;
else s = Yap_PreAllocCodeSpace(); else s = Yap_PreAllocCodeSpace();
@ -537,7 +537,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
CurSlot = Yap_StartSlots(); CurSlot = Yap_StartSlots();
fd = Sopenmem(&s, &sz, "w"); fd = Sopenmem(&s, &sz, "w");
fd->encoding = ENC_UTF8; fd->encoding = ENC_UTF8;
if ( ! PL_write_term(fd, Yap_InitSlot(inp->val.t PASS_REGS), 1200, 0) || if ( ! PL_write_term(fd, Yap_InitSlot(inp->val.t), 1200, 0) ||
Sputcode(EOS, fd) < 0 || Sputcode(EOS, fd) < 0 ||
Sflush(fd) < 0 ) { Sflush(fd) < 0 ) {
AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char); AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char);
@ -563,7 +563,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
} else { } else {
LOCAL_Error_TYPE = gen_type_error( inp->type ); LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t; LOCAL_Error_Term = t;
} }
} else if (IsPairTerm(t) ) { } else if (IsPairTerm(t) ) {
if (inp->type & (YAP_STRING_CODES|YAP_STRING_ATOMS)) { if (inp->type & (YAP_STRING_CODES|YAP_STRING_ATOMS)) {
inp->type &= (YAP_STRING_CODES|YAP_STRING_ATOMS); inp->type &= (YAP_STRING_CODES|YAP_STRING_ATOMS);
@ -584,7 +584,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
} else { } else {
LOCAL_Error_TYPE = gen_type_error( inp->type ); LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t; LOCAL_Error_Term = t;
} }
} else if (IsIntegerTerm(t)) { } else if (IsIntegerTerm(t)) {
if (inp->type & (YAP_STRING_INT)) { if (inp->type & (YAP_STRING_INT)) {
inp->type &= (YAP_STRING_INT); inp->type &= (YAP_STRING_INT);
@ -593,7 +593,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
} else { } else {
LOCAL_Error_TYPE = gen_type_error( inp->type ); LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t; LOCAL_Error_Term = t;
} }
} else if (IsFloatTerm(t)) { } else if (IsFloatTerm(t)) {
if (inp->type & (YAP_STRING_FLOAT)) { if (inp->type & (YAP_STRING_FLOAT)) {
inp->type &= (YAP_STRING_FLOAT); inp->type &= (YAP_STRING_FLOAT);
@ -602,7 +602,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
} else { } else {
LOCAL_Error_TYPE = gen_type_error( inp->type ); LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t; LOCAL_Error_Term = t;
} }
#if USE_GMP #if USE_GMP
} else if (IsBigIntTerm(t)) { } else if (IsBigIntTerm(t)) {
if (inp->type & (YAP_STRING_BIG)) { if (inp->type & (YAP_STRING_BIG)) {
@ -612,7 +612,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
} else { } else {
LOCAL_Error_TYPE = gen_type_error( inp->type ); LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t; LOCAL_Error_Term = t;
} }
#endif #endif
} else { } else {
if (!Yap_IsGroundTerm(t)) { if (!Yap_IsGroundTerm(t)) {
@ -652,7 +652,7 @@ write_strings( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng
max++; max++;
buf = utf8_put_char(buf, '\0'); buf = utf8_put_char(buf, '\0');
} }
close_tstring( buf PASS_REGS ); close_tstring( buf PASS_REGS );
out->val.t = t; out->val.t = t;
} }
@ -730,7 +730,7 @@ write_atoms( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
int chr; int chr;
CELL *cl; CELL *cl;
cp = utf8_get_char(cp, &chr); cp = utf8_get_char(cp, &chr);
if (chr == '\0') break; if (chr == '\0') break;
w[0] = chr; w[0] = chr;
cl = HR; cl = HR;
HR += 2; HR += 2;
@ -787,7 +787,7 @@ write_atoms( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
} else { } else {
if (sz == 0) t = TermNil; if (sz == 0) t = TermNil;
else HR[-1] = TermNil; else HR[-1] = TermNil;
} }
out->val.t = t; out->val.t = t;
return (t); return (t);
} }
@ -864,7 +864,7 @@ write_codes( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
} else { } else {
if (sz == 0) t = TermNil; if (sz == 0) t = TermNil;
else HR[-1] = TermNil; else HR[-1] = TermNil;
} }
out->val.t = t; out->val.t = t;
return (t); return (t);
} }
@ -877,7 +877,7 @@ write_atom( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng US
if (out->type & (YAP_STRING_NCHARS|YAP_STRING_TRUNC)) { if (out->type & (YAP_STRING_NCHARS|YAP_STRING_TRUNC)) {
if (out->type & YAP_STRING_TRUNC && out->max < max) max = out->max; if (out->type & YAP_STRING_TRUNC && out->max < max) max = out->max;
} }
switch (enc) { switch (enc) {
case YAP_UTF8: case YAP_UTF8:
{ char *s = s0, *lim = s + strnlen(s, max); { char *s = s0, *lim = s + strnlen(s, max);
@ -921,7 +921,7 @@ static ssize_t
write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS) write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS)
{ {
size_t max = -1; size_t max = -1;
if (out->type & (YAP_STRING_NCHARS|YAP_STRING_TRUNC)) { if (out->type & (YAP_STRING_NCHARS|YAP_STRING_TRUNC)) {
if (out->type & YAP_STRING_NCHARS && out->sz != (size_t)-1) return out->sz; if (out->type & YAP_STRING_NCHARS && out->sz != (size_t)-1) return out->sz;
if (out->type & YAP_STRING_TRUNC) max = out->max; if (out->type & YAP_STRING_TRUNC) max = out->max;
@ -955,7 +955,7 @@ write_number( void *s0, seq_tv_t *out, encoding_t enc, int minimal, int size USE
char *s = s0; char *s = s0;
Term t = 0L; Term t = 0L;
if ( (st=Sopenmem( &s, NULL, "r")) != NULL ) if ( (st=Sopenmem( &s, NULL, "r")) != NULL )
{ {
if (enc == YAP_UTF8) if (enc == YAP_UTF8)
st->encoding = ENC_UTF8; st->encoding = ENC_UTF8;
else if (enc == YAP_WCHAR) else if (enc == YAP_WCHAR)
@ -1005,7 +1005,7 @@ write_term( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng US
size_t len = out->sz; size_t len = out->sz;
Term t = 0L; Term t = 0L;
if ( (st=Sopenmem( s0, &len, "r")) ) if ( (st=Sopenmem( s0, &len, "r")) )
{ {
if (enc == YAP_UTF8) if (enc == YAP_UTF8)
st->encoding = ENC_UTF8; st->encoding = ENC_UTF8;
else if (enc == YAP_WCHAR) else if (enc == YAP_WCHAR)
@ -1030,7 +1030,7 @@ write_Text( void *inp, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
case YAP_STRING_ATOMS: case YAP_STRING_ATOMS:
out->val.t = out->val.t =
write_atoms( inp, out, enc, minimal, leng PASS_REGS); write_atoms( inp, out, enc, minimal, leng PASS_REGS);
return out->val.t != 0; return out->val.t != 0;
case YAP_STRING_CODES: case YAP_STRING_CODES:
out->val.t = out->val.t =
write_codes( inp, out, enc, minimal, leng PASS_REGS); write_codes( inp, out, enc, minimal, leng PASS_REGS);
@ -1042,13 +1042,13 @@ write_Text( void *inp, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
case YAP_STRING_ATOM: case YAP_STRING_ATOM:
out->val.a = out->val.a =
write_atom( inp, out, enc, minimal, leng PASS_REGS); write_atom( inp, out, enc, minimal, leng PASS_REGS);
return out->val.a != NULL; return out->val.a != NULL;
case YAP_STRING_INT: case YAP_STRING_INT:
case YAP_STRING_FLOAT: case YAP_STRING_FLOAT:
case YAP_STRING_BIG: case YAP_STRING_BIG:
out->val.t = out->val.t =
write_number( inp, out, enc, minimal, leng PASS_REGS); write_number( inp, out, enc, minimal, leng PASS_REGS);
return out->val.t != 0; return out->val.t != 0;
case YAP_STRING_CHARS: case YAP_STRING_CHARS:
out->val.c = inp; out->val.c = inp;
return 1; return 1;
@ -1163,14 +1163,14 @@ cmp_Text( void *s1, void *s2, int l, encoding_t enc1, encoding_t enc2 )
char *w2 = s2; char *w2 = s2;
for (i = 0; i < l; i++) { chr2 = *w2++; w1 = utf8_get_char(w1, &chr1); if (chr1-chr2) return chr1-chr2; } for (i = 0; i < l; i++) { chr2 = *w2++; w1 = utf8_get_char(w1, &chr1); if (chr1-chr2) return chr1-chr2; }
} }
return 0; return 0;
case YAP_UTF8: case YAP_UTF8:
{ {
int chr1, chr2; int chr1, chr2;
char *w2 = s2; char *w2 = s2;
for (i = 0; i < l; i++) { w2 = utf8_get_char(w2, &chr2); w1 = utf8_get_char(w1, &chr1); if (chr1-chr2) return chr1-chr2; } for (i = 0; i < l; i++) { w2 = utf8_get_char(w2, &chr2); w1 = utf8_get_char(w1, &chr1); if (chr1-chr2) return chr1-chr2; }
} }
return 0; return 0;
case YAP_WCHAR: case YAP_WCHAR:
{ {
int chr1, chr2; int chr1, chr2;
@ -1179,7 +1179,7 @@ cmp_Text( void *s1, void *s2, int l, encoding_t enc1, encoding_t enc2 )
} }
return 0; return 0;
} }
} }
case YAP_WCHAR: case YAP_WCHAR:
{ {
wchar_t *w1 = (wchar_t *)s1; wchar_t *w1 = (wchar_t *)s1;
@ -1330,7 +1330,7 @@ slice( size_t min, size_t max, void *buf, seq_tv_t *out, encoding_t enc USES_REG
} else if (enc == YAP_CHAR) { } else if (enc == YAP_CHAR) {
/* atom */ /* atom */
char *nbuf = (char *)HR; char *nbuf = (char *)HR;
if (max>min) { if (max>min) {
Term t = TermNil; Term t = TermNil;
char *ptr = (char *)buf + min; char *ptr = (char *)buf + min;
@ -1377,7 +1377,7 @@ Yap_Concat_Text( int n, seq_tv_t inp[], seq_tv_t *out USES_REGS)
buf = NULL; buf = NULL;
for (i = 0 ; i < n ; i++) { for (i = 0 ; i < n ; i++) {
void *nbuf = read_Text( buf, inp+i, encv+i, &minimal, &leng PASS_REGS ); void *nbuf = read_Text( buf, inp+i, encv+i, &minimal, &leng PASS_REGS );
if (!nbuf) if (!nbuf)
return 0L; return 0L;
bufv[i] = nbuf; bufv[i] = nbuf;
@ -1391,8 +1391,8 @@ Yap_Concat_Text( int n, seq_tv_t inp[], seq_tv_t *out USES_REGS)
return buf; return buf;
} }
// //
// out must be an atom or a string // out must be an atom or a string
void * void *
Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, encoding_t encv[], seq_tv_t outv[] USES_REGS) Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, encoding_t encv[], seq_tv_t outv[] USES_REGS)
{ {
@ -1442,7 +1442,7 @@ Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, encoding_t encv[], seq_tv
return NULL; return NULL;
l1 = write_length( buf1, outv+1, enc1, minimal1, leng1 PASS_REGS); l1 = write_length( buf1, outv+1, enc1, minimal1, leng1 PASS_REGS);
if (l < l1) return NULL; if (l < l1) return NULL;
l0 = l-l1; l0 = l-l1;
if (cmp_Text( advance_Text(buf, l0, enc), buf1, l1, enc, enc1) != 0) if (cmp_Text( advance_Text(buf, l0, enc), buf1, l1, enc, enc1) != 0)
return NULL; return NULL;
buf0 = slice(0, l0, buf, outv, enc PASS_REGS); buf0 = slice(0, l0, buf, outv, enc PASS_REGS);
@ -1463,4 +1463,3 @@ Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, encoding_t encv[], seq_tv
} }
return (void *)outv;; return (void *)outv;;
} }

14
C/tracer.c
View File

@ -144,6 +144,20 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
Int arity; Int arity;
/* extern int gc_calls; */ /* extern int gc_calls; */
vsc_count++; vsc_count++;
#if __ANDROID__
PredEntry *ap = pred;
if (pred && port == enter_pred) {
UInt flags = ap->PredFlags;
if (ap->ArityOfPE && ap->ModuleOfPred != IDB_MODULE)
__android_log_print(ANDROID_LOG_INFO, "YAP ", " %s/%ld %lx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, flags);
/* printf(" %s/%ld %lx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, flags); */
else if (ap->ModuleOfPred != IDB_MODULE)
__android_log_print(ANDROID_LOG_INFO, "YAP "," %s/%ld %lx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags);
/* printf(" %s/%ld %lx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags); */
__android_log_print(ANDROID_LOG_INFO, "YAP "," %x ", ap->src.OwnerFile);
}
return;
#endif
// if (!worker_id) return; // if (!worker_id) return;
LOCK(Yap_heap_regs->low_level_trace_lock); LOCK(Yap_heap_regs->low_level_trace_lock);

6
C/write.c
View File

@ -694,8 +694,8 @@ static Term from_pointer(CELL *ptr0, struct rewind_term *rwt,
if (wglb->Keep_terms) { if (wglb->Keep_terms) {
struct rewind_term *x = rwt->parent; struct rewind_term *x = rwt->parent;
rwt->u_sd.s.old = Yap_InitSlot(t PASS_REGS); rwt->u_sd.s.old = Yap_InitSlot(t);
rwt->u_sd.s.ptr = Yap_InitSlot((CELL)ptr0 PASS_REGS); rwt->u_sd.s.ptr = Yap_InitSlot((CELL)ptr0);
if (!IsAtomicTerm(t) && !IsVarTerm(t)) { if (!IsAtomicTerm(t) && !IsVarTerm(t)) {
while (x) { while (x) {
@ -785,7 +785,7 @@ static Term check_infinite_loop(Term t, struct rewind_term *x,
CACHE_REGS CACHE_REGS
if (wglb->Keep_terms) { if (wglb->Keep_terms) {
while (x) { while (x) {
if (Yap_GetFromSlot(x->u_sd.s.old PASS_REGS) == t) if (Yap_GetFromSlot(x->u_sd.s.old) == t)
return TermFoundVar; return TermFoundVar;
x = x->parent; x = x->parent;
} }

5
C/yap-args.c
View File

@ -167,11 +167,7 @@ int
YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
{ {
char *p; char *p;
#ifdef USE_SYSTEM_MALLOC
int BootMode = YAP_FULL_BOOT_FROM_PROLOG;
#else
int BootMode = YAP_BOOT_FROM_SAVED_CODE; int BootMode = YAP_BOOT_FROM_SAVED_CODE;
#endif
unsigned long int *ssize; unsigned long int *ssize;
iap->SavedState = NULL; iap->SavedState = NULL;
@ -554,5 +550,6 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
} }
GD->cmdline.appl_argc = argc; GD->cmdline.appl_argc = argc;
GD->cmdline.appl_argv = argv; GD->cmdline.appl_argv = argv;
//___androidlog_print(ANDROID_LOG_INFO, "YAP ", "boot mode %d", BootMode);
return BootMode; return BootMode;
} }

65
CXX/yapdb.hh
View File

@ -55,11 +55,11 @@ public:
class YAPModuleProp: public YAPProp { class YAPModuleProp: public YAPProp {
friend class YAPPredicate; friend class YAPPredicate;
ModEntry *m; ModEntry *m;
YAPModuleProp(ModEntry *mod) {m = mod;}; YAPModuleProp(ModEntry *mod) {m = mod;};
YAPModuleProp(Term tmod) { m = Yap_GetModuleEntry(tmod); }; YAPModuleProp(Term tmod) { m = Yap_GetModuleEntry(tmod); };
public: public:
YAPModuleProp() { m = Yap_GetModuleEntry(Yap_CurrentModule()); }; YAPModuleProp() { m = Yap_GetModuleEntry(Yap_CurrentModule()); };
YAPModuleProp(YAPModule tmod) ; YAPModuleProp(YAPModule tmod) ;
virtual YAPModule module() { return YAPModule(m->AtomOfME); }; virtual YAPModule module() { return YAPModule(m->AtomOfME); };
}; };
@ -103,7 +103,7 @@ public:
arity_t arity(void) { arity_t arity(void) {
return ArityOfFunctor( f ); return ArityOfFunctor( f );
} }
}; };
/** /**
@ -118,14 +118,34 @@ protected:
PredEntry *ap; PredEntry *ap;
/// auxiliary routine to find a predicate in the current module. /// auxiliary routine to find a predicate in the current module.
PredEntry *getPred( Term t, Term* &outp ) ; PredEntry *getPred( Term &t, Term* &outp ) ;
/// String constructor for predicates /// String constructor for predicates
/// ///
/// It also communicates the array of arguments t[] /// It also communicates the array of arguments t[]
/// and the array of variables /// and the array of variables
/// back to yapquery /// back to yapquery
YAPPredicate(const char *s, Term* &out, Term& vnames ) throw (int); YAPPredicate(const char *s, Term &out, yhandle_t &vnames ) {
CACHE_REGS
BACKUP_MACHINE_REGS();
Term *outp;
char ns[strlen(s)+1];
memcpy(ns, s, strlen(s)+1);
LOG("iPP=%d %d %d", strlen(s), s[0], s[1]);
LOG("iPP=%s", s);
vnames = Yap_NewSlots(1);
out = Yap_StringToTerm(ns, strlen(s)+1, vnames ) ;
LOG("iP2=%s", s);
//extern char *s0;
//fprintf(stderr,"ap=%p arity=%d text=%s", ap, ap->ArityOfPE, s);
// Yap_DebugPlWrite(out);
// delete [] ns;
if (out == 0L)
throw YAPError::YAP_SYNTAX_ERROR;
ap = getPred( out, outp);
RECOVER_MACHINE_REGS();
}
/// Term constructor for predicates /// Term constructor for predicates
/// ///
@ -185,30 +205,6 @@ public:
YAPPredicate(YAPAtom at, arity_t arity); YAPPredicate(YAPAtom at, arity_t arity);
/// String constructor for predicates.
///
/// String is a Prolog term, we extract the main functor after considering the module qualifiers.
inline YAPPredicate(const char *s) throw (int) {
Term t, tp;
t = YAP_ReadBuffer(s,&tp);
if (t == 0L)
throw YAPError::YAP_SYNTAX_ERROR;
CELL * v;
ap = getPred( t, v);
}
/// String constructor for predicates, also keeps arguments in tp[]
///
/// String is a Prolog term, we extract the main functor after considering the module qualifiers.
inline YAPPredicate(const char *s, Term* outp) throw (int) {
Term t, tp;
t = YAP_ReadBuffer(s,&tp);
if (t == 0L)
throw YAPError::YAP_SYNTAX_ERROR;
ap = getPred( t, outp );
}
/// module of a predicate /// module of a predicate
/// ///
/// notice that modules are currently treated as atoms, this should change. /// notice that modules are currently treated as atoms, this should change.
@ -290,7 +286,7 @@ public:
call, arity); call, arity);
} }
} }
}; };
YAPFLIP(const char *name, YAPFLIP(const char *name,
arity_t arity, arity_t arity,
@ -313,6 +309,5 @@ public:
bool addCut(CPredicate call) { bool addCut(CPredicate call) {
return Yap_AddCutToFli( ap, call ); return Yap_AddCutToFli( ap, call );
} }
};
};

254
CXX/yapi.cpp
View File

@ -88,7 +88,7 @@ YAPStringTerm::YAPStringTerm(char *s, size_t len) { // build string
BACKUP_H(); BACKUP_H();
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c = s;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
@ -105,7 +105,7 @@ YAPStringTerm::YAPStringTerm(wchar_t *s): YAPTerm() { // build string
BACKUP_H(); BACKUP_H();
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.w = s; inp.val.w = s;
inp.type = YAP_STRING_WCHARS; inp.type = YAP_STRING_WCHARS;
@ -121,7 +121,7 @@ YAPStringTerm::YAPStringTerm(wchar_t *s, size_t len) : YAPTerm() { // build stri
BACKUP_H(); BACKUP_H();
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.w = s; inp.val.w = s;
inp.type = YAP_STRING_WCHARS; inp.type = YAP_STRING_WCHARS;
@ -136,23 +136,23 @@ YAPStringTerm::YAPStringTerm(wchar_t *s, size_t len) : YAPTerm() { // build stri
YAPApplTerm::YAPApplTerm(YAPFunctor f, YAPTerm ts[]) : YAPTerm() { YAPApplTerm::YAPApplTerm(YAPFunctor f, YAPTerm ts[]) : YAPTerm() {
BACKUP_MACHINE_REGS(); BACKUP_H();
UInt arity = ArityOfFunctor(f.f); UInt arity = ArityOfFunctor(f.f);
mk ( Yap_MkApplTerm( f.f, arity, (Term *)ts) ); mk ( Yap_MkApplTerm( f.f, arity, (Term *)ts) );
RECOVER_MACHINE_REGS(); RECOVER_H();
} }
YAPApplTerm::YAPApplTerm(YAPFunctor f) : YAPTerm() { YAPApplTerm::YAPApplTerm(YAPFunctor f) : YAPTerm() {
BACKUP_MACHINE_REGS(); BACKUP_H();
UInt arity = ArityOfFunctor(f.f); UInt arity = ArityOfFunctor(f.f);
mk ( Yap_MkNewApplTerm( f.f, arity) ); mk ( Yap_MkNewApplTerm( f.f, arity) );
RECOVER_MACHINE_REGS(); RECOVER_H();
} }
YAPTerm YAPApplTerm::getArg(int arg) { YAPTerm YAPApplTerm::getArg(int arg) {
BACKUP_MACHINE_REGS(); BACKUP_H();
YAPTerm to = YAPTerm( ArgOfTerm(arg, gt() ) ); YAPTerm to = YAPTerm( ArgOfTerm(arg, gt() ) );
RECOVER_MACHINE_REGS(); RECOVER_H();
return to; return to;
} }
@ -162,20 +162,20 @@ YAPFunctor YAPApplTerm::getFunctor() {
YAPPairTerm::YAPPairTerm(YAPTerm th, YAPTerm tl) : YAPTerm() { YAPPairTerm::YAPPairTerm(YAPTerm th, YAPTerm tl) : YAPTerm() {
CACHE_REGS CACHE_REGS
BACKUP_MACHINE_REGS(); BACKUP_H();
mk ( MkPairTerm( th.term(), tl.term() ) ); mk ( MkPairTerm( th.term(), tl.term() ) );
RECOVER_MACHINE_REGS(); RECOVER_H();
} }
YAPPairTerm::YAPPairTerm() : YAPTerm() { YAPPairTerm::YAPPairTerm() : YAPTerm() {
BACKUP_MACHINE_REGS(); BACKUP_H();
t = Yap_MkNewPairTerm( ); t = Yap_MkNewPairTerm( );
RECOVER_MACHINE_REGS(); RECOVER_H();
} }
void YAPTerm::mk(Term t0) { CACHE_REGS t = Yap_InitSlot( t0 PASS_REGS); } void YAPTerm::mk(Term t0) { CACHE_REGS t = Yap_InitSlot( t0 ); }
Term YAPTerm::gt() { CACHE_REGS return Yap_GetFromSlot( t PASS_REGS); } Term YAPTerm::gt() { CACHE_REGS return Yap_GetFromSlot( t ); }
YAP_tag_t YAPTerm::tag() { YAP_tag_t YAPTerm::tag() {
Term tt = gt( ); Term tt = gt( );
@ -193,7 +193,7 @@ YAP_tag_t YAPTerm::tag() {
return YAP_TAG_PAIR; return YAP_TAG_PAIR;
if (IsAtomOrIntTerm(tt)) { if (IsAtomOrIntTerm(tt)) {
if (IsAtomTerm(tt)) if (IsAtomTerm(tt))
return YAP_TAG_ATOM; return YAP_TAG_ATOM;
return YAP_TAG_INT; return YAP_TAG_INT;
} else { } else {
Functor f = FunctorOfTerm(tt); Functor f = FunctorOfTerm(tt);
@ -296,20 +296,9 @@ const char *YAPTerm::text() {
return os; return os;
} }
char *YAPQuery::text() { const char *YAPQuery::text() {
size_t sze = 4096, length;
char *os;
int enc;
{ CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "I t=(%d) %lx", *q_g) ; } return goal.text();
BACKUP_MACHINE_REGS();
if (!(os = Yap_HandleToString(*q_g, sze, &length, &enc, 0))) {
RECOVER_MACHINE_REGS();
return (char *)NULL;
}
{ CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "II %s", os) ; }
RECOVER_MACHINE_REGS();
return os;
} }
@ -335,7 +324,7 @@ YAPTerm::YAPTerm(intptr_t i) { CACHE_REGS Term tn = MkIntegerTerm( i ); mk( tn )
YAPTerm YAPListTerm::car() YAPTerm YAPListTerm::car()
{ {
Term to = gt(); Term to = gt();
{ CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "to=%p", to) ; } { LOG( "to=%lx", to) ; }
if (IsPairTerm(to)) if (IsPairTerm(to))
return YAPTerm(HeadOfTerm(to)); return YAPTerm(HeadOfTerm(to));
else else
@ -395,51 +384,80 @@ char *YAPAtom::getName(void) {
} }
} }
void YAPQuery::initOpenQ() {
CACHE_REGS
oq = LOCAL_execution;
LOCAL_execution = this;
q_open=1;
q_state=0;
q_flags = PL_Q_PASS_EXCEPTION;
q_p = P;
q_cp = CP;
}
void void
YAPQuery::initQuery( Term *ts ) YAPQuery::initQuery( Term t )
{
CACHE_REGS
BACKUP_MACHINE_REGS();
size_t arity = ap->ArityOfPE;
LOG("iQ=%d", arity);
goal = YAPTerm( t );
if (arity) {
q_g = Yap_NewSlots( arity );
for (size_t i=0; i < arity; i++) {
Yap_PutInSlot(q_g+i, ArgOfTerm(i+1, t) PASS_REGS);
}
} else {
q_g = 0;
}
initOpenQ();
RECOVER_MACHINE_REGS();
}
void
YAPQuery::initQuery( YAPTerm ts[], arity_t arity )
{ {
CACHE_REGS CACHE_REGS
this->oq = (YAPQuery *)LOCAL_execution;
LOCAL_execution = (struct open_query_struct *)this;
this->q_open=1;
this->q_state=0;
this->q_flags = PL_Q_PASS_EXCEPTION;
this->q_g = ts;
this->q_p = P;
this->q_cp = CP;
}
void BACKUP_MACHINE_REGS();
YAPQuery::initQuery( YAPTerm t[], arity_t arity ) if (arity) {
{ q_g = Yap_NewSlots( arity );
Term *ts = new Term[arity]; for (size_t i=0; i < arity; i++) {
for (arity_t i = 0; i < arity; i++) Yap_PutInSlot(q_g+i, ts[i].term() PASS_REGS);
ts[i] = t[i].term(); }
Term t = Yap_MkApplTerm(ap->FunctorOfPred, ap->ArityOfPE, Yap_AddressFromSlot(q_g));
return initQuery( ts ); goal = YAPTerm( t );
} else {
q_g = 0;
goal = YAPTerm( MkAtomTerm((Atom)ap->FunctorOfPred) );
}
initOpenQ();
RECOVER_MACHINE_REGS();
} }
YAPQuery::YAPQuery(YAPFunctor f, YAPTerm mod, YAPTerm t[]): YAPPredicate(f, mod) YAPQuery::YAPQuery(YAPFunctor f, YAPTerm mod, YAPTerm ts[]): YAPPredicate(f, mod)
{ {
/* ignore flags for now */ /* ignore flags for now */
initQuery( t , f.arity()); initQuery( ts , f.arity());
} }
YAPQuery::YAPQuery(YAPFunctor f, YAPTerm t[]): YAPPredicate(f) YAPQuery::YAPQuery(YAPFunctor f, YAPTerm ts[]): YAPPredicate(f)
{ {
/* ignore flags for now */ /* ignore flags for now */
initQuery( t , f.arity()); initQuery( ts , f.arity());
} }
YAPQuery::YAPQuery(YAPPredicate p, YAPTerm t[]): YAPPredicate(p.ap) YAPQuery::YAPQuery(YAPPredicate p, YAPTerm ts[]): YAPPredicate(p.ap)
{ {
initQuery( t , p.ap->ArityOfPE); initQuery( ts , p.ap->ArityOfPE);
} }
YAPListTerm YAPQuery::namedVars() { YAPListTerm YAPQuery::namedVars() {
CACHE_REGS CACHE_REGS
Term o = Yap_GetFromSlot( this->vnames.t PASS_REGS ); Term o = Yap_GetFromSlot( vnames );
return YAPListTerm( o ); return YAPListTerm( o );
} }
@ -447,25 +465,24 @@ bool YAPQuery::next()
{ {
CACHE_REGS CACHE_REGS
int result; int result;
if (q_open != 1) return false;
if (setjmp(((YAPQuery *)LOCAL_execution)->q_env))
return false;
// don't forget, on success these guys must create slots
if (q_state == 0) {
// extern void toggle_low_level_trace(void);
//toggle_low_level_trace();
result = (bool)YAP_EnterGoal((YAP_PredEntryPtr)ap, q_g, &q_h);
BACKUP_MACHINE_REGS();
if (q_open != 1) return false;
if (setjmp(q_env))
return false;
// don't forget, on success these guys must create slots
if (this->q_state == 0) {
result = (bool)YAP_EnterGoal((YAP_PredEntryPtr)ap, q_g, &q_h);
} else { } else {
LOCAL_AllowRestart = this->q_open; LOCAL_AllowRestart = q_open;
result = (bool)YAP_RetryGoal(&q_h); result = (bool)YAP_RetryGoal(&q_h);
} }
this->q_state = 1; q_state = 1;
if (!result) { if (!result) {
YAP_LeaveGoal(FALSE, &q_h); YAP_LeaveGoal(FALSE, &q_h);
this->q_open = 0; q_open = 0;
} }
RECOVER_MACHINE_REGS();
return result; return result;
} }
@ -473,26 +490,31 @@ void YAPQuery::cut()
{ {
CACHE_REGS CACHE_REGS
if (this->q_open != 1 || this->q_state == 0) return; BACKUP_MACHINE_REGS();
YAP_LeaveGoal(FALSE, &this->q_h); if (q_open != 1 || q_state == 0) return;
this->q_open = 0; YAP_LeaveGoal(FALSE, &q_h);
LOCAL_execution = (struct open_query_struct *)this->oq; q_open = 0;
LOCAL_execution = this;
RECOVER_MACHINE_REGS();
} }
void YAPQuery::close() void YAPQuery::close()
{ {
CACHE_REGS CACHE_REGS
if (EX && !(this->q_flags & (PL_Q_CATCH_EXCEPTION))) { RECOVER_MACHINE_REGS();
if (EX && !(q_flags & (PL_Q_CATCH_EXCEPTION))) {
EX = (struct DB_TERM *)NULL; EX = (struct DB_TERM *)NULL;
} }
/* need to implement backtracking here */ /* need to implement backtracking here */
if (this->q_open != 1 || this->q_state == 0) { if (q_open != 1 || q_state == 0) {
RECOVER_MACHINE_REGS();
return; return;
} }
YAP_LeaveGoal(FALSE, &this->q_h); YAP_LeaveGoal(FALSE, &q_h);
this->q_open = 0; q_open = 0;
LOCAL_execution = (struct open_query_struct *)this->oq; LOCAL_execution = this;
RECOVER_MACHINE_REGS();
} }
static YAPEngine *curren; static YAPEngine *curren;
@ -502,7 +524,16 @@ static YAPEngine *curren;
#include <jni.h> #include <jni.h>
#include <string.h> #include <string.h>
extern AAssetManager *assetManager; JNIEnv *Yap_jenv;
JNIEXPORT jint JNICALL JNI_OnLoad(JavaVM* vm, void* reserved) {
JNIEnv* env;
if (vm->GetEnv(reinterpret_cast<void**>(&env), JNI_VERSION_1_6) != JNI_OK) {
return -1;
}
Yap_jenv = env;
return JNI_VERSION_1_6;
}
extern char *Yap_AndroidBufp; extern char *Yap_AndroidBufp;
static size_t Yap_AndroidMax, Yap_AndroidSz; static size_t Yap_AndroidMax, Yap_AndroidSz;
@ -530,6 +561,19 @@ displayWithJava(int c)
} }
} }
extern "C" void Java_pt_up_fc_dcc_yap_JavaYap_load(JNIEnv *env0, jobject obj, jobject mgr);
extern "C" void Java_pt_up_fc_dcc_yap_JavaYap_load
(JNIEnv *env0, jobject obj, jobject asset_manager)
{
AAssetManager *mgr = AAssetManager_fromJava(Yap_jenv, asset_manager);
if (mgr == NULL) {
LOG( "we're doomed, mgr = 0; bip bip bip");
} else {
Yap_assetManager = mgr;
}
}
#endif #endif
@ -548,8 +592,6 @@ YAPEngine::YAPEngine( char *savedState,
YAPCallback *cb): _callback(0) YAPCallback *cb): _callback(0)
{ // a single engine can be active { // a single engine can be active
#if __ANDROID__ #if __ANDROID__
if (GLOBAL_assetManager == (AAssetManager *)NULL)
return;
Yap_DisplayWithJava = displayWithJava; Yap_DisplayWithJava = displayWithJava;
Yap_AndroidBufp = (char *)malloc(Yap_AndroidMax = 4096); Yap_AndroidBufp = (char *)malloc(Yap_AndroidMax = 4096);
Yap_AndroidBufp[0] = '\0'; Yap_AndroidBufp[0] = '\0';
@ -573,22 +615,6 @@ YAPEngine::YAPEngine( char *savedState,
YAP_Init( &init_args ); YAP_Init( &init_args );
} }
YAPQuery *YAPEngine::query( char *s ) {
YAPQuery *n = new YAPQuery( s );
return n;
}
YAPPredicate::YAPPredicate(const char *s, Term* &outp, Term &vnames) throw (int) {
CACHE_REGS
yhandle_t sl = Yap_NewSlots(1 PASS_REGS);
Term t = Yap_StringToTerm(s, strlen(s)+1, sl );
if (t == 0L)
throw YAPError::YAP_SYNTAX_ERROR;
vnames = Yap_GetFromSlot( sl PASS_REGS );
ap = getPred( t, outp );
}
YAPPredicate::YAPPredicate(YAPAtom at) { YAPPredicate::YAPPredicate(YAPAtom at) {
CACHE_REGS CACHE_REGS
@ -606,35 +632,32 @@ YAPPredicate::YAPPredicate(YAPAtom at, arity_t arity) {
} }
/// auxiliary routine to find a predicate in the current module. /// auxiliary routine to find a predicate in the current module.
PredEntry *YAPPredicate::getPred( Term t, Term* &outp ) { PredEntry *YAPPredicate::getPred( Term &t, Term* &outp ) {
CACHE_REGS CACHE_REGS
Term m = CurrentModule ; Term m = CurrentModule ;
{ CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "H= %p, outp=%p", HR, outp) ; } t = Yap_StripModule(t, &m);
t = Yap_StripModule(t, &m);
if (IsVarTerm(t) || IsNumTerm(t)) { if (IsVarTerm(t) || IsNumTerm(t)) {
ap = (PredEntry *)NULL; ap = (PredEntry *)NULL;
outp = (Term *)NULL; outp = (Term *)NULL;
return ap;
} }
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
ap = RepPredProp(PredPropByAtom(AtomOfTerm(t), m)); ap = RepPredProp(PredPropByAtom(AtomOfTerm(t), m));
if (outp) outp = (Term *)NULL; outp = (Term *)NULL;
return ap;
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
ap = RepPredProp(PredPropByFunc(FunctorCsult, PROLOG_MODULE)); Term ts[1];
outp = HR; ts[0] = t;
HR[0] = RepPair(t)[0]; t = Yap_MkApplTerm(FunctorCsult, 1, ts);
HR[1] = m; }
HR+=2; Functor f = FunctorOfTerm(t);
} else { if (IsExtensionFunctor(f)) {
Functor f = FunctorOfTerm(t);
if (IsExtensionFunctor(f)) {
ap = (PredEntry *)NULL; ap = (PredEntry *)NULL;
outp = (Term *)NULL; outp = (Term *)NULL;
} else { } else {
ap = RepPredProp(PredPropByFunc(f, m)); ap = RepPredProp(PredPropByFunc(f, m));
outp = RepAppl(t)+1; outp = RepAppl(t)+1;
}
} }
{ CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "done H= %p, outp=%p", HR, outp) ; }
return ap; return ap;
} }
@ -711,15 +734,20 @@ YAPPrologPredicate::YAPPrologPredicate(YAPAtom name,
void *YAPPrologPredicate::assertClause( YAPTerm clause, bool last, YAPTerm source) { void *YAPPrologPredicate::assertClause( YAPTerm clause, bool last, YAPTerm source) {
CACHE_REGS CACHE_REGS
RECOVER_MACHINE_REGS();
Term tt = clause.gt(); Term tt = clause.gt();
Term sourcet = source.gt(); Term sourcet = source.gt();
yamop *codeaddr = Yap_cclause(tt, PP->ArityOfPE, CurrentModule, sourcet); /* vsc: give the number of arguments yamop *codeaddr = Yap_cclause(tt, PP->ArityOfPE, CurrentModule, sourcet); /* vsc: give the number of arguments
to cclause in case there is overflow */ to cclause in case there is overflow */
Term ntt = clause.gt(); Term ntt = clause.gt();
if (LOCAL_ErrorMessage) if (LOCAL_ErrorMessage) {
return 0; RECOVER_MACHINE_REGS();
return 0;
}
Term *tref = &ntt; Term *tref = &ntt;
if (Yap_addclause(ntt, codeaddr, (last ? 0 : 2), CurrentModule, tref)) if (Yap_addclause(ntt, codeaddr, (last ? 0 : 2), CurrentModule, tref)) {
RECOVER_MACHINE_REGS();
}
return tref; return tref;
return 0; return 0;
} }

5
CXX/yapi.hh
View File

@ -25,13 +25,13 @@
#include <config.h> #include <config.h>
#if USE_GMP #if USE_GMP
#include <gmpxx.h> #include <gmpxx.h>
#endif #endif
extern "C" { extern "C" {
#include <stddef.h> #include <stddef.h>
#include "Yap.h" #include "Yap.h"
#include "Yatom.h" #include "Yatom.h"
@ -68,7 +68,6 @@ extern "C" {
#include <windows.h> #include <windows.h>
#endif #endif
// taken from yap_structs.h // taken from yap_structs.h
#include "iopreds.h" #include "iopreds.h"

45
CXX/yapq.hh
View File

@ -5,25 +5,22 @@
Queries and engines Queries and engines
*/ */
static const char *s0;
/** /**
* @brief Queries * @brief Queries
* *
* interface to a YAP Query; * interface to a YAP Query;
* uses an SWI-like status info internally. * uses an SWI-like status info internally.
*/ */
class YAPQuery: public YAPPredicate { class YAPQuery: public YAPPredicate, open_query_struct {
int q_open; yhandle_t vnames;
int q_state; YAPTerm goal;
Term *q_g; Term t;
yamop *q_p, *q_cp;
jmp_buf q_env; void initOpenQ();
int q_flags; void initQuery( Term t );
Term vs; void initQuery( YAPTerm ts[], arity_t arity );
YAP_dogoalinfo q_h;
YAPQuery *oq;
YAPTerm vnames;
void initQuery( Term ts[] );
void initQuery( YAPTerm t[], arity_t arity );
public: public:
/// main constructor, uses a predicate and an array of terms /// main constructor, uses a predicate and an array of terms
/// ///
@ -43,13 +40,12 @@ public:
/// string constructor without varnames /// string constructor without varnames
/// ///
/// It is given a string, calls the parser and obtains a Prolog term that should be a callable /// It is given a string, calls the parser and obtains a Prolog term that should be a callable
/// goal. It does not ask for a list of variables. /// goal.
inline YAPQuery(const char *s): YAPPredicate(s, q_g, vs) inline YAPQuery(const char *s): YAPPredicate(s, t, vnames)
{ {
vnames = YAPTerm( vs ); initQuery( t );
initQuery( q_g ); };
}
/// set flags for query execution, currently only for exception handling /// set flags for query execution, currently only for exception handling
void setFlag(int flag) {q_flags |= flag; } void setFlag(int flag) {q_flags |= flag; }
/// reset flags for query execution, currently only for exception handling /// reset flags for query execution, currently only for exception handling
@ -62,7 +58,7 @@ public:
/// same call for every solution /// same call for every solution
bool next(); bool next();
/// represent the top-goal /// represent the top-goal
char *text(); const char *text();
/// remove alternatives in the current search space, and finish the current query /// remove alternatives in the current search space, and finish the current query
void cut(); void cut();
/// finish the current query: undo all bindings. /// finish the current query: undo all bindings.
@ -77,8 +73,8 @@ public:
/// class that actually implements the callback. /// class that actually implements the callback.
class YAPCallback { class YAPCallback {
public: public:
virtual ~YAPCallback() { printf("~YAPCallback\n"); } virtual ~YAPCallback() { }
virtual void run() { __android_log_print(ANDROID_LOG_INFO, __FUNCTION__, "callback"); } virtual void run() { LOG("callback"); }
virtual void run(char *s) { } virtual void run(char *s) { }
}; };
@ -119,7 +115,10 @@ public:
/// execute the callback with a text argument. /// execute the callback with a text argument.
YAPError hasError( ) { return yerror; } YAPError hasError( ) { return yerror; }
/// build a query on the engine /// build a query on the engine
YAPQuery *query( char *s ); YAPQuery *query( const char *s ) {
s0=s;
return new YAPQuery( s );
};
/// current module for the engine /// current module for the engine
YAPModule currentModule( ) { return YAPModule( ) ; } YAPModule currentModule( ) { return YAPModule( ) ; }
}; };

51
CXX/yapt.hh
View File

@ -11,14 +11,14 @@ class YAPTerm {
friend class YAPPrologPredicate; friend class YAPPrologPredicate;
friend class YAPQuery; friend class YAPQuery;
friend class YAPModule; friend class YAPModule;
friend class YAPModuleProp; friend class YAPModuleProp;
friend class YAPApplTerm; friend class YAPApplTerm;
protected: protected:
yhandle_t t; /// handle to term, equivalent to term_t yhandle_t t; /// handle to term, equivalent to term_t
void mk(Term t0); /// internal method to convert from term to handle void mk(Term t0); /// internal method to convert from term to handle
Term gt(); /// get handle and obtain term Term gt(); /// get handle and obtain term
public: public:
~YAPTerm() {}; virtual ~YAPTerm() {};
YAPTerm(Term tn) { mk( tn ); } /// private method to convert from Term (internal YAP representation) to YAPTerm YAPTerm(Term tn) { mk( tn ); } /// private method to convert from Term (internal YAP representation) to YAPTerm
// do nothing constructor // do nothing constructor
YAPTerm() { mk(TermNil); } YAPTerm() { mk(TermNil); }
@ -32,7 +32,7 @@ public:
YAP_tag_t tag(); YAP_tag_t tag();
/// copy the term ( term copy ) /// copy the term ( term copy )
YAPTerm deepCopy(); YAPTerm deepCopy();
inline Term term() { return gt(); } /// private method to convert from YAPTerm to Term (internal YAP representation) inline Term term() { return gt(); } /// from YAPTerm to Term (internal YAP representation)
//const YAPTerm *vars(); //const YAPTerm *vars();
/// this term is == to t1 /// this term is == to t1
bool exactlyEqual(YAPTerm t1); bool exactlyEqual(YAPTerm t1);
@ -67,7 +67,7 @@ public:
tf = YAPTerm((Term)0); tf = YAPTerm((Term)0);
} }
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
//{ CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "after getArg H= %p, i=%d", HR, tf.gt()) ; } REGS_LOG( "after getArg H= %p, i=%d", HR, tf.gt()) ;
return tf; return tf;
} }
@ -78,7 +78,7 @@ public:
/** /**
* @brief Variable Term * @brief Variable Term
*/ */
class YAPVarTerm: private YAPTerm { class YAPVarTerm: public YAPTerm {
YAPVarTerm(Term t) { if (IsVarTerm(t)) mk( t ); } YAPVarTerm(Term t) { if (IsVarTerm(t)) mk( t ); }
public: public:
/// constructor /// constructor
@ -103,7 +103,7 @@ public:
* @brief Atom Term * @brief Atom Term
* Term Representation of an Atom * Term Representation of an Atom
*/ */
class YAPAtomTerm: YAPTerm { class YAPAtomTerm: public YAPTerm {
friend class YAPModule; friend class YAPModule;
// Constructor: receives a C-atom; // Constructor: receives a C-atom;
YAPAtomTerm(Atom a) { mk( MkAtomTerm(a) ); } YAPAtomTerm(Atom a) { mk( MkAtomTerm(a) ); }
@ -113,13 +113,13 @@ class YAPAtomTerm: YAPTerm {
public: public:
// Constructor: receives an atom; // Constructor: receives an atom;
YAPAtomTerm(YAPAtom a): YAPTerm() { mk( MkAtomTerm(a.a) ); } YAPAtomTerm(YAPAtom a): YAPTerm() { mk( MkAtomTerm(a.a) ); }
// Constructor: receives a sequence of ISO-LATIN1 codes; // Constructor: receives a sequence of ISO-LATIN1 codes;
YAPAtomTerm(char *s) ; YAPAtomTerm(char *s) ;
// Constructor: receives a sequence of up to n ISO-LATIN1 codes; // Constructor: receives a sequence of up to n ISO-LATIN1 codes;
YAPAtomTerm(char *s, size_t len); YAPAtomTerm(char *s, size_t len);
// Constructor: receives a sequence of wchar_ts, whatever they may be; // Constructor: receives a sequence of wchar_ts, whatever they may be;
YAPAtomTerm(wchar_t *s) ; YAPAtomTerm(wchar_t *s) ;
// Constructor: receives a sequence of n wchar_ts, whatever they may be; // Constructor: receives a sequence of n wchar_ts, whatever they may be;
YAPAtomTerm(wchar_t *s, size_t len); YAPAtomTerm(wchar_t *s, size_t len);
virtual bool isVar() { return false; } /// type check for unbound virtual bool isVar() { return false; } /// type check for unbound
virtual bool isAtom() { return true; } /// type check for atom virtual bool isAtom() { return true; } /// type check for atom
@ -131,16 +131,16 @@ public:
virtual bool isPair() { return false; } /// is a pair term virtual bool isPair() { return false; } /// is a pair term
virtual bool isGround() { return true; } /// term is ground virtual bool isGround() { return true; } /// term is ground
virtual bool isList() { return gt() == TermNil; } /// [] is a list virtual bool isList() { return gt() == TermNil; } /// [] is a list
// Getter: outputs the atom; // Getter: outputs the atom;
YAPAtom getAtom() { return YAPAtom(AtomOfTerm( gt() )); } YAPAtom getAtom() { return YAPAtom(AtomOfTerm( gt() )); }
// Getter: outputs the name as a sequence of ISO-LATIN1 codes; // Getter: outputs the name as a sequence of ISO-LATIN1 codes;
const char *text() { return AtomOfTerm( gt() )->StrOfAE; } const char *text() { return AtomOfTerm( gt() )->StrOfAE; }
}; };
/** /**
* @brief Compound Term * @brief Compound Term
*/ */
class YAPApplTerm: YAPTerm { class YAPApplTerm: public YAPTerm {
friend class YAPTerm; friend class YAPTerm;
YAPApplTerm(Term t0) { mk(t0); } YAPApplTerm(Term t0) { mk(t0); }
public: public:
@ -164,7 +164,7 @@ public:
/** /**
* @brief List Constructor Term * @brief List Constructor Term
*/ */
class YAPPairTerm: YAPTerm { class YAPPairTerm: public YAPTerm {
friend class YAPTerm; friend class YAPTerm;
YAPPairTerm(Term t0) { if (IsPairTerm(t0)) mk( t0 ); else mk(0); } YAPPairTerm(Term t0) { if (IsPairTerm(t0)) mk( t0 ); else mk(0); }
public: public:
@ -174,15 +174,24 @@ public:
YAPTerm getTail() { return YAPTerm(TailOfTerm( gt() )); } YAPTerm getTail() { return YAPTerm(TailOfTerm( gt() )); }
}; };
/**
* @brief Number Term
*/
class YAPNumberTerm: public YAPTerm {
public:
YAPNumberTerm() {};
bool isTagged() { return IsIntTerm( gt() ); }
};
/** /**
* @brief Integer Term * @brief Integer Term
*/ */
class YAPIntegerTerm: YAPTerm { class YAPIntegerTerm: public YAPNumberTerm {
public: public:
YAPIntegerTerm(intptr_t i); YAPIntegerTerm(intptr_t i);
intptr_t getInteger() { return IntegerOfTerm( gt() ); } intptr_t getInteger() { return IntegerOfTerm( gt() ); }
bool isTagged() { return IsIntTerm( gt() ); }
}; };
class YAPListTerm: public YAPTerm { class YAPListTerm: public YAPTerm {
@ -218,15 +227,15 @@ public:
return YAPListTerm(TailOfTerm( to )); return YAPListTerm(TailOfTerm( to ));
else if ( to == TermNil) else if ( to == TermNil)
return YAPListTerm( ); return YAPListTerm( );
/* error */; /* error */
throw YAPError::YAP_TYPE_ERROR;
} }
/// Check if the list is empty. /// Check if the list is empty.
/// ///
/// @param[in] the list /// @param[in] the list
inline bool nil() { inline bool nil() {
CACHE_REGS { LOG( "II %x %x", gt(), TermNil) ; }
{ CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "II %x %x", gt(), TermNil) ; }
return gt() == TermNil; return gt() == TermNil;
} }
@ -236,7 +245,7 @@ public:
/** /**
* @brief String Term * @brief String Term
*/ */
class YAPStringTerm: private YAPTerm { class YAPStringTerm: public YAPTerm {
public: public:
/// your standard constructor /// your standard constructor
YAPStringTerm(char *s) ; YAPStringTerm(char *s) ;

2
H/Atoms.h
View File

@ -126,7 +126,7 @@ typedef struct PropEntryStruct
typedef CELL arity_t; typedef CELL arity_t;
#define FunctorProperty ((PropFlags)(0xbb00)) #define FunctorProperty ((PropFlags)(0xbb00))
/* functor property */ /* functor property */
typedef struct FunctorEntryStruct typedef struct FunctorEntryStruct

18
H/Regs.h
View File

@ -81,7 +81,7 @@ INLINE_ONLY inline EXTERN void save_B(void);
#define CACHE_REGS #define CACHE_REGS
#define REFRESH_CACHE_REGS #define REFRESH_CACHE_REGS
#define INIT_REGS #define INIT_REGS
#define PASS_REGS1 #define PASS_REGS1
#define PASS_REGS #define PASS_REGS
#define USES_REGS1 void #define USES_REGS1 void
#define USES_REGS #define USES_REGS
@ -223,7 +223,7 @@ extern REGSTORE Yap_REGS;
#define YENV2MEM #define YENV2MEM
#define YENV_ADDRESS (&(YENV)) #define YENV_ADDRESS (&(YENV))
#define MEM2YENV #define MEM2YENV
#if defined(__GNUC__) && defined(__alpha) #if defined(__GNUC__) && defined(__alpha)
@ -391,7 +391,7 @@ INLINE_ONLY EXTERN inline void restore_B(void) {
#define RECOVER_B() save_B(); B = BK_B #define RECOVER_B() save_B(); B = BK_B
#define restore_TR() #define restore_TR()
#elif defined(__GNUC__) && defined(hppa) #elif defined(__GNUC__) && defined(hppa)
@ -478,7 +478,7 @@ INLINE_ONLY EXTERN inline void restore_TR(void) {
#elif defined(__GNUC__) && (defined(_POWER) || defined(__POWERPC__)) #elif defined(__GNUC__) && (defined(_POWER) || defined(__POWERPC__))
/* /*
Because of a bug in GCC, we should always start from the first available Because of a bug in GCC, we should always start from the first available
general register. According to rs6000.h, this is r13 everywhere general register. According to rs6000.h, this is r13 everywhere
@ -490,7 +490,7 @@ INLINE_ONLY EXTERN inline void restore_TR(void) {
*/ */
#define CreepFlag Yap_REGS.CreepFlag_ #define CreepFlag Yap_REGS.CreepFlag_
/* /*
vsc: this MUST start from register 13, otherwise GCC will break down in flames and vsc: this MUST start from register 13, otherwise GCC will break down in flames and
use the registers for evil purposes. :-( use the registers for evil purposes. :-(
*/ */
@ -509,7 +509,7 @@ register CELL *YENV asm ("r19");
#undef YENV2MEM #undef YENV2MEM
#undef YENV_ADDRESS (&(YENV)) #undef YENV_ADDRESS (&(YENV))
#undef MEM2YENV #undef MEM2YENV
#define YENV2MEM { CELL *YENV_MEM = YENV #define YENV2MEM { CELL *YENV_MEM = YENV
#define YENV_ADDRESS (&YENV_MEM) #define YENV_ADDRESS (&YENV_MEM)
@ -628,7 +628,7 @@ INLINE_ONLY EXTERN inline void restore_B(void) {
#define RECOVER_B() #define RECOVER_B()
#define restore_TR() #define restore_TR()
#endif #endif
@ -745,8 +745,8 @@ StackGap( USES_REGS1 )
{ {
UInt gmin = (LCL0-H0)>>2; UInt gmin = (LCL0-H0)>>2;
if (gmin < MinStackGap) gmin = MinStackGap; if (gmin < MinStackGap) gmin = MinStackGap;
// if (gmin > 1024*1024) return 1024*1024; // if (gmin > 1024*1024) return 1024*1024;
return gmin; return gmin;
} }

49
H/Yap.h
View File

@ -1,4 +1,4 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog %W% %G% * * YAP Prolog %W% %G% *
* Yap Prolog was developed at NCCUP - Universidade do Porto * * Yap Prolog was developed at NCCUP - Universidade do Porto *
@ -505,16 +505,19 @@ extern int Yap_output_msg;
#if __ANDROID__ #if __ANDROID__
#include <jni.h>
#include <android/asset_manager.h> #include <android/asset_manager.h>
#include <android/asset_manager_jni.h> #include <android/asset_manager_jni.h>
#include <android/log.h> #include <android/log.h>
#else
static inline char * __android_log_print(int i,const char *loc,const char *msg,...) { extern AAssetManager * Yap_assetManager;
return NULL;
} extern void *Yap_openAssetFile( const char *path ) ;
#define ANDROID_LOG_INFO 0 extern bool Yap_isAsset( const char *path );
#define ANDROID_LOG_ERROR 0 extern bool Yap_AccessAsset( const char *name , int mode);
#define ANDROID_LOG_DEBUG 0 extern bool Yap_AssetIsFile( const char *name );
extern bool Yap_AssetIsDir( const char *name );
extern int64_t Yap_AssetSize( const char *name );
#endif #endif
@ -858,4 +861,34 @@ Global variables for JIT
#endif #endif
#endif #endif
#if DEBUGX
inline static void
LOG0(const char *f, int l, const char *fmt, ...)
{
va_list ap;
va_start(ap, fmt);
#if __ANDROID__
__android_log_print(ANDROID_LOG_INFO, "YAP ", fmt, ap);
#else __WINDOWS__
FILE * fd;
fd = fopen("c:\\cygwin\\Log.txt", "a");
vfprintf(fd, fmt, ap);
fclose(fd);
#endif
vfprintf(stderr, fmt, ap);
va_end(ap);
}
#else
#define LOG0( ... )
#endif
#ifndef __ANDROID__
#define __android_log_print( ... )
#endif
#define LOG( ... ) LOG0( __FILE__, __LINE__, __VA_ARGS__ )
#define REGS_LOG( ... ) CACHE_REGS LOG0( __FILE__, __LINE__, __VA_ARGS__ )
#endif /* YAP_H */ #endif /* YAP_H */

35
H/YapHandles.h
View File

@ -30,10 +30,10 @@ of a function. Hence, slots should always be used as local variables.
Slots are organized as follows: Slots are organized as follows:
---- Offset of next pointer in chain (tagged as an handle_t) ---- Offset of next pointer in chain (tagged as an handle_t)
---- Number of entries (tagged as handle_t), in the example TAG(INT,4) ---- Number of entries (tagged as handle_t), in the example TAG(INT,4)
Entry Entry
Entry Entry
Entry Entry
Entry Entry
---- Number of entries (tagged as handle_t), in the example TAG(INT,4) ---- Number of entries (tagged as handle_t), in the example TAG(INT,4)
Slots are not known to the yaam. Instead, A new set of slots is created when the emulator calls user C-code. Slots are not known to the yaam. Instead, A new set of slots is created when the emulator calls user C-code.
@ -54,8 +54,8 @@ Slots are not known to the yaam. Instead, A new set of slots is created when the
static inline void static inline void
Yap_RebootSlots__( int wid USES_REGS ) { Yap_RebootSlots__( int wid USES_REGS ) {
// fprintf( stderr, " StartSlots = %ld", LOCAL_CurSlot); // fprintf( stderr, " StartSlots = %ld", LOCAL_CurSlot);
REMOTE_CurSlot(wid) = 1; REMOTE_CurSlot(wid) = 1;
} }
@ -65,7 +65,7 @@ Yap_RebootSlots__( int wid USES_REGS ) {
static inline yhandle_t static inline yhandle_t
Yap_StartSlots__( USES_REGS1 ) { Yap_StartSlots__( USES_REGS1 ) {
// fprintf( stderr, " StartSlots = %ld", LOCAL_CurSlot); // fprintf( stderr, " StartSlots = %ld", LOCAL_CurSlot);
if (LOCAL_CurSlot < 0) { if (LOCAL_CurSlot < 0) {
Yap_Error( SYSTEM_ERROR, 0L, " StartSlots = %ld", LOCAL_CurSlot); Yap_Error( SYSTEM_ERROR, 0L, " StartSlots = %ld", LOCAL_CurSlot);
} }
@ -87,9 +87,10 @@ Yap_CurrentSlot( USES_REGS1 ) {
return LOCAL_CurSlot; return LOCAL_CurSlot;
} }
#define Yap_GetFromSlot(slot) Yap_GetFromSlot__(slot PASS_REGS)
/// @brief read from a slot. /// @brief read from a slot.
static inline Term static inline Term
Yap_GetFromSlot(yhandle_t slot USES_REGS) Yap_GetFromSlot__(yhandle_t slot USES_REGS)
{ {
return(Deref(LOCAL_SlotBase[slot])); return(Deref(LOCAL_SlotBase[slot]));
} }
@ -142,21 +143,25 @@ ensure_slots(int N USES_REGS)
} }
} }
#define Yap_InitSlot( t ) Yap_InitSlot__( t PASS_REGS )
/// @brief create a new slot with term t /// @brief create a new slot with term t
static inline Int static inline yhandle_t
Yap_InitSlot(Term t USES_REGS) Yap_InitSlot__(Term t USES_REGS)
{ {
yhandle_t old_slots = LOCAL_CurSlot; yhandle_t old_slots = LOCAL_CurSlot;
ensure_slots( 1 PASS_REGS); ensure_slots( 1 PASS_REGS);
LOCAL_SlotBase[old_slots] = t; LOCAL_SlotBase[old_slots] = t;
LOCAL_CurSlot++; LOCAL_CurSlot++;
return old_slots; return old_slots;
} }
#define Yap_NewSlots( n ) Yap_NewSlots__( n PASS_REGS )
/// @brief allocate n empty new slots /// @brief allocate n empty new slots
static inline yhandle_t static inline yhandle_t
Yap_NewSlots(int n USES_REGS) Yap_NewSlots__(int n USES_REGS)
{ {
yhandle_t old_slots = LOCAL_CurSlot; yhandle_t old_slots = LOCAL_CurSlot;
int i; int i;
@ -169,7 +174,7 @@ Yap_NewSlots(int n USES_REGS)
return old_slots; return old_slots;
} }
#define Yap_InitSlots(n, ts) Yap_InitSlots__(n, ts PASS_REGS) #define Yap_InitSlots(n, ts) Yap_InitSlots__(n, ts PASS_REGS)
/// @brief create n new slots with terms ts[] /// @brief create n new slots with terms ts[]
static inline yhandle_t static inline yhandle_t
@ -177,7 +182,7 @@ Yap_InitSlots__(int n, Term *ts USES_REGS)
{ {
yhandle_t old_slots = LOCAL_CurSlot; yhandle_t old_slots = LOCAL_CurSlot;
int i; int i;
ensure_slots( n PASS_REGS); ensure_slots( n PASS_REGS);
for (i=0; i< n; i++) for (i=0; i< n; i++)
LOCAL_SlotBase[old_slots+i] = ts[i]; LOCAL_SlotBase[old_slots+i] = ts[i];
@ -193,7 +198,7 @@ Yap_RecoverSlots(int n, yhandle_t topSlot USES_REGS)
return false; return false;
#ifdef DEBUG #ifdef DEBUG
if (topSlot + n > LOCAL_CurSlot) { if (topSlot + n > LOCAL_CurSlot) {
Yap_Error(SYSTEM_ERROR, 0 /* TermNil */, "Inconsistent slot state in Yap_RecoverSlots."); Yap_Error(SYSTEM_ERROR, 0 /* TermNil */, "Inconsistent slot state in Yap_RecoverSlots.");
return false; return false;
} }
#endif #endif

12
H/Yapproto.h
View File

@ -371,7 +371,13 @@ int Yap_signal_index(const char *);
#ifdef MAC #ifdef MAC
void Yap_SetTextFile(char *); void Yap_SetTextFile(char *);
#endif #endif
char *Yap_getcwd(const char *, size_t); #if __ANDROIDD__
extern AAssetManager * Yap_assetManager;
extern void *Yap_openAssetFile( const char *path ) ;
extern bool Yap_isAsset( const char *path );
#endif
const char *Yap_getcwd(const char *, size_t);
void Yap_cputime_interval(Int *,Int *); void Yap_cputime_interval(Int *,Int *);
void Yap_systime_interval(Int *,Int *); void Yap_systime_interval(Int *,Int *);
void Yap_walltime_interval(Int *,Int *); void Yap_walltime_interval(Int *,Int *);
@ -452,7 +458,7 @@ struct AtomEntryStruct *Yap_lookupBlob(void *blob, size_t len, void *type, int *
void Yap_init_optyap_preds(void); void Yap_init_optyap_preds(void);
/* pl-file.c */ /* pl-file.c */
struct PL_local_data *Yap_InitThreadIO(int wid); struct PL_local_data *Yap_InitThreadIO(int wid);
void Yap_flush(void); void Yap_flush(void);
/* pl-yap.c */ /* pl-yap.c */
@ -465,5 +471,3 @@ gc_P(yamop *p, yamop *cp)
{ {
return (p->opc == Yap_opcode(_execute_cpred) ? cp : p); return (p->opc == Yap_opcode(_execute_cpred) ? cp : p);
} }

25
H/Yatom.h
View File

@ -188,7 +188,7 @@ IsFunctorProperty (int flags)
00 00 predicate entry 00 00 predicate entry
80 00 db property 80 00 db property
bb 00 functor entry bb 00 functor entry
ff df sparse functor ff df sparse functor
ff ex arithmetic property ff ex arithmetic property
ff f4 translation ff f4 translation
@ -404,7 +404,7 @@ AbsModProp (ModEntry * p)
} }
#define ModToTerm(m) (m == PROLOG_MODULE ? TermProlog : m ) #define ModToTerm(m) (m == PROLOG_MODULE ? TermProlog : m )
#endif #endif
#define ModProperty ((PropFlags)0xfffa) #define ModProperty ((PropFlags)0xfffa)
@ -638,8 +638,8 @@ IsValProperty (int flags)
return (PropFlags) ((flags == ValProperty)); return (PropFlags) ((flags == ValProperty));
} }
typedef uint64_t pred_flags_t; typedef uint64_t pred_flags_t;
/* predicate property entry structure */ /* predicate property entry structure */
/* AsmPreds are things like var, nonvar, atom ...which are implemented /* AsmPreds are things like var, nonvar, atom ...which are implemented
@ -749,12 +749,12 @@ typedef enum {
#endif #endif
Term ModuleOfPred; /* module for this definition */ Term ModuleOfPred; /* module for this definition */
UInt TimeStampOfPred; UInt TimeStampOfPred;
timestamp_type LastCallOfPred; timestamp_type LastCallOfPred;
/* This must be at an odd number of cells, otherwise it /* This must be at an odd number of cells, otherwise it
will not be aligned on RISC machines */ will not be aligned on RISC machines */
profile_data StatisticsForPred; /* enable profiling for predicate */ profile_data StatisticsForPred; /* enable profiling for predicate */
struct pred_entry *NextPredOfModule; /* next pred for same module */ struct pred_entry *NextPredOfModule; /* next pred for same module */
} PredEntry; } PredEntry;
#define PEProp ((PropFlags)(0x0000)) #define PEProp ((PropFlags)(0x0000))
#if USE_OFFSETS_IN_PROPS #if USE_OFFSETS_IN_PROPS
@ -1269,7 +1269,7 @@ Yap_GetTranslationProp(Atom at)
if (p0 == NIL) return (TranslationEntry *)NULL; if (p0 == NIL) return (TranslationEntry *)NULL;
return p; return p;
} }
INLINE_ONLY inline EXTERN PropFlags IsTranslationProperty (int); INLINE_ONLY inline EXTERN PropFlags IsTranslationProperty (int);
INLINE_ONLY inline EXTERN PropFlags INLINE_ONLY inline EXTERN PropFlags
@ -1361,7 +1361,7 @@ IsTranslationProperty (int flags)
} }
/* end of code for named mutexes */ /* end of code for named mutexes */
typedef enum { typedef enum {
STATIC_ARRAY = 1, STATIC_ARRAY = 1,
DYNAMIC_ARRAY = 2, DYNAMIC_ARRAY = 2,
@ -1708,7 +1708,7 @@ GetPredPropByFuncHavingLock (FunctorEntry *fe, Term cur_mod)
UInt hash = PRED_HASH(fe,cur_mod,PredHashTableSize); UInt hash = PRED_HASH(fe,cur_mod,PredHashTableSize);
READ_LOCK(PredHashRWLock); READ_LOCK(PredHashRWLock);
p = PredHash[hash]; p = PredHash[hash];
while (p) { while (p) {
if (p->FunctorOfPred == fe && if (p->FunctorOfPred == fe &&
p->ModuleOfPred == cur_mod) p->ModuleOfPred == cur_mod)
@ -1766,7 +1766,7 @@ GetPredPropByFuncAndModHavingLock (FunctorEntry *fe, Term cur_mod)
UInt hash = PRED_HASH(fe,cur_mod,PredHashTableSize); UInt hash = PRED_HASH(fe,cur_mod,PredHashTableSize);
READ_LOCK(PredHashRWLock); READ_LOCK(PredHashRWLock);
p = PredHash[hash]; p = PredHash[hash];
while (p) { while (p) {
if (p->FunctorOfPred == fe && if (p->FunctorOfPred == fe &&
p->ModuleOfPred == cur_mod) p->ModuleOfPred == cur_mod)
@ -1883,11 +1883,11 @@ INLINE_ONLY EXTERN inline void AddPropToAtom(AtomEntry *, PropEntry *p);
INLINE_ONLY EXTERN inline void INLINE_ONLY EXTERN inline void
AddPropToAtom(AtomEntry *ae, PropEntry *p) AddPropToAtom(AtomEntry *ae, PropEntry *p)
{ {
/* old properties should be always last, and wide atom properties /* old properties should be always last, and wide atom properties
should always be first */ should always be first */
if (ae->PropsOfAE != NIL && if (ae->PropsOfAE != NIL &&
RepProp(ae->PropsOfAE)->KindOfPE == WideAtomProperty) { RepProp(ae->PropsOfAE)->KindOfPE == WideAtomProperty) {
PropEntry *pp = RepProp(ae->PropsOfAE); PropEntry *pp = RepProp(ae->PropsOfAE);
p->NextOfPE = pp->NextOfPE; p->NextOfPE = pp->NextOfPE;
pp->NextOfPE = AbsProp(p); pp->NextOfPE = AbsProp(p);
} else { } else {
@ -1898,4 +1898,3 @@ AddPropToAtom(AtomEntry *ae, PropEntry *p)
#endif #endif

2
H/amidefs.h
View File

@ -1089,8 +1089,6 @@ extern void **Yap_ABSMI_OPCODES;
#endif #endif
#if DEPTH_LIMIT #if DEPTH_LIMIT
/* /*
Make this into an even number so that the system will know Make this into an even number so that the system will know

3
H/arrays.h
View File

@ -1,4 +1,4 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog * * YAP Prolog *
* * * *
@ -25,4 +25,3 @@ typedef struct array_access_struct {
Term indx; /* index in array, for now Term indx; /* index in array, for now
keep it as an integer! */ keep it as an integer! */
} array_access; } array_access;

21
H/clause.h
View File

@ -201,7 +201,7 @@ INLINE_ONLY EXTERN inline CELL *EXO_OFFSET_TO_ADDRESS(struct index_t *it, BITS3
INLINE_ONLY EXTERN inline CELL * INLINE_ONLY EXTERN inline CELL *
EXO_OFFSET_TO_ADDRESS(struct index_t *it, BITS32 off) EXO_OFFSET_TO_ADDRESS(struct index_t *it, BITS32 off)
{ {
if (off == 0L) if (off == 0L)
return (CELL *)NULL; return (CELL *)NULL;
return (it->cls)+(off-1)*it->arity; return (it->cls)+(off-1)*it->arity;
} }
@ -258,8 +258,8 @@ typedef struct dbterm_list {
#define CL_IN_USE(X) ((X)->ClRefCount) #define CL_IN_USE(X) ((X)->ClRefCount)
#else #else
#define INIT_CLREF_COUNT(X) #define INIT_CLREF_COUNT(X)
#define INC_CLREF_COUNT(X) #define INC_CLREF_COUNT(X)
#define DEC_CLREF_COUNT(X) #define DEC_CLREF_COUNT(X)
#define CL_IN_USE(X) ((X)->ClFlags & InUseMask || (X)->ClRefCount) #define CL_IN_USE(X) ((X)->ClFlags & InUseMask || (X)->ClRefCount)
#endif #endif
@ -301,6 +301,7 @@ LogUpdClause *Yap_FollowIndexingCode(PredEntry *,yamop *, Term *, yamop *,yamop
yamop *Yap_ExoLookup(PredEntry *ap USES_REGS); yamop *Yap_ExoLookup(PredEntry *ap USES_REGS);
CELL Yap_NextExo(choiceptr cpt, struct index_t *it); CELL Yap_NextExo(choiceptr cpt, struct index_t *it);
#
#if USE_THREADED_CODE #if USE_THREADED_CODE
#define OP_HASH_SIZE 2048 #define OP_HASH_SIZE 2048
@ -359,7 +360,7 @@ same_lu_block(yamop **paddr, yamop *p)
#define Yap_MkStaticRefTerm(cp, ap) __Yap_MkStaticRefTerm((cp), (ap) PASS_REGS) #define Yap_MkStaticRefTerm(cp, ap) __Yap_MkStaticRefTerm((cp), (ap) PASS_REGS)
static inline Term static inline Term
__Yap_MkStaticRefTerm(StaticClause *cp, PredEntry *ap USES_REGS) __Yap_MkStaticRefTerm(StaticClause *cp, PredEntry *ap USES_REGS)
{ {
Term t[2]; Term t[2];
@ -376,7 +377,7 @@ Yap_ClauseFromTerm(Term t)
#define Yap_MkMegaRefTerm(ap, ipc) __Yap_MkMegaRefTerm((ap), (ipc) PASS_REGS) #define Yap_MkMegaRefTerm(ap, ipc) __Yap_MkMegaRefTerm((ap), (ipc) PASS_REGS)
static inline Term static inline Term
__Yap_MkMegaRefTerm(PredEntry *ap,yamop *ipc USES_REGS) __Yap_MkMegaRefTerm(PredEntry *ap,yamop *ipc USES_REGS)
{ {
Term t[2]; Term t[2];
@ -385,13 +386,13 @@ __Yap_MkMegaRefTerm(PredEntry *ap,yamop *ipc USES_REGS)
return Yap_MkApplTerm(FunctorMegaClause,2,t); return Yap_MkApplTerm(FunctorMegaClause,2,t);
} }
static inline yamop * static inline yamop *
Yap_MegaClauseFromTerm(Term t) Yap_MegaClauseFromTerm(Term t)
{ {
return (yamop *)IntegerOfTerm(ArgOfTerm(2,t)); return (yamop *)IntegerOfTerm(ArgOfTerm(2,t));
} }
static inline PredEntry * static inline PredEntry *
Yap_MegaClausePredicateFromTerm(Term t) Yap_MegaClausePredicateFromTerm(Term t)
{ {
return (PredEntry *)IntegerOfTerm(ArgOfTerm(1,t)); return (PredEntry *)IntegerOfTerm(ArgOfTerm(1,t));
@ -399,7 +400,7 @@ Yap_MegaClausePredicateFromTerm(Term t)
#define Yap_MkExoRefTerm(ap, i) __Yap_MkExoRefTerm((ap), (i) PASS_REGS) #define Yap_MkExoRefTerm(ap, i) __Yap_MkExoRefTerm((ap), (i) PASS_REGS)
static inline Term static inline Term
__Yap_MkExoRefTerm(PredEntry *ap,Int i USES_REGS) __Yap_MkExoRefTerm(PredEntry *ap,Int i USES_REGS)
{ {
Term t[2]; Term t[2];
@ -408,13 +409,13 @@ __Yap_MkExoRefTerm(PredEntry *ap,Int i USES_REGS)
return Yap_MkApplTerm(FunctorExoClause,2,t); return Yap_MkApplTerm(FunctorExoClause,2,t);
} }
static inline Int static inline Int
Yap_ExoClauseFromTerm(Term t) Yap_ExoClauseFromTerm(Term t)
{ {
return IntegerOfTerm(ArgOfTerm(2,t)); return IntegerOfTerm(ArgOfTerm(2,t));
} }
static inline PredEntry * static inline PredEntry *
Yap_ExoClausePredicateFromTerm(Term t) Yap_ExoClausePredicateFromTerm(Term t)
{ {
return (PredEntry *)IntegerOfTerm(ArgOfTerm(1,t)); return (PredEntry *)IntegerOfTerm(ArgOfTerm(1,t));

1
H/dglobals.h
View File

@ -38,6 +38,7 @@
#if __ANDROID__ #if __ANDROID__
#define GLOBAL_assetManager Yap_global->assetManager_ #define GLOBAL_assetManager Yap_global->assetManager_
#define GLOBAL_AssetsWD Yap_global->AssetsWD_
#endif #endif
#if THREADS #if THREADS

1
H/hglobals.h
View File

@ -38,6 +38,7 @@ typedef struct global_data {
#if __ANDROID__ #if __ANDROID__
struct AAssetManager* assetManager_; struct AAssetManager* assetManager_;
char* AssetsWD_;
#endif #endif
#if THREADS #if THREADS

3
H/iglobals.h
View File

@ -37,7 +37,8 @@ static void InitGlobal(void) {
GLOBAL_AGCHook = NULL; GLOBAL_AGCHook = NULL;
#if __ANDROID__ #if __ANDROID__
GLOBAL_assetManager = GLOBAL_assetManager; GLOBAL_assetManager = NULL;
GLOBAL_AssetsWD = NULL;
#endif #endif
#if THREADS #if THREADS

6
H/pl-codelist.h
View File

@ -26,21 +26,21 @@ EXTEND_SEQ_CHARS(Word ptr, int c) {
return ptr+2; return ptr+2;
} }
static inline int static inline int
CLOSE_SEQ_STRING(Word p, Word p0, term_t tail, term_t term, term_t l) { CLOSE_SEQ_STRING(Word p, Word p0, term_t tail, term_t term, term_t l) {
CACHE_REGS CACHE_REGS
Yap_PutInSlot(l, AbsPair(p0) PASS_REGS); Yap_PutInSlot(l, AbsPair(p0) PASS_REGS);
p--; p--;
if (tail) { if (tail) {
RESET_VARIABLE(p); RESET_VARIABLE(p);
if (Yap_unify(Yap_GetFromSlot(l PASS_REGS), Yap_GetFromSlot(term PASS_REGS))) { if (Yap_unify(Yap_GetFromSlot(l), Yap_GetFromSlot(term))) {
Yap_PutInSlot(tail, (CELL)(p) PASS_REGS); Yap_PutInSlot(tail, (CELL)(p) PASS_REGS);
return TRUE; return TRUE;
} }
return FALSE; return FALSE;
} else { } else {
p[0] = TermNil; p[0] = TermNil;
return Yap_unify(Yap_GetFromSlot(l PASS_REGS), Yap_GetFromSlot(term PASS_REGS)); return Yap_unify(Yap_GetFromSlot(l), Yap_GetFromSlot(term ));
} }
} }

7
H/pl-global.h
View File

@ -188,6 +188,7 @@ typedef struct {
int optimise; /* -O: optimised compilation */ int optimise; /* -O: optimised compilation */
} cmdline; } cmdline;
#if 0
struct struct
{ //char * CWDdir; { //char * CWDdir;
//size_t CWDlen; //size_t CWDlen;
@ -196,6 +197,7 @@ typedef struct {
char * module; /* argv[0] module passed */ char * module; /* argv[0] module passed */
#endif #endif
} paths; } paths;
#endif
struct struct
{ ExtensionCell _ext_head; /* head of registered extensions */ { ExtensionCell _ext_head; /* head of registered extensions */
@ -251,7 +253,7 @@ typedef struct {
/* Procedure dc_call_prolog0; /\* $c_call_prolog/0 *\/ */ /* Procedure dc_call_prolog0; /\* $c_call_prolog/0 *\/ */
/* #ifdef O_ATTVAR */ /* #ifdef O_ATTVAR */
/* Procedure dwakeup1; /\* system:$wakeup/1 *\/ */ /* Procedure dwakeup1; /\* system:$wakeup/1 *\/ */
predicate_t portray_attvar1; /* $attvar:portray_attvar/1 */ predicate_t portray_attvar1; /* $attvar:portray_attvar/1 */
/* #endif */ /* #endif */
/* #ifdef O_CALL_RESIDUE */ /* #ifdef O_CALL_RESIDUE */
/* Procedure call_residue_vars2; /\* $attvar:call_residue_vars/2 *\/ */ /* Procedure call_residue_vars2; /\* $attvar:call_residue_vars/2 *\/ */
@ -390,7 +392,7 @@ typedef struct PL_local_data {
#ifdef O_GMP #ifdef O_GMP
struct struct
{ {
int persistent; /* do persistent operations */ int persistent; /* do persistent operations */
} gmp; } gmp;
#endif #endif
@ -411,4 +413,3 @@ typedef struct PL_local_data {
extern PL_local_data_t lds; extern PL_local_data_t lds;
#endif #endif

18
H/pl-incl.h
View File

@ -141,7 +141,7 @@ typedef int Char; /* char that can pass EOF */
typedef enum typedef enum
{ V_INTEGER, /* integer (64-bit) value */ { V_INTEGER, /* integer (64-bit) value */
#ifdef O_GMP #ifdef O_GMP
V_MPZ, /* mpz_t */ V_MPZ, /* mpz_t */
V_MPQ, /* mpq_t */ V_MPQ, /* mpq_t */
#endif #endif
@ -226,7 +226,7 @@ typedef enum
#endif #endif
typedef Term PL_atomic_t; /* same size as a word */ typedef Term PL_atomic_t; /* same size as a word */
typedef struct record * Record; typedef struct record * Record;
#define MAXSIGNAL 64 #define MAXSIGNAL 64
@ -242,7 +242,7 @@ users foreign language code.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define NOTRACE PL_FA_NOTRACE #define NOTRACE PL_FA_NOTRACE
#define META PL_FA_TRANSPARENT #define METAP PL_FA_TRANSPARENT
#define NDET PL_FA_NONDETERMINISTIC #define NDET PL_FA_NONDETERMINISTIC
#define VA PL_FA_VARARGS #define VA PL_FA_VARARGS
#define CREF PL_FA_CREF #define CREF PL_FA_CREF
@ -491,7 +491,7 @@ typedef struct wakeup_state
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Defining built-in predicates using the new interface Defining built-in predicates using the new interface
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define ESC ((char) 27) #define ESC ((char) 27)
@ -698,19 +698,19 @@ extern int System(char *cmd);
extern char *expandVars(const char *pattern, char *expanded, int maxlen); extern char *expandVars(const char *pattern, char *expanded, int maxlen);
PL_EXPORT(bool) ChDir(const char *X); PL_EXPORT(bool) ChDir(const char *X);
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
PL_EXPORT(char *) BaseName(const char *X); PL_EXPORT(char *) BaseName(const char *X);
PL_EXPORT(char *) DirName(const char *f); PL_EXPORT(char *) DirName(const char *f);
#else #else
#define BaseName basename #define BaseName basename
#define DirName dirname #define DirName dirname
#endif #endif
PL_EXPORT(char *) OsPath(const char *X, char *Y); PL_EXPORT(char *) OsPath(const char *X, char *Y);
#define DeleteTemporaryFile(F) RemoveFile(stringAtom(F)) #define DeleteTemporaryFile(F) RemoveFile(stringAtom(F))
PL_EXPORT(intptr_t) lengthList(term_t list, int errors); PL_EXPORT(intptr_t) lengthList(term_t list, int errors);

14
H/pl-yap.h
View File

@ -75,16 +75,16 @@ COMMON(word) pl_writeq(term_t term);
static inline int static inline int
get_procedure(term_t descr, predicate_t *proc, term_t he, int f) { get_procedure(term_t descr, predicate_t *proc, term_t he, int f) {
CACHE_REGS CACHE_REGS
Term t = Yap_GetFromSlot(descr PASS_REGS); Term t = Yap_GetFromSlot(descr );
if (IsVarTerm(t)) return FALSE; if (IsVarTerm(t)) return FALSE;
if (IsAtomTerm(t)) if (IsAtomTerm(t))
*proc = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t),CurrentModule)); *proc = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t),CurrentModule));
else if (IsApplTerm(t)) { else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
return FALSE; return FALSE;
} }
*proc = RepPredProp(Yap_GetPredPropByFunc(f, CurrentModule)); *proc = RepPredProp(Yap_GetPredPropByFunc(f, CurrentModule));
} }
return TRUE; return TRUE;
@ -125,7 +125,7 @@ void PL_license(const char *license, const char *module);
inline static char * inline static char *
atomName(Atom atom) atomName(Atom atom)
{ {
if (IsWideAtom(atom)) if (IsWideAtom(atom))
return (char *)(atom->WStrOfAE); return (char *)(atom->WStrOfAE);
return atom->StrOfAE; return atom->StrOfAE;
} }
@ -143,7 +143,7 @@ atomName(Atom atom)
Procedure resolveProcedure(functor_t f, Module module); Procedure resolveProcedure(functor_t f, Module module);
#define charEscapeWriteOption(A) FALSE // VSC: to implement #define charEscapeWriteOption(A) FALSE // VSC: to implement
#define wordToTermRef(A) Yap_InitSlot(*(A) PASS_REGS) #define wordToTermRef(A) Yap_InitSlot(*(A))
#define isTaggedInt(A) IsIntegerTerm(A) #define isTaggedInt(A) IsIntegerTerm(A)
#define valInt(A) IntegerOfTerm(A) #define valInt(A) IntegerOfTerm(A)
@ -161,7 +161,7 @@ int isWideAtom(atom_t atom);
inline static int inline static int
charCode(Term w) charCode(Term w)
{ if ( IsAtomTerm(w) ) { if ( IsAtomTerm(w) )
{ {
Atom a = atomValue(w); Atom a = atomValue(w);
if (IsWideAtom(a)) { if (IsWideAtom(a)) {
@ -203,7 +203,7 @@ stripostfix(const char *s, const char *e)
return strcasecmp(&s[ls-le], e) == 0; return strcasecmp(&s[ls-le], e) == 0;
return FALSE; return FALSE;
} }
#endif #endif
#if HAVE_SIGPROCMASK #if HAVE_SIGPROCMASK

1
H/rglobals.h
View File

@ -38,6 +38,7 @@ static void RestoreGlobal(void) {
#if __ANDROID__ #if __ANDROID__
#endif #endif
#if THREADS #if THREADS

69
Makefile.in
View File

@ -18,19 +18,21 @@ YAPLIBDIR=@libdir@/Yap
# #
# where YAP should look for architecture-independent Prolog libraries # where YAP should look for architecture-independent Prolog libraries
# #
SHAREDIR=$(ROOTDIR)/share DATAROOTDIR=@datarootdir@
#
SHAREDIR=$(DATAROOTDIR)
# #
# where the includes should be stored # where the includes should be stored
# #
INCLUDEDIR=$(ROOTDIR)/include/Yap INCLUDEDIR=@includedir@/Yap
# #
# where to store info files # where to store info files
# #
INFODIR=$(SHAREDIR)/info INFODIR=$(DATAROOTDIR)/info
# #
# where to store documentation files # where to store documentation files
# #
DOCSDIR=$(SHAREDIR)/doc/Yap DOCSDIR=$(SHAREDIR)/doc/yap
# #
# Add this flag to YAP_EXTRAS if you need the extension: # Add this flag to YAP_EXTRAS if you need the extension:
@ -413,8 +415,8 @@ JIT_OBJECTS = \
@JITDEBUGPREDS@ \ @JITDEBUGPREDS@ \
@JITSTATISTICPREDS@ @JITSTATISTICPREDS@
MYDDAS_OBJECTS = \ MYDDAS_ALL_OBJECTS = \
@INCLUDE_MYDDAS@ myddas_initialization.o \ myddas_initialization.o \
myddas_mysql.o \ myddas_mysql.o \
myddas_odbc.o \ myddas_odbc.o \
myddas_postgres.o \ myddas_postgres.o \
@ -424,6 +426,8 @@ MYDDAS_OBJECTS = \
myddas_util.o \ myddas_util.o \
myddas_wkb2prolog.o myddas_wkb2prolog.o
MYDDAS_OBJECTS = @OBJECTS_MYDDAS@
LIBTAI_OBJECTS = \ LIBTAI_OBJECTS = \
tai_add.o tai_now.o tai_pack.o \ tai_add.o tai_now.o tai_pack.o \
tai_sub.o tai_unpack.o taia_add.o taia_approx.o \ tai_sub.o tai_unpack.o taia_add.o taia_approx.o \
@ -465,7 +469,15 @@ PLCONS_OBJECTS = \
pl-ntmain.o \ pl-ntmain.o \
yapres.o yapres.o
all: startup.yss @WINDOWS@ yap-win@EXEC_SUFFIX@ all: "$(STARTUP_ANDROID)android-setup startup.yss windowsi
xandroid-setup:
( cd packages/swig && make android/jni/Android.mk )
android-setup:
windowsi:
@WINDOWS@ yap-win@EXEC_SUFFIX@
Makefile: Makefile.in Makefile: Makefile.in
@ -507,7 +519,7 @@ save.o: C/save.c
%.o: BEAM/%.c config.h %.o: BEAM/%.c config.h
$(CC) -c $(CFLAGS) $< -o $@ $(CC) -c $(CFLAGS) $< -o $@
yapi.o: CXX/yapi.cpp CXX/yapi.hh config.h yapi.o: CXX/yapi.cpp CXX/yapi.hh CXX/yapq.hh CXX/yapt.hh CXX/yapdb.hh CXX/yapie.hh CXX/yapa.hh config.h
$(CXX) -c $(CXXFLAGS) $< -o $@ $(CXX) -c $(CXXFLAGS) $< -o $@
sys.o: library/system/sys.c config.h sys.o: library/system/sys.c config.h
@ -640,34 +652,27 @@ libYap.a: $(LIB_OBJECTS) yapi.o
done done
@STARTUP_ANDROID@startup.yss: yap@EXEC_SUFFIX@ @DYNYAPLIB@ $(PL_SOURCES) $(SWI_LIB_SOURCES) @STARTUP_ANDROID@startup.yss: yap@EXEC_SUFFIX@ @DYNYAPLIB@ $(PL_SOURCES) $(SWI_LIB_SOURCES)
adb shell rm -rf /data/yap \rm -rf data/yap
adb shell mkdir -p /data/yap mkdir -p data/yap/packages
adb shell mkdir -p /data/yap/pl mkdir -p data/yap/swi
adb shell mkdir -p /data/yap/swi/library cp -a yap data/yap
adb shell mkdir -p /data/yap/packages/chr cp -a @DYNYAPLIB@ data/yap
adb shell mkdir -p /data/yap/packages/clib
adb shell mkdir -p /data/yap/packages/myddas
adb shell mkdir -p /data/yap/assets/myddas
adb shell mkdir -p /data/yap/assets/lib
adb shell mkdir -p /data/yap/assets/share
adb push yap /data/yap/
adb push @DYNYAPLIB@ /data/yap/
for p in $(EXTRAYAPLIBS); do \ for p in $(EXTRAYAPLIBS); do \
adb shell $(LN_S) /data/yap/@DYNYAPLIB@ /data/yap/$$p; \ (cd data/yap && $(LN_S) @DYNYAPLIB@ $$p ); \
done done
adb push $(GMPDIR)/lib/libgmp.so /data/yap cp -a ../../gmp-android/lib/libgmp.so data/yap
adb push $(SQLITE3DIR)/lib/libsqliteX.so /data/yap cp -a ../../sqlite3-android/lib/libsqliteX.so data/yap
#adb push packages/clib/*.so /data/yap cp -a $(srcdir)/pl data/yap
#adb push library/system/*.so /data/yap cp -a $(srcdir)/library data/yap
adb push $(srcdir)/swi/library /data/yap/swi/library cp -a $(srcdir)/swi/library data/yap/swi
adb push $(srcdir)/pl /data/yap/pl/ cp -a $(srcdir)/packages/clib data/yap/packages
adb push $(srcdir)/library /data/yap/library/ cp -a $(srcdir)/packages/chr data/yap/packages
adb push $(srcdir)/packages/myddas /data/yap/packages/myddas/ cp -a $(srcdir)/packages/myddas data/yap/packages
adb push $(srcdir)/packages/chr /data/yap/packages/chr/ \rm -rf data/yap/packages/*/.git
adb push $(srcdir)/packages/clib /data/yap/packages/clib/ adb push data/yap /data/yap >/dev/null 2>&1
adb shell "echo \"bootstrap('/data/yap/pl/init.yap'). module(user). qsave_program('/data/yap/startup.yss').\" | LD_LIBRARY_PATH=/data/yap /data/yap/yap@EXEC_SUFFIX@ -b /data/yap/pl/boot.yap" adb shell "echo \"bootstrap('/data/yap/pl/init.yap'). module(user). qsave_program('/data/yap/startup.yss').\" | LD_LIBRARY_PATH=/data/yap /data/yap/yap@EXEC_SUFFIX@ -b /data/yap/pl/boot.yap"
adb pull /data/yap/startup.yss adb pull /data/yap/startup.yss
#adb shell rm -rf /data/yap
install: @INSTALL_COMMAND@ install_startup install_common install: @INSTALL_COMMAND@ install_startup install_common

37
config.h.in
View File

@ -1,8 +1,5 @@
/* config.h.in. Generated from configure.in by autoheader. */ /* config.h.in. Generated from configure.in by autoheader. */
/* Define if building universal (internal helper macro) */
#undef AC_APPLE_UNIVERSAL_BUILD
/* longs should be in addresses that are multiple of four. */ /* longs should be in addresses that are multiple of four. */
#undef ALIGN_LONGS #undef ALIGN_LONGS
@ -331,9 +328,6 @@
/* Define to 1 if you have the <gmp.h> header file. */ /* Define to 1 if you have the <gmp.h> header file. */
#undef HAVE_GMP_H #undef HAVE_GMP_H
/* Define to 1 if you have the `gmtime' function. */
#undef HAVE_GMTIME
/* Define of h_errno is provided */ /* Define of h_errno is provided */
#undef HAVE_H_ERRNO #undef HAVE_H_ERRNO
@ -475,9 +469,6 @@
/* Define to 1 if you have the `localtime' function. */ /* Define to 1 if you have the `localtime' function. */
#undef HAVE_LOCALTIME #undef HAVE_LOCALTIME
/* Define to 1 if the system has the type `long long'. */
#undef HAVE_LONG_LONG
/* Define to 1 if you have the `lstat' function. */ /* Define to 1 if you have the `lstat' function. */
#undef HAVE_LSTAT #undef HAVE_LSTAT
@ -743,12 +734,6 @@
/* Define to 1 if you have the <sqlite3.h> header file. */ /* Define to 1 if you have the <sqlite3.h> header file. */
#undef HAVE_SQLITE3_H #undef HAVE_SQLITE3_H
/* Define to 1 if the system has the type `SQLLEN'. */
#undef HAVE_SQLLEN
/* Define to 1 if the system has the type `SQLULEN'. */
#undef HAVE_SQLULEN
/* Define to 1 if you have the <sql.h> header file. */ /* Define to 1 if you have the <sql.h> header file. */
#undef HAVE_SQL_H #undef HAVE_SQL_H
@ -884,9 +869,6 @@
/* Define to 1 if you have the `time' function. */ /* Define to 1 if you have the `time' function. */
#undef HAVE_TIME #undef HAVE_TIME
/* Define to 1 if you have the `timegm' function. */
#undef HAVE_TIMEGM
/* Define to 1 if you have the `times' function. */ /* Define to 1 if you have the `times' function. */
#undef HAVE_TIMES #undef HAVE_TIMES
@ -1067,9 +1049,6 @@
/* The size of `short int', as computed by sizeof. */ /* The size of `short int', as computed by sizeof. */
#undef SIZEOF_SHORT_INT #undef SIZEOF_SHORT_INT
/* The size of `SQLWCHAR', as computed by sizeof. */
#undef SIZEOF_SQLWCHAR
/* The size of `void*', as computed by sizeof. */ /* The size of `void*', as computed by sizeof. */
#undef SIZEOF_VOIDP #undef SIZEOF_VOIDP
@ -1130,18 +1109,6 @@
/* Define to name of the UUID header file. */ /* Define to name of the UUID header file. */
#undef UUID_H #undef UUID_H
/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most
significant byte first (like Motorola and SPARC, unlike Intel). */
#if defined AC_APPLE_UNIVERSAL_BUILD
# if defined __BIG_ENDIAN__
# define WORDS_BIGENDIAN 1
# endif
#else
# ifndef WORDS_BIGENDIAN
# undef WORDS_BIGENDIAN
# endif
#endif
/* architecture */ /* architecture */
#undef YAP_ARCH #undef YAP_ARCH
@ -1157,13 +1124,13 @@
/* numerical version */ /* numerical version */
#undef YAP_NUMERIC_VERSION #undef YAP_NUMERIC_VERSION
/* where to look for Prolog sources */ /* where YAP lives */
#undef YAP_PL_SRCDIR #undef YAP_PL_SRCDIR
/* where YAP lives */ /* where YAP lives */
#undef YAP_ROOTDIR #undef YAP_ROOTDIR
/* where to look for the Prolog library */ /* where YAP lives */
#undef YAP_SHAREDIR #undef YAP_SHAREDIR
/* saved state file */ /* saved state file */

774
configure vendored
View File

@ -690,16 +690,12 @@ CPLINT_LIBS
CUDD_CPPFLAGS CUDD_CPPFLAGS
CUDD_LIBS CUDD_LIBS
PKG_BDDLIB PKG_BDDLIB
ODBC_LIBS
ODBC_LDFLAGS
ODBC_CFLAGS
ODBC_PLTARGETS
ODBC_TARGETS
ARCHIVE_LDFLAGS ARCHIVE_LDFLAGS
ARCHIVE_CPPFLAGS ARCHIVE_CPPFLAGS
ARCHIVE_LIBS ARCHIVE_LIBS
ARCHIVE_PLTARGETS ARCHIVE_PLTARGETS
ARCHIVE_TARGETS ARCHIVE_TARGETS
CLIB_CPPFLAGS
CLIB_LIBUUID CLIB_LIBUUID
CLIB_CRYPTOBJ CLIB_CRYPTOBJ
CLIB_CRYPTLIBS CLIB_CRYPTLIBS
@ -725,7 +721,7 @@ JITFLAGS
LLVM_CONFIG LLVM_CONFIG
MYDDAS_LIBS MYDDAS_LIBS
MYDDAS_CPPFLAGS MYDDAS_CPPFLAGS
INCLUDE_MYDDAS OBJECTS_MYDDAS
PKG_MYDDAS PKG_MYDDAS
EXTRA_LIBS_FOR_SWIDLLS EXTRA_LIBS_FOR_SWIDLLS
CLIB_PTHREADS CLIB_PTHREADS
@ -1613,7 +1609,6 @@ Optional Packages:
--without-time Exclude alarm library --without-time Exclude alarm library
--with-libarchive=DIR libarchive package --with-libarchive=DIR libarchive package
--with-odbc=<dir> Location of ODBC include/lib
--with-cudd=DIR use CUDD package in DIR --with-cudd=DIR use CUDD package in DIR
--with-cplint=DIR with the cplint library using the CUDD library in DIR/lib --with-cplint=DIR with the cplint library using the CUDD library in DIR/lib
--with-zlib=DIR zlib compression library --with-zlib=DIR zlib compression library
@ -7259,13 +7254,6 @@ else
PKG_LIBARCHIVE="" PKG_LIBARCHIVE=""
fi fi
if test -e "$srcdir"/packages/odbc/Makefile.in
then
PKG_ODBC="packages/odbc"
else
PKG_ODBC=""
fi
if test "$use_chr" = no if test "$use_chr" = no
then then
PKG_CHR="" PKG_CHR=""
@ -11219,11 +11207,11 @@ else
ENABLE_MYDDAS="" ENABLE_MYDDAS=""
fi fi
INCLUDE_MYDDAS="#" OBJECTS_MYDDAS="#"
if test x"$ENABLE_MYDDAS" = x -a x"$STARTUP_ANDROID" = x if test x"$ENABLE_MYDDAS" = x -a x"$STARTUP_ANDROID" = x
then then
#in Android we have to actually include myddas in the binary #in Android we have to actually include myddas in the binary
INCLUDE_MYDDAS="" OBJECTS_MYDDAS="$(ALL_MYDDAS_OBJECTS)"
fi fi
@ -12215,6 +12203,7 @@ fi
CLIB_TARGETS="socket.$SO cgi.$SO memfile.$SO files.$SO mime.$SO crypt.$SO time.$SO" CLIB_TARGETS="socket.$SO cgi.$SO memfile.$SO files.$SO mime.$SO crypt.$SO time.$SO"
case "$PLARCH" in case "$PLARCH" in
@ -12394,7 +12383,69 @@ fi
fi fi
dl to be installed in various places.
# brew in OSX
if test -d /usr/local/opt/ossp-uuid; then
CPPFLAGS="$CPPFLAGS -I /usr/local/opt/ossp-uuid/include"
UUID_LIB_PATH="-L /usr/local/opt/ossp-uuid/lib"
fi
# /opt
if test -d /opt/include/ossp; then
CPPFLAGS="$CPPFLAGS -I /opt/include"
UUID_LIB_PATH="-L /opt/lib"
fi
# /usr/local
if test -d /opt/include/ossp; then
CPPFLAGS="$CPPFLAGS -I /opt/include"
UUID_LIB_PATH="-L /opt/lib"
fi
if test x"$UUID_H" = "x"; then
ac_fn_c_check_header_compile "$LINENO" "ossp/uuid.h" "ac_cv_header_ossp_uuid_h" "/*first*/
"
if test "x$ac_cv_header_ossp_uuid_h" = xyes; then :
UUID_H=ossp/uuid.h
has_uuid=true
fi
fi
if test x"$UUID_H" = "x" -a ! -d /usr/include/uuid; then
ac_fn_c_check_header_compile "$LINENO" "uuid/uuid.h" "ac_cv_header_uuid_uuid_h" "/*first*/
"
if test "x$ac_cv_header_uuid_uuid_h" = xyes; then :
UUID_H=uuid/uuid.h
has_uuid=true
fi
fi
if test x"$UUID_H" = "x"; then
ac_fn_c_check_header_compile "$LINENO" "uuid.h" "ac_cv_header_uuid_h" "/*first*/
"
if test "x$ac_cv_header_uuid_h" = xyes; then :
UUID_H=uuid.h
has_uuid=true
fi
fi
if test x"$UUID_H" = "x"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Cannot find uuid.h -- dropping uuid.pl" >&5
$as_echo "$as_me: WARNING: Cannot find uuid.h -- dropping uuid.pl" >&2;}
else
cat >>confdefs.h <<_ACEOF
#define UUID_H <$UUID_H>
_ACEOF
has_uuid=true
fi
if test x"$has_uuid" != "x"; then
ac_fn_c_check_func "$LINENO" "uuid_create" "ac_cv_func_uuid_create" ac_fn_c_check_func "$LINENO" "uuid_create" "ac_cv_func_uuid_create"
if test "x$ac_cv_func_uuid_create" = xyes; then : if test "x$ac_cv_func_uuid_create" = xyes; then :
has_uuid=true has_uuid=true
@ -12438,7 +12489,7 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_uuid_uuid_create" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_uuid_uuid_create" >&5
$as_echo "$ac_cv_lib_uuid_uuid_create" >&6; } $as_echo "$ac_cv_lib_uuid_uuid_create" >&6; }
if test "x$ac_cv_lib_uuid_uuid_create" = xyes; then : if test "x$ac_cv_lib_uuid_uuid_create" = xyes; then :
CLIB_LIBUUID=-luuid CLIB_LIBUUID="$UUID_LIB_PATH -luuid"
has_uuid=true has_uuid=true
fi fi
@ -12452,45 +12503,6 @@ $as_echo "$as_me: WARNING: Cannot find libossp-uuid or libuuid -- dropping uuid
fi fi
if test x"$has_uuid" != "x"; then
if test x"$UUID_H" = "x"; then
ac_fn_c_check_header_compile "$LINENO" "ossp/uuid.h" "ac_cv_header_ossp_uuid_h" "/*first*/
"
if test "x$ac_cv_header_ossp_uuid_h" = xyes; then :
UUID_H=ossp/uuid.h
fi
fi
if test x"$UUID_H" = "x" -a ! -d /usr/include/uuid; then
ac_fn_c_check_header_compile "$LINENO" "uuid/uuid.h" "ac_cv_header_uuid_uuid_h" "/*first*/
"
if test "x$ac_cv_header_uuid_uuid_h" = xyes; then :
UUID_H=uuid/uuid.h
fi
fi
if test x"$UUID_H" = "x"; then
ac_fn_c_check_header_compile "$LINENO" "uuid.h" "ac_cv_header_uuid_h" "/*first*/
"
if test "x$ac_cv_header_uuid_h" = xyes; then :
UUID_H=uuid.h
fi
fi
if test x"$UUID_H" = "x"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Cannot find uuid.h -- dropping uuid.pl" >&5
$as_echo "$as_me: WARNING: Cannot find uuid.h -- dropping uuid.pl" >&2;}
else
cat >>confdefs.h <<_ACEOF
#define UUID_H <$UUID_H>
_ACEOF
CLIB_TARGETS="$CLIB_TARGETS uuid.$SO"
fi
fi fi
@ -12835,6 +12847,7 @@ if echo "$CLIB_PLTARGETS" | grep socket.pl 2>&1 >/dev/null; then
CLIB_PLTARGETS="$CLIB_PLTARGETS streampool.pl" CLIB_PLTARGETS="$CLIB_PLTARGETS streampool.pl"
fi fi
CLIB_CPPFLAGS="$CPPFLAGS"
@ -13024,608 +13037,6 @@ fi
fi fi
if test "$PKG_ODBC" != ""; then
# Check whether --with-odbc was given.
if test "${with_odbc+set}" = set; then :
withval=$with_odbc; case $withval in
no|yes) echo 'Specify dir for ODBC please';
exit 1 ;;
*) ODBC_DIR=${withval}
esac
fi
if test ! -z "$ODBC_DIR"; then
ODBC_CFLAGS="-I${ODBC_DIR}/include"
ODBC_LDFLAGS="-L${ODBC_DIR}/lib"
CFLAGS="-I${ODBC_DIR}/include ${CFLAGS}"
CPPFLAGS="-I${ODBC_DIR}/include ${CPPFLAGS}"
CIFLAGS="-I${ODBC_DIR}/include ${CIFLAGS}"
LDFLAGS="-L${ODBC_DIR}/lib ${LDFLAGS}"
fi
havelib=no
case "$PLARCH" in
*-win32|*-win64)
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lodbc32" >&5
$as_echo_n "checking for main in -lodbc32... " >&6; }
if ${ac_cv_lib_odbc32_main+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lodbc32 $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
return main ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_odbc32_main=yes
else
ac_cv_lib_odbc32_main=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_odbc32_main" >&5
$as_echo "$ac_cv_lib_odbc32_main" >&6; }
if test "x$ac_cv_lib_odbc32_main" = xyes; then :
ODBC_LIBS="-lodbc32 $LIBS"
havelib=yes
fi
;;
*)
if test $havelib = no; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for SQLAllocEnv in -lodbc" >&5
$as_echo_n "checking for SQLAllocEnv in -lodbc... " >&6; }
if ${ac_cv_lib_odbc_SQLAllocEnv+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lodbc $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char SQLAllocEnv ();
int
main ()
{
return SQLAllocEnv ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_odbc_SQLAllocEnv=yes
else
ac_cv_lib_odbc_SQLAllocEnv=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_odbc_SQLAllocEnv" >&5
$as_echo "$ac_cv_lib_odbc_SQLAllocEnv" >&6; }
if test "x$ac_cv_lib_odbc_SQLAllocEnv" = xyes; then :
ODBC_LIBS="-lodbc $LIBS"
havelib=yes
fi
if test $havelib = no; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for SQLAllocEnv in -liodbc" >&5
$as_echo_n "checking for SQLAllocEnv in -liodbc... " >&6; }
if ${ac_cv_lib_iodbc_SQLAllocEnv+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-liodbc $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char SQLAllocEnv ();
int
main ()
{
return SQLAllocEnv ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_iodbc_SQLAllocEnv=yes
else
ac_cv_lib_iodbc_SQLAllocEnv=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_iodbc_SQLAllocEnv" >&5
$as_echo "$ac_cv_lib_iodbc_SQLAllocEnv" >&6; }
if test "x$ac_cv_lib_iodbc_SQLAllocEnv" = xyes; then :
ODBC_LIBS="-liodbc $LIBS"
havelib=yes
fi
fi
fi
esac
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5
$as_echo_n "checking whether byte ordering is bigendian... " >&6; }
if ${ac_cv_c_bigendian+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_cv_c_bigendian=unknown
# See if we're dealing with a universal compiler.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifndef __APPLE_CC__
not a universal capable compiler
#endif
typedef int dummy;
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
# Check for potential -arch flags. It is not universal unless
# there are at least two -arch flags with different values.
ac_arch=
ac_prev=
for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do
if test -n "$ac_prev"; then
case $ac_word in
i?86 | x86_64 | ppc | ppc64)
if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then
ac_arch=$ac_word
else
ac_cv_c_bigendian=universal
break
fi
;;
esac
ac_prev=
elif test "x$ac_word" = "x-arch"; then
ac_prev=arch
fi
done
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
if test $ac_cv_c_bigendian = unknown; then
# See if sys/param.h defines the BYTE_ORDER macro.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
#include <sys/param.h>
int
main ()
{
#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \
&& defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \
&& LITTLE_ENDIAN)
bogus endian macros
#endif
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
# It does; now see whether it defined to BIG_ENDIAN or not.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
#include <sys/param.h>
int
main ()
{
#if BYTE_ORDER != BIG_ENDIAN
not big endian
#endif
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_c_bigendian=yes
else
ac_cv_c_bigendian=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
if test $ac_cv_c_bigendian = unknown; then
# See if <limits.h> defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris).
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <limits.h>
int
main ()
{
#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN)
bogus endian macros
#endif
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
# It does; now see whether it defined to _BIG_ENDIAN or not.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <limits.h>
int
main ()
{
#ifndef _BIG_ENDIAN
not big endian
#endif
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_c_bigendian=yes
else
ac_cv_c_bigendian=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
if test $ac_cv_c_bigendian = unknown; then
# Compile a test program.
if test "$cross_compiling" = yes; then :
# Try to guess by grepping values from an object file.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
short int ascii_mm[] =
{ 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
short int ascii_ii[] =
{ 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 };
int use_ascii (int i) {
return ascii_mm[i] + ascii_ii[i];
}
short int ebcdic_ii[] =
{ 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
short int ebcdic_mm[] =
{ 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 };
int use_ebcdic (int i) {
return ebcdic_mm[i] + ebcdic_ii[i];
}
extern int foo;
int
main ()
{
return use_ascii (foo) == use_ebcdic (foo);
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then
ac_cv_c_bigendian=yes
fi
if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then
if test "$ac_cv_c_bigendian" = unknown; then
ac_cv_c_bigendian=no
else
# finding both strings is unlikely to happen, but who knows?
ac_cv_c_bigendian=unknown
fi
fi
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$ac_includes_default
int
main ()
{
/* Are we little or big endian? From Harbison&Steele. */
union
{
long int l;
char c[sizeof (long int)];
} u;
u.l = 1;
return u.c[sizeof (long int) - 1] == 1;
;
return 0;
}
_ACEOF
if ac_fn_c_try_run "$LINENO"; then :
ac_cv_c_bigendian=no
else
ac_cv_c_bigendian=yes
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5
$as_echo "$ac_cv_c_bigendian" >&6; }
case $ac_cv_c_bigendian in #(
yes)
$as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h
;; #(
no)
;; #(
universal)
$as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h
;; #(
*)
as_fn_error $? "unknown endianness
presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;;
esac
for ac_header in malloc.h time.h
do :
as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
cat >>confdefs.h <<_ACEOF
#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
_ACEOF
fi
done
for ac_header in sql.h
do :
ac_fn_c_check_header_compile "$LINENO" "sql.h" "ac_cv_header_sql_h" "
#ifdef __WINDOWS__
#include <windef.h>
#endif
"
if test "x$ac_cv_header_sql_h" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_SQL_H 1
_ACEOF
fi
done
for ac_func in localtime mktime gmtime timegm
do :
as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
cat >>confdefs.h <<_ACEOF
#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF
fi
done
ac_fn_c_check_type "$LINENO" "long long" "ac_cv_type_long_long" "$ac_includes_default"
if test "x$ac_cv_type_long_long" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_LONG_LONG 1
_ACEOF
fi
# The cast to long int works around a bug in the HP C Compiler
# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
# This bug is HP SR number 8606223364.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of long" >&5
$as_echo_n "checking size of long... " >&6; }
if ${ac_cv_sizeof_long+:} false; then :
$as_echo_n "(cached) " >&6
else
if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long))" "ac_cv_sizeof_long" "$ac_includes_default"; then :
else
if test "$ac_cv_type_long" = yes; then
{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error 77 "cannot compute sizeof (long)
See \`config.log' for more details" "$LINENO" 5; }
else
ac_cv_sizeof_long=0
fi
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_long" >&5
$as_echo "$ac_cv_sizeof_long" >&6; }
cat >>confdefs.h <<_ACEOF
#define SIZEOF_LONG $ac_cv_sizeof_long
_ACEOF
# The cast to long int works around a bug in the HP C Compiler
# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
# This bug is HP SR number 8606223364.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of SQLWCHAR" >&5
$as_echo_n "checking size of SQLWCHAR... " >&6; }
if ${ac_cv_sizeof_SQLWCHAR+:} false; then :
$as_echo_n "(cached) " >&6
else
if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (SQLWCHAR))" "ac_cv_sizeof_SQLWCHAR" "
#ifdef __WINDOWS__
#include <windef.h>
#endif
#include <sql.h>
"; then :
else
if test "$ac_cv_type_SQLWCHAR" = yes; then
{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error 77 "cannot compute sizeof (SQLWCHAR)
See \`config.log' for more details" "$LINENO" 5; }
else
ac_cv_sizeof_SQLWCHAR=0
fi
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_SQLWCHAR" >&5
$as_echo "$ac_cv_sizeof_SQLWCHAR" >&6; }
cat >>confdefs.h <<_ACEOF
#define SIZEOF_SQLWCHAR $ac_cv_sizeof_SQLWCHAR
_ACEOF
# The cast to long int works around a bug in the HP C Compiler
# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
# This bug is HP SR number 8606223364.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of wchar_t" >&5
$as_echo_n "checking size of wchar_t... " >&6; }
if ${ac_cv_sizeof_wchar_t+:} false; then :
$as_echo_n "(cached) " >&6
else
if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (wchar_t))" "ac_cv_sizeof_wchar_t" "$ac_includes_default"; then :
else
if test "$ac_cv_type_wchar_t" = yes; then
{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error 77 "cannot compute sizeof (wchar_t)
See \`config.log' for more details" "$LINENO" 5; }
else
ac_cv_sizeof_wchar_t=0
fi
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_wchar_t" >&5
$as_echo "$ac_cv_sizeof_wchar_t" >&6; }
cat >>confdefs.h <<_ACEOF
#define SIZEOF_WCHAR_T $ac_cv_sizeof_wchar_t
_ACEOF
ac_fn_c_check_type "$LINENO" "SQLLEN" "ac_cv_type_SQLLEN" "
#ifdef __WINDOWS__
#include <windef.h>
#endif
#include <sql.h>
"
if test "x$ac_cv_type_SQLLEN" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_SQLLEN 1
_ACEOF
fi
ac_fn_c_check_type "$LINENO" "SQLULEN" "ac_cv_type_SQLULEN" "
#ifdef __WINDOWS__
#include <windef.h>
#endif
#include <sql.h>
"
if test "x$ac_cv_type_SQLULEN" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_SQLULEN 1
_ACEOF
fi
if test "$havelib" = yes &&
test "$ac_cv_header_sql_h" = yes; then
ODBC_TARGETS="odbc4pl.$SO"
else
echo "ERROR: Cannot find odbc library or the header sql.h"
echo "WARNING: ODBC interface will not be built"
ODBC_TARGETS=""
fi
ODBC_PLTARGETS=`echo $ODBC_TARGETS | sed "s/4pl\.$SO/.pl/g"`
if test "$ODBC_TARGETS" = "nolib"
then
PKG_ODBC=""
fi
else
ODBC_TARGETS=nolib
ODBC_PLTARGETS=odbc.pl
fi
# Check whether --with-cudd was given. # Check whether --with-cudd was given.
@ -14731,7 +14142,7 @@ else
JAVA_TEST=Test.java JAVA_TEST=Test.java
CLASS_TEST=Test.class CLASS_TEST=Test.class
cat << \EOF > $JAVA_TEST cat << \EOF > $JAVA_TEST
/* #line 14734 "configure" */ /* #line 14145 "configure" */
public class Test { public class Test {
} }
EOF EOF
@ -14907,7 +14318,7 @@ EOF
if uudecode$EXEEXT Test.uue; then if uudecode$EXEEXT Test.uue; then
ac_cv_prog_uudecode_base64=yes ac_cv_prog_uudecode_base64=yes
else else
echo "configure: 14910: uudecode had trouble decoding base 64 file 'Test.uue'" >&5 echo "configure: 14321: uudecode had trouble decoding base 64 file 'Test.uue'" >&5
echo "configure: failed file was:" >&5 echo "configure: failed file was:" >&5
cat Test.uue >&5 cat Test.uue >&5
ac_cv_prog_uudecode_base64=no ac_cv_prog_uudecode_base64=no
@ -15038,7 +14449,7 @@ else
JAVA_TEST=Test.java JAVA_TEST=Test.java
CLASS_TEST=Test.class CLASS_TEST=Test.class
cat << \EOF > $JAVA_TEST cat << \EOF > $JAVA_TEST
/* #line 15041 "configure" */ /* #line 14452 "configure" */
public class Test { public class Test {
} }
EOF EOF
@ -15073,7 +14484,7 @@ JAVA_TEST=Test.java
CLASS_TEST=Test.class CLASS_TEST=Test.class
TEST=Test TEST=Test
cat << \EOF > $JAVA_TEST cat << \EOF > $JAVA_TEST
/* [#]line 15076 "configure" */ /* [#]line 14487 "configure" */
public class Test { public class Test {
public static void main (String args[]) { public static void main (String args[]) {
System.exit (0); System.exit (0);
@ -16054,7 +15465,6 @@ LTLIBOBJS=$ac_ltlibobjs
: "${CONFIG_STATUS=./config.status}" : "${CONFIG_STATUS=./config.status}"
ac_write_fail=0 ac_write_fail=0
ac_clean_files_save=$ac_clean_files ac_clean_files_save=$ac_clean_files
@ -17741,10 +17151,11 @@ fi
if test "$PKG_SWIG" != ""; then if test "$PKG_SWIG" != ""; then
mkdir -p packages/swig/android
mkdir -p packages/swig/android/usr
mkdir -p packages/swig/python mkdir -p packages/swig/python
mkdir -p packages/swig/R mkdir -p packages/swig/R
mkdir -p packages/swig/java mkdir -p packages/swig/java
mkdir -p packages/swig/fli
mkdir -p packages/swig/jni mkdir -p packages/swig/jni
@ -18208,6 +17619,10 @@ yap_timestamp=`date`
yap_nversion=`expr $YAP_MAJOR_VERSION \* 10000 + $YAP_MINOR_VERSION \* 100 + $YAP_POINT_VERSION` yap_nversion=`expr $YAP_MAJOR_VERSION \* 10000 + $YAP_MINOR_VERSION \* 100 + $YAP_POINT_VERSION`
yap_startup=startup.yss yap_startup=startup.yss
BINDIR=$bindir
DATAROOTDIR="$prefix"/share
BINDIR="$bindir"
cat >>confdefs.h <<_ACEOF cat >>confdefs.h <<_ACEOF
#define YAP_STARTUP "$yap_startup" #define YAP_STARTUP "$yap_startup"
@ -18255,7 +17670,7 @@ _ACEOF
cat >>confdefs.h <<_ACEOF cat >>confdefs.h <<_ACEOF
#define YAP_BINDIR "$prefix/bin" #define YAP_BINDIR "$BINDIR"
_ACEOF _ACEOF
@ -18265,7 +17680,7 @@ _ACEOF
cat >>confdefs.h <<_ACEOF cat >>confdefs.h <<_ACEOF
#define YAP_LIBDIR "$prefix/lib/Yap" #define YAP_LIBDIR "$LIBDIR/Yap"
_ACEOF _ACEOF
@ -18274,18 +17689,18 @@ cat >>confdefs.h <<_ACEOF
_ACEOF _ACEOF
cat >>confdefs.h <<_ACEOF
#define YAP_PL_SRCDIR "$prefix/share/Yap/pl"
_ACEOF
cat >>confdefs.h <<_ACEOF cat >>confdefs.h <<_ACEOF
#define YAP_ROOTDIR "$prefix" #define YAP_ROOTDIR "$prefix"
_ACEOF _ACEOF
cat >>confdefs.h <<_ACEOF cat >>confdefs.h <<_ACEOF
#define YAP_SHAREDIR "$prefix/share" #define YAP_SHAREDIR "$DATAROOTDIR"
_ACEOF
cat >>confdefs.h <<_ACEOF
#define YAP_PL_SRCDIR "$DATAROOTDIR/Yap/pl"
_ACEOF _ACEOF
@ -18347,7 +17762,6 @@ mkdir -p packages/prism/src/c/up
mkdir -p packages/prism/src/prolog mkdir -p packages/prism/src/prolog
mkdir -p packages/ProbLog mkdir -p packages/ProbLog
mkdir -p packages/ProbLog/simplecudd mkdir -p packages/ProbLog/simplecudd
mkdir -p packages/prosqlite
mkdir -p packages/R mkdir -p packages/R
mkdir -p packages/RDF mkdir -p packages/RDF
mkdir -p packages/real mkdir -p packages/real
@ -18468,12 +17882,6 @@ ac_config_files="$ac_config_files packages/archive/Makefile"
fi fi
if test "$PKG_ODBC" != ""; then
ac_config_files="$ac_config_files packages/odbc/Makefile"
fi
if test "$PKG_MINISAT" != ""; then if test "$PKG_MINISAT" != ""; then
ac_config_files="$ac_config_files packages/swi-minisat2/Makefile" ac_config_files="$ac_config_files packages/swi-minisat2/Makefile"
@ -18507,11 +17915,6 @@ ac_config_files="$ac_config_files packages/prism/src/prolog/Makefile"
fi fi
if test "$PKG_PROSQLITE" != ""; then
ac_config_files="$ac_config_files packages/prosqlite/Makefile"
fi
if test "$PKG_WINCONSOLE" != ""; then if test "$PKG_WINCONSOLE" != ""; then
ac_config_files="$ac_config_files swi/console/Makefile" ac_config_files="$ac_config_files swi/console/Makefile"
@ -18630,7 +18033,6 @@ LTLIBOBJS=$ac_ltlibobjs
: "${CONFIG_STATUS=./config.status}" : "${CONFIG_STATUS=./config.status}"
ac_write_fail=0 ac_write_fail=0
ac_clean_files_save=$ac_clean_files ac_clean_files_save=$ac_clean_files
@ -19262,7 +18664,6 @@ do
"packages/sgml/Makefile") CONFIG_FILES="$CONFIG_FILES packages/sgml/Makefile" ;; "packages/sgml/Makefile") CONFIG_FILES="$CONFIG_FILES packages/sgml/Makefile" ;;
"packages/zlib/Makefile") CONFIG_FILES="$CONFIG_FILES packages/zlib/Makefile" ;; "packages/zlib/Makefile") CONFIG_FILES="$CONFIG_FILES packages/zlib/Makefile" ;;
"packages/archive/Makefile") CONFIG_FILES="$CONFIG_FILES packages/archive/Makefile" ;; "packages/archive/Makefile") CONFIG_FILES="$CONFIG_FILES packages/archive/Makefile" ;;
"packages/odbc/Makefile") CONFIG_FILES="$CONFIG_FILES packages/odbc/Makefile" ;;
"packages/swi-minisat2/Makefile") CONFIG_FILES="$CONFIG_FILES packages/swi-minisat2/Makefile" ;; "packages/swi-minisat2/Makefile") CONFIG_FILES="$CONFIG_FILES packages/swi-minisat2/Makefile" ;;
"packages/swi-minisat2/C/Makefile") CONFIG_FILES="$CONFIG_FILES packages/swi-minisat2/C/Makefile" ;; "packages/swi-minisat2/C/Makefile") CONFIG_FILES="$CONFIG_FILES packages/swi-minisat2/C/Makefile" ;;
"packages/real/Makefile") CONFIG_FILES="$CONFIG_FILES packages/real/Makefile" ;; "packages/real/Makefile") CONFIG_FILES="$CONFIG_FILES packages/real/Makefile" ;;
@ -19272,7 +18673,6 @@ do
"packages/CLPBN/horus/Makefile") CONFIG_FILES="$CONFIG_FILES packages/CLPBN/horus/Makefile" ;; "packages/CLPBN/horus/Makefile") CONFIG_FILES="$CONFIG_FILES packages/CLPBN/horus/Makefile" ;;
"packages/prism/src/c/Makefile") CONFIG_FILES="$CONFIG_FILES packages/prism/src/c/Makefile" ;; "packages/prism/src/c/Makefile") CONFIG_FILES="$CONFIG_FILES packages/prism/src/c/Makefile" ;;
"packages/prism/src/prolog/Makefile") CONFIG_FILES="$CONFIG_FILES packages/prism/src/prolog/Makefile" ;; "packages/prism/src/prolog/Makefile") CONFIG_FILES="$CONFIG_FILES packages/prism/src/prolog/Makefile" ;;
"packages/prosqlite/Makefile") CONFIG_FILES="$CONFIG_FILES packages/prosqlite/Makefile" ;;
"swi/console/Makefile") CONFIG_FILES="$CONFIG_FILES swi/console/Makefile" ;; "swi/console/Makefile") CONFIG_FILES="$CONFIG_FILES swi/console/Makefile" ;;
"packages/yap-lbfgs/Makefile") CONFIG_FILES="$CONFIG_FILES packages/yap-lbfgs/Makefile" ;; "packages/yap-lbfgs/Makefile") CONFIG_FILES="$CONFIG_FILES packages/yap-lbfgs/Makefile" ;;

50
configure.in
View File

@ -639,8 +639,8 @@ then
YAP_TARGET=amd64 YAP_TARGET=amd64
AC_CHECK_LIB(ws2_32,main) AC_CHECK_LIB(ws2_32,main)
AC_CHECK_LIB(comdlg32,main) AC_CHECK_LIB(comdlg32,main)
AC_CHECK_LIB(shell32,main) AC_CHECK_LIB(shell32,main)
AC_CHECK_LIB(shlwapi,main) AC_CHECK_LIB(shlwapi,main)
EXTRA_LIBS_FOR_DLLS="-lws2_32" EXTRA_LIBS_FOR_DLLS="-lws2_32"
elif test "$target_os" = "cygwin"; then elif test "$target_os" = "cygwin"; then
CC="${CC} -mno-cygwin" CC="${CC} -mno-cygwin"
@ -653,7 +653,7 @@ then
AC_CHECK_LIB(wsock32,main) AC_CHECK_LIB(wsock32,main)
AC_CHECK_LIB(comdlg32,main) AC_CHECK_LIB(comdlg32,main)
AC_CHECK_LIB(shell32,main) AC_CHECK_LIB(shell32,main)
AC_CHECK_LIB(shlwapi,main) AC_CHECK_LIB(shlwapi,main)
fi fi
AC_DEFINE(__WINDOWS__, 1, [compiling for Windows]) AC_DEFINE(__WINDOWS__, 1, [compiling for Windows])
EXTRA_LIBS_FOR_DLLS="\$(abs_top_builddir)/yap.dll $EXTRA_LIBS_FOR_DLLS" EXTRA_LIBS_FOR_DLLS="\$(abs_top_builddir)/yap.dll $EXTRA_LIBS_FOR_DLLS"
@ -793,13 +793,6 @@ else
PKG_LIBARCHIVE="" PKG_LIBARCHIVE=""
fi fi
if test -e "$srcdir"/packages/odbc/Makefile.in
then
PKG_ODBC="packages/odbc"
else
PKG_ODBC=""
fi
if test "$use_chr" = no if test "$use_chr" = no
then then
PKG_CHR="" PKG_CHR=""
@ -2038,21 +2031,6 @@ fi
fi fi
if test "$PKG_ODBC" != ""; then
m4_include([packages/odbc/configure.in])
if test "$ODBC_TARGETS" = "nolib"
then
PKG_ODBC=""
fi
else
ODBC_TARGETS=nolib
ODBC_PLTARGETS=odbc.pl
fi
m4_include([packages/bdd/configure.in]) m4_include([packages/bdd/configure.in])
m4_include([packages/cplint/configure.in]) m4_include([packages/cplint/configure.in])
@ -2131,6 +2109,10 @@ yap_timestamp=`date`
yap_nversion=`expr $YAP_MAJOR_VERSION \* 10000 + $YAP_MINOR_VERSION \* 100 + $YAP_POINT_VERSION` yap_nversion=`expr $YAP_MAJOR_VERSION \* 10000 + $YAP_MINOR_VERSION \* 100 + $YAP_POINT_VERSION`
yap_startup=startup.yss yap_startup=startup.yss
BINDIR=$bindir
DATAROOTDIR="$prefix"/share
BINDIR="$bindir"
AC_DEFINE_UNQUOTED(YAP_STARTUP, [ "$yap_startup" ], [saved state file]) AC_DEFINE_UNQUOTED(YAP_STARTUP, [ "$yap_startup" ], [saved state file])
AC_DEFINE_UNQUOTED( C_CC, [ "$CC" ], [c-compiler used]) AC_DEFINE_UNQUOTED( C_CC, [ "$CC" ], [c-compiler used])
AC_DEFINE_UNQUOTED( C_CFLAGS, ["$CFLAGS $YAP_EXTRAS $ -D_YAP_NOT_INSTALLED_=1 $CPPFLAGS -I. -I$srcdir/H -I$srcdir/include -I$srcdir/os -I$srcdir/OPTYap -I$srcdir/BEAM" ], [compilation flags]) AC_DEFINE_UNQUOTED( C_CFLAGS, ["$CFLAGS $YAP_EXTRAS $ -D_YAP_NOT_INSTALLED_=1 $CPPFLAGS -I. -I$srcdir/H -I$srcdir/include -I$srcdir/os -I$srcdir/OPTYap -I$srcdir/BEAM" ], [compilation flags])
@ -2140,13 +2122,13 @@ AC_DEFINE_UNQUOTED( C_LIBPLSO, [ "$LIBS $EXTRA_LIBS_FOR_DLLS" ], [libs for linki
AC_DEFINE_UNQUOTED( SO_EXT, [ "$SO" ], [relocable objects]) AC_DEFINE_UNQUOTED( SO_EXT, [ "$SO" ], [relocable objects])
AC_DEFINE_UNQUOTED( SO_PATH, [ "$SOPATH" ], [library search variable]) AC_DEFINE_UNQUOTED( SO_PATH, [ "$SOPATH" ], [library search variable])
AC_DEFINE_UNQUOTED( YAP_ARCH, [ "$ARCH" ], [architecture]) AC_DEFINE_UNQUOTED( YAP_ARCH, [ "$ARCH" ], [architecture])
AC_DEFINE_UNQUOTED( YAP_BINDIR, [ "$prefix/bin" ], [where the yap executable lives]) AC_DEFINE_UNQUOTED( YAP_BINDIR, [ "$BINDIR" ], [where the yap executable lives])
AC_DEFINE_UNQUOTED( YAP_FULL_VERSION, [ "YAP $YAP_VERSION ($ARCH): $yap_timestamp" ], [YAP version string]) AC_DEFINE_UNQUOTED( YAP_FULL_VERSION, [ "YAP $YAP_VERSION ($ARCH): $yap_timestamp" ], [YAP version string])
AC_DEFINE_UNQUOTED( YAP_LIBDIR, [ "$prefix/lib/Yap" ], [where to look for shared libraries]) AC_DEFINE_UNQUOTED( YAP_LIBDIR, [ "$LIBDIR/Yap" ], [where to look for shared libraries])
AC_DEFINE_UNQUOTED( YAP_NUMERIC_VERSION, [ $yap_nversion ], [numerical version]) AC_DEFINE_UNQUOTED( YAP_NUMERIC_VERSION, [ $yap_nversion ], [numerical version])
AC_DEFINE_UNQUOTED( YAP_PL_SRCDIR, [ "$prefix/share/Yap/pl" ], [where to look for Prolog sources])
AC_DEFINE_UNQUOTED( YAP_ROOTDIR, [ "$prefix" ], [where YAP lives]) AC_DEFINE_UNQUOTED( YAP_ROOTDIR, [ "$prefix" ], [where YAP lives])
AC_DEFINE_UNQUOTED( YAP_SHAREDIR, [ "$prefix/share" ], [where to look for the Prolog library]) AC_DEFINE_UNQUOTED( YAP_SHAREDIR, [ "$DATAROOTDIR" ], [where YAP lives])
AC_DEFINE_UNQUOTED( YAP_PL_SRCDIR, [ "$DATAROOTDIR/Yap/pl" ], [where YAP lives])
AC_DEFINE_UNQUOTED( YAP_TIMESTAMP, [ "$yap_timestamp" ], [date of compilation]) AC_DEFINE_UNQUOTED( YAP_TIMESTAMP, [ "$yap_timestamp" ], [date of compilation])
AC_DEFINE_UNQUOTED( YAP_VERSION, [ "$YAP_VERSION" ], [yap version]) AC_DEFINE_UNQUOTED( YAP_VERSION, [ "$YAP_VERSION" ], [yap version])
AC_DEFINE_UNQUOTED( YAP_YAPLIB, [ "$YAPLIB" ], [name of YAP library]) AC_DEFINE_UNQUOTED( YAP_YAPLIB, [ "$YAPLIB" ], [name of YAP library])
@ -2194,7 +2176,6 @@ mkdir -p packages/prism/src/c/up
mkdir -p packages/prism/src/prolog mkdir -p packages/prism/src/prolog
mkdir -p packages/ProbLog mkdir -p packages/ProbLog
mkdir -p packages/ProbLog/simplecudd mkdir -p packages/ProbLog/simplecudd
mkdir -p packages/prosqlite
mkdir -p packages/R mkdir -p packages/R
mkdir -p packages/RDF mkdir -p packages/RDF
mkdir -p packages/real mkdir -p packages/real
@ -2281,11 +2262,6 @@ if test "$PKG_LIBARCHIVE" != ""; then
AC_CONFIG_FILES([packages/archive/Makefile]) AC_CONFIG_FILES([packages/archive/Makefile])
fi fi
if test "$PKG_ODBC" != ""; then
AC_CONFIG_FILES([packages/odbc/Makefile])
fi
if test "$PKG_MINISAT" != ""; then if test "$PKG_MINISAT" != ""; then
AC_CONFIG_FILES([packages/swi-minisat2/Makefile]) AC_CONFIG_FILES([packages/swi-minisat2/Makefile])
AC_CONFIG_FILES([packages/swi-minisat2/C/Makefile]) AC_CONFIG_FILES([packages/swi-minisat2/C/Makefile])
@ -2310,10 +2286,6 @@ AC_CONFIG_FILES([packages/prism/src/c/Makefile])
AC_CONFIG_FILES([packages/prism/src/prolog/Makefile]) AC_CONFIG_FILES([packages/prism/src/prolog/Makefile])
fi fi
if test "$PKG_PROSQLITE" != ""; then
AC_CONFIG_FILES([packages/prosqlite/Makefile])
fi
if test "$PKG_WINCONSOLE" != ""; then if test "$PKG_WINCONSOLE" != ""; then
AC_CONFIG_FILES([swi/console/Makefile]) AC_CONFIG_FILES([swi/console/Makefile])
fi fi

29
include/YapDefs.h
View File

@ -19,6 +19,7 @@
#define _YAPDEFS_H 1 #define _YAPDEFS_H 1
#include <stdlib.h> #include <stdlib.h>
#include <setjmp.h>
#ifdef YAP_H #ifdef YAP_H
@ -72,7 +73,7 @@ typedef bool YAP_Bool;
#define YAP_Term Term #define YAP_Term Term
#define YAP_Arity arity_t #define YAP_Arity arity_t
#define YAP_Module Term #define YAP_Module Term
@ -99,9 +100,9 @@ typedef bool YAP_Bool;
/* Type definitions */ /* Type definitions */
#if _WIN64 #if _WIN64
typedef unsigned long long YAP_CELL; typedef unsigned long long YAP_CELL;
#else #else
typedef uintptr_t YAP_CELL; typedef uintptr_t YAP_CELL;
#endif #endif
typedef YAP_CELL YAP_Term; typedef YAP_CELL YAP_Term;
@ -115,7 +116,7 @@ typedef struct FunctorEntry *YAP_Functor;
typedef struct AtomEntry *YAP_Atom; typedef struct AtomEntry *YAP_Atom;
#if _WIN64 #if _WIN64
typedef long long int YAP_Int; typedef long long int YAP_Int;
typedef unsigned long long int YAP_UInt; typedef unsigned long long int YAP_UInt;
@ -282,16 +283,30 @@ typedef struct yap_boot_params {
Int Yap_InitDefaults( YAP_init_args *init_args, char saved_state[] ); Int Yap_InitDefaults( YAP_init_args *init_args, char saved_state[] );
#endif #endif
/* this should be opaque to the user */ /* this should be opaque to the user */
typedef struct { typedef struct {
unsigned long b; //> choice-point at entry unsigned long b; //> choice-point at entry
YAP_Int CurSlot; //> variables at entry YAP_handle_t CurSlot; //> variables at entry
YAP_Int EndSlot; //> variables at successful execution YAP_handle_t EndSlot; //> variables at successful execution
struct yami *p; //> Program Counter at entry struct yami *p; //> Program Counter at entry
struct yami *cp; //> Continuation PC at entry struct yami *cp; //> Continuation PC at entry
} YAP_dogoalinfo; } YAP_dogoalinfo;
// query manipulation support
typedef struct open_query_struct {
int q_open;
int q_state;
YAP_handle_t q_g;
struct pred_entry *q_pe;
struct yami *q_p, *q_cp;
jmp_buf q_env;
int q_flags;
YAP_dogoalinfo q_h;
struct open_query_struct *oq;
} YAP_openQuery;
typedef void (*YAP_halt_hook)(int exit_code, void *closure); typedef void (*YAP_halt_hook)(int exit_code, void *closure);
typedef YAP_Int YAP_opaque_tag_t; typedef YAP_Int YAP_opaque_tag_t;

154
include/YapInterface.h
View File

@ -47,7 +47,7 @@
@defgroup c-interface YAP original C-interface @defgroup c-interface YAP original C-interface
@ingroup ChYInterface @ingroup ChYInterface
Before describing in full detail how to interface to C code, we will examine Before describing in full detail how to interface to C code, we will examine
a brief example. a brief example.
Assume the user requires a predicate `my_process_id(Id)` which succeeds Assume the user requires a predicate `my_process_id(Id)` which succeeds
@ -59,7 +59,7 @@ C-code described below.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.c} ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.c}
#include "YAP/YapInterface.h" #include "YAP/YapInterface.h"
static int my_process_id(void) static int my_process_id(void)
{ {
YAP_Term pid = YAP_MkIntTerm(getpid()); YAP_Term pid = YAP_MkIntTerm(getpid());
YAP_Term out = YAP_ARG1; YAP_Term out = YAP_ARG1;
@ -205,17 +205,17 @@ follows
The primitive The primitive
YAP_Bool YAP_IsVarTerm(YAP_Term _t_) YAP_Bool YAP_IsVarTerm(YAP_Term _t_)
returns true iff its argument is an uninstantiated variable. Conversely the returns true iff its argument is an uninstantiated variable. Conversely the
primitive primitive
<ul> <ul>
<li>YAP_Bool YAP_NonVarTerm(YAP_Term _t_) <li>YAP_Bool YAP_NonVarTerm(YAP_Term _t_)
returns true iff its argument is not a variable. returns true iff its argument is not a variable.
</li> </li>
</ul> </ul>
The user can create a new uninstantiated variable using the primitive The user can create a new uninstantiated variable using the primitive
@ -228,25 +228,25 @@ The following primitives can be used to discriminate among the different types
of non-variable terms: of non-variable terms:
<ul> <ul>
<li>YAP_Bool YAP_IsIntTerm(YAP_Term _t_) <li>YAP_Bool YAP_IsIntTerm(YAP_Term _t_)
</li> </li>
<li>YAP_Bool YAP_IsFloatTerm(YAP_Term _t_) <li>YAP_Bool YAP_IsFloatTerm(YAP_Term _t_)
</li> </li>
<li>YAP_Bool YAP_IsDbRefTerm(YAP_Term _t_) <li>YAP_Bool YAP_IsDbRefTerm(YAP_Term _t_)
</li> </li>
<li>YAP_Bool YAP_IsAtomTerm(YAP_Term _t_) <li>YAP_Bool YAP_IsAtomTerm(YAP_Term _t_)
</li> </li>
<li>YAP_Bool YAP_IsPairTerm(YAP_Term _t_) <li>YAP_Bool YAP_IsPairTerm(YAP_Term _t_)
</li> </li>
<li>YAP_Bool YAP_IsApplTerm(YAP_Term _t_) <li>YAP_Bool YAP_IsApplTerm(YAP_Term _t_)
</li> </li>
<li>YAP_Bool YAP_IsCompoundTerm(YAP_Term _t_) <li>YAP_Bool YAP_IsCompoundTerm(YAP_Term _t_)
</li> </li>
</ul> </ul>
@ -294,10 +294,10 @@ The following primitives are provided for creating an integer term from an
integer and to access the value of an integer term. integer and to access the value of an integer term.
<ul> <ul>
<li>YAP_Term YAP_MkIntTerm(YAP_Int _i_) <li>YAP_Term YAP_MkIntTerm(YAP_Int _i_)
</li> </li>
<li>YAP_Int YAP_IntOfTerm(YAP_Term _t_) <li>YAP_Int YAP_IntOfTerm(YAP_Term _t_)
</li> </li>
</ul> </ul>
@ -310,11 +310,11 @@ on 64 bit machines.
The two following primitives play a similar role for floating-point terms The two following primitives play a similar role for floating-point terms
<ul> <ul>
<li>YAP_Term YAP_MkFloatTerm(YAP_flt _double_) <li>YAP_Term YAP_MkFloatTerm(YAP_flt _double_)
</li> </li>
<li>YAP_flt YAP_FloatOfTerm(YAP_Term _t_) <li>YAP_flt YAP_FloatOfTerm(YAP_Term _t_)
</li> </li>
</ul> </ul>
@ -326,13 +326,13 @@ a big int, creating a term from a big integer and to access the value
of a big int from a term. of a big int from a term.
<ul> <ul>
<li>YAP_Bool YAP_IsBigNumTerm(YAP_Term _t_) <li>YAP_Bool YAP_IsBigNumTerm(YAP_Term _t_)
</li> </li>
<li>YAP_Term YAP_MkBigNumTerm(void \* _b_) <li>YAP_Term YAP_MkBigNumTerm(void \* _b_)
</li> </li>
<li>void \*YAP_BigNumOfTerm(YAP_Term _t_, void \* _b_) <li>void \*YAP_BigNumOfTerm(YAP_Term _t_, void \* _b_)
</li> </li>
</ul> </ul>
@ -359,7 +359,7 @@ p_print_bignum(void)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Currently, no primitives are supplied to users for manipulating data base Currently, no primitives are supplied to users for manipulating data base
references. references.
A special typedef `YAP_Atom` is provided to describe Prolog A special typedef `YAP_Atom` is provided to describe Prolog
\a atoms (symbolic constants). The two following primitives can be used \a atoms (symbolic constants). The two following primitives can be used
@ -367,24 +367,24 @@ to manipulate atom terms
<ul> <ul>
<li>YAP_Term YAP_MkAtomTerm(YAP_Atom at) <li>YAP_Term YAP_MkAtomTerm(YAP_Atom at)
</li> </li>
<li>YAP_Atom YAP_AtomOfTerm(YAP_Term _t_) <li>YAP_Atom YAP_AtomOfTerm(YAP_Term _t_)
</li> </li>
</ul> </ul>
The following primitives are available for associating atoms with their The following primitives are available for associating atoms with their
names names
<ul> <ul>
<li>YAP_Atom YAP_LookupAtom(char \* _s_) <li>YAP_Atom YAP_LookupAtom(char \* _s_)
</li> </li>
<li>YAP_Atom YAP_FullLookupAtom(char \* _s_) <li>YAP_Atom YAP_FullLookupAtom(char \* _s_)
</li> </li>
<li>char \*YAP_AtomName(YAP_Atom _t_) <li>char \*YAP_AtomName(YAP_Atom _t_)
</li> </li>
</ul> </ul>
@ -398,10 +398,10 @@ The following primitives handle constructing atoms from strings with
wide characters, and vice-versa: wide characters, and vice-versa:
<ul> <ul>
<li>YAP_Atom YAP_LookupWideAtom(wchar_t \* _s_) <li>YAP_Atom YAP_LookupWideAtom(wchar_t \* _s_)
</li> </li>
<li>wchar_t \*YAP_WideAtomName(YAP_Atom _t_) <li>wchar_t \*YAP_WideAtomName(YAP_Atom _t_)
</li> </li>
</ul> </ul>
@ -410,16 +410,16 @@ The following primitive tells whether an atom needs wide atoms in its
representation: representation:
<ul> <ul>
<li>int YAP_IsWideAtom(YAP_Atom _t_) <li>int YAP_IsWideAtom(YAP_Atom _t_)
</li> </li>
</ul> </ul>
The following primitive can be used to obtain the size of an atom in a The following primitive can be used to obtain the size of an atom in a
representation-independent way: representation-independent way:
<ul> <ul>
<li>int YAP_AtomNameLength(YAP_Atom _t_) <li>int YAP_AtomNameLength(YAP_Atom _t_)
</li> </li>
</ul> </ul>
@ -431,13 +431,13 @@ externally to the Prolog engine, allow it to be collected, and call a
hook on garbage collection: hook on garbage collection:
<ul> <ul>
<li>int YAP_AtomGetHold(YAP_Atom _at_) <li>int YAP_AtomGetHold(YAP_Atom _at_)
</li> </li>
<li>int YAP_AtomReleaseHold(YAP_Atom _at_) <li>int YAP_AtomReleaseHold(YAP_Atom _at_)
</li> </li>
<li>int YAP_AGCRegisterHook(YAP_AGC_hook _f_) <li>int YAP_AGCRegisterHook(YAP_AGC_hook _f_)
</li> </li>
</ul> </ul>
@ -448,19 +448,19 @@ most often used to build <em>lists</em>. The following primitives can be
used to manipulate pairs: used to manipulate pairs:
<ul> <ul>
<li>YAP_Term YAP_MkPairTerm(YAP_Term _Head_, YAP_Term _Tail_) <li>YAP_Term YAP_MkPairTerm(YAP_Term _Head_, YAP_Term _Tail_)
</li> </li>
<li>YAP_Term YAP_MkNewPairTerm(void) <li>YAP_Term YAP_MkNewPairTerm(void)
</li> </li>
<li>YAP_Term YAP_HeadOfTerm(YAP_Term _t_) <li>YAP_Term YAP_HeadOfTerm(YAP_Term _t_)
</li> </li>
<li>YAP_Term YAP_TailOfTerm(YAP_Term _t_) <li>YAP_Term YAP_TailOfTerm(YAP_Term _t_)
</li> </li>
<li>YAP_Term YAP_MkListFromTerms(YAP_Term \* _pt_, YAP_Int \* _sz_) <li>YAP_Term YAP_MkListFromTerms(YAP_Term \* _pt_, YAP_Int \* _sz_)
</li> </li>
</ul> </ul>
@ -472,28 +472,28 @@ The last function supports the common operation of constructing a list from an
array of terms of size _sz_ in a simple sweep. array of terms of size _sz_ in a simple sweep.
Notice that the list constructors can call the garbage collector if Notice that the list constructors can call the garbage collector if
there is not enough space in the global stack. there is not enough space in the global stack.
A \a compound term consists of a \a functor and a sequence of terms with A \a compound term consists of a \a functor and a sequence of terms with
length equal to the \a arity of the functor. A functor, described in C by length equal to the \a arity of the functor. A functor, described in C by
the typedef `Functor`, consists of an atom and of an integer. the typedef `Functor`, consists of an atom and of an integer.
The following primitives were designed to manipulate compound terms and The following primitives were designed to manipulate compound terms and
functors functors
<ul> <ul>
<li>YAP_Term YAP_MkApplTerm(YAP_Functor _f_, unsigned long int _n_, YAP_Term[] _args_) <li>YAP_Term YAP_MkApplTerm(YAP_Functor _f_, unsigned long int _n_, YAP_Term[] _args_)
</li> </li>
<li>YAP_Term YAP_MkNewApplTerm(YAP_Functor _f_, int _n_) <li>YAP_Term YAP_MkNewApplTerm(YAP_Functor _f_, int _n_)
</li> </li>
<li>YAP_Term YAP_ArgOfTerm(int argno,YAP_Term _ts_) <li>YAP_Term YAP_ArgOfTerm(int argno,YAP_Term _ts_)
</li> </li>
<li>YAP_Term \*YAP_ArgsOfTerm(YAP_Term _ts_) <li>YAP_Term \*YAP_ArgsOfTerm(YAP_Term _ts_)
</li> </li>
<li>YAP_Functor YAP_FunctorOfTerm(YAP_Term _ts_) <li>YAP_Functor YAP_FunctorOfTerm(YAP_Term _ts_)
</li> </li>
</ul> </ul>
@ -512,7 +512,7 @@ collector if there is not enough space in the global stack.
YAP allows one to manipulate the functors of compound term. The function YAP allows one to manipulate the functors of compound term. The function
[YAP_FunctorOfTerm](@ref YAP_FunctorOfTerm) allows one to obtain a variable of type [YAP_FunctorOfTerm](@ref YAP_FunctorOfTerm) allows one to obtain a variable of type
`YAP_Functor` with the functor to a term. The following functions `YAP_Functor` with the functor to a term. The following functions
then allow one to construct functors, and to obtain their name and arity. then allow one to construct functors, and to obtain their name and arity.
<ul> <ul>
<li>YAP_Functor YAP_MkFunctor(YAP_Atom _a_,unsigned long int _arity_) <li>YAP_Functor YAP_MkFunctor(YAP_Atom _a_,unsigned long int _arity_)
@ -529,7 +529,7 @@ arity.
Constructing terms in the stack may lead to overflow. The routine Constructing terms in the stack may lead to overflow. The routine
<ul> <ul>
<li>int YAP_RequiresExtraStack(size_t _min_) <li>int YAP_RequiresExtraStack(size_t _min_)
</li> </li>
</ul> </ul>
@ -550,7 +550,7 @@ YAP provides a single routine to attempt the unification of two Prolog
terms. The routine may succeed or fail: terms. The routine may succeed or fail:
<ul> <ul>
<li>Int YAP_Unify(YAP_Term _a_, YAP_Term _b_) <li>Int YAP_Unify(YAP_Term _a_, YAP_Term _b_)
</li> </li>
</ul> </ul>
@ -564,7 +564,7 @@ The YAP C-interface now includes an utility routine to copy a string
represented as a list of a character codes to a previously allocated buffer represented as a list of a character codes to a previously allocated buffer
<ul> <ul>
<li>int YAP_StringToBuffer(YAP_Term _String_, char \* _buf_, unsigned int _bufsize_) <li>int YAP_StringToBuffer(YAP_Term _String_, char \* _buf_, unsigned int _bufsize_)
</li> </li>
</ul> </ul>
@ -595,7 +595,7 @@ strings of wide characters:
</li> </li>
<li>YAP_Term YAP_WideBufferToAtomList(wchar_t \* _buf_) <li>YAP_Term YAP_WideBufferToAtomList(wchar_t \* _buf_)
</li> </li>
<li>YAP_Term YAP_NWideBufferToAtomList(wchar_t \* _buf_, size_t _len_) <li>YAP_Term YAP_NWideBufferToAtomList(wchar_t \* _buf_, size_t _len_)
</li> </li>
</ul> </ul>
@ -606,7 +606,7 @@ The C-interface function calls the parser on a sequence of characters
stored at _buf_ and returns the resulting term. stored at _buf_ and returns the resulting term.
<ul> <ul>
<li>YAP_Term YAP_ReadBuffer(char \* _buf_,YAP_Term \* _error_) <li>YAP_Term YAP_ReadBuffer(char \* _buf_,YAP_Term \* _error_)
</li> </li>
</ul> </ul>
@ -619,7 +619,7 @@ These C-interface functions are useful when converting chunks of data to Prolog:
<ul> <ul>
<li>YAP_Term YAP_FloatsToList(double \* _buf_,size_t _sz_) <li>YAP_Term YAP_FloatsToList(double \* _buf_,size_t _sz_)
</li> </li>
<li>YAP_Term YAP_IntsToList(YAP_Int \* _buf_,size_t _sz_) <li>YAP_Term YAP_IntsToList(YAP_Int \* _buf_,size_t _sz_)
</li> </li>
</ul> </ul>
@ -631,7 +631,7 @@ These C-interface functions are useful when converting Prolog lists to arrays:
<ul> <ul>
<li>YAP_Int YAP_IntsToList(YAP_Term t, YAP_Int \* _buf_,size_t _sz_) <li>YAP_Int YAP_IntsToList(YAP_Term t, YAP_Int \* _buf_,size_t _sz_)
</li> </li>
<li>YAP_Int YAP_FloatsToList(YAP_Term t, double \* _buf_,size_t _sz_) <li>YAP_Int YAP_FloatsToList(YAP_Term t, double \* _buf_,size_t _sz_)
</li> </li>
</ul> </ul>
@ -643,7 +643,7 @@ and <tt>-1</tt> on error.
The next routine can be used to ask space from the Prolog data-base: The next routine can be used to ask space from the Prolog data-base:
<ul> <ul>
<li>void \*YAP_AllocSpaceFromYAP(int _size_) <li>void \*YAP_AllocSpaceFromYAP(int _size_)
</li> </li>
</ul> </ul>
@ -654,7 +654,7 @@ The space allocated with [YAP_AllocSpaceFromYAP](@ref YAP_AllocSpaceFromYAP) can
back to YAP by using: back to YAP by using:
<ul> <ul>
<li>void YAP_FreeSpaceFromYAP(void \* _buf_) <li>void YAP_FreeSpaceFromYAP(void \* _buf_)
</li> </li>
</ul> </ul>
@ -669,7 +669,7 @@ control over the YAP Input/Output system. The first routine allows one
to find a file number given a current stream: to find a file number given a current stream:
<ul> <ul>
<li>int YAP_StreamToFileNo(YAP_Term _stream_) <li>int YAP_StreamToFileNo(YAP_Term _stream_)
</li> </li>
</ul> </ul>
@ -683,7 +683,7 @@ stale.
A second routine that is sometimes useful is: A second routine that is sometimes useful is:
<ul> <ul>
<li>void YAP_CloseAllOpenStreams(void) <li>void YAP_CloseAllOpenStreams(void)
</li> </li>
</ul> </ul>
@ -694,7 +694,7 @@ streams. It is most useful if you are doing `fork()`.
Last, one may sometimes need to flush all streams: Last, one may sometimes need to flush all streams:
<ul> <ul>
<li>void YAP_CloseAllOpenStreams(void) <li>void YAP_CloseAllOpenStreams(void)
</li> </li>
</ul> </ul>
@ -706,7 +706,7 @@ routine receives as arguments a file descriptor, the true file name as a
string, an atom with the user name, and a set of flags: string, an atom with the user name, and a set of flags:
<ul> <ul>
<li>void YAP_OpenStream(void \* _FD_, char \* _name_, YAP_Term _t_, int _flags_) <li>void YAP_OpenStream(void \* _FD_, char \* _name_, YAP_Term _t_, int _flags_)
</li> </li>
</ul> </ul>
@ -725,7 +725,7 @@ functions that are useful.
The first provides a way to insert a term into the data-base The first provides a way to insert a term into the data-base
<ul> <ul>
<li>void \*YAP_Record(YAP_Term _t_) <li>void \*YAP_Record(YAP_Term _t_)
</li> </li>
</ul> </ul>
@ -735,7 +735,7 @@ This function returns a pointer to a copy of the term in the database
The next functions provides a way to recover the term from the data-base: The next functions provides a way to recover the term from the data-base:
<ul> <ul>
<li>YAP_Term YAP_Recorded(void \* _handle_) <li>YAP_Term YAP_Recorded(void \* _handle_)
</li> </li>
</ul> </ul>
@ -746,7 +746,7 @@ variables. The function returns <tt>0L</tt> if it cannot create a new term.
Last, the next function allows one to recover space: Last, the next function allows one to recover space:
<ul> <ul>
<li>int YAP_Erase(void \* _handle_) <li>int YAP_Erase(void \* _handle_)
</li> </li>
</ul> </ul>
@ -803,13 +803,13 @@ The second function computes a hash function for a term, as in
`term_hash/4`. `term_hash/4`.
<ul> <ul>
<li>YAP_Int YAP_TermHash(YAP_Term t, YAP_Int range, YAP_Int depth, int ignore_variables)); <li>YAP_Int YAP_TermHash(YAP_Term t, YAP_Int range, YAP_Int depth, int ignore_variables));
</li> </li>
</ul> </ul>
The first three arguments follow `term_has/4`. The last argument The first three arguments follow `term_has/4`. The last argument
indicates what to do if we find a variable: if `0` fail, otherwise indicates what to do if we find a variable: if `0` fail, otherwise
ignore the variable. ignore the variable.
@section Calling_YAP_From_C From `C` back to Prolog @section Calling_YAP_From_C From `C` back to Prolog
@ -823,7 +823,7 @@ has been initialised before:
</ul> </ul>
Execute query _Goal_ and return 1 if the query succeeds, and 0 Execute query _Goal_ and return 1 if the query succeeds, and 0
otherwise. The predicate returns 0 if failure, otherwise it will return otherwise. The predicate returns 0 if failure, otherwise it will return
an _YAP_Term_. an _YAP_Term_.
Quite often, one wants to run a query once. In this case you should use Quite often, one wants to run a query once. In this case you should use
_Goal_: _Goal_:
@ -862,7 +862,7 @@ Look for the next solution to the current query by forcing YAP to
backtrack to the latest goal. Notice that slots allocated since the last backtrack to the latest goal. Notice that slots allocated since the last
YAP_RunGoal() will become invalid. YAP_RunGoal() will become invalid.
<li> `int` YAP_Reset(`yap_reset_t mode`) <li> `int` YAP_Reset(`yap_reset_t mode`)
Reset execution environment Reset execution environment
(similar to the abort/0 built-in). This is useful when (similar to the abort/0 built-in). This is useful when
@ -913,12 +913,12 @@ YAP_FunctorToPredInModule(`YAP_Functor` _f_, `YAP_Module` _m_),
Return the predicate in module _m_ whose main functor is _f_. Return the predicate in module _m_ whose main functor is _f_.
</li> </li>
<li>`YAP_PredEntryPtr` YAP_AtomToPred(`YAP_Atom` _at_, `YAP_Module` _m_), <li>`YAP_PredEntryPtr` YAP_AtomToPred(`YAP_Atom` _at_, `YAP_Module` _m_),
Return the arity 0 predicate in module _m_ whose name is _at_. Return the arity 0 predicate in module _m_ whose name is _at_.
</li> </li>
<li>`YAP_Bool` YAP_EnterGoal(`YAP_PredEntryPtr` _pe_), <li>`YAP_Bool` YAP_EnterGoal(`YAP_PredEntryPtr` _pe_),
`YAP_Term \*` _array_, `YAP_dogoalinfo \*` _infop_) `YAP_Term \*` _array_, `YAP_dogoalinfo \*` _infop_)
Execute a query for predicate _pe_. The query is given as an Execute a query for predicate _pe_. The query is given as an
@ -979,7 +979,7 @@ finding the first solution to the goal, but you can call
[findall/3](@ref findall) or friends if you need all the solutions. [findall/3](@ref findall) or friends if you need all the solutions.
Notice that during execution, garbage collection or stack shifting may Notice that during execution, garbage collection or stack shifting may
have moved the terms have moved the terms
@section Module_Manipulation_in_C Module Manipulation in C @section Module_Manipulation_in_C Module Manipulation in C
@ -1167,7 +1167,7 @@ static int start_n100(void);
static int continue_n100(void); static int continue_n100(void);
typedef struct { typedef struct {
YAP_Term next_solution; YAP_Term next_solution;
} n100_data_type; } n100_data_type;
n100_data_type *n100_data; n100_data_type *n100_data;
@ -1204,7 +1204,7 @@ terms, as in the example. It is also correct to store pointers to
objects external to YAP stacks, as the garbage collector will ignore objects external to YAP stacks, as the garbage collector will ignore
such references. such references.
If the argument of the predicate is a variable, the routine initializes the If the argument of the predicate is a variable, the routine initializes the
structure to be preserved across backtracking with the information structure to be preserved across backtracking with the information
required to provide the next solution, and exits by calling required to provide the next solution, and exits by calling
`continue_n100` to provide that solution. `continue_n100` to provide that solution.
@ -1423,13 +1423,13 @@ The following C-functions are available from YAP:
Compile the Prolog term _Clause_ and assert it as the last clause Compile the Prolog term _Clause_ and assert it as the last clause
for the corresponding procedure. for the corresponding procedure.
+ YAP_MkExo(`YAP_PredEntryPtr` _pred_, `size_t` _sz_, `void *` _uid_) + YAP_MkExo(`YAP_PredEntryPtr` _pred_, `size_t` _sz_, `void *` _uid_)
Predicate _pred_ is an exo-predicate that needs _sz_ bytes of Predicate _pred_ is an exo-predicate that needs _sz_ bytes of
contiguous storage. If _uid_ is non-null associate user-defined contiguous storage. If _uid_ is non-null associate user-defined
code with _pred_. code with _pred_.
+ YAP_AssertTuples(`YAP_PredEntryPtr` pred, `const YAP_Term *` _Facts_, `size_t` nb) + YAP_AssertTuples(`YAP_PredEntryPtr` pred, `const YAP_Term *` _Facts_, `size_t` nb)
Add the array of _nb_ Prolog term `Facts` to the table Add the array of _nb_ Prolog term `Facts` to the table
`Predicate`. `Predicate`.
+ `int` YAP_ContinueGoal(`void`) + `int` YAP_ContinueGoal(`void`)
@ -1489,7 +1489,7 @@ call YAP.
If booting failed you may consult `ErrorNo` and `ErrorCause` If booting failed you may consult `ErrorNo` and `ErrorCause`
for the cause of the error, or call for the cause of the error, or call
`YAP_Error(ErrorNo,0L,ErrorCause)` to do default processing. `YAP_Error(ErrorNo,0L,ErrorCause)` to do default processing.
+ `void` YAP_PutValue(`Atom` _at_, `YAP_Term` _value_) + `void` YAP_PutValue(`Atom` _at_, `YAP_Term` _value_)
Associate the term _value_ with the atom _at_. The term Associate the term _value_ with the atom _at_. The term
@ -1848,7 +1848,7 @@ extern X_API YAP_PredEntryPtr YAP_FunctorToPredInModule(YAP_Functor, YAP_Module)
extern X_API YAP_PredEntryPtr YAP_AtomToPredInModule(YAP_Atom, YAP_Module); extern X_API YAP_PredEntryPtr YAP_AtomToPredInModule(YAP_Atom, YAP_Module);
/* int YAP_EnterGoal(void) */ /* int YAP_EnterGoal(void) */
extern X_API YAP_Bool YAP_EnterGoal(YAP_PredEntryPtr, YAP_Term *, YAP_dogoalinfo *); extern X_API YAP_Bool YAP_EnterGoal(YAP_PredEntryPtr, YAP_handle_t, YAP_dogoalinfo *);
/* int YAP_RetryGoal(void) */ /* int YAP_RetryGoal(void) */
extern X_API YAP_Bool YAP_RetryGoal(YAP_dogoalinfo *); extern X_API YAP_Bool YAP_RetryGoal(YAP_dogoalinfo *);

22
library/dialect/swi/fli/blobs.c
View File

@ -16,7 +16,7 @@
*************************************************************************/ *************************************************************************/
/** /**
* *
* @{ * @{
* @file blobs.c * @file blobs.c
* *
* @addtogroup swi-c-interface * @addtogroup swi-c-interface
@ -47,7 +47,7 @@ PL_EXPORT(int)
PL_is_blob(term_t t, PL_blob_t **type) PL_is_blob(term_t t, PL_blob_t **type)
{ {
CACHE_REGS CACHE_REGS
Term yt = Yap_GetFromSlot(t PASS_REGS); Term yt = Yap_GetFromSlot(t);
Atom a; Atom a;
BlobPropEntry *b; BlobPropEntry *b;
@ -129,7 +129,7 @@ Yap_lookupBlob(void *blob, size_t len, void *type0, int *new)
return ae; return ae;
} }
PL_EXPORT(int) PL_EXPORT(int)
PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type) PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
{ {
CACHE_REGS CACHE_REGS
@ -144,10 +144,10 @@ PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
if (type->acquire) { if (type->acquire) {
type->acquire(AtomToSWIAtom(AbsAtom(ae))); type->acquire(AtomToSWIAtom(AbsAtom(ae)));
} }
return Yap_unify(Yap_GetFromSlot(t PASS_REGS), MkAtomTerm(AbsAtom(ae))); return Yap_unify(Yap_GetFromSlot(t), MkAtomTerm(AbsAtom(ae)));
} }
PL_EXPORT(int) PL_EXPORT(int)
PL_put_blob(term_t t, void *blob, size_t len, PL_blob_t *type) PL_put_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
{ {
CACHE_REGS CACHE_REGS
@ -167,7 +167,7 @@ PL_put_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
return ret; return ret;
} }
PL_EXPORT(int) PL_EXPORT(int)
PL_get_blob(term_t t, void **blob, size_t *len, PL_blob_t **type) PL_get_blob(term_t t, void **blob, size_t *len, PL_blob_t **type)
{ {
CACHE_REGS CACHE_REGS
@ -175,7 +175,7 @@ PL_get_blob(term_t t, void **blob, size_t *len, PL_blob_t **type)
Term tt; Term tt;
AtomEntry *ae; AtomEntry *ae;
tt = Yap_GetFromSlot(t PASS_REGS); tt = Yap_GetFromSlot(t);
if (IsVarTerm(tt)) if (IsVarTerm(tt))
return FALSE; return FALSE;
if (!IsAtomTerm(tt)) if (!IsAtomTerm(tt))
@ -193,7 +193,7 @@ PL_get_blob(term_t t, void **blob, size_t *len, PL_blob_t **type)
return TRUE; return TRUE;
} }
PL_EXPORT(void*) PL_EXPORT(void*)
PL_blob_data(atom_t a, size_t *len, struct PL_blob_t **type) PL_blob_data(atom_t a, size_t *len, struct PL_blob_t **type)
{ {
Atom x = SWIAtomToAtom(a); Atom x = SWIAtomToAtom(a);
@ -227,7 +227,7 @@ PL_register_blob_type(PL_blob_t *type)
SWI_BlobTypes = type; SWI_BlobTypes = type;
} }
PL_EXPORT(PL_blob_t*) PL_EXPORT(PL_blob_t*)
PL_find_blob_type(const char* name) PL_find_blob_type(const char* name)
{ {
Atom at = Yap_LookupAtom((char *)name); Atom at = Yap_LookupAtom((char *)name);
@ -235,7 +235,7 @@ PL_find_blob_type(const char* name)
return YAP_find_blob_type((YAP_Atom)at); return YAP_find_blob_type((YAP_Atom)at);
} }
PL_EXPORT(PL_blob_t*) PL_EXPORT(PL_blob_t*)
YAP_find_blob_type(YAP_Atom at) YAP_find_blob_type(YAP_Atom at)
{ {
AtomEntry *a = RepAtom((Atom)at); AtomEntry *a = RepAtom((Atom)at);
@ -245,7 +245,7 @@ YAP_find_blob_type(YAP_Atom at)
return RepBlobProp(a->PropsOfAE)->blob_t; return RepBlobProp(a->PropsOfAE)->blob_t;
} }
PL_EXPORT(int) PL_EXPORT(int)
PL_unregister_blob_type(PL_blob_t *type) PL_unregister_blob_type(PL_blob_t *type)
{ {
fprintf(stderr,"PL_unregister_blob_type not implemented yet\n"); fprintf(stderr,"PL_unregister_blob_type not implemented yet\n");

284
library/dialect/swi/fli/swi.c
View File

File diff suppressed because it is too large Load Diff

16
library/dialect/swi/fli/swi.h
View File

@ -8,10 +8,10 @@
* * * *
*************************************************************************/ *************************************************************************/
/** /**
@{ @{
@file swi.h @file swi.h
@defgroup swi-c-interface SWI-Prolog Foreign Language Interface @defgroup swi-c-interface SWI-Prolog Foreign Language Interface
@ -37,18 +37,6 @@
void Yap_swi_install(void); void Yap_swi_install(void);
void Yap_install_blobs(void); void Yap_install_blobs(void);
typedef struct open_query_struct {
int q_open;
int q_state;
YAP_Term *q_g;
PredEntry *q_pe;
yamop *q_p, *q_cp;
jmp_buf q_env;
int q_flags;
YAP_dogoalinfo q_h;
struct open_query_struct *oq;
} open_query;
#define addr_hash(V) (((CELL) (V)) >> 4 & (N_SWI_HASH-1)) #define addr_hash(V) (((CELL) (V)) >> 4 & (N_SWI_HASH-1))
static inline void static inline void

3
man/pl.bib
View File

@ -258,7 +258,7 @@
publisher = {Springer-Verlag}, publisher = {Springer-Verlag},
location = {Link{\"o}ping, Sweden} location = {Link{\"o}ping, Sweden}
} }
@Book{Bratko:86, @Book{Bratko:86,
author = "I. Bratko", author = "I. Bratko",
@ -1099,4 +1099,3 @@ pages = {14--17}
Data Representation in the BinWAM. {\em Proc.~of Programming Data Representation in the BinWAM. {\em Proc.~of Programming
Languages Implementation and Logic Programming (PLILP'94)}, LNCS Languages Implementation and Logic Programming (PLILP'94)}, LNCS
844, Madrid 1994. 844, Madrid 1994.

3
misc/GLOBALS
View File

@ -39,7 +39,8 @@ Agc_hook AGCHook =NULL
#if __ANDROID__ #if __ANDROID__
// no need to perform initialization, it is done before we start the Prolog engine. // no need to perform initialization, it is done before we start the Prolog engine.
struct AAssetManager* assetManager =GLOBAL_assetManager struct AAssetManager* assetManager =NULL
char* AssetsWD =NULL
#endif #endif
/* multi-thread support */ /* multi-thread support */

49
misc/mkandroid
View File

@ -130,50 +130,57 @@ startemulator () {
fi fi
} }
androidize () {
cd packages/swig
mkdir -p "$ANDROID_NDK_ROOT"/build/core/lib
make install-android
cd ../..
}
cd $BUILDDROID cd $BUILDDROID
if test x$1 = xmake export HOST="$ANDROID_ARCH"-linux-androideabi
then export CPP="$HOST"-cpp
./config.status export DESTDIR=`pwd`/packages/swig/android
make -j install export PATH="$PATH":/usr/local/bin
rm -r packages/swig/android
elif test x$1 = xenv if test x$1 = xenv
then then
return 0 return 0
elif test x$1 = xdmake elif test x$1 = xdmake
then then
make make
elif test x$1 = xgo elif test x$1 = xmake
then then
echo "In make I believe" pushd packages/swig
make clean
popd
./config.status
CFLAGS="-g" make -j install
elif test x$1 = xeclipse elif test x$1 = xeclipse
then then
startemulator startemulator
"$ECLIPSE" & "$ECLIPSE" &
return 0 return 0
else else
startemulator startemulator
rm -rf "$BUILDDROID"/* rm -rf "$BUILDDROID"/*
cd "$BUILDDROID" cd "$BUILDDROID"
export HOST="$ANDROID_ARCH"-linux-androideabi
export CPP="$HOST"-cpp
"$YAP_SRC"/configure \ "$YAP_SRC"/configure \
--host="$HOST" \ --host="$HOST" \
--prefix=`pwd` \
--enable-low-level-tracer \ --enable-low-level-tracer \
--enable-debug-yap \ --enable-debug-yap \
--enable-dynamic-loading \ --enable-dynamic-loading \
--bindir=/usr/bin \
--prefix=/assets \
--enable-dynamic-loading \
--with-swig \ --with-swig \
--with-gmp=$GMPDIR \ --with-gmp="$GMPDIR" \
--with-sqlite3=$SQLITE3DIR #\ --with-sqlite3="$SQLITE3DIR"
#\
#--enable-chr=yes #--enable-threads #--enable-chr=yes #--enable-threads
make depend make depend
make -j install CFLAGS="-g" make -j install
fi fi
cd packages/swig androidize
mkdir -p "$ANDROID_NDK_ROOT"/build/core/lib
make android
make install-android
adb uninstall pt.up.fc.dcc.yap
adb install android/bin/JavaYap-debug.apk

5
os/SWI-Stream.h
View File

@ -369,9 +369,6 @@ PL_EXPORT(int) StryLock(IOSTREAM *s);
PL_EXPORT(int) Sunlock(IOSTREAM *s); PL_EXPORT(int) Sunlock(IOSTREAM *s);
PL_EXPORT(IOSTREAM *) Snew(void *handle, int flags, IOFUNCTIONS *functions); PL_EXPORT(IOSTREAM *) Snew(void *handle, int flags, IOFUNCTIONS *functions);
PL_EXPORT(IOSTREAM *) Sopen_file(const char *path, const char *how); PL_EXPORT(IOSTREAM *) Sopen_file(const char *path, const char *how);
#ifdef ANDROID_ASSET_MANAGER_H
PL_EXPORT(IOSTREAM *) Sopen_asset(char *bufp, const char *how, AAssetManager* mgr);
#endif
PL_EXPORT(IOSTREAM *) Sfdopen(int fd, const char *type); PL_EXPORT(IOSTREAM *) Sfdopen(int fd, const char *type);
PL_EXPORT(int) Sfileno(IOSTREAM *s); PL_EXPORT(int) Sfileno(IOSTREAM *s);
PL_EXPORT(IOSTREAM *) Sopen_pipe(const char *command, const char *type); PL_EXPORT(IOSTREAM *) Sopen_pipe(const char *command, const char *type);
@ -393,7 +390,7 @@ PL_EXPORT(SOCKET) Swinsock(IOSTREAM *s);
#endif #endif
#endif #endif
PL_EXPORT(int) ScheckBOM(IOSTREAM *s); PL_EXPORT(int) ScheckBOM(IOSTREAM *s);
PL_EXPORT(int) SwriteBOM(IOSTREAM *s); PL_EXPORT(int) SwriteBOM(IOSTREAM *s);
PL_EXPORT(ssize_t) Sread_user(void *handle, char *buf, size_t size); PL_EXPORT(ssize_t) Sread_user(void *handle, char *buf, size_t size);

212
os/pl-file.c
View File

@ -2703,7 +2703,7 @@ PRED_IMPL("put_byte", 2, put_byte2, 0)
} }
/** @pred put_byte(+ _N_) is iso /** @pred put_byte(+ _N_) is iso
Outputs to the current output stream the character whose code is Outputs to the current output stream the character whose code is
@ -2737,7 +2737,7 @@ put_code(term_t stream, term_t chr ARG_LD)
As `put_code(N)`, but to text stream _S_. As `put_code(N)`, but to text stream _S_.
*/ */
/** @pred put_char(+ _S_,+ _A_) is iso /** @pred put_char(+ _S_,+ _A_) is iso
@ -2762,7 +2762,7 @@ text stream.
*/ */
/** @pred put_code(+ _N_) is iso /** @pred put_code(+ _N_) is iso
Outputs to the current output stream the character whose ASCII code is Outputs to the current output stream the character whose ASCII code is
@ -2770,7 +2770,7 @@ Outputs to the current output stream the character whose ASCII code is
_N_ must be a legal ASCII character code, an expression yielding such _N_ must be a legal ASCII character code, an expression yielding such
a code, or a list in which case only the first element is used. a code, or a list in which case only the first element is used.
*/ */
static static
PRED_IMPL("put_code", 1, put_code1, 0) PRED_IMPL("put_code", 1, put_code1, 0)
@ -2784,7 +2784,7 @@ PRED_IMPL("put_code", 1, put_code1, 0)
As `put(N)`, but to stream _S_. As `put(N)`, but to stream _S_.
*/ */
static static
PRED_IMPL("put", 2, put2, 0) PRED_IMPL("put", 2, put2, 0)
@ -2794,7 +2794,7 @@ PRED_IMPL("put", 2, put2, 0)
} }
/** @pred put(+ _N_) /** @pred put(+ _N_)
Outputs to the current output stream the character whose ASCII code is Outputs to the current output stream the character whose ASCII code is
@ -2802,7 +2802,7 @@ Outputs to the current output stream the character whose ASCII code is
expression yielding such a code, or a list in which case only the first expression yielding such a code, or a list in which case only the first
element is used. element is used.
*/ */
static static
PRED_IMPL("put", 1, put1, 0) PRED_IMPL("put", 1, put1, 0)
@ -2838,7 +2838,7 @@ get_nonblank(term_t in, term_t chr ARG_LD)
} }
/** @pred get(- _C_) /** @pred get(- _C_)
The next non-blank character from the current input stream is unified The next non-blank character from the current input stream is unified
@ -2847,7 +2847,7 @@ greater than 32. If there are no more non-blank characters in the
stream, _C_ is unified with -1. If `end_of_stream` has already stream, _C_ is unified with -1. If `end_of_stream` has already
been reached in the previous reading, this call will give an error message. been reached in the previous reading, this call will give an error message.
*/ */
static static
PRED_IMPL("get", 1, get1, 0) PRED_IMPL("get", 1, get1, 0)
@ -2861,7 +2861,7 @@ PRED_IMPL("get", 1, get1, 0)
The same as `get(C)`, but from stream _S_. The same as `get(C)`, but from stream _S_.
*/ */
static static
PRED_IMPL("get", 2, get2, 0) PRED_IMPL("get", 2, get2, 0)
@ -2889,14 +2889,14 @@ skip(term_t in, term_t chr ARG_LD)
} }
/** @pred skip(+ _N_) /** @pred skip(+ _N_)
Skips input characters until the next occurrence of the character with Skips input characters until the next occurrence of the character with
ASCII code _N_. The argument to this predicate can take the same forms ASCII code _N_. The argument to this predicate can take the same forms
as those for `put` (see 6.11). as those for `put` (see 6.11).
*/ */
static static
PRED_IMPL("skip", 1, skip1, 0) PRED_IMPL("skip", 1, skip1, 0)
@ -2911,7 +2911,7 @@ PRED_IMPL("skip", 1, skip1, 0)
Like skip/1, but using stream _S_ instead of the current Like skip/1, but using stream _S_ instead of the current
input stream. input stream.
*/ */
static static
PRED_IMPL("skip", 2, skip2, 0) PRED_IMPL("skip", 2, skip2, 0)
@ -2979,7 +2979,7 @@ If _C_ is unbound, or is a character code, and the stream _S_ is a
binary stream, read the next byte from that stream and unify its binary stream, read the next byte from that stream and unify its
code with _C_. code with _C_.
*/ */
static static
PRED_IMPL("get_byte", 2, get_byte2, 0) PRED_IMPL("get_byte", 2, get_byte2, 0)
@ -2989,14 +2989,14 @@ PRED_IMPL("get_byte", 2, get_byte2, 0)
} }
/** @pred get_byte(- _C_) is iso /** @pred get_byte(- _C_) is iso
If _C_ is unbound, or is a character code, and the current stream is a If _C_ is unbound, or is a character code, and the current stream is a
binary stream, read the next byte from the current stream and unify its binary stream, read the next byte from the current stream and unify its
code with _C_. code with _C_.
*/ */
static static
PRED_IMPL("get_byte", 1, get_byte1, 0) PRED_IMPL("get_byte", 1, get_byte1, 0)
@ -3038,7 +3038,7 @@ If _C_ is unbound, or is a character code, and the stream _S_ is a
text stream, read the next character from that stream and unify its text stream, read the next character from that stream and unify its
code with _C_. code with _C_.
*/ */
static static
PRED_IMPL("get_code", 2, get_code2, 0) PRED_IMPL("get_code", 2, get_code2, 0)
@ -3047,14 +3047,14 @@ PRED_IMPL("get_code", 2, get_code2, 0)
} }
/** @pred get_code(- _C_) is iso /** @pred get_code(- _C_) is iso
If _C_ is unbound, or is the code for a character, and If _C_ is unbound, or is the code for a character, and
the current stream is a text stream, read the next character from the the current stream is a text stream, read the next character from the
current stream and unify its code with _C_. current stream and unify its code with _C_.
*/ */
static static
PRED_IMPL("get_code", 1, get_code1, 0) PRED_IMPL("get_code", 1, get_code1, 0)
@ -3090,7 +3090,7 @@ If _C_ is unbound, or is an atom representation of a character, and
the stream _S_ is a text stream, read the next character from that the stream _S_ is a text stream, read the next character from that
stream and unify its representation as an atom with _C_. stream and unify its representation as an atom with _C_.
*/ */
static static
PRED_IMPL("get_char", 2, get_char2, 0) PRED_IMPL("get_char", 2, get_char2, 0)
@ -3099,14 +3099,14 @@ PRED_IMPL("get_char", 2, get_char2, 0)
} }
/** @pred get_char(- _C_) is iso /** @pred get_char(- _C_) is iso
If _C_ is unbound, or is an atom representation of a character, and If _C_ is unbound, or is an atom representation of a character, and
the current stream is a text stream, read the next character from the the current stream is a text stream, read the next character from the
current stream and unify its atom representation with _C_. current stream and unify its atom representation with _C_.
*/ */
static static
PRED_IMPL("get_char", 1, get_char1, 0) PRED_IMPL("get_char", 1, get_char1, 0)
@ -3181,7 +3181,7 @@ PRED_IMPL("protocolling", 1, protocolling, 0)
} }
/** @pred prompt(- _A_,+ _B_) /** @pred prompt(- _A_,+ _B_)
Changes YAP input prompt from _A_ to _B_. Changes YAP input prompt from _A_ to _B_.
*/ */
@ -3280,7 +3280,7 @@ tab(term_t out, term_t spaces ARG_LD)
The same as tab/1, but using stream _S_. The same as tab/1, but using stream _S_.
*/ */
static static
PRED_IMPL("tab", 2, tab2, 0) PRED_IMPL("tab", 2, tab2, 0)
@ -3289,12 +3289,12 @@ PRED_IMPL("tab", 2, tab2, 0)
return tab(A1, A2 PASS_LD); return tab(A1, A2 PASS_LD);
} }
/** @pred tab(+ _N_) /** @pred tab(+ _N_)
Outputs _N_ spaces to the current output stream. Outputs _N_ spaces to the current output stream.
*/ */
static static
PRED_IMPL("tab", 1, tab1, 0) PRED_IMPL("tab", 1, tab1, 0)
@ -3413,7 +3413,7 @@ openStream(term_t file, term_t mode, term_t options)
int reposition = TRUE; int reposition = TRUE;
atom_t alias = NULL_ATOM; atom_t alias = NULL_ATOM;
atom_t eof_action = ATOM_eof_code; atom_t eof_action = ATOM_eof_code;
int close_on_abort = TRUE; int close_on_abort = TRUE;
atom_t buffer = ATOM_full; atom_t buffer = ATOM_full;
atom_t lock = ATOM_none; atom_t lock = ATOM_none;
int wait = TRUE; int wait = TRUE;
@ -3533,15 +3533,6 @@ openStream(term_t file, term_t mode, term_t options)
#endif /*HAVE_POPEN*/ #endif /*HAVE_POPEN*/
if ( PL_get_file_name(file, &path, 0) ) if ( PL_get_file_name(file, &path, 0) )
{ {
#if __ANDROID__
if (strstr(path,"/assets/")) {
if (!(s=Sopen_asset(path+8, "r", GLOBAL_assetManager)))
{ PL_error(NULL, 0, OsError(), ERR_FILE_OPERATION,
ATOM_open, ATOM_source_sink, file);
return NULL;
}
} else
#endif
if ( !(s = Sopen_file(path, how)) ) if ( !(s = Sopen_file(path, how)) )
{ PL_error(NULL, 0, OsError(), ERR_FILE_OPERATION, { PL_error(NULL, 0, OsError(), ERR_FILE_OPERATION,
ATOM_open, ATOM_source_sink, file); ATOM_open, ATOM_source_sink, file);
@ -3697,7 +3688,7 @@ open_expands_filename.
*/ */
static static
PRED_IMPL("open", 4, open4, PL_FA_ISO) PRED_IMPL("open", 4, open4, PL_FA_ISO)
@ -3710,7 +3701,7 @@ PRED_IMPL("open", 4, open4, PL_FA_ISO)
} }
/** @pred open(+ _F_,+ _M_,- _S_) is iso /** @pred open(+ _F_,+ _M_,- _S_) is iso
Opens the file with name _F_ in mode _M_ (`read`, `write` or Opens the file with name _F_ in mode _M_ (`read`, `write` or
@ -3828,7 +3819,7 @@ pl_seen(void)
return symbol_no_stream(ATOM_current_input); return symbol_no_stream(ATOM_current_input);
} }
/** @pred see(+ _S_) /** @pred see(+ _S_)
If _S_ is a currently opened input stream then it is assumed to be If _S_ is a currently opened input stream then it is assumed to be
@ -3844,7 +3835,7 @@ When _S_ is a stream not currently opened for input, an error may be
reported, depending on the state of the `file_errors` flag. If reported, depending on the state of the `file_errors` flag. If
_S_ is neither a stream nor an atom the predicates just fails. _S_ is neither a stream nor an atom the predicates just fails.
*/ */
static static
PRED_IMPL("see", 1, see, 0) PRED_IMPL("see", 1, see, 0)
@ -3852,7 +3843,7 @@ PRED_IMPL("see", 1, see, 0)
} }
/** @pred seen /** @pred seen
Closes the current input stream (see 6.7.). Closes the current input stream (see 6.7.).
@ -3864,12 +3855,12 @@ PRED_IMPL("seen", 0, seen, 0)
} }
/** @pred seeing(- _S_) /** @pred seeing(- _S_)
The current input stream is unified with _S_. The current input stream is unified with _S_.
*/ */
static static
PRED_IMPL("seeing", 1, seeing, 0) PRED_IMPL("seeing", 1, seeing, 0)
@ -3925,7 +3916,7 @@ ok:
return TRUE; return TRUE;
} }
/** @pred tell(+ _S_) /** @pred tell(+ _S_)
If _S_ is a currently opened stream for output, it becomes the If _S_ is a currently opened stream for output, it becomes the
@ -3941,7 +3932,7 @@ Whenever _S_ is a stream not currently opened for output, an error
may be reported, depending on the state of the file_errors flag. The may be reported, depending on the state of the file_errors flag. The
predicate just fails, if _S_ is neither a stream nor an atom. predicate just fails, if _S_ is neither a stream nor an atom.
*/ */
static static
PRED_IMPL("tell", 1, tell, 0) PRED_IMPL("tell", 1, tell, 0)
@ -3953,12 +3944,12 @@ PRED_IMPL("append", 1, append, 0)
{ return do_tell(A1, ATOM_append); { return do_tell(A1, ATOM_append);
} }
/** @pred telling(- _S_) /** @pred telling(- _S_)
The current output stream is unified with _S_. The current output stream is unified with _S_.
*/ */
static static
PRED_IMPL("telling", 1, telling, 0) PRED_IMPL("telling", 1, telling, 0)
@ -3970,7 +3961,7 @@ PRED_IMPL("telling", 1, telling, 0)
return PL_unify_stream(A1, Scurout); return PL_unify_stream(A1, Scurout);
} }
/** @pred told /** @pred told
Closes the current output stream, and the user's terminal becomes again Closes the current output stream, and the user's terminal becomes again
@ -3978,7 +3969,7 @@ the current output stream. It is important to remember to close streams
after having finished using them, as the maximum number of after having finished using them, as the maximum number of
simultaneously opened streams is 17. simultaneously opened streams is 17.
*/ */
static static
PRED_IMPL("told", 0, told, 0) PRED_IMPL("told", 0, told, 0)
@ -4128,14 +4119,14 @@ pl_close(term_t stream, int force ARG_LD)
} }
/** @pred close(+ _S_) is iso /** @pred close(+ _S_) is iso
Closes the stream _S_. If _S_ does not stand for a stream Closes the stream _S_. If _S_ does not stand for a stream
currently opened an error is reported. The streams user_input, currently opened an error is reported. The streams user_input,
user_output, and user_error can never be closed. user_output, and user_error can never be closed.
*/ */
static static
PRED_IMPL("close", 1, close, PL_FA_ISO) PRED_IMPL("close", 1, close, PL_FA_ISO)
@ -4153,12 +4144,12 @@ static const opt_spec close2_options[] =
/** @pred close(+ _S_,+ _O_) is iso /** @pred close(+ _S_,+ _O_) is iso
Closes the stream _S_, following options _O_. Closes the stream _S_, following options _O_.
The only valid options are `force(true)` and `force(false)`. The only valid options are `force(true)` and `force(false)`.
YAP currently ignores these options. YAP currently ignores these options.
*/ */
static static
PRED_IMPL("close", 2, close2, PL_FA_ISO) PRED_IMPL("close", 2, close2, PL_FA_ISO)
@ -4560,7 +4551,7 @@ typedef struct
} prop_enum; } prop_enum;
/** @pred stream_property(? _Stream_,? _Prop_) is iso /** @pred stream_property(? _Stream_,? _Prop_) is iso
@ -4633,12 +4624,12 @@ The initial mode is `prolog` for the user streams and
+ current_line_number(- _LineNumber_) + current_line_number(- _LineNumber_)
Unify _LineNumber_ with the line number for the current stream. Unify _LineNumber_ with the line number for the current stream.
*/ */
static static
PRED_IMPL("stream_property", 2, stream_property, PRED_IMPL("stream_property", 2, stream_property,
@ -4848,7 +4839,7 @@ PRED_IMPL("stream_property", 2, stream_property,
} }
/** @pred is_stream( _S_) /** @pred is_stream( _S_)
Succeeds if _S_ is a currently open stream. Succeeds if _S_ is a currently open stream.
@ -4891,12 +4882,12 @@ flush_output(term_t out ARG_LD)
return FALSE; return FALSE;
} }
/** @pred flush_output is iso /** @pred flush_output is iso
Send out all data in the output buffer of the current output stream. Send out all data in the output buffer of the current output stream.
*/ */
static static
PRED_IMPL("flush_output", 0, flush_output, PL_FA_ISO) PRED_IMPL("flush_output", 0, flush_output, PL_FA_ISO)
@ -4909,7 +4900,7 @@ PRED_IMPL("flush_output", 0, flush_output, PL_FA_ISO)
Send all data in the output buffer for stream _S_. Send all data in the output buffer for stream _S_.
*/ */
static static
PRED_IMPL("flush_output", 1, flush_output1, PL_FA_ISO) PRED_IMPL("flush_output", 1, flush_output1, PL_FA_ISO)
@ -4973,13 +4964,13 @@ getRepositionableStream(term_t stream, IOSTREAM **sp)
} }
/** @pred set_stream_position(+ _S_, + _POS_) is iso /** @pred set_stream_position(+ _S_, + _POS_) is iso
Given a stream position _POS_ for a stream _S_, set the current Given a stream position _POS_ for a stream _S_, set the current
stream position for _S_ to be _POS_. stream position for _S_ to be _POS_.
*/ */
static static
PRED_IMPL("set_stream_position", 2, set_stream_position, PL_FA_ISO) PRED_IMPL("set_stream_position", 2, set_stream_position, PL_FA_ISO)
@ -5079,13 +5070,13 @@ PRED_IMPL("seek", 4, seek, 0)
} }
/** @pred set_input(+ _S_) is iso /** @pred set_input(+ _S_) is iso
Set stream _S_ as the current input stream. Predicates like read/1 Set stream _S_ as the current input stream. Predicates like read/1
and get/1 will start using stream _S_. and get/1 will start using stream _S_.
*/ */
static static
PRED_IMPL("set_input", 1, set_input, PL_FA_ISO) PRED_IMPL("set_input", 1, set_input, PL_FA_ISO)
@ -5108,7 +5099,7 @@ PRED_IMPL("set_input", 1, set_input, PL_FA_ISO)
Set stream _S_ as the current output stream. Predicates like Set stream _S_ as the current output stream. Predicates like
write/1 and put/1 will start using stream _S_. write/1 and put/1 will start using stream _S_.
*/ */
static static
PRED_IMPL("set_output", 1, set_output, PL_FA_ISO) PRED_IMPL("set_output", 1, set_output, PL_FA_ISO)
@ -5125,12 +5116,12 @@ PRED_IMPL("set_output", 1, set_output, PL_FA_ISO)
} }
/** @pred current_input(- _S_) is iso /** @pred current_input(- _S_) is iso
Unify _S_ with the current input stream. Unify _S_ with the current input stream.
*/ */
static static
PRED_IMPL("current_input", 1, current_input, PL_FA_ISO) PRED_IMPL("current_input", 1, current_input, PL_FA_ISO)
@ -5139,12 +5130,12 @@ PRED_IMPL("current_input", 1, current_input, PL_FA_ISO)
} }
/** @pred current_output(- _S_) is iso /** @pred current_output(- _S_) is iso
Unify _S_ with the current output stream. Unify _S_ with the current output stream.
*/ */
static static
PRED_IMPL("current_output", 1, current_output, PL_FA_ISO) PRED_IMPL("current_output", 1, current_output, PL_FA_ISO)
@ -5177,13 +5168,13 @@ PRED_IMPL("byte_count", 2, byte_count, 0)
} }
/** @pred character_count(+ _Stream_,- _CharacterCount_) /** @pred character_count(+ _Stream_,- _CharacterCount_)
Unify _CharacterCount_ with the number of characters written to or Unify _CharacterCount_ with the number of characters written to or
read from _Stream_. read from _Stream_.
*/ */
static static
PRED_IMPL("character_count", 2, character_count, 0) PRED_IMPL("character_count", 2, character_count, 0)
@ -5201,12 +5192,12 @@ PRED_IMPL("character_count", 2, character_count, 0)
} }
/** @pred line_count(+ _Stream_,- _LineNumber_) /** @pred line_count(+ _Stream_,- _LineNumber_)
Unify _LineNumber_ with the line number for the _Stream_. Unify _LineNumber_ with the line number for the _Stream_.
*/ */
static static
PRED_IMPL("line_count", 2, line_count, 0) PRED_IMPL("line_count", 2, line_count, 0)
@ -5224,13 +5215,13 @@ PRED_IMPL("line_count", 2, line_count, 0)
} }
/** @pred line_position(+ _Stream_,- _LinePosition_) /** @pred line_position(+ _Stream_,- _LinePosition_)
Unify _LinePosition_ with the position on current text stream Unify _LinePosition_ with the position on current text stream
_Stream_. _Stream_.
*/ */
static static
PRED_IMPL("line_position", 2, line_position, 0) PRED_IMPL("line_position", 2, line_position, 0)
@ -5289,7 +5280,7 @@ at_end_of_stream(term_t stream ARG_LD)
Succeed if the stream _S_ has stream position end-of-stream or Succeed if the stream _S_ has stream position end-of-stream or
past-end-of-stream. Note that _S_ must be a readable stream. past-end-of-stream. Note that _S_ must be a readable stream.
*/ */
static static
PRED_IMPL("at_end_of_stream", 1, at_end_of_stream, PL_FA_ISO) PRED_IMPL("at_end_of_stream", 1, at_end_of_stream, PL_FA_ISO)
@ -5297,13 +5288,13 @@ PRED_IMPL("at_end_of_stream", 1, at_end_of_stream, PL_FA_ISO)
return at_end_of_stream(A1 PASS_LD); return at_end_of_stream(A1 PASS_LD);
} }
/** @pred at_end_of_stream is iso /** @pred at_end_of_stream is iso
Succeed if the current stream has stream position end-of-stream or Succeed if the current stream has stream position end-of-stream or
past-end-of-stream. past-end-of-stream.
*/ */
static static
PRED_IMPL("at_end_of_stream", 0, at_end_of_stream0, PL_FA_ISO) PRED_IMPL("at_end_of_stream", 0, at_end_of_stream0, PL_FA_ISO)
@ -5327,13 +5318,13 @@ peek(term_t stream, term_t chr, int how ARG_LD)
if ( how == PL_BYTE ) if ( how == PL_BYTE )
{ IOPOS pos = s->posbuf; { IOPOS pos = s->posbuf;
c = Sgetc(s); c = Sgetc(s);
if ( c != EOF ) if ( c != EOF ){
Sungetc(c, s); Sungetc(c, s);
}
s->posbuf = pos; s->posbuf = pos;
} else } else {
{ c = Speekcode(s); c = Speekcode(s);
} }
if ( Sferror(s) ) if ( Sferror(s) )
return streamStatus(s); return streamStatus(s);
@ -5359,7 +5350,7 @@ If _C_ is unbound, or is a character code, and _S_ is a binary
stream, read the next byte from the current stream and unify its code stream, read the next byte from the current stream and unify its code
with _C_, while leaving the current stream position unaltered. with _C_, while leaving the current stream position unaltered.
*/ */
static static
PRED_IMPL("peek_byte", 2, peek_byte2, 0) PRED_IMPL("peek_byte", 2, peek_byte2, 0)
@ -5368,14 +5359,14 @@ PRED_IMPL("peek_byte", 2, peek_byte2, 0)
} }
/** @pred peek_byte(- _C_) is iso /** @pred peek_byte(- _C_) is iso
If _C_ is unbound, or is a character code, and the current stream is a If _C_ is unbound, or is a character code, and the current stream is a
binary stream, read the next byte from the current stream and unify its binary stream, read the next byte from the current stream and unify its
code with _C_, while leaving the current stream position unaltered. code with _C_, while leaving the current stream position unaltered.
*/ */
static static
PRED_IMPL("peek_byte", 1, peek_byte1, 0) PRED_IMPL("peek_byte", 1, peek_byte1, 0)
@ -5391,7 +5382,7 @@ the stream _S_ is a text stream, read the next character from that
stream and unify its representation as an atom with _C_, while leaving stream and unify its representation as an atom with _C_, while leaving
the current stream position unaltered. the current stream position unaltered.
*/ */
static static
PRED_IMPL("peek_code", 2, peek_code2, 0) PRED_IMPL("peek_code", 2, peek_code2, 0)
@ -5407,7 +5398,7 @@ the stream _S_ is a text stream, read the next character from that
stream and unify its representation as an atom with _C_, while leaving stream and unify its representation as an atom with _C_, while leaving
the current stream position unaltered. the current stream position unaltered.
*/ */
static static
PRED_IMPL("peek_code", 1, peek_code1, 0) PRED_IMPL("peek_code", 1, peek_code1, 0)
@ -5423,7 +5414,7 @@ the stream _S_ is a text stream, read the next character from that
stream and unify its representation as an atom with _C_, while leaving stream and unify its representation as an atom with _C_, while leaving
the current stream position unaltered. the current stream position unaltered.
*/ */
static static
PRED_IMPL("peek_char", 2, peek_char2, 0) PRED_IMPL("peek_char", 2, peek_char2, 0)
@ -5431,7 +5422,7 @@ PRED_IMPL("peek_char", 2, peek_char2, 0)
return peek(A1, A2, PL_CHAR PASS_LD); return peek(A1, A2, PL_CHAR PASS_LD);
} }
/** @pred peek_char(- _C_) is iso /** @pred peek_char(- _C_) is iso
If _C_ is unbound, or is an atom representation of a character, and If _C_ is unbound, or is an atom representation of a character, and
@ -5439,7 +5430,7 @@ the current stream is a text stream, read the next character from the
current stream and unify its atom representation with _C_, while current stream and unify its atom representation with _C_, while
leaving the current stream position unaltered. leaving the current stream position unaltered.
*/ */
static static
PRED_IMPL("peek_char", 1, peek_char1, 0) PRED_IMPL("peek_char", 1, peek_char1, 0)
@ -5755,7 +5746,7 @@ BeginPredDefs(file)
PRED_DEF("get0", 1, get_code1, 0) PRED_DEF("get0", 1, get_code1, 0)
PRED_DEF("ttyflush", 0, ttyflush, 0) PRED_DEF("ttyflush", 0, ttyflush, 0)
PRED_DEF("prompt", 2, prompt, 0) PRED_DEF("prompt", 2, prompt, 0)
PRED_DEF("tab", 2, tab2, 0) PRED_DEF("tab", 2, tab2, 0)
PRED_DEF("tab", 1, tab1, 0) PRED_DEF("tab", 1, tab1, 0)
/* Quintus IO */ /* Quintus IO */
PRED_DEF("byte_count", 2, byte_count, 0) PRED_DEF("byte_count", 2, byte_count, 0)
@ -5883,20 +5874,20 @@ static const PL_extension foreigns[] = {
FRG("print", 1, pl_print, 0), FRG("print", 1, pl_print, 0),
FRG("writeln", 1, pl_writeln, 0), FRG("writeln", 1, pl_writeln, 0),
FRG("nl", 1, pl_nl1, ISO), FRG("nl", 1, pl_nl1, ISO),
FRG("format", 2, pl_format, META), FRG("format", 2, pl_format, METAP),
FRG("write", 2, pl_write2, ISO), FRG("write", 2, pl_write2, ISO),
FRG("writeq", 2, pl_writeq2, ISO), FRG("writeq", 2, pl_writeq2, ISO),
FRG("print", 2, pl_print2, 0), FRG("print", 2, pl_print2, 0),
FRG("write_canonical", 2, pl_write_canonical2, ISO), FRG("write_canonical", 2, pl_write_canonical2, ISO),
FRG("format", 3, pl_format3, META), FRG("format", 3, pl_format3, METAP),
FRG("sleep", 1, pl_sleep, 0), FRG("sleep", 1, pl_sleep, 0),
FRG("get_time", 1, pl_get_time, 0), FRG("get_time", 1, pl_get_time, 0),
// vsc // vsc
FRG("format_predicate", 2, pl_format_predicate, META), FRG("format_predicate", 2, pl_format_predicate, METAP),
FRG("current_format_predicate", 2, pl_current_format_predicate, FRG("current_format_predicate", 2, pl_current_format_predicate,
META|NDET), METAP|NDET),
FRG("$raw_read", 1, pl_raw_read, 0), FRG("$raw_read", 1, pl_raw_read, 0),
FRG("$raw_read", 2, pl_raw_read2, 0), FRG("$raw_read", 2, pl_raw_read2, 0),
@ -5906,37 +5897,11 @@ static const PL_extension foreigns[] = {
LFRG((char *)NULL, 0, NULL, 0) LFRG((char *)NULL, 0, NULL, 0)
}; };
#if __ANDROID__
JNIEnv *Yap_jenv;
void Java_pt_up_fc_dcc_yap_JavaYap_load(JNIEnv *env0, jobject obj, jobject mgr);
void Java_pt_up_fc_dcc_yap_JavaYap_load
(JNIEnv *env0, jobject obj, jobject mgr0)
{
AAssetManager *mgr = AAssetManager_fromJava(env0, mgr0);
Yap_jenv = env0;
if (mgr == NULL) {
__android_log_print(ANDROID_LOG_DEBUG, "YapJava", "Need to print : we're doomed, mgr = 0; bip bip bip");
} else {
__android_log_print(ANDROID_LOG_DEBUG, "YapJava", "Need to print : we're winning, mgr = %p; yeah", mgr);
GLOBAL_assetManager = mgr;
}
}
AAssetManager *Yap_assetManager( void );
AAssetManager *Yap_assetManager( void )
{
return GLOBAL_assetManager;
}
#endif
struct PL_local_data *Yap_InitThreadIO(int wid) struct PL_local_data *Yap_InitThreadIO(int wid)
{ {
struct PL_local_data *p; struct PL_local_data *p;
if (wid) if (wid)
p = (struct PL_local_data *)malloc(sizeof(struct PL_local_data)); p = (struct PL_local_data *)malloc(sizeof(struct PL_local_data));
else else
return &lds; return &lds;
@ -6046,4 +6011,3 @@ init_yap(void)
/** /**
@} @}
*/ */

180
os/pl-files.c
View File

@ -122,25 +122,12 @@ LastModifiedFile(const char *name, double *tp)
char tmp[MAXPATHLEN]; char tmp[MAXPATHLEN];
statstruct buf; statstruct buf;
#ifdef __ANDROID__ #ifdef __ANDROID__
if (strstr(name,"/assets")) { if (Yap_isAsset(name)) {
AAssetManager* mgr = GLOBAL_assetManager; if ( statfunc(OsPath("/", tmp), &buf) < 0 )
*tp = (double)0; return FALSE;
if (!strcmp(name,"/assets"))
return TRUE; *tp = (double)buf.st_mtime;
const char *bufp=name+strlen("/assets/"); return Yap_AccessAsset(name, R_OK);
// check if file is a directory.
AAssetDir *assetDir = AAssetManager_openDir(mgr, bufp);
if (assetDir) {
const char *ptr = AAssetDir_getNextFileName(assetDir) ;
AAssetDir_close(assetDir);
if (ptr)
return TRUE;
}
AAsset *asset = AAssetManager_open(mgr, bufp, AASSET_MODE_UNKNOWN);
if (!asset)
return FALSE;
AAsset_close(asset);
return TRUE;
} }
#endif #endif
@ -202,31 +189,19 @@ LastModifiedFile64(const char *name, int64_t *tp)
char tmp[MAXPATHLEN]; char tmp[MAXPATHLEN];
statstruct buf; statstruct buf;
#ifdef __ANDROID__ #ifdef __ANDROID__
if (strstr(name,"/assets")) { if (Yap_isAsset(name)) {
AAssetManager* mgr = GLOBAL_assetManager; if ( statfunc(OsPath("/", tmp), &buf) < 0 ) {
*tp = (int64_t)0; return FALSE;
if (!strcmp(name,"/assets")) }
return TRUE; *tp = (int64_t)buf.st_mtime;
const char *bufp=name+strlen("/assets/"); return Yap_AccessAsset(name, R_OK);
// check if file is a directory. }
AAssetDir *assetDir = AAssetManager_openDir(mgr, bufp);
if (assetDir) {
const char *ptr = AAssetDir_getNextFileName(assetDir) ;
AAssetDir_close(assetDir);
if (ptr)
return TRUE;
}
AAsset *asset = AAssetManager_open(mgr, bufp, AASSET_MODE_UNKNOWN);
if (!asset)
return FALSE;
AAsset_close(asset);
return TRUE;
}
#endif #endif
if ( statfunc(OsPath(name, tmp), &buf) < 0 ) if ( statfunc(OsPath(name, tmp), &buf) < 0 ){
return FALSE; return FALSE;
}
*tp = (int64_t)buf.st_mtime; *tp = (int64_t)buf.st_mtime;
return TRUE; return TRUE;
@ -246,26 +221,9 @@ SizeFile(const char *path)
statstruct buf; statstruct buf;
#ifdef __ANDROID__ #ifdef __ANDROID__
if (strstr(path,"/assets")) { if (Yap_isAsset(path)) {
AAssetManager* mgr = GLOBAL_assetManager; return Yap_AssetSize( path );
if (!strcmp(path,"/assets")) }
return 0;
const char *bufp=path+strlen("/assets/");
// check if file is a directory.
AAssetDir *assetDir = AAssetManager_openDir(mgr, bufp);
if (assetDir) {
const char *ptr = AAssetDir_getNextFileName(assetDir) ;
AAssetDir_close(assetDir);
if (ptr)
return 0;
}
AAsset *asset = AAssetManager_open(mgr, bufp, AASSET_MODE_UNKNOWN);
if (!asset)
return -1;
AAsset_close(asset);
return 0;
}
#endif #endif
if ( statfunc(OsPath(path, tmp), &buf) < 0 ) if ( statfunc(OsPath(path, tmp), &buf) < 0 )
return -1; return -1;
@ -288,36 +246,6 @@ ACCESS_WRITE and ACCESS_EXECUTE.
int int
AccessFile(const char *path, int mode) AccessFile(const char *path, int mode)
{ char tmp[MAXPATHLEN]; { char tmp[MAXPATHLEN];
#ifdef __ANDROID__
if (strstr(path,"/assets")) {
AAssetManager* mgr = GLOBAL_assetManager;
if (!strcmp(path,"/assets"))
return !(mode & ACCESS_WRITE );
const char *bufp=path+strlen("/assets/");
// check if file is a directory.
AAssetDir *assetDir = AAssetManager_openDir(mgr, bufp);
if (assetDir) {
const char *ptr = AAssetDir_getNextFileName(assetDir) ;
AAssetDir_close(assetDir);
if (ptr)
return !(mode & ACCESS_WRITE );
}
AAsset *asset = AAssetManager_open(mgr, bufp, AASSET_MODE_UNKNOWN);
if (!asset)
return FALSE;
AAsset_close(asset);
if ( mode == ACCESS_EXIST )
return TRUE;
else
{
if ( mode & ACCESS_WRITE ) return FALSE;
#ifdef X_OK
if ( mode & ACCESS_EXECUTE ) return FALSE;
#endif
return TRUE;
}
}
#endif
#ifdef HAVE_ACCESS #ifdef HAVE_ACCESS
int m = 0; int m = 0;
@ -331,6 +259,11 @@ AccessFile(const char *path, int mode)
#endif #endif
} }
#ifdef __ANDROID__
if (Yap_isAsset(path)) {
return !(mode & ACCESS_WRITE ) && Yap_AccessAsset(path, m);
}
#endif
return access(OsPath(path, tmp), m) == 0 ? TRUE : FALSE; return access(OsPath(path, tmp), m) == 0 ? TRUE : FALSE;
#else #else
# error "No implementation for AccessFile()" # error "No implementation for AccessFile()"
@ -348,25 +281,9 @@ ExistsFile(const char *path)
statstruct buf; statstruct buf;
#ifdef __ANDROID__ #ifdef __ANDROID__
if (strstr(path,"/assets")) { if (Yap_isAsset(path)) {
AAssetManager* mgr = GLOBAL_assetManager; return Yap_AssetIsFile(path);
if (!strcmp(path,"/assets")) }
return TRUE;
const char *bufp=path+strlen("/assets/");
// check if file is a directory.
AAssetDir *assetDir = AAssetManager_openDir(mgr, bufp);
if (assetDir) {
const char *ptr = AAssetDir_getNextFileName(assetDir) ;
AAssetDir_close(assetDir);
if (ptr)
return TRUE;
}
AAsset *asset = AAssetManager_open(mgr, bufp, AASSET_MODE_UNKNOWN);
if (!asset)
return FALSE;
AAsset_close(asset);
return TRUE;
}
#endif #endif
if ( statfunc(OsPath(path, tmp), &buf) == -1 || !S_ISREG(buf.st_mode) ) if ( statfunc(OsPath(path, tmp), &buf) == -1 || !S_ISREG(buf.st_mode) )
{ DEBUG(2, perror(tmp)); { DEBUG(2, perror(tmp));
@ -388,22 +305,9 @@ ExistsDirectory(const char *path)
statstruct buf; statstruct buf;
#ifdef __ANDROID__ #ifdef __ANDROID__
if (strstr(ospath,"/assets")) { if (Yap_isAsset(ospath)) {
AAssetManager* mgr = GLOBAL_assetManager; return Yap_AssetIsDir(ospath);
const char *ptr = NULL; }
if (!strcmp(path,"/assets"))
return TRUE;
const char *bufp=path+strlen("/assets/");
// check if file is a directory.
AAssetDir *assetDir = AAssetManager_openDir(mgr, bufp);
if (assetDir)
ptr = AAssetDir_getNextFileName(assetDir);
if (assetDir) {
AAssetDir_close(assetDir);
}
return ptr != NULL;
}
#endif #endif
if ( statfunc(ospath, &buf) < 0 ) if ( statfunc(ospath, &buf) < 0 )
return FALSE; return FALSE;
@ -688,12 +592,10 @@ get_file_name(term_t n, char **namep, char *tmp, int flags)
if ( len+1 >= MAXPATHLEN ) if ( len+1 >= MAXPATHLEN )
return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
ATOM_max_path_length); ATOM_max_path_length);
if ( truePrologFlag(PLFLAG_FILEVARS) ) if ( truePrologFlag(PLFLAG_FILEVARS) )
{ if ( !(name = expandVars(name, tmp, MAXPATHLEN)) ) { if ( !(name = expandVars(name, tmp, MAXPATHLEN)) )
return FALSE; return FALSE;
} }
if ( !(flags & PL_FILE_NOERRORS) ) if ( !(flags & PL_FILE_NOERRORS) )
{ atom_t op = 0; { atom_t op = 0;
@ -732,10 +634,9 @@ PL_get_file_name(term_t n, char **namep, int flags)
if ( (rc=get_file_name(n, &name, buf, flags)) ) if ( (rc=get_file_name(n, &name, buf, flags)) )
{ if ( (flags & PL_FILE_OSPATH) ) { if ( (flags & PL_FILE_OSPATH) )
{ if ( !(name = OsPath(name, ospath)) ) { if ( !(name = OsPath(name, ospath)) )
return FALSE; return FALSE;
} }
*namep = buffer_string(name, BUF_RING); *namep = buffer_string(name, BUF_RING);
} }
@ -836,11 +737,11 @@ PRED_IMPL("size_file", 2, size_file, 0)
static static
PRED_IMPL("access_file", 2, access_file, 0) PRED_IMPL("access_file", 2, access_file, 0)
/** @pred access_file(+ _F_,+ _M_) /** @pred access_file(+ _F_,+ _M_)
Is the file accessible? Is the file accessible?
*/ */
{ PRED_LD { PRED_LD
char *n; char *n;
@ -873,7 +774,7 @@ Is the file accessible?
return TRUE; return TRUE;
if ( md == ACCESS_WRITE && !AccessFile(n, ACCESS_EXIST) ) if ( md == ACCESS_WRITE && !AccessFile(n, ACCESS_EXIST) )
{ {
char *dir = DirName(n); char *dir = DirName(n);
if ( dir[0] ) if ( dir[0] )
@ -956,12 +857,12 @@ PRED_IMPL("same_file", 2, same_file, 0)
} }
/** @pred file_base_name(+ _Name_,- _FileName_) /** @pred file_base_name(+ _Name_,- _FileName_)
Give the path a full path _FullPath_ extract the _FileName_. Give the path a full path _FullPath_ extract the _FileName_.
*/ */
static static
PRED_IMPL("file_base_name", 2, file_base_name, 0) PRED_IMPL("file_base_name", 2, file_base_name, 0)
@ -969,7 +870,7 @@ PRED_IMPL("file_base_name", 2, file_base_name, 0)
if ( !PL_get_chars(A1, &n, CVT_ALL|REP_FN|CVT_EXCEPTION) ) if ( !PL_get_chars(A1, &n, CVT_ALL|REP_FN|CVT_EXCEPTION) )
return FALSE; return FALSE;
return PL_unify_chars(A2, PL_ATOM|REP_FN, -1, BaseName(n)); return PL_unify_chars(A2, PL_ATOM|REP_FN, -1, BaseName(n));
} }
@ -977,7 +878,7 @@ PRED_IMPL("file_base_name", 2, file_base_name, 0)
static static
PRED_IMPL("file_directory_name", 2, file_directory_name, 0) PRED_IMPL("file_directory_name", 2, file_directory_name, 0)
{ char *n; { char *n;
if ( !PL_get_chars(A1, &n, CVT_ALL|REP_FN|CVT_EXCEPTION) ) if ( !PL_get_chars(A1, &n, CVT_ALL|REP_FN|CVT_EXCEPTION) )
return FALSE; return FALSE;
int out = PL_unify_chars(A2, PL_ATOM|REP_FN, -1, DirName(n)); int out = PL_unify_chars(A2, PL_ATOM|REP_FN, -1, DirName(n));
@ -1138,7 +1039,6 @@ PRED_IMPL("$absolute_file_name", 2, absolute_file_name, 0)
term_t name = A1; term_t name = A1;
term_t expanded = A2; term_t expanded = A2;
if ( PL_get_file_name(name, &n, 0) && if ( PL_get_file_name(name, &n, 0) &&
(n = AbsoluteFile(n, tmp)) ) (n = AbsoluteFile(n, tmp)) )
return PL_unify_chars(expanded, PL_ATOM|REP_FN, -1, n); return PL_unify_chars(expanded, PL_ATOM|REP_FN, -1, n);
@ -1212,7 +1112,7 @@ name_too_long(void)
} }
/** @pred file_name_extension(? _Base_,? _Extension_, ? _Name_) /** @pred file_name_extension(? _Base_,? _Extension_, ? _Name_)
@ -1224,7 +1124,7 @@ case-insensitive too. _Extension_ may be specified with or
without a leading dot (.). If an _Extension_ is generated, it without a leading dot (.). If an _Extension_ is generated, it
will not have a leading dot. will not have a leading dot.
*/ */
static static
PRED_IMPL("file_name_extension", 3, file_name_extension, 0) PRED_IMPL("file_name_extension", 3, file_name_extension, 0)

1195
os/pl-os.c
View File

File diff suppressed because it is too large Load Diff

6
os/pl-privitf.c
View File

@ -144,16 +144,16 @@ unifyList(term_t term, list_ctx *ctx)
CACHE_REGS CACHE_REGS
if (!CloseList(ctx->gstore, TermNil)) if (!CloseList(ctx->gstore, TermNil))
return FALSE; return FALSE;
return Yap_unify(Yap_GetFromSlot(term PASS_REGS), ctx->start); return Yap_unify(Yap_GetFromSlot(term), ctx->start);
} }
int int
unifyDiffList(term_t head, term_t tail, list_ctx *ctx) unifyDiffList(term_t head, term_t tail, list_ctx *ctx)
{ {
CACHE_REGS CACHE_REGS
if (!CloseList(ctx->gstore, Yap_GetFromSlot(tail PASS_REGS))) if (!CloseList(ctx->gstore, Yap_GetFromSlot(tail)))
return FALSE; return FALSE;
return Yap_unify(Yap_GetFromSlot(head PASS_REGS), ctx->start); return Yap_unify(Yap_GetFromSlot(head), ctx->start);
} }
#else #else

33
os/pl-read.c
View File

@ -40,10 +40,10 @@ _PL_rd->backquoted_string = truePrologFlag(PLFLAG_BACKQUOTED_STRING);
void void
free_read_data(ReadData _PL_rd) free_read_data(ReadData _PL_rd)
{ {
} }
static int static int
read_term(term_t t, ReadData _PL_rd ARG_LD) read_term(term_t t, ReadData _PL_rd ARG_LD)
{ {
return Yap_read_term(t, rb.stream, _PL_rd); return Yap_read_term(t, rb.stream, _PL_rd);
@ -1182,7 +1182,7 @@ read_clause(IOSTREAM *s, term_t term, term_t options ARG_LD)
PL_TERM, term, PL_TERM, term,
PL_TERM, tpos ); PL_TERM, tpos );
} }
ap = Yap_PredFromClause( Yap_GetFromSlot(term PASS_REGS) PASS_REGS); ap = Yap_PredFromClause( Yap_GetFromSlot(term) PASS_REGS);
if (rd.styleCheck & (DISCONTIGUOUS_STYLE|MULTIPLE_CHECK) && ap != NULL ) { if (rd.styleCheck & (DISCONTIGUOUS_STYLE|MULTIPLE_CHECK) && ap != NULL ) {
if ( rd.styleCheck & (DISCONTIGUOUS_STYLE) && Yap_discontiguous( ap PASS_REGS) ) { if ( rd.styleCheck & (DISCONTIGUOUS_STYLE) && Yap_discontiguous( ap PASS_REGS) ) {
printMessage(ATOM_warning, printMessage(ATOM_warning,
@ -1377,7 +1377,7 @@ return rval;
Reads term _T_ from stream _Stream_ with execution controlled by the Reads term _T_ from stream _Stream_ with execution controlled by the
same options as read_term/2. same options as read_term/2.
*/ */
static static
PRED_IMPL("read_term", 3, read_term, PL_FA_ISO) PRED_IMPL("read_term", 3, read_term, PL_FA_ISO)
@ -1400,18 +1400,18 @@ return FALSE;
*/ */
/** @pred read_term(- _T_,+ _Options_) is iso /** @pred read_term(- _T_,+ _Options_) is iso
Reads term _T_ from the current input stream with execution Reads term _T_ from the current input stream with execution
controlled by the following options: controlled by the following options:
+ comments(- _Comments_) + comments(- _Comments_)
Unify _Comments_ with a list of string terms including comments before Unify _Comments_ with a list of string terms including comments before
and within the term. and within the term.
+ module( + _Module_) + module( + _Module_)
Read term using _Module_ as source module. Read term using _Module_ as source module.
@ -1419,13 +1419,13 @@ and within the term.
Unify _List_ with the quasi-quotations present in the term. Unify _List_ with the quasi-quotations present in the term.
+ term_position(- _Position_) + term_position(- _Position_)
Unify _Position_ with a term describing the position of the stream Unify _Position_ with a term describing the position of the stream
at the start of parse. Use stream_position_data/3 to obtain extra at the start of parse. Use stream_position_data/3 to obtain extra
information. information.
+ singletons(- _Names_) + singletons(- _Names_)
Unify _Names_ with a list of the form _Name=Var_, where Unify _Names_ with a list of the form _Name=Var_, where
_Name_ is the name of a non-anonymous singleton variable in the _Name_ is the name of a non-anonymous singleton variable in the
@ -1433,12 +1433,12 @@ original term, and `Var` is the variable's representation in
YAP. YAP.
The variables occur in left-to-right traversal order. The variables occur in left-to-right traversal order.
+ syntax_errors(+ _Val_) + syntax_errors(+ _Val_)
Control action to be taken after syntax errors. See yap_flag/2 Control action to be taken after syntax errors. See yap_flag/2
for detailed information. for detailed information.
+ variables(- _Names_) + variables(- _Names_)
Unify _Names_ with a list of the form _Name=Var_, where _Name_ is Unify _Names_ with a list of the form _Name=Var_, where _Name_ is
the name of a non-anonymous variable in the original term, and _Var_ the name of a non-anonymous variable in the original term, and _Var_
@ -1541,7 +1541,7 @@ Yap_StringToTerm(const char *s, size_t len, term_t bindings)
init_read_data(&rd, stream PASS_LD); init_read_data(&rd, stream PASS_LD);
rd.varnames = bindings; rd.varnames = bindings;
term_t tt = Yap_NewSlots(1 PASS_REGS); term_t tt = Yap_NewSlots(1);
if ( !(rval = read_term(tt, &rd PASS_LD)) && rd.has_exception ) { if ( !(rval = read_term(tt, &rd PASS_LD)) && rd.has_exception ) {
rval = PL_raise_exception(rd.exception); rval = PL_raise_exception(rd.exception);
@ -1552,15 +1552,15 @@ Sclose(stream);
LD->read_source = oldsrc; LD->read_source = oldsrc;
// getchar(); // getchar();
return Yap_GetFromSlot( tt PASS_REGS); return Yap_GetFromSlot( tt);
} }
/** @pred atom_to_term(+ _Atom_, - _Term_, - _Bindings_) /** @pred atom_to_term(+ _Atom_, - _Term_, - _Bindings_)
Use _Atom_ as input to read_term/2 using the option `variable_names` and return the read term in _Term_ and the variable bindings in _Bindings_. _Bindings_ is a list of `Name = Var` couples, thus providing access to the actual variable names. See also read_term/2. If Atom has no valid syntax, a syntax_error exception is raised. Use _Atom_ as input to read_term/2 using the option `variable_names` and return the read term in _Term_ and the variable bindings in _Bindings_. _Bindings_ is a list of `Name = Var` couples, thus providing access to the actual variable names. See also read_term/2. If Atom has no valid syntax, a syntax_error exception is raised.
*/ */
static static
PRED_IMPL("atom_to_term", 3, atom_to_term, 0) PRED_IMPL("atom_to_term", 3, atom_to_term, 0)
@ -1583,7 +1583,7 @@ PRED_IMPL("$context_variables", 1, context_variables, 0)
static static
PRED_IMPL("$set_source", 2, set_source, 0) PRED_IMPL("$set_source", 2, set_source, 0)
{ {
GET_LD GET_LD
atom_t at; atom_t at;
term_t a = PL_new_term_ref(); term_t a = PL_new_term_ref();
@ -1638,4 +1638,3 @@ PRED_DEF("$qq_open", 2, qq_open, 0)
EndPredDefs EndPredDefs
//! @} //! @}

124
os/pl-stream.c
View File

@ -44,11 +44,16 @@
#include <android/asset_manager.h> #include <android/asset_manager.h>
#include <android/asset_manager_jni.h> #include <android/asset_manager_jni.h>
#include <android/log.h> #include <android/log.h>
int Yap_isAsset( const char *path );
#define LOG(...) __android_log_print(ANDROID_LOG_DEBUG,"YAP Stream", __VA_ARGS__)
#else #else
#define __android_log_print(i,loc,msg,...) #define __android_log_print(i,loc,msg,...)
#define ANDROID_LOG_INFO 0 #define ANDROID_LOG_INFO 0
#define ANDROID_LOG_ERROR 0 #define ANDROID_LOG_ERROR 0
#define ANDROID_LOG_DEBUG 0 #define ANDROID_LOG_DEBUG 0
#define LOG(...)
#endif #endif
@ -768,7 +773,8 @@ unget_byte(int c, IOSTREAM *s)
int int
Sungetc(int c, IOSTREAM *s) Sungetc(int c, IOSTREAM *s)
{ if ( s->bufp > s->unbuffer ) {
if ( s->bufp > s->unbuffer )
{ unget_byte(c, s); { unget_byte(c, s);
return c; return c;
@ -1153,7 +1159,6 @@ Speekcode(IOSTREAM *s)
{ int c; { int c;
char *start; char *start;
size_t safe = (size_t)-1; size_t safe = (size_t)-1;
if ( !s->buffer ) if ( !s->buffer )
{ if ( (s->flags & SIO_NBUF) ) { if ( (s->flags & SIO_NBUF) )
{ errno = EINVAL; { errno = EINVAL;
@ -1786,6 +1791,11 @@ object, which in turn calls the ->unlink which may wish to close the
associated stream. associated stream.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#if __ANDROID__
static int
Sclose_asset(void *handle);
#endif
int int
Sclose(IOSTREAM *s) Sclose(IOSTREAM *s)
{ int rval = 0; { int rval = 0;
@ -1825,12 +1835,19 @@ Sclose(IOSTREAM *s)
rval = -1; rval = -1;
} }
#if __ANDROID__
if (s->functions->close == Sclose_asset) {
#endif
while(s->locks > 0) /* remove buffer-locks */ while(s->locks > 0) /* remove buffer-locks */
{ int rc = Sunlock(s); { int rc = Sunlock(s);
if ( rval == 0 ) if ( rval == 0 )
rval = rc; rval = rc;
} }
#if __ANDROID__
}
#endif
if ( rval < 0 ) if ( rval < 0 )
reportStreamError(s); reportStreamError(s);
run_close_hooks(s); /* deletes Prolog registration */ run_close_hooks(s); /* deletes Prolog registration */
@ -2916,11 +2933,41 @@ Sopen_file(const char *path, const char *how)
#endif #endif
#if __ANDROID__ #if __ANDROID__
if (strstr(path, "/assets/") == path) { if (Yap_isAsset(path)) {
AAssetManager *Yap_assetManager( void ); extern IOFUNCTIONS Sassetfunctions;
char * p = (char *)path + strlen("/assets/"); extern void *Yap_openAssetFile(const char *);
return Sopen_asset( p, how-1, Yap_assetManager());
} if (op != 'r')
return NULL;
for( ; *how; how++)
{ switch(*how)
{
case 'b': /* binary */
flags &= ~SIO_TEXT;
enc = ENC_OCTET;
break;
case 'r': /* no record */
flags &= ~SIO_RECORDPOS;
break;
default:
errno = EINVAL;
return NULL;
}
}
#if O_LARGEFILES && defined(O_LARGEFILE)
oflags |= O_LARGEFILE;
#endif
lfd = (intptr_t)Yap_openAssetFile( path );
if (!lfd) {
errno = EINVAL;
return NULL;
}
Sfilefunctions = Sassetfunctions;
lock = 0;
flags |= SIO_INPUT;
goto build_stream;
}
#endif #endif
for( ; *how; how++) for( ; *how; how++)
@ -3037,6 +3084,9 @@ Sopen_file(const char *path, const char *how)
} }
lfd = (intptr_t)fd; lfd = (intptr_t)fd;
#if __ANDROID__
build_stream:
#endif
s = Snew((void *)lfd, flags, &Sfilefunctions); s = Snew((void *)lfd, flags, &Sfilefunctions);
if ( enc != ENC_UNKNOWN ) if ( enc != ENC_UNKNOWN )
s->encoding = enc; s->encoding = enc;
@ -3332,66 +3382,6 @@ Sopen_asset(char **buffer, size_t *sizep, const char* mode)
Open an Android asset, essentially a read-only part of a ZIP archive. Open an Android asset, essentially a read-only part of a ZIP archive.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
IOSTREAM *
Sopen_asset(char *bufp, const char *how, AAssetManager* mgr)
{
AAsset* asset;
int flags = SIO_FILE|SIO_TEXT|SIO_RECORDPOS|SIO_FBUF;
int op = *how++;
IOSTREAM *s;
IOENC enc = ENC_UNKNOWN;
for( ; *how; how++)
{ switch(*how)
{ case 'b': /* binary */
flags &= ~SIO_TEXT;
enc = ENC_OCTET;
break;
case 'r': /* no record */
flags &= ~SIO_RECORDPOS;
break;
case 'L': /* lock r: read, w: write */
case 'l': /* lock r: read, w: write */
// read-only, nothing changes.
break;
default:
errno = EINVAL;
return NULL;
}
}
#if O_LARGEFILES && defined(O_LARGEFILE)
oflags |= O_LARGEFILE;
#endif
switch(op)
{ case 'w':
return NULL;
case 'a':
return NULL;
case 'u':
return NULL;
case 'r':
//const char *utf8 = (*env)->GetStringUTFChars(env, bufp, NULL);
asset = AAssetManager_open(mgr, bufp, AASSET_MODE_UNKNOWN);
flags |= SIO_INPUT;
break;
default:
errno = EINVAL;
return NULL;
}
if ( !asset )
return NULL;
s = Snew((void *)asset, flags, &Sassetfunctions);
if ( enc != ENC_UNKNOWN )
s->encoding = enc;
return s;
}
#endif /* __ANDROID__ */ #endif /* __ANDROID__ */
/******************************* /*******************************

5
os/pl-util.c
View File

@ -7,7 +7,7 @@ int
stricmp(const char *s1, const char *s2) stricmp(const char *s1, const char *s2)
{ while(*s1 && makeLower(*s1) == makeLower(*s2)) { while(*s1 && makeLower(*s1) == makeLower(*s2))
s1++, s2++; s1++, s2++;
return makeLower(*s1) - makeLower(*s2); return makeLower(*s1) - makeLower(*s2);
} }
#endif #endif
@ -67,6 +67,3 @@ out:
return rc; return rc;
} }
#endif #endif

18
os/pl-write.c
View File

@ -193,7 +193,7 @@ static int
bind_varnames(term_t varnames ARG_LD) bind_varnames(term_t varnames ARG_LD)
{ {
CACHE_REGS CACHE_REGS
Term t = Yap_GetFromSlot(varnames PASS_REGS); Term t = Yap_GetFromSlot(varnames);
while(!IsVarTerm(t) && IsPairTerm(t)) { while(!IsVarTerm(t) && IsPairTerm(t)) {
Term tl = HeadOfTerm(t); Term tl = HeadOfTerm(t);
Functor f; Functor f;
@ -221,7 +221,7 @@ char *
varName(term_t t, char *name) varName(term_t t, char *name)
{ {
CACHE_REGS CACHE_REGS
CELL *adr = (CELL *)Yap_GetFromSlot(t PASS_REGS); CELL *adr = (CELL *)Yap_GetFromSlot(t);
if (IsAttVar(adr)) { if (IsAttVar(adr)) {
Ssprintf(name, "_D%ld", (CELL)adr - (CELL)H0); Ssprintf(name, "_D%ld", (CELL)adr - (CELL)H0);
@ -262,20 +262,10 @@ writeTopTerm(term_t t, int prec, write_options *options)
if (flags & PL_WRT_BLOB_PORTRAY) if (flags & PL_WRT_BLOB_PORTRAY)
yap_flag |= Blob_Portray_f; yap_flag |= Blob_Portray_f;
old_module = CurrentModule; old_module = CurrentModule;
char * buf[1024];
size_t length;
int encode; Term tn;
__android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "Yap_REGS=%p\n", Yap_REGS);
CurrentModule = Yap_GetModuleFromEntry(options->module); CurrentModule = Yap_GetModuleFromEntry(options->module);
__android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "t=%d\n", t) ; Yap_plwrite(Yap_GetFromSlot(t), options->out, options->max_depth, yap_flag, prec);
__android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "LOCAl_SlotBase[t]=%ld\n", LOCAL_SlotBase[t]);
__android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "LOCAl_SlotBase=%ld\n", Deref(LOCAL_SlotBase[t]));
Yap_plwrite(Yap_GetFromSlot(t PASS_REGS), options->out, options->max_depth, yap_flag, prec);
CurrentModule = old_module; CurrentModule = old_module;
return TRUE; return TRUE;
} }

68
packages/gecode/clpfd.yap
View File

@ -29,7 +29,7 @@ Constraints supported are:
:- module(gecode_clpfd, [ :- module(gecode_clpfd, [
op(100, yf, []), op(100, yf, []),
op(760, yfx, #<==>), op(760, yfx, #<==>),
op(750, xfy, #==>), op(750, xfy, #==>),
op(750, yfx, #<==), op(750, yfx, #<==),
@ -116,7 +116,7 @@ Constraints supported are:
]). ]).
/** @pred _X_ #< _B_ is det /** @pred _X_ #< _B_ is det
reified implication reified implication
As an example. consider finding out the people who wanted to sit As an example. consider finding out the people who wanted to sit
next to a friend and that are are actually sitting together: next to a friend and that are are actually sitting together:
@ -127,7 +127,7 @@ preference_satisfied(X-Y, B) :-
~~~~~ ~~~~~
Note that not all constraints may be reifiable. Note that not all constraints may be reifiable.
*/ */
/** @pred _X_ #< _Y_ is semidet /** @pred _X_ #< _Y_ is semidet
smaller or equal smaller or equal
@ -137,7 +137,7 @@ Arguments to this constraint may be an arithmetic expression with <tt>+</tt>,
<tt>count</tt>, and <tt>count</tt>, and
<tt>abs</tt>. Boolean variables support conjunction (/\), disjunction (\/), <tt>abs</tt>. Boolean variables support conjunction (/\), disjunction (\/),
implication (=>), equivalence (<=>), and xor. The <tt>sum</tt> constraint allows a two argument version using the implication (=>), equivalence (<=>), and xor. The <tt>sum</tt> constraint allows a two argument version using the
`where` conditional, in Zinc style. `where` conditional, in Zinc style.
The send more money equation may be written as: The send more money equation may be written as:
@ -157,35 +157,35 @@ OutFlow[I] #= sum(J in 1..N where D[J,I]<M, X[J,I])
The <tt>count</tt> constraint counts the number of elements that match a The <tt>count</tt> constraint counts the number of elements that match a
certain constant or variable (integer sets are not available). certain constant or variable (integer sets are not available).
*/ */
/** @pred _X_ #<==> _B_ is det /** @pred _X_ #<==> _B_ is det
reified equivalence reified equivalence
*/ */
/** @pred _X_ #= _Y_ is semidet /** @pred _X_ #= _Y_ is semidet
equality equality
*/ */
/** @pred _X_ #=< _Y_ is semidet /** @pred _X_ #=< _Y_ is semidet
smaller smaller
*/ */
/** @pred _X_ #==> _B_ is det /** @pred _X_ #==> _B_ is det
Reified implication Reified implication
*/ */
/** @pred _X_ #> _Y_ is semidet /** @pred _X_ #> _Y_ is semidet
larger larger
*/ */
/** @pred _X_ #>= _Y_ is semidet /** @pred _X_ #>= _Y_ is semidet
larger or equal larger or equal
*/ */
/** @pred _X_ #\= _Y_ is semidet /** @pred _X_ #\= _Y_ is semidet
disequality disequality
*/ */
/** @pred labeling( _Opts_, _Xs_) /** @pred labeling( _Opts_, _Xs_)
performs labeling, several variable and value selection options are performs labeling, several variable and value selection options are
@ -217,14 +217,14 @@ median
all value starting from the minimum. all value starting from the minimum.
*/ */
/** @pred scalar_product(+ _Cs_, + _Vs_, + _Rel_, ? _V_ ) /** @pred scalar_product(+ _Cs_, + _Vs_, + _Rel_, ? _V_ )
The product of constant _Cs_ by _Vs_ must be in relation The product of constant _Cs_ by _Vs_ must be in relation
_Rel_ with _V_ . _Rel_ with _V_ .
*/ */
:- use_module(library(gecode)). :- use_module(library(gecode)).
@ -341,7 +341,7 @@ process_constraints(B, B, _Env).
post( rel(NA, (#=)), Env, _). post( rel(NA, (#=)), Env, _).
/** @pred _X_ #= is det /** @pred _X_ #= is det
all elements of _X_ must take the same value all elements of _X_ must take the same value
*/ */
( A #\= ) :- ( A #\= ) :-
get_home(Env), get_home(Env),
@ -350,7 +350,7 @@ all elements of _X_ must take the same value
/** @pred _X_ #< is det /** @pred _X_ #< is det
elements of _X_ must be decreasing or equal elements of _X_ must be decreasing or equal
*/ */
( A #< ) :- ( A #< ) :-
get_home(Env), get_home(Env),
@ -358,7 +358,7 @@ elements of _X_ must be decreasing or equal
post( rel(NA, (#<)), Env, _). post( rel(NA, (#<)), Env, _).
/** @pred _X_ #> is det /** @pred _X_ #> is det
elements of _X_ must be increasing elements of _X_ must be increasing
*/ */
( A #> ) :- ( A #> ) :-
get_home(Env), get_home(Env),
@ -366,7 +366,7 @@ elements of _X_ must be increasing
post( rel(NA, (#>)), Env, _). post( rel(NA, (#>)), Env, _).
/** @pred _X_ #=< is det /** @pred _X_ #=< is det
elements of _X_ must be decreasing elements of _X_ must be decreasing
*/ */
( A #=< ) :- ( A #=< ) :-
get_home(Env), get_home(Env),
@ -374,7 +374,7 @@ elements of _X_ must be decreasing
post( rel(NA, (#=<) ), Env, _). post( rel(NA, (#=<) ), Env, _).
/** @pred _X_ #>= is det /** @pred _X_ #>= is det
elements of _X_ must be increasinga or equal elements of _X_ must be increasinga or equal
*/ */
( A #>= ) :- ( A #>= ) :-
get_home(Env), get_home(Env),
@ -537,7 +537,7 @@ clause( or, Ps, Ns, V ) :-
labeling(Opts, Xs) :- labeling(Opts, Xs) :-
get_home(Space-Map), get_home(Space-Map),
foldl2( processs_lab_opt, Opts, 'INT_VAR_SIZE_MIN', BranchVar, 'INT_VAL_MIN', BranchVal), foldl2( processs_lab_opt, Opts, 'INT_VAR_SIZE_MIN', BranchVar, 'INT_VAL_MIN', BranchVal),
term_variables(Xs, Vs), term_variables(Xs, Vs),
check( Vs, X1s ), check( Vs, X1s ),
( X1s == [] -> true ; ( X1s == [] -> true ;
@ -602,7 +602,7 @@ post( rel( A, Op), Space-Map, Reify):-
(var(Reify) -> Space += rel(IA, GOP) ; (var(Reify) -> Space += rel(IA, GOP) ;
Space += rel(IA, GOP, Reify) ). Space += rel(IA, GOP, Reify) ).
% X #< Y % X #< Y
% X #< 2 % X #< 2
post( rel( A, Op, B), Space-Map, Reify):- post( rel( A, Op, B), Space-Map, Reify):-
var(A), var(A),
@ -672,12 +672,12 @@ post( rel(A1+A2, Op, B), Space-Map, Reify):-
(var(Reify) -> (var(Reify) ->
( checklist(is_one, CAs) -> ( checklist(is_one, CAs) ->
Space += linear(As, GOP, B0); Space += linear(As, GOP, B0);
Space += linear(CAs, As, GOP, B0) Space += linear(CAs, As, GOP, B0)
) )
; ;
( checklist(is_one, CAs) -> ( checklist(is_one, CAs) ->
Space += linear(As, GOP, B0, Reify); Space += linear(As, GOP, B0, Reify);
Space += linear(CAs, As, GOP, B0, Reify) Space += linear(CAs, As, GOP, B0, Reify)
) )
). ).
@ -689,18 +689,18 @@ post( rel(A1-A2, Op, B), Space-Map, Reify):-
(var(Reify) -> (var(Reify) ->
( checklist(is_one, CAs) -> ( checklist(is_one, CAs) ->
Space += linear(As, GOP, B0); Space += linear(As, GOP, B0);
Space += linear(CAs, As, GOP, B0) Space += linear(CAs, As, GOP, B0)
) )
; ;
( checklist(is_one, CAs) -> ( checklist(is_one, CAs) ->
Space += linear(As, GOP, B0, Reify); Space += linear(As, GOP, B0, Reify);
Space += linear(CAs, As, GOP, B0, Reify) Space += linear(CAs, As, GOP, B0, Reify)
) )
). ).
post( rel(A, Op, B), Space-Map, Reify):- post( rel(A, Op, B), Space-Map, Reify):-
arith(A, Name), arith(A, Name),
A =.. [_Op,A1], A =.. [_Op,A1],
is_list(A1), !, is_list(A1), !,
( _Op = min -> true ; _Op = max ), ( _Op = min -> true ; _Op = max ),
maplist(equality_l( Space-Map), A1, NA1), maplist(equality_l( Space-Map), A1, NA1),
@ -710,7 +710,7 @@ post( rel(A, Op, B), Space-Map, Reify):-
post( rel(A, Op, B), Space-Map, Reify):- post( rel(A, Op, B), Space-Map, Reify):-
arith(A, Name), arith(A, Name),
A =.. [_Op,A1], !, A =.. [_Op,A1], !,
equality(A1, NA1, Space-Map), equality(A1, NA1, Space-Map),
in_c(NA1, VA1, Space-Map), !, in_c(NA1, VA1, Space-Map), !,
equality(B, B1, Space-Map), equality(B, B1, Space-Map),
@ -718,7 +718,7 @@ post( rel(A, Op, B), Space-Map, Reify):-
post( rel(A, Op, B), Space-Map, Reify):- post( rel(A, Op, B), Space-Map, Reify):-
arith(A, Name), arith(A, Name),
A =.. [_Op,A1,A2], !, A =.. [_Op,A1,A2], !,
equality(A1, NA1, Space-Map), equality(A1, NA1, Space-Map),
in_c(NA1, VA1, Space-Map), in_c(NA1, VA1, Space-Map),
equality(A2, NA2, Space-Map), equality(A2, NA2, Space-Map),
@ -828,7 +828,7 @@ reverse_arith_op( (#>=) , (#=<) ).
reverse_arith_op( (#<) , (#>) ). reverse_arith_op( (#<) , (#>) ).
reverse_arith_op( (#=<) , (#>=) ). reverse_arith_op( (#=<) , (#>=) ).
linearize(V, C, [A|As], As, [C|CAs], CAs, I, I, _-Map) :- linearize(V, C, [A|As], As, [C|CAs], CAs, I, I, _-Map) :-
var(V), !, var(V), !,
l(V, A, Map). l(V, A, Map).
linearize(A+B, C, As, Bs, CAs, CBs, I, IF, Env) :- linearize(A+B, C, As, Bs, CAs, CBs, I, IF, Env) :-
@ -953,7 +953,7 @@ out_c(Name, A1, B, Op, Space-Map, Reify) :-
new_arith( Name, A1, NB, Space-Map), new_arith( Name, A1, NB, Space-Map),
gecode_arith_op( Op, BOP ), gecode_arith_op( Op, BOP ),
l(NB, IB, Map), l(NB, IB, Map),
( var(Reify) -> ( var(Reify) ->
Space += rel(IB, BOP, B) Space += rel(IB, BOP, B)
; ;
Space += rel(IB, BOP, B, Reify) Space += rel(IB, BOP, B, Reify)
@ -988,7 +988,7 @@ out_c(Name, A1, A2, B, Op, Space-Map, Reify) :-
new_arith( Name, A1, A2, NB, Space-Map), new_arith( Name, A1, A2, NB, Space-Map),
l(NB, IB, Map), l(NB, IB, Map),
gecode_arith_op( Op, BOP ), gecode_arith_op( Op, BOP ),
( var(Reify) -> ( var(Reify) ->
Space += rel(IB, BOP, B) Space += rel(IB, BOP, B)
; ;
Space += rel(IB, BOP, B, Reify) Space += rel(IB, BOP, B, Reify)
@ -1198,7 +1198,7 @@ sum_l(Map, V, Min0, Min, Max0, Max) :-
in_c(A, A, _y) :- in_c(A, A, _y) :-
var(A), !. var(A), !.
in_c(C, A, Space-Map) :- in_c(C, A, Space-Map) :-
integer(C), integer(C),
Min is C-1, Min is C-1,
NX := intvar(Space, Min, C), NX := intvar(Space, Min, C),
m(A, NX, Min, C, Map), m(A, NX, Min, C, Map),
@ -1221,7 +1221,7 @@ init_gecode(Space-Map, new) :-
b_setval(gecode_space, Space-Map). b_setval(gecode_space, Space-Map).
close_gecode(_Space, _Vs, old) :- !. close_gecode(_Space, _Vs, old) :- !.
close_gecode(Space-Map, Vs0, new) :- close_gecode(Space-Map, Vs0, new) :-
term_variables(Vs0, Vs), term_variables(Vs0, Vs),
selectlist(intvar(Map), Vs, CVs), selectlist(intvar(Map), Vs, CVs),
maplist(ll(Map), CVs, IVs), maplist(ll(Map), CVs, IVs),
@ -1294,7 +1294,7 @@ l(NV, OV, [v(V, OV, _A, _B)|_Vs]) :-
l(NV, OV, [_|Vs]) :- l(NV, OV, [_|Vs]) :-
l(NV, OV, Vs). l(NV, OV, Vs).
*/ */
ll(Map, X, Y) :- ll(Map, X, Y) :-
l(X, Y, Map). l(X, Y, Map).

4
packages/myddas/Makefile.in
View File

@ -62,7 +62,7 @@ MYDDAS_PROLOG= \
myddas_assert_predicates.ypp \ myddas_assert_predicates.ypp \
myddas_mysql.ypp \ myddas_mysql.ypp \
myddas_sqlite3.ypp \ myddas_sqlite3.ypp \
myddas_top_level.ypp \ myddas_top_level.ypp \
myddas_errors.ypp \ myddas_errors.ypp \
myddas_postgres.ypp \ myddas_postgres.ypp \
myddas_prolog2sql.ypp \ myddas_prolog2sql.ypp \
@ -85,7 +85,7 @@ all: $(SOBJS) $(MYDDAS_YAP)
$(CC) -c $(CFLAGS) $< -o $@ $(CC) -c $(CFLAGS) $< -o $@
%.yap: $(srcdir)/pl/%.ypp %.yap: $(srcdir)/pl/%.ypp
$(ECPP) $(YAP_EXTRAS) -P -w $< -o $@ $(ECPP) $(YAP_EXTRAS) -P -w $< > $@
@DO_SECOND_LD@%.@SO@: $(OBJS) @DO_SECOND_LD@%.@SO@: $(OBJS)
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $(OBJS) @EXTRA_LIBS_FOR_DLLS@ @MYDDAS_LIBS@ @DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $(OBJS) @EXTRA_LIBS_FOR_DLLS@ @MYDDAS_LIBS@

6
packages/myddas/configure.in
View File

@ -195,14 +195,14 @@ else
ENABLE_MYDDAS="" ENABLE_MYDDAS=""
fi fi
INCLUDE_MYDDAS="#" OBJECTS_MYDDAS="#"
if test x"$ENABLE_MYDDAS" = x -a x"$STARTUP_ANDROID" = x if test x"$ENABLE_MYDDAS" = x -a x"$STARTUP_ANDROID" = x
then then
#in Android we have to actually include myddas in the binary #in Android we have to actually include myddas in the binary
INCLUDE_MYDDAS="" OBJECTS_MYDDAS="$(ALL_MYDDAS_OBJECTS)"
fi fi
AC_SUBST(PKG_MYDDAS) AC_SUBST(PKG_MYDDAS)
AC_SUBST(INCLUDE_MYDDAS) AC_SUBST(OBJECTS_MYDDAS)
AC_SUBST(MYDDAS_CPPFLAGS) AC_SUBST(MYDDAS_CPPFLAGS)
AC_SUBST(MYDDAS_LIBS) AC_SUBST(MYDDAS_LIBS)

2
packages/myddas/myddas_shared.c
View File

@ -127,7 +127,7 @@ c_db_connection_type ( USES_REGS1 ){
switch (type) { switch (type) {
case API_MYSQL: case API_MYSQL:
/* MYSQL Connection */ /* MYSQL Connection */
return Yap_unify(arg_type, MkAtomTerm(Yap_LookupAtom("mysql"))); return Yap_unify(arg_type, MkAtomTerm(Yap_LookupAtom("mysql")));
case API_ODBC: case API_ODBC:
/* ODBC Connection */ /* ODBC Connection */

3
packages/swig/Android.mk.in
View File

@ -26,9 +26,8 @@ LOCAL_MODULE := example
LOCAL_SHARED_LIBRARIES := yap0 yap1 sqliteX yap2 LOCAL_SHARED_LIBRARIES := yap0 yap1 sqliteX yap2
LOCAL_STATIC_LIBRARIES := @abs_top_builddir@/libYap.ar LOCAL_STATIC_LIBRARIES := @abs_top_builddir@/libYap.ar
LOCAL_SRC_FILES += @abs_top_builddir@/packages/swig/android/jni/yap_wrap.cpp LOCAL_SRC_FILES += @abs_top_builddir@/packages/swig/android/jni/yap_wrap.cpp
LOCAL_SRC_FILES += @srcdir@/../prosqlite/c/prosqlite.c
LOCAL_C_INCLUDES := @abs_top_builddir@ @GMPDIR@/include @srcdir@/../../H @srcdir@/../../include @srcdir@/../../os @srcdir@/../../OPTYap @srcdir@/../../BEAM @srcdir@/../../CXX sqlite LOCAL_C_INCLUDES := @abs_top_builddir@ @GMPDIR@/include @srcdir@/../../H @srcdir@/../../include @srcdir@/../../os @srcdir@/../../OPTYap @srcdir@/../../BEAM @srcdir@/../../CXX sqlite
LOCAL_CFLAGS := @YAP_EXTRAS@ @DEFS@ -D_YAP_NOT_INSTALLED_=1 -DDESTDIR=\"\" LOCAL_CFLAGS := @YAP_EXTRAS@ @DEFS@ -D_YAP_NOT_INSTALLED_=1 -DDESTDIR=\"\"
LOCAL_CPP_FEATURES := rtti LOCAL_CPP_FEATURES := rtti
# LOCAL_ALLOW_UNDEFINED_SYMBOLS := true LOCAL_ALLOW_UNDEFINED_SYMBOLS := false
include $(BUILD_SHARED_LIBRARY) include $(BUILD_SHARED_LIBRARY)

15
packages/swig/Makefile.in
View File

@ -26,11 +26,9 @@ JAVA_SQLITE="$(srcdir)/android/src/org"
SQLITE=$(JNI_SQLITE) $(JAVA_SQLITE) SQLITE=$(JNI_SQLITE) $(JAVA_SQLITE)
PROSQLITE=$(srcdir)/../prosqlite/prolog/prosqlite.pl
PYTHON_PROGRAMS = $(srcdir)/python/demo.py PYTHON_PROGRAMS = $(srcdir)/python/demo.py
ANDROID_PROGRAMS=$(srcdir)/android/JavaYap.java $(PROSQLITE) $(SQLITE) ANDROID_PROGRAMS=$(srcdir)/android/JavaYap.java $(SQLITE)
PROGRAMS= $(PYTHON_PROGRAMS) $(JAVA_PROGRAMS) $(ANDROID_PROGRAMS) PROGRAMS= $(PYTHON_PROGRAMS) $(JAVA_PROGRAMS) $(ANDROID_PROGRAMS)
@ -42,7 +40,7 @@ YAP_EXPORT_SAVED_STATE="../../startup.yss"
PYTHON_PROGRAMS = $(srcdir)/python/demo.py PYTHON_PROGRAMS = $(srcdir)/python/demo.py
ANDROID_PROGRAMS=$(srcdir)/android/JavaYap.java $(PROSQLITE) $(SQLITE) ANDROID_PROGRAMS=$(srcdir)/android/JavaYap.java $(SQLITE)
SWIG_FILES= \ SWIG_FILES= \
$(srcdir)/yap.i $(srcdir)/yap.i
@ -89,9 +87,6 @@ JavaYap-debug.apk: android/libs/armeabi/libexample.so
android/libs/armeabi/libexample.so: android/jni/Android.mk android/jni/Application.mk android/jni/yap_wrap.cpp android/libs/armeabi/libexample.so: android/jni/Android.mk android/jni/Application.mk android/jni/yap_wrap.cpp
( cd android/jni && NDK_DEBUG=1 ndk-build ) ( cd android/jni && NDK_DEBUG=1 ndk-build )
cp -r $(YAP_EXPORT_PLS)/* android/assets/share/Yap
cp -r $(YAP_EXPORT_DLLS)/*.so android/jni
cp -r $(YAP_EXPORT_SAVED_STATE) android/assets/lib/Yap
android/jni/Application.mk: android/jni/Android.mk android/jni/Application.mk: android/jni/Android.mk
cp $(srcdir)/android/jni/Application.mk android/jni cp $(srcdir)/android/jni/Application.mk android/jni
@ -124,11 +119,13 @@ R:
yap.i: $(srcdir)/../../../../include/YapInterface.h yap.i: $(srcdir)/../../../../include/YapInterface.h
install: install: all
clean: clean:
rm -fr android/* jni/* java/* python/* rm -fr android/libs/armeabi/libexample.so JavaYap-debug.apk android/jni/Application.mk \
android/jni/Android.mk android/jni/yap_wrap.cpp python/_yap.so jni/yap_wrap.o \
python/yap_wrap.cpp python/yap.py jni/yap_wrap.cpp java/yap.java
distclean: clean distclean: clean
rm -f *def Makefile rm -f *def Makefile

34
packages/swig/android/JavaYap.java
View File

@ -60,9 +60,10 @@ public class JavaYap extends Activity
String str; String str;
String buf; String buf;
YAPQuery q; YAPQuery q;
Boolean running = false; Boolean running = false, compute = true;
int i=1; int i=1;
YAPListTerm vs0; YAPListTerm vs0;
private AssetManager mgr;
void runQuery(String str, Boolean more) void runQuery(String str, Boolean more)
{ {
@ -70,13 +71,18 @@ public class JavaYap extends Activity
{ {
// check if at initial query // check if at initial query
if (!running) { if (!running) {
if (BuildConfig.DEBUG) {
Log.i(TAG, "query "+str);
}
q = eng.query( str ); q = eng.query( str );
// get the uninstantiated query variables. // get the uninstantiated query variables.
vs0 = q.namedVars(); vs0 = q.namedVars();
running = true; running = true;
} }
// start computing // start computing
Boolean compute = true; compute = true;
if (BuildConfig.DEBUG) { if (BuildConfig.DEBUG) {
Log.i(TAG, "onQueryButtonClick called"); Log.i(TAG, "onQueryButtonClick called");
@ -89,7 +95,7 @@ public class JavaYap extends Activity
if (BuildConfig.DEBUG) { if (BuildConfig.DEBUG) {
Log.i(TAG, "q0=\n"); Log.i(TAG, "q0=\n");
} }
if (compute && q.next()) { if (compute && (rc = q.next())) {
outputText.append( "yes\n" ); outputText.append( "yes\n" );
running = compute = more; running = compute = more;
} else { } else {
@ -102,7 +108,7 @@ public class JavaYap extends Activity
Log.i(TAG, "q1= "+vs0.text()+"\n"); Log.i(TAG, "q1= "+vs0.text()+"\n");
} }
while (compute && (rc = q.next()) ) { while (compute && (rc = q.next()) ) {
YAPListTerm vs = vs0; YAPListTerm vs = q.namedVars();
while(!vs.nil()){ while(!vs.nil()){
if (BuildConfig.DEBUG) { if (BuildConfig.DEBUG) {
Log.i(TAG, "q= "+vs0.text()+"\n"); Log.i(TAG, "q= "+vs0.text()+"\n");
@ -118,11 +124,14 @@ public class JavaYap extends Activity
} }
if ( !rc) { if ( !rc) {
q.close(); q.close();
running = compute = false; compute = true;
running = false;
} }
} catch(Exception e){ } catch(Exception e){
outputText.append("Exception thrown :" + e); outputText.append("Exception thrown :" + e);
return; q.close();
compute = true;
running = false;
} }
} }
@ -139,8 +148,8 @@ public class JavaYap extends Activity
s = getPackageName(); s = getPackageName();
PackageInfo p = m.getPackageInfo(s, 0); PackageInfo p = m.getPackageInfo(s, 0);
//s = p.applicationInfo.dataDir; //s = p.applicationInfo.dataDir;
AssetManager mgr = getResources().getAssets(); mgr = getResources().getAssets();
Log.i(TAG, "mgr=" +mgr + " " + s); Log.i(TAG, "mgr0=" +mgr + " " + s);
load(mgr); load(mgr);
} catch(NameNotFoundException e) { } catch(NameNotFoundException e) {
Log.e(TAG, "Couldn't find package information in PackageManager", e); Log.e(TAG, "Couldn't find package information in PackageManager", e);
@ -239,8 +248,6 @@ public class JavaYap extends Activity
private static native void load(AssetManager mgr); private static native void load(AssetManager mgr);
private AssetManager mgr;
private static final String TAG = "JavaYap"; private static final String TAG = "JavaYap";
} }
@ -256,13 +263,6 @@ class JavaCallback extends YAPCallback
Log.i(TAG, "java callback init"); Log.i(TAG, "java callback init");
} }
public void run()
{
Log.i(TAG, "java callback ");
System.out.println("JavaCallback.run() ");
}
public void run(String s) public void run(String s)
{ {
Log.i(TAG, "java callback "); Log.i(TAG, "java callback ");

44
packages/swig/android/jni/sqlite/sqlite3.c
View File

@ -3567,7 +3567,7 @@ SQLITE_API const void *sqlite3_column_name16(sqlite3_stmt*, int N);
** UTF-16 encoded strings and the other functions return UTF-8. ** UTF-16 encoded strings and the other functions return UTF-8.
** **
** ^These APIs are only available if the library was compiled with the ** ^These APIs are only available if the library was compiled with the
** [SQLITE_ENABLE_COLUMN_METADATA] C-preprocessor symbol. ** [SQLITE_ENABLE_COLUMN_METAPDATA] C-preprocessor symbol.
** **
** If two or more threads call one or more of these routines against the same ** If two or more threads call one or more of these routines against the same
** prepared statement and column at the same time then the results are ** prepared statement and column at the same time then the results are
@ -5130,7 +5130,7 @@ SQLITE_API SQLITE_DEPRECATED void sqlite3_soft_heap_limit(int N);
** in the [database connection] (to be retrieved using sqlite3_errmsg()).)^ ** in the [database connection] (to be retrieved using sqlite3_errmsg()).)^
** **
** ^This API is only available if the library was compiled with the ** ^This API is only available if the library was compiled with the
** [SQLITE_ENABLE_COLUMN_METADATA] C-preprocessor symbol defined. ** [SQLITE_ENABLE_COLUMN_METAPDATA] C-preprocessor symbol defined.
*/ */
SQLITE_API int sqlite3_table_column_metadata( SQLITE_API int sqlite3_table_column_metadata(
sqlite3 *db, /* Connection handle */ sqlite3 *db, /* Connection handle */
@ -8674,7 +8674,7 @@ typedef struct WhereInfo WhereInfo;
/* TODO: This definition is just included so other modules compile. It /* TODO: This definition is just included so other modules compile. It
** needs to be revisited. ** needs to be revisited.
*/ */
#define SQLITE_N_BTREE_META 10 #define SQLITE_N_BTREE_METAP 10
/* /*
** If defined as non-zero, auto-vacuum is enabled by default. Otherwise ** If defined as non-zero, auto-vacuum is enabled by default. Otherwise
@ -9045,7 +9045,7 @@ typedef struct VdbeOpList VdbeOpList;
#define COLNAME_DATABASE 2 #define COLNAME_DATABASE 2
#define COLNAME_TABLE 3 #define COLNAME_TABLE 3
#define COLNAME_COLUMN 4 #define COLNAME_COLUMN 4
#ifdef SQLITE_ENABLE_COLUMN_METADATA #ifdef SQLITE_ENABLE_COLUMN_METAPDATA
# define COLNAME_N 5 /* Number of COLNAME_xxx symbols */ # define COLNAME_N 5 /* Number of COLNAME_xxx symbols */
#else #else
# ifdef SQLITE_OMIT_DECLTYPE # ifdef SQLITE_OMIT_DECLTYPE
@ -13104,8 +13104,8 @@ static const char * const azCompileOpt[] = {
#ifdef SQLITE_ENABLE_CEROD #ifdef SQLITE_ENABLE_CEROD
"ENABLE_CEROD", "ENABLE_CEROD",
#endif #endif
#ifdef SQLITE_ENABLE_COLUMN_METADATA #ifdef SQLITE_ENABLE_COLUMN_METAPDATA
"ENABLE_COLUMN_METADATA", "ENABLE_COLUMN_METAPDATA",
#endif #endif
#ifdef SQLITE_ENABLE_EXPENSIVE_ASSERT #ifdef SQLITE_ENABLE_EXPENSIVE_ASSERT
"ENABLE_EXPENSIVE_ASSERT", "ENABLE_EXPENSIVE_ASSERT",
@ -65428,12 +65428,12 @@ SQLITE_API const void *sqlite3_column_name16(sqlite3_stmt *pStmt, int N){
#endif #endif
/* /*
** Constraint: If you have ENABLE_COLUMN_METADATA then you must ** Constraint: If you have ENABLE_COLUMN_METAPDATA then you must
** not define OMIT_DECLTYPE. ** not define OMIT_DECLTYPE.
*/ */
#if defined(SQLITE_OMIT_DECLTYPE) && defined(SQLITE_ENABLE_COLUMN_METADATA) #if defined(SQLITE_OMIT_DECLTYPE) && defined(SQLITE_ENABLE_COLUMN_METAPDATA)
# error "Must not define both SQLITE_OMIT_DECLTYPE \ # error "Must not define both SQLITE_OMIT_DECLTYPE \
and SQLITE_ENABLE_COLUMN_METADATA" and SQLITE_ENABLE_COLUMN_METAPDATA"
#endif #endif
#ifndef SQLITE_OMIT_DECLTYPE #ifndef SQLITE_OMIT_DECLTYPE
@ -65453,7 +65453,7 @@ SQLITE_API const void *sqlite3_column_decltype16(sqlite3_stmt *pStmt, int N){
#endif /* SQLITE_OMIT_UTF16 */ #endif /* SQLITE_OMIT_UTF16 */
#endif /* SQLITE_OMIT_DECLTYPE */ #endif /* SQLITE_OMIT_DECLTYPE */
#ifdef SQLITE_ENABLE_COLUMN_METADATA #ifdef SQLITE_ENABLE_COLUMN_METAPDATA
/* /*
** Return the name of the database from which a result column derives. ** Return the name of the database from which a result column derives.
** NULL is returned if the result column is an expression or constant or ** NULL is returned if the result column is an expression or constant or
@ -65501,7 +65501,7 @@ SQLITE_API const void *sqlite3_column_origin_name16(sqlite3_stmt *pStmt, int N){
pStmt, N, (const void*(*)(Mem*))sqlite3_value_text16, COLNAME_COLUMN); pStmt, N, (const void*(*)(Mem*))sqlite3_value_text16, COLNAME_COLUMN);
} }
#endif /* SQLITE_OMIT_UTF16 */ #endif /* SQLITE_OMIT_UTF16 */
#endif /* SQLITE_ENABLE_COLUMN_METADATA */ #endif /* SQLITE_ENABLE_COLUMN_METAPDATA */
/******************************* sqlite3_bind_ *************************** /******************************* sqlite3_bind_ ***************************
@ -69285,7 +69285,7 @@ case OP_ReadCookie: { /* out2-prerelease */
assert( p->bIsReader ); assert( p->bIsReader );
iDb = pOp->p1; iDb = pOp->p1;
iCookie = pOp->p3; iCookie = pOp->p3;
assert( pOp->p3<SQLITE_N_BTREE_META ); assert( pOp->p3<SQLITE_N_BTREE_METAP );
assert( iDb>=0 && iDb<db->nDb ); assert( iDb>=0 && iDb<db->nDb );
assert( db->aDb[iDb].pBt!=0 ); assert( db->aDb[iDb].pBt!=0 );
assert( (p->btreeMask & (((yDbMask)1)<<iDb))!=0 ); assert( (p->btreeMask & (((yDbMask)1)<<iDb))!=0 );
@ -69307,7 +69307,7 @@ case OP_ReadCookie: { /* out2-prerelease */
*/ */
case OP_SetCookie: { /* in3 */ case OP_SetCookie: { /* in3 */
Db *pDb; Db *pDb;
assert( pOp->p2<SQLITE_N_BTREE_META ); assert( pOp->p2<SQLITE_N_BTREE_METAP );
assert( pOp->p1>=0 && pOp->p1<db->nDb ); assert( pOp->p1>=0 && pOp->p1<db->nDb );
assert( (p->btreeMask & (((yDbMask)1)<<pOp->p1))!=0 ); assert( (p->btreeMask & (((yDbMask)1)<<pOp->p1))!=0 );
assert( p->readOnly==0 ); assert( p->readOnly==0 );
@ -95154,7 +95154,7 @@ struct sqlite3_api_routines {
** excluded from a build of SQLite. Substitute a NULL pointer ** excluded from a build of SQLite. Substitute a NULL pointer
** for any missing APIs. ** for any missing APIs.
*/ */
#ifndef SQLITE_ENABLE_COLUMN_METADATA #ifndef SQLITE_ENABLE_COLUMN_METAPDATA
# define sqlite3_column_database_name 0 # define sqlite3_column_database_name 0
# define sqlite3_column_database_name16 0 # define sqlite3_column_database_name16 0
# define sqlite3_column_table_name 0 # define sqlite3_column_table_name 0
@ -100186,9 +100186,9 @@ static void generateSortTail(
** The declaration type for any expression other than a column is NULL. ** The declaration type for any expression other than a column is NULL.
** **
** This routine has either 3 or 6 parameters depending on whether or not ** This routine has either 3 or 6 parameters depending on whether or not
** the SQLITE_ENABLE_COLUMN_METADATA compile-time option is used. ** the SQLITE_ENABLE_COLUMN_METAPDATA compile-time option is used.
*/ */
#ifdef SQLITE_ENABLE_COLUMN_METADATA #ifdef SQLITE_ENABLE_COLUMN_METAPDATA
# define columnType(A,B,C,D,E,F) columnTypeImpl(A,B,C,D,E,F) # define columnType(A,B,C,D,E,F) columnTypeImpl(A,B,C,D,E,F)
static const char *columnTypeImpl( static const char *columnTypeImpl(
NameContext *pNC, NameContext *pNC,
@ -100201,14 +100201,14 @@ static const char *columnTypeImpl(
char const *zOrigDb = 0; char const *zOrigDb = 0;
char const *zOrigTab = 0; char const *zOrigTab = 0;
char const *zOrigCol = 0; char const *zOrigCol = 0;
#else /* if !defined(SQLITE_ENABLE_COLUMN_METADATA) */ #else /* if !defined(SQLITE_ENABLE_COLUMN_METAPDATA) */
# define columnType(A,B,C,D,E,F) columnTypeImpl(A,B,F) # define columnType(A,B,C,D,E,F) columnTypeImpl(A,B,F)
static const char *columnTypeImpl( static const char *columnTypeImpl(
NameContext *pNC, NameContext *pNC,
Expr *pExpr, Expr *pExpr,
u8 *pEstWidth u8 *pEstWidth
){ ){
#endif /* !defined(SQLITE_ENABLE_COLUMN_METADATA) */ #endif /* !defined(SQLITE_ENABLE_COLUMN_METAPDATA) */
char const *zType = 0; char const *zType = 0;
int j; int j;
u8 estWidth = 1; u8 estWidth = 1;
@ -100281,7 +100281,7 @@ static const char *columnTypeImpl(
assert( !pS ); assert( !pS );
if( iCol<0 ) iCol = pTab->iPKey; if( iCol<0 ) iCol = pTab->iPKey;
assert( iCol==-1 || (iCol>=0 && iCol<pTab->nCol) ); assert( iCol==-1 || (iCol>=0 && iCol<pTab->nCol) );
#ifdef SQLITE_ENABLE_COLUMN_METADATA #ifdef SQLITE_ENABLE_COLUMN_METAPDATA
if( iCol<0 ){ if( iCol<0 ){
zType = "INTEGER"; zType = "INTEGER";
zOrigCol = "rowid"; zOrigCol = "rowid";
@ -100325,7 +100325,7 @@ static const char *columnTypeImpl(
#endif #endif
} }
#ifdef SQLITE_ENABLE_COLUMN_METADATA #ifdef SQLITE_ENABLE_COLUMN_METAPDATA
if( pzOrigDb ){ if( pzOrigDb ){
assert( pzOrigTab && pzOrigCol ); assert( pzOrigTab && pzOrigCol );
*pzOrigDb = zOrigDb; *pzOrigDb = zOrigDb;
@ -100355,7 +100355,7 @@ static void generateColumnTypes(
for(i=0; i<pEList->nExpr; i++){ for(i=0; i<pEList->nExpr; i++){
Expr *p = pEList->a[i].pExpr; Expr *p = pEList->a[i].pExpr;
const char *zType; const char *zType;
#ifdef SQLITE_ENABLE_COLUMN_METADATA #ifdef SQLITE_ENABLE_COLUMN_METAPDATA
const char *zOrigDb = 0; const char *zOrigDb = 0;
const char *zOrigTab = 0; const char *zOrigTab = 0;
const char *zOrigCol = 0; const char *zOrigCol = 0;
@ -121509,7 +121509,7 @@ SQLITE_API void sqlite3_thread_cleanup(void){
** Return meta information about a specific column of a database table. ** Return meta information about a specific column of a database table.
** See comment in sqlite3.h (sqlite.h.in) for details. ** See comment in sqlite3.h (sqlite.h.in) for details.
*/ */
#ifdef SQLITE_ENABLE_COLUMN_METADATA #ifdef SQLITE_ENABLE_COLUMN_METAPDATA
SQLITE_API int sqlite3_table_column_metadata( SQLITE_API int sqlite3_table_column_metadata(
sqlite3 *db, /* Connection handle */ sqlite3 *db, /* Connection handle */
const char *zDbName, /* Database name or NULL */ const char *zDbName, /* Database name or NULL */

549
packages/swig/android/jni/sqlite/sqlite3.h
View File

File diff suppressed because it is too large Load Diff

3
packages/swig/configure.in
View File

@ -21,10 +21,11 @@ fi
if test "$PKG_SWIG" != ""; then if test "$PKG_SWIG" != ""; then
mkdir -p packages/swig/android
mkdir -p packages/swig/android/usr
mkdir -p packages/swig/python mkdir -p packages/swig/python
mkdir -p packages/swig/R mkdir -p packages/swig/R
mkdir -p packages/swig/java mkdir -p packages/swig/java
mkdir -p packages/swig/fli
mkdir -p packages/swig/jni mkdir -p packages/swig/jni
AC_SUBST(SWIG) AC_SUBST(SWIG)

39
packages/swig/python/demo.py
View File

@ -3,20 +3,31 @@
import sys import sys
import yap import yap
#
# initialize engine
engine = yap.YAPEngine(); engine = yap.YAPEngine();
# engine = yap.YAPEngine(yap.YAPParams()); # engine = yap.YAPEngine(yap.YAPParams());
def go(): def query( s ):
while True: q = engine.query(s)
s = raw_input("Prolog Query: ") while q.next():
q = engine.query(s) vs = q.namedVars()
while q.next(): if vs.length() == 0:
vs = q.namedVars(); print( "yes" )
if vs.length() == 0: return
print "yes" else:
else: while vs.length() > 0:
while vs.length() > 0: eq = vs.car()
eq = vs.car() print( eq.getArg(1).text() + " = " + eq.getArg(2).text() )
print eq.getArg(1).text() + " = " + eq.getArg(2).text() vs = vs.cdr()
vs = vs.cdr() s = raw_input("next: ?")
print "no more answers" if s.find(';') != 0 :
return
print( "no more answers" )
return
def live():
loop = True
while loop:
s = raw_input("?- ")
query( s )

21
packages/swig/yap.i
View File

@ -2,7 +2,7 @@
%module(directors="1") yap %module(directors="1") yap
// Language independent exception handler // Language independent exception handler
%include exception.i %include exception.i
class YAPPredicate; class YAPPredicate;
class YAPEngine; class YAPEngine;
@ -21,7 +21,7 @@
%exception query { %exception query {
try { try {
$action $action
} }
catch (YAPError YAP_SYMTAX_ERROR) { catch (YAPError YAP_SYMTAX_ERROR) {
SWIG_exception(SWIG_SyntaxError,"Syntax Error exception"); SWIG_exception(SWIG_SyntaxError,"Syntax Error exception");
} }
@ -33,7 +33,7 @@
%exception next { %exception next {
try { try {
$action $action
} }
catch (...) { catch (...) {
SWIG_exception(SWIG_RuntimeError,"Unknown exception"); SWIG_exception(SWIG_RuntimeError,"Unknown exception");
} }
@ -42,16 +42,14 @@
%{ %{
/* Put header files here or function declarations like below */ /* Put header files here or function declarations like below */
#define YAP_CPP_INTERFACE 1 #define YAP_CPP_INTERFACE 1
#include "yapi.hh" #include "yapi.hh"
extern "C" { extern "C" {
extern Term Yap_StringToTerm(const char *s, size_t len, term_t bindings);
#if THREADS #if THREADS
#define Yap_regp regcache #define Yap_regp regcache
#endif #endif
@ -61,11 +59,11 @@
} }
%} %}
/* turn on director wrapping Callback */ /* turn on director wrapping Callback */
%feature("director") YAPCallback; %feature("director") YAPCallback;
%include "yapi.hh" %include "yapi.hh"
%include "yapa.hh" %include "yapa.hh"
@ -89,4 +87,3 @@
} }
} }
#endif #endif

3
pl/consult.yap
View File

@ -16,7 +16,7 @@
*************************************************************************/ *************************************************************************/
:- system_module( '$_consult', [compile/1, :- system_module( '$_consult', [compile/1,
consult/1, consult/1,
db_files/1,- db_files/1,
ensure_loaded/1, ensure_loaded/1,
exists_source/1, exists_source/1,
exo_files/1, exo_files/1,
@ -879,6 +879,7 @@ db_files(Fs) :-
'$do_startup_reconsult'(_). '$do_startup_reconsult'(_).
'$skip_unix_header'(Stream) :- '$skip_unix_header'(Stream) :-
writeln(Stream),
peek_code(Stream, 0'#), !, % 35 is ASCII for '# peek_code(Stream, 0'#), !, % 35 is ASCII for '#
skip(Stream, 10), skip(Stream, 10),
'$skip_unix_header'(Stream). '$skip_unix_header'(Stream).

36
pl/init.yap
View File

@ -17,10 +17,10 @@
%% @defgroup builtins YAP Built-Ins %% @defgroup builtins YAP Built-Ins
/* /*
@addtogroup YAPControl @addtogroup YAPControl
@{ @{
*/ */
:- system_module( '$_init', [!/0, :- system_module( '$_init', [!/0,
@ -51,21 +51,21 @@
% These are pseudo declarations % These are pseudo declarations
% so that the user will get a redefining system predicate % so that the user will get a redefining system predicate
/** @pred fail is iso /** @pred fail is iso
Always fails. Always fails.
*/ */
fail :- fail. fail :- fail.
/** @pred false is iso /** @pred false is iso
The same as fail. The same as fail.
*/ */
false :- fail. false :- fail.
@ -127,7 +127,7 @@ otherwise.
'arith.yap', 'arith.yap',
'flags.yap' 'flags.yap'
]. ].
:- [ 'preds.yap', :- [ 'preds.yap',
'modules.yap' 'modules.yap'
]. ].
@ -232,7 +232,7 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- module(user). :- module(user).
/** @pred _CurrentModule_:goal_expansion(+ _G_,+ _M_,- _NG_), user:goal_expansion(+ _G_,+ _M_,- _NG_) /** @pred _CurrentModule_:goal_expansion(+ _G_,+ _M_,- _NG_), user:goal_expansion(+ _G_,+ _M_,- _NG_)
YAP now supports goal_expansion/3. This is an user-defined YAP now supports goal_expansion/3. This is an user-defined
@ -244,7 +244,7 @@ sub-goal _NG_ will replace _G_ and will be processed in the same
way. If goal_expansion/3 fails the system will use the default way. If goal_expansion/3 fails the system will use the default
rules. rules.
*/ */
:- multifile goal_expansion/3. :- multifile goal_expansion/3.
@ -263,25 +263,25 @@ rules.
:- dynamic goal_expansion/2. :- dynamic goal_expansion/2.
/** @pred _CurrentModule_:term_expansion( _T_,- _X_), user:term_expansion( _T_,- _X_) /** @pred _CurrentModule_:term_expansion( _T_,- _X_), user:term_expansion( _T_,- _X_)
This user-defined predicate is called by `expand_term/3` to This user-defined predicate is called by `expand_term/3` to
preprocess all terms read when consulting a file. If it succeeds: preprocess all terms read when consulting a file. If it succeeds:
+ +
If _X_ is of the form `:- G` or `?- G`, it is processed as If _X_ is of the form `:- G` or `?- G`, it is processed as
a directive. a directive.
+ +
If _X_ is of the form `$source_location`( _File_, _Line_): _Clause_` it is processed as if from `File` and line `Line`. If _X_ is of the form `$source_location`( _File_, _Line_): _Clause_` it is processed as if from `File` and line `Line`.
+ +
If _X_ is a list, all terms of the list are asserted or processed If _X_ is a list, all terms of the list are asserted or processed
as directives. as directives.
+ The term _X_ is asserted instead of _T_. + The term _X_ is asserted instead of _T_.
*/ */
:- multifile term_expansion/2. :- multifile term_expansion/2.
@ -294,7 +294,7 @@ as directives.
:- multifile swi:swi_predicate_table/4. :- multifile swi:swi_predicate_table/4.
/** @pred user:message_hook(+ _Term_, + _Kind_, + _Lines_) /** @pred user:message_hook(+ _Term_, + _Kind_, + _Lines_)
Hook predicate that may be define in the module `user` to intercept Hook predicate that may be define in the module `user` to intercept
@ -305,7 +305,7 @@ format statements as described with print_message_lines/3.
This predicate should be defined dynamic and multifile to allow other This predicate should be defined dynamic and multifile to allow other
modules defining clauses for it too. modules defining clauses for it too.
*/ */
:- multifile user:message_hook/3. :- multifile user:message_hook/3.
@ -315,7 +315,7 @@ modules defining clauses for it too.
:- dynamic user:portray_message/2. :- dynamic user:portray_message/2.
/** @pred exception(+ _Exception_, + _Context_, - _Action_) /** @pred exception(+ _Exception_, + _Context_, - _Action_)
Dynamic predicate, normally not defined. Called by the Prolog system on run-time exceptions that can be repaired `just-in-time`. The values for _Exception_ are described below. See also catch/3 and throw/1. Dynamic predicate, normally not defined. Called by the Prolog system on run-time exceptions that can be repaired `just-in-time`. The values for _Exception_ are described below. See also catch/3 and throw/1.
@ -337,7 +337,7 @@ If this hook predicate succeeds it must instantiate the _Action_ argument to th
:- dynamic user:exception/3. :- dynamic user:exception/3.
:- yap_flag(unknown,error). :- yap_flag(unknown,error).
:- stream_property(user_input, tty(true)) -> set_prolog_flag(readline, true) ; true. :- stream_property(user_input, tty(true)) -> set_prolog_flag(readline, true) ; true.

23
pl/modules.yap
View File

@ -823,7 +823,10 @@ expand_goal(G, G).
% be careful here not to generate an undefined exception. % be careful here not to generate an undefined exception.
'$imported_pred'(G, ImportingMod, G0, ExportingMod) :- '$imported_pred'(G, ImportingMod, G0, ExportingMod) :-
'$enter_undefp', '$enter_undefp',
'$undefined'(G, ImportingMod), ( var(G) -> true ;
var(ImportingMod) -> true ;
'$undefined'(G, ImportingMod)
),
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod), '$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
ExportingMod \= ImportingMod, !, ExportingMod \= ImportingMod, !,
'$exit_undefp'. '$exit_undefp'.
@ -833,8 +836,8 @@ expand_goal(G, G).
% This predicate should be bidirectional: both % This predicate should be bidirectional: both
% a consumer and a generator. % a consumer and a generator.
'$get_undefined_pred'(G, ImportingMod, call(G), ImportingMod) :- %'$get_undefined_pred'(G, ImportingMod, call(G), ImportingMod) :-
var(G), !. % var(G), !.
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :- '$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_), recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_),
'$continue_imported'(ExportingMod, ExportingModI, G0, G0I). '$continue_imported'(ExportingMod, ExportingModI, G0, G0I).
@ -852,8 +855,8 @@ expand_goal(G, G).
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :- '$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
yap_flag(autoload, V), yap_flag(autoload, V),
V = true, V = true,
functor(G, N, K), functor(G, N, K),
functor(G0, N, K), functor(G0, N, K),
'$autoloader_find_predicate'(G0,ExportingMod), '$autoloader_find_predicate'(G0,ExportingMod),
ExportingMod \= ImportingMod, ExportingMod \= ImportingMod,
(recordzifnot('$import','$import'(ExportingMod,ImportingMod,G0,G0, N ,K),_) -> true ; true ). (recordzifnot('$import','$import'(ExportingMod,ImportingMod,G0,G0, N ,K),_) -> true ; true ).
@ -1404,10 +1407,14 @@ export_list(Module, List) :-
G0=..[_N0|Args], G0=..[_N0|Args],
G1=..[N1|Args], G1=..[N1|Args],
( '$check_import'(M0,ContextMod,N1,K) -> ( '$check_import'(M0,ContextMod,N1,K) ->
( ContextMod = user -> ( ContextMod == prolog ->
( recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_) -> true ; true) recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_),
fail
; ;
( recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_) -> true ; true ) recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_),
fail
;
true
) )
; ;
true true

17
pl/preddecls.yap
View File

@ -31,7 +31,7 @@
The YAP Compiler allows the programmer to include declarations with The YAP Compiler allows the programmer to include declarations with
important pproprties of predicates, such as where they can be modified important pproprties of predicates, such as where they can be modified
during execution time, whether they are meta-predicates, or whether they can be during execution time, whether they are meta-predicates, or whether they can be
defined across multiple files. We next join some of these declarations. defined across multiple files. We next join some of these declarations.
*/ */
@ -50,7 +50,7 @@ as a dynamic predicate. _P_ must be written as a predicate indicator, that is i
:- dynamic god/1. :- dynamic god/1.
~~~~~ ~~~~~
a more convenient form can be used: a more convenient form can be used:
~~~~~ ~~~~~
@ -65,10 +65,10 @@ or, equivalently,
Note: Note:
a predicate is assumed to be dynamic when a predicate is assumed to be dynamic when
asserted before being defined. asserted before being defined.
*/ */
dynamic(X) :- '$access_yap_flags'(8, 0), !, dynamic(X) :- '$access_yap_flags'(8, 0), !,
'$current_module'(M), '$current_module'(M),
@ -102,7 +102,7 @@ dynamic(X) :-
F /\ 0x00000400 =:= 0x00000400, '$undefined'(T,Mod) -> F1 is F /\ \(0x400), N1F is F1 \/ 0x00002000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod); F /\ 0x00000400 =:= 0x00000400, '$undefined'(T,Mod) -> F1 is F /\ \(0x400), N1F is F1 \/ 0x00002000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N)) '$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
). ).
'$dynamic2'(X,Mod) :- '$dynamic2'(X,Mod) :-
'$do_pi_error'(type_error(callable,X),dynamic(Mod:X)). '$do_pi_error'(type_error(callable,X),dynamic(Mod:X)).
'$logical_updatable'(A//N,Mod) :- integer(N), !, '$logical_updatable'(A//N,Mod) :- integer(N), !,
@ -117,7 +117,7 @@ dynamic(X) :-
F /\ 0x00000400 =:= 0x00000400 , '$undefined'(T,Mod) -> N1F is F \/ 0x08000000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod); F /\ 0x00000400 =:= 0x00000400 , '$undefined'(T,Mod) -> N1F is F \/ 0x08000000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N)) '$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
). ).
'$logical_updatable'(X,Mod) :- '$logical_updatable'(X,Mod) :-
'$do_error'(type_error(callable,X),dynamic(Mod:X)). '$do_error'(type_error(callable,X),dynamic(Mod:X)).
/** @pred public( _P_ ) is iso /** @pred public( _P_ ) is iso
@ -144,7 +144,7 @@ defines all new or redefined predicates to be public.
'$public'(A/N, Mod) :- integer(N), atom(A), !, '$public'(A/N, Mod) :- integer(N), atom(A), !,
functor(T,A,N), functor(T,A,N),
'$do_make_public'(T, Mod). '$do_make_public'(T, Mod).
'$public'(X, Mod) :- '$public'(X, Mod) :-
'$do_pi_error'(type_error(callable,X),dynamic(Mod:X)). '$do_pi_error'(type_error(callable,X),dynamic(Mod:X)).
'$do_make_public'(T, Mod) :- '$do_make_public'(T, Mod) :-
@ -250,5 +250,4 @@ discontiguous(F) :-
write(user_error,' (line '), write(user_error,' (line '),
'$start_line'(LN), write(user_error,LN), '$start_line'(LN), write(user_error,LN),
write(user_error,')'), write(user_error,')'),
nl(user_error). nl(user_error).

242
pl/preds.yap
View File

@ -15,14 +15,15 @@
* * * *
*************************************************************************/ *************************************************************************/
/** @defgroup Database Using the Clausal Data Base /**
@ingroup builtins * @defgroup Database Using the Clausal Data Base
@{ * @ingroup builtins
* @{
Predicates in YAP may be dynamic or static. By default, when Predicates in YAP may be dynamic or static. By default, when
consulting or reconsulting, predicates are assumed to be static: consulting or reconsulting, predicates are assumed to be static:
execution is faster and the code will probably use less space. execution is faster and the code will probably use less space.
Static predicates impose some restrictions: in general there can be no Static predicates impose some restrictions: in general there can be no
addition or removal of clauses for a procedure if it is being used in the addition or removal of clauses for a procedure if it is being used in the
current execution. current execution.
@ -30,12 +31,9 @@ Dynamic predicates allow programmers to change the Clausal Data Base with
the same flexibility as in C-Prolog. With dynamic predicates it is the same flexibility as in C-Prolog. With dynamic predicates it is
always possible to add or remove clauses during execution and the always possible to add or remove clauses during execution and the
semantics will be the same as for C-Prolog. But the programmer should be semantics will be the same as for C-Prolog. But the programmer should be
aware of the fact that asserting or retracting are still expensive operations, aware of the fact that asserting or retracting are still expensive operations,
and therefore he should try to avoid them whenever possible. and therefore he should try to avoid them whenever possible.
*/ */
:- system_module( '$_preds', [abolish/1, :- system_module( '$_preds', [abolish/1,
@ -103,13 +101,13 @@ and therefore he should try to avoid them whenever possible.
% The next predicates are applicable only % The next predicates are applicable only
% to dynamic code % to dynamic code
/** @pred asserta(+ _C_) is iso /** @pred asserta(+ _C_) is iso
Adds clause _C_ to the beginning of the program. If the predicate is Adds clause _C_ to the beginning of the program. If the predicate is
undefined, declare it as dynamic. undefined, declare it as dynamic.
*/ */
asserta(Mod:C) :- !, asserta(Mod:C) :- !,
'$assert'(C,Mod,first,_,asserta(Mod:C)). '$assert'(C,Mod,first,_,asserta(Mod:C)).
@ -117,7 +115,7 @@ asserta(C) :-
'$current_module'(Mod), '$current_module'(Mod),
'$assert'(C,Mod,first,_,asserta(C)). '$assert'(C,Mod,first,_,asserta(C)).
/** @pred assertz(+ _C_) is iso /** @pred assertz(+ _C_) is iso
Adds clause _C_ to the end of the program. If the predicate is Adds clause _C_ to the end of the program. If the predicate is
@ -129,7 +127,7 @@ asserting clauses for static predicates. The current version of YAP
supports this feature, but this feature is deprecated and support may go supports this feature, but this feature is deprecated and support may go
away in future versions. away in future versions.
*/ */
assertz(Mod:C) :- !, assertz(Mod:C) :- !,
'$assert'(C,Mod,last,_,assertz(Mod:C)). '$assert'(C,Mod,last,_,assertz(Mod:C)).
@ -137,7 +135,7 @@ assertz(C) :-
'$current_module'(Mod), '$current_module'(Mod),
'$assert'(C,Mod,last,_,assertz(C)). '$assert'(C,Mod,last,_,assertz(C)).
/** @pred assert(+ _C_) /** @pred assert(+ _C_)
Same as assertz/1. Adds clause _C_ to the program. If the predicate is undefined, Same as assertz/1. Adds clause _C_ to the program. If the predicate is undefined,
@ -150,7 +148,7 @@ in use and the language flag is <tt>cprolog</tt>. Note that this feature is
deprecated, if you want to assert clauses for static procedures you deprecated, if you want to assert clauses for static procedures you
should use assert_static/1. should use assert_static/1.
*/ */
assert(Mod:C) :- !, assert(Mod:C) :- !,
'$assert'(C,Mod,last,_,assert(Mod:C)). '$assert'(C,Mod,last,_,assert(Mod:C)).
@ -186,7 +184,7 @@ assert(C) :-
'$is_dynamic'(H, Mod) -> '$is_dynamic'(H, Mod) ->
'$assertat_d'(Where, H, true, H, Mod, R) '$assertat_d'(Where, H, true, H, Mod, R)
; ;
'$undefined'(H,Mod) -> '$undefined'(H,Mod) ->
functor(H, Na, Ar), functor(H, Na, Ar),
'$dynamic'(Na/Ar, Mod), '$dynamic'(Na/Ar, Mod),
'$assert_fact'(H,Mod,Where,R) '$assert_fact'(H,Mod,Where,R)
@ -211,7 +209,7 @@ assert(C) :-
'$is_dynamic'(H, Mod) -> '$is_dynamic'(H, Mod) ->
'$assertat_d'(Where, H, B, C0, Mod, R) '$assertat_d'(Where, H, B, C0, Mod, R)
; ;
'$undefined'(H,Mod) -> '$undefined'(H,Mod) ->
functor(H, Na, Ar), functor(H, Na, Ar),
'$dynamic'(Na/Ar, Mod), '$dynamic'(Na/Ar, Mod),
'$assert_clause3'(C0,C,Mod,Where,R,P) '$assert_clause3'(C0,C,Mod,Where,R,P)
@ -242,7 +240,7 @@ assert(C) :-
'$is_dynamic'(H, Mod) -> '$is_dynamic'(H, Mod) ->
'$assertat_d'(Where,H,B,C0,Mod,R) '$assertat_d'(Where,H,B,C0,Mod,R)
; ;
'$undefined'(H, Mod) -> '$undefined'(H, Mod) ->
functor(H, Na, Ar), functor(H, Na, Ar),
'$dynamic'(Na/Ar, Mod), '$dynamic'(Na/Ar, Mod),
'$assert_dynamic2'(C0,C,Mod,Where,R,P) '$assert_dynamic2'(C0,C,Mod,Where,R,P)
@ -251,14 +249,14 @@ assert(C) :-
'$do_error'(permission_error(modify,static_procedure,Na/Ar),P) '$do_error'(permission_error(modify,static_procedure,Na/Ar),P)
). ).
/** @pred assert_static(: _C_) /** @pred assert_static(: _C_)
Adds clause _C_ to a static procedure. Asserting a static clause Adds clause _C_ to a static procedure. Asserting a static clause
for a predicate while choice-points for the predicate are available has for a predicate while choice-points for the predicate are available has
undefined results. undefined results.
*/ */
assert_static(Mod:C) :- !, assert_static(Mod:C) :- !,
'$assert_static'(C,Mod,last,_,assert_static(Mod:C)). '$assert_static'(C,Mod,last,_,assert_static(Mod:C)).
@ -266,12 +264,12 @@ assert_static(C) :-
'$current_module'(Mod), '$current_module'(Mod),
'$assert_static'(C,Mod,last,_,assert_static(C)). '$assert_static'(C,Mod,last,_,assert_static(C)).
/** @pred asserta_static(: _C_) /** @pred asserta_static(: _C_)
Adds clause _C_ to the beginning of a static procedure. Adds clause _C_ to the beginning of a static procedure.
*/ */
asserta_static(Mod:C) :- !, asserta_static(Mod:C) :- !,
'$assert_static'(C,Mod,first,_,asserta_static(Mod:C)). '$assert_static'(C,Mod,first,_,asserta_static(Mod:C)).
@ -281,7 +279,7 @@ asserta_static(C) :-
asserta_static(Mod:C) :- !, asserta_static(Mod:C) :- !,
'$assert_static'(C,Mod,last,_,assertz_static(Mod:C)). '$assert_static'(C,Mod,last,_,assertz_static(Mod:C)).
/** @pred assertz_static(: _C_) /** @pred assertz_static(: _C_)
Adds clause _C_ to the end of a static procedure. Asserting a Adds clause _C_ to the end of a static procedure. Asserting a
@ -295,7 +293,7 @@ static predicates, if source mode was on when they were compiled:
*/ */
assertz_static(C) :- assertz_static(C) :-
'$current_module'(Mod), '$current_module'(Mod),
@ -328,13 +326,13 @@ assertz_static(C) :-
( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true ) ( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true )
; ;
true true
), ),
'$head_and_body'(C0, H0, B0), '$head_and_body'(C0, H0, B0),
'$recordap'(Mod:Head,(H0 :- B0),R,CR), '$recordap'(Mod:Head,(H0 :- B0),R,CR),
( '$is_multifile'(Head, Mod) -> ( '$is_multifile'(Head, Mod) ->
source_location(F, _), source_location(F, _),
functor(H0, Na, Ar), functor(H0, Na, Ar),
recorda('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _) recorda('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _)
; ;
true true
). ).
@ -346,13 +344,13 @@ assertz_static(C) :-
( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true ) ( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true )
; ;
true true
), ),
'$head_and_body'(C0, H0, B0), '$head_and_body'(C0, H0, B0),
'$recordzp'(Mod:Head,(H0 :- B0),R,CR), '$recordzp'(Mod:Head,(H0 :- B0),R,CR),
( '$is_multifile'(H0, Mod) -> ( '$is_multifile'(H0, Mod) ->
source_location(F, _), source_location(F, _),
functor(H0, Na, Ar), functor(H0, Na, Ar),
recordz('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _) recordz('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _)
; ;
true true
). ).
@ -363,8 +361,8 @@ assertz_static(C) :-
'$assertz_dynamic'(X, C, C0, Mod) :- (X/\4)=:=0, !, '$assertz_dynamic'(X, C, C0, Mod) :- (X/\4)=:=0, !,
'$head_and_body'(C,H,B), '$head_and_body'(C,H,B),
'$assertat_d'(last,H,B,C0,Mod,_). '$assertat_d'(last,H,B,C0,Mod,_).
'$assertz_dynamic'(X,C,C0,Mod) :- '$assertz_dynamic'(X,C,C0,Mod) :-
'$head_and_body'(C,H,B), '$head_and_body'(C,H,B),
functor(H,N,A), functor(H,N,A),
('$check_if_reconsulted'(N,A) -> ('$check_if_reconsulted'(N,A) ->
true true
@ -396,12 +394,12 @@ assertz_static(C) :-
/** @pred asserta(+ _C_,- _R_) /** @pred asserta(+ _C_,- _R_)
The same as `asserta(C)` but unifying _R_ with The same as `asserta(C)` but unifying _R_ with
the database reference that identifies the new clause, in a the database reference that identifies the new clause, in a
one-to-one way. Note that `asserta/2` only works for dynamic one-to-one way. Note that `asserta/2` only works for dynamic
predicates. If the predicate is undefined, it will automatically be predicates. If the predicate is undefined, it will automatically be
declared dynamic. declared dynamic.
*/ */
asserta(M:C,R) :- !, asserta(M:C,R) :- !,
'$assert_dynamic'(C,M,first,R,asserta(M:C,R)). '$assert_dynamic'(C,M,first,R,asserta(M:C,R)).
@ -412,12 +410,12 @@ asserta(C,R) :-
/** @pred assertz(+ _C_,- _R_) /** @pred assertz(+ _C_,- _R_)
The same as `assertz(C)` but unifying _R_ with The same as `assertz(C)` but unifying _R_ with
the database reference that identifies the new clause, in a the database reference that identifies the new clause, in a
one-to-one way. Note that `asserta/2` only works for dynamic one-to-one way. Note that `asserta/2` only works for dynamic
predicates. If the predicate is undefined, it will automatically be predicates. If the predicate is undefined, it will automatically be
declared dynamic. declared dynamic.
*/ */
assertz(M:C,R) :- !, assertz(M:C,R) :- !,
'$assert_dynamic'(C,M,last,R,assertz(M:C,R)). '$assert_dynamic'(C,M,last,R,assertz(M:C,R)).
@ -433,7 +431,7 @@ clause, in a one-to-one way. Note that `asserta/2` only works for dynamic
predicates. If the predicate is undefined, it will automatically be predicates. If the predicate is undefined, it will automatically be
declared dynamic. declared dynamic.
*/ */
assert(M:C,R) :- !, assert(M:C,R) :- !,
'$assert_dynamic'(C,M,last,R,assert(M:C,R)). '$assert_dynamic'(C,M,last,R,assert(M:C,R)).
@ -441,7 +439,7 @@ assert(C,R) :-
'$current_module'(M), '$current_module'(M),
'$assert_dynamic'(C,M,last,R,assert(C,R)). '$assert_dynamic'(C,M,last,R,assert(C,R)).
/** @pred clause(+ _H_, _B_) is iso /** @pred clause(+ _H_, _B_) is iso
A clause whose head matches _H_ is searched for in the A clause whose head matches _H_ is searched for in the
@ -452,7 +450,7 @@ program. Its head and body are respectively unified with _H_ and
This predicate is applicable to static procedures compiled with This predicate is applicable to static procedures compiled with
`source` active, and to all dynamic procedures. `source` active, and to all dynamic procedures.
*/ */
clause(M:P,Q) :- !, clause(M:P,Q) :- !,
'$clause'(P,M,Q,_). '$clause'(P,M,Q,_).
@ -467,7 +465,7 @@ reference to the clause in the database. You can use instance/2
to access the reference's value. Note that you may not use to access the reference's value. Note that you may not use
erase/1 on the reference on static procedures. erase/1 on the reference on static procedures.
*/ */
clause(P,Q,R) :- var(P), !, clause(P,Q,R) :- var(P), !,
'$current_module'(M), '$current_module'(M),
@ -483,9 +481,9 @@ clause(V,Q,R) :-
M0 = M, M0 = M,
instance(R,T), instance(R,T),
( T = (H :- B) -> P = H, Q = B ; P=T, Q = true). ( T = (H :- B) -> P = H, Q = B ; P=T, Q = true).
'$clause'(V,M,Q,R) :- var(V), !, '$clause'(V,M,Q,R) :- var(V), !,
'$do_error'(instantiation_error,clause(M:V,Q,R)). '$do_error'(instantiation_error,clause(M:V,Q,R)).
'$clause'(C,M,Q,R) :- '$clause'(C,M,Q,R) :-
number(C), !, number(C), !,
'$do_error'(type_error(callable,C),clause(M:C,Q,R)). '$do_error'(type_error(callable,C),clause(M:C,Q,R)).
'$clause'(C,M,Q,R) :- '$clause'(C,M,Q,R) :-
@ -515,26 +513,26 @@ clause(V,Q,R) :-
'$do_error'(permission_error(access,private_procedure,Name/Arity), '$do_error'(permission_error(access,private_procedure,Name/Arity),
clause(M:P,Q,R)). clause(M:P,Q,R)).
'$init_preds' :- '$init_preds' :-
once('$handle_throw'(_,_,_)), once('$handle_throw'(_,_,_)),
fail. fail.
'$init_preds' :- '$init_preds' :-
once('$do_static_clause'(_,_,_,_,_)), once('$do_static_clause'(_,_,_,_,_)),
fail. fail.
'$init_preds' :- '$init_preds' :-
once('$do_log_upd_clause0'(_,_,_,_,_,_)), once('$do_log_upd_clause0'(_,_,_,_,_,_)),
fail. fail.
'$init_preds' :- '$init_preds' :-
once('$do_log_upd_clause'(_,_,_,_,_,_)), once('$do_log_upd_clause'(_,_,_,_,_,_)),
fail. fail.
'$init_preds' :- '$init_preds' :-
once('$do_log_upd_clause_erase'(_,_,_,_,_,_)), once('$do_log_upd_clause_erase'(_,_,_,_,_,_)),
fail. fail.
'$init_preds'. '$init_preds'.
:- '$init_preds'. :- '$init_preds'.
/** @pred nth_clause(+ _H_, _I_,- _R_) /** @pred nth_clause(+ _H_, _I_,- _R_)
Find the _I_th clause in the predicate defining _H_, and give Find the _I_th clause in the predicate defining _H_, and give
@ -548,7 +546,7 @@ The following predicates can only be used for dynamic predicates:
*/ */
nth_clause(V,I,R) :- nth_clause(V,I,R) :-
'$current_module'(M), '$current_module'(M),
@ -563,7 +561,7 @@ nth_clause(V,I,R) :-
'$nth_clause'(P,M,I,R) :- '$nth_clause'(P,M,I,R) :-
'$fetch_nth_clause'(P,M,I,R). '$fetch_nth_clause'(P,M,I,R).
/** @pred retract(+ _C_) is iso /** @pred retract(+ _C_) is iso
Erases the first clause in the program that matches _C_. This Erases the first clause in the program that matches _C_. This
@ -571,20 +569,20 @@ predicate may also be used for the static predicates that have been
compiled when the source mode was `on`. For more information on compiled when the source mode was `on`. For more information on
source/0 ( (see Setting the Compiler)). source/0 ( (see Setting the Compiler)).
*/ */
retract(M:C) :- !, retract(M:C) :- !,
'$retract'(C,M). '$retract'(C,M).
retract(C) :- retract(C) :-
'$current_module'(M), '$current_module'(M),
'$retract'(C,M). '$retract'(C,M).
'$retract'(V,_) :- var(V), !, '$retract'(V,_) :- var(V), !,
'$do_error'(instantiation_error,retract(V)). '$do_error'(instantiation_error,retract(V)).
'$retract'(M:C,_) :- !, '$retract'(M:C,_) :- !,
'$retract'(C,M). '$retract'(C,M).
'$retract'(C,M) :- '$retract'(C,M) :-
'$check_head_and_body'(C,H,B,retract(M:C)), !, '$check_head_and_body'(C,H,B,retract(M:C)), !,
'$flags'(H, M, F, F), '$flags'(H, M, F, F),
'$retract2'(F, H,M,B,_). '$retract2'(F, H,M,B,_).
@ -595,24 +593,24 @@ retract(C) :-
'$log_update_clause'(H,M,B,R), '$log_update_clause'(H,M,B,R),
( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,R),MR), erase(MR), fail ; true), ( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,R),MR), erase(MR), fail ; true),
erase(R). erase(R).
'$retract2'(F, H, M, B, R) :- '$retract2'(F, H, M, B, R) :-
% '$is_dynamic'(H,M), !, % '$is_dynamic'(H,M), !,
F /\ 0x00002000 =:= 0x00002000, !, F /\ 0x00002000 =:= 0x00002000, !,
'$recordedp'(M:H,(H:-B),R), '$recordedp'(M:H,(H:-B),R),
( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,MRef),MR), erase(MR), erase(MRef), fail ; true), ( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,MRef),MR), erase(MR), erase(MRef), fail ; true),
erase(R). erase(R).
'$retract2'(_, H,M,_,_) :- '$retract2'(_, H,M,_,_) :-
'$undefined'(H,M), !, '$undefined'(H,M), !,
functor(H,Na,Ar), functor(H,Na,Ar),
'$dynamic'(Na/Ar,M), '$dynamic'(Na/Ar,M),
fail. fail.
'$retract2'(_, H,M,B,_) :- '$retract2'(_, H,M,B,_) :-
functor(H,Na,Ar), functor(H,Na,Ar),
'$do_error'(permission_error(modify,static_procedure,Na/Ar),retract(M:(H:-B))). '$do_error'(permission_error(modify,static_procedure,Na/Ar),retract(M:(H:-B))).
/** @pred retract(+ _C_,- _R_) /** @pred retract(+ _C_,- _R_)
Erases from the program the clause _C_ whose Erases from the program the clause _C_ whose
database reference is _R_. The predicate must be dynamic. database reference is _R_. The predicate must be dynamic.
@ -645,9 +643,9 @@ retract(C,R) :-
functor(C, Na, Ar). functor(C, Na, Ar).
'$fetch_predicate_indicator_from_clause'(C, Na/Ar) :- '$fetch_predicate_indicator_from_clause'(C, Na/Ar) :-
functor(C, Na, Ar). functor(C, Na, Ar).
/** @pred retractall(+ _G_) is iso
/** @pred retractall(+ _G_) is iso
Retract all the clauses whose head matches the goal _G_. Goal Retract all the clauses whose head matches the goal _G_. Goal
@ -689,7 +687,7 @@ retractall(V) :-
functor(T,Na,Ar), functor(T,Na,Ar),
'$do_error'(permission_error(modify,static_procedure,Na/Ar),retractall(T)) '$do_error'(permission_error(modify,static_procedure,Na/Ar),retractall(T))
). ).
'$retractall_lu'(T,M) :- '$retractall_lu'(T,M) :-
'$free_arguments'(T), !, '$free_arguments'(T), !,
( '$purge_clauses'(T,M), fail ; true ). ( '$purge_clauses'(T,M), fail ; true ).
@ -717,14 +715,14 @@ retractall(V) :-
Completely delete the predicate with name _P_ and arity _N_. It will Completely delete the predicate with name _P_ and arity _N_. It will
remove both static and dynamic predicates. All state on the predicate, remove both static and dynamic predicates. All state on the predicate,
including whether it is dynamic or static, multifile, or including whether it is dynamic or static, multifile, or
meta-predicate, will be lost. meta-predicate, will be lost.
*/ */
abolish(Mod:N,A) :- !, abolish(Mod:N,A) :- !,
'$abolish'(N,A,Mod). '$abolish'(N,A,Mod).
abolish(N,A) :- abolish(N,A) :-
'$current_module'(Mod), '$current_module'(Mod),
'$abolish'(N,A,Mod). '$abolish'(N,A,Mod).
'$abolish'(N,A,M) :- var(N), !, '$abolish'(N,A,M) :- var(N), !,
'$do_error'(instantiation_error,abolish(M:N,A)). '$do_error'(instantiation_error,abolish(M:N,A)).
'$abolish'(N,A,M) :- var(A), !, '$abolish'(N,A,M) :- var(A), !,
@ -736,7 +734,7 @@ abolish(N,A) :-
( '$is_dynamic'(T, M) -> '$abolishd'(T,M) ; ( '$is_dynamic'(T, M) -> '$abolishd'(T,M) ;
/* else */ '$abolishs'(T,M) ). /* else */ '$abolishs'(T,M) ).
/** @pred abolish(+ _PredSpec_) is iso /** @pred abolish(+ _PredSpec_) is iso
Deletes the predicate given by _PredSpec_ from the database. If Deletes the predicate given by _PredSpec_ from the database. If
@ -744,9 +742,9 @@ Deletes the predicate given by _PredSpec_ from the database. If
current module. The current module. The
specification must include the name and arity, and it may include module specification must include the name and arity, and it may include module
information. Under <tt>iso</tt> language mode this built-in will only abolish information. Under <tt>iso</tt> language mode this built-in will only abolish
dynamic procedures. Under other modes it will abolish any procedures. dynamic procedures. Under other modes it will abolish any procedures.
*/ */
abolish(V) :- var(V), !, abolish(V) :- var(V), !,
'$do_error'(instantiation_error,abolish(V)). '$do_error'(instantiation_error,abolish(V)).
@ -754,14 +752,14 @@ abolish(Mod:V) :- var(V), !,
'$do_error'(instantiation_error,abolish(Mod:V)). '$do_error'(instantiation_error,abolish(Mod:V)).
abolish(M:X) :- !, abolish(M:X) :- !,
'$abolish'(X,M). '$abolish'(X,M).
abolish(X) :- abolish(X) :-
'$current_module'(M), '$current_module'(M),
'$abolish'(X,M). '$abolish'(X,M).
'$abolish'(X,M) :- '$abolish'(X,M) :-
'$access_yap_flags'(8, 2), !, '$access_yap_flags'(8, 2), !,
'$new_abolish'(X,M). '$new_abolish'(X,M).
'$abolish'(X, M) :- '$abolish'(X, M) :-
'$old_abolish'(X,M). '$old_abolish'(X,M).
'$new_abolish'(V,M) :- var(V), !, '$new_abolish'(V,M) :- var(V), !,
@ -858,7 +856,7 @@ abolish(X) :-
'$old_abolish'([H|T], M) :- !, '$old_abolish'(H, M), '$old_abolish'(T, M). '$old_abolish'([H|T], M) :- !, '$old_abolish'(H, M), '$old_abolish'(T, M).
'$old_abolish'(T, M) :- '$old_abolish'(T, M) :-
'$do_error'(type_error(predicate_indicator,T),abolish(M:T)). '$do_error'(type_error(predicate_indicator,T),abolish(M:T)).
'$abolish_all_old'(M) :- '$abolish_all_old'(M) :-
'$current_predicate'(Na, M, S, _), '$current_predicate'(Na, M, S, _),
functor( S, Na, Ar ), functor( S, Na, Ar ),
@ -913,14 +911,14 @@ abolish(X) :-
'$purge_clauses'(G, M), fail. '$purge_clauses'(G, M), fail.
'$abolishs'(_, _). '$abolishs'(_, _).
/** @pred dynamic_predicate(+ _P_,+ _Semantics_) /** @pred dynamic_predicate(+ _P_,+ _Semantics_)
Declares predicate _P_ or list of predicates [ _P1_,..., _Pn_] Declares predicate _P_ or list of predicates [ _P1_,..., _Pn_]
as a dynamic predicate following either `logical` or as a dynamic predicate following either `logical` or
`immediate` semantics. `immediate` semantics.
*/ */
dynamic_predicate(P,Sem) :- dynamic_predicate(P,Sem) :-
'$bad_if_is_semantics'(Sem, dynamic(P,Sem)). '$bad_if_is_semantics'(Sem, dynamic(P,Sem)).
@ -999,11 +997,11 @@ hide_predicate(P) :-
'$hide_predicate2'(PredDesc, M) :- '$hide_predicate2'(PredDesc, M) :-
'$do_error'(type_error(predicate_indicator,PredDesc),hide_predicate(M:PredDesc)). '$do_error'(type_error(predicate_indicator,PredDesc),hide_predicate(M:PredDesc)).
/** @pred predicate_property( _P_, _Prop_) is iso /** @pred predicate_property( _P_, _Prop_) is iso
For the predicates obeying the specification _P_ unify _Prop_ For the predicates obeying the specification _P_ unify _Prop_
with a property of _P_. These properties may be: with a property of _P_. These properties may be:
+ `built_in ` + `built_in `
true for built-in predicates, true for built-in predicates,
@ -1042,30 +1040,29 @@ Number of clauses in the predicate definition. Always one if external
or built-in. or built-in.
*/
predicate_property(Pred,Prop) :- var(Pred), !,
'$current_module'(Mod),
'$predicate_property2'(Pred,Prop,Mod).
predicate_property(Mod:Pred,Prop) :- !,
'$predicate_property2'(Pred,Prop,Mod).
predicate_property(Pred,Prop) :-
'$current_module'(Mod),
'$predicate_property2'(Pred,Prop,Mod).
'$predicate_property2'(Pred,Prop,M) :- var(M), !, */
'$all_current_modules'(M), predicate_property(Pred,Prop) :-
'$predicate_property2'(Pred,Prop,M). strip_module(Pred, Mod, TruePred),
'$predicate_property2'(Pred,Prop,M0) :- var(Pred), !, '$predicate_property2'(TruePred,Prop,Mod).
(M = M0 ; M = prolog), % prolog mode is automatically incorporate in every other module
'$predicate_property2'(Pred, Prop, Mod) :-
var(Mod), !,
'$all_current_modules'(Mod),
'$predicate_property2'(Pred, Prop, Mod).
'$predicate_property2'(Pred,Prop,M0) :-
var(Pred), !,
(M = M0 ;
M = prolog ;
M = user), % prolog and user modules are automatically incorporate in every other module
'$generate_all_preds_from_mod'(Pred, SourceMod, M), '$generate_all_preds_from_mod'(Pred, SourceMod, M),
'$predicate_property'(Pred,SourceMod,M,Prop). '$predicate_property'(Pred,SourceMod,M,Prop).
'$predicate_property2'(M:Pred,Prop,_) :- !, '$predicate_property2'(M:Pred,Prop,_) :- !,
'$predicate_property2'(Pred,Prop,M). '$predicate_property2'(Pred,Prop,M).
'$predicate_property2'(Pred,Prop,Mod) :- '$predicate_property2'(Pred,Prop,Mod) :-
'$pred_exists'(Pred,Mod), !, '$pred_exists'(Pred,Mod), !,
'$predicate_property'(Pred,Mod,Mod,Prop). '$predicate_property'(Pred,Mod,Mod,Prop).
'$predicate_property2'(Pred,Prop,Mod) :- '$predicate_property2'(Pred,Prop,Mod) :-
'$imported_pred'(Pred, Mod, NPred, M), '$imported_pred'(Pred, Mod, NPred, M),
( (
Prop = imported_from(M) Prop = imported_from(M)
@ -1080,12 +1077,12 @@ predicate_property(Pred,Prop) :-
recorded('$import','$import'(SourceMod, Mod, Orig, Pred,_,_),_), recorded('$import','$import'(SourceMod, Mod, Orig, Pred,_,_),_),
'$pred_exists'(Orig, SourceMod). '$pred_exists'(Orig, SourceMod).
'$predicate_property'(P,M,_,built_in) :- '$predicate_property'(P,M,_,built_in) :-
'$system_predicate'(P,M). '$system_predicate'(P,M).
'$predicate_property'(P,M,_,source) :- '$predicate_property'(P,M,_,source) :-
'$flags'(P,M,F,F), '$flags'(P,M,F,F),
F /\ 0x00400000 =\= 0. F /\ 0x00400000 =\= 0.
'$predicate_property'(P,M,_,tabled) :- '$predicate_property'(P,M,_,tabled) :-
'$flags'(P,M,F,F), '$flags'(P,M,F,F),
F /\ 0x00000040 =\= 0. F /\ 0x00000040 =\= 0.
'$predicate_property'(P,M,_,dynamic) :- '$predicate_property'(P,M,_,dynamic) :-
@ -1140,7 +1137,7 @@ predicate_statistics(P,NCls,Sz,ISz) :-
'$predicate_statistics'(P,M,NCls,Sz,ISz) :- '$predicate_statistics'(P,M,NCls,Sz,ISz) :-
'$static_pred_statistics'(P,M,NCls,Sz,ISz). '$static_pred_statistics'(P,M,NCls,Sz,ISz).
/** @pred predicate_erased_statistics( _P_, _NCls_, _Sz_, _IndexSz_) /** @pred predicate_erased_statistics( _P_, _NCls_, _Sz_, _IndexSz_)
Given predicate _P_, _NCls_ is the number of erased clauses for Given predicate _P_, _NCls_ is the number of erased clauses for
@ -1153,7 +1150,7 @@ of space required to store indices to those clauses (in bytes).
*/ */
predicate_erased_statistics(P,NCls,Sz,ISz) :- predicate_erased_statistics(P,NCls,Sz,ISz) :-
var(P), !, var(P), !,
current_predicate(_,P), current_predicate(_,P),
predicate_erased_statistics(P,NCls,Sz,ISz). predicate_erased_statistics(P,NCls,Sz,ISz).
predicate_erased_statistics(M:P,NCls,Sz,ISz) :- !, predicate_erased_statistics(M:P,NCls,Sz,ISz) :- !,
@ -1164,26 +1161,26 @@ predicate_erased_statistics(P,NCls,Sz,ISz) :-
/** @pred current_predicate( _A_, _P_) /** @pred current_predicate( _A_, _P_)
Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_. Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_.
*/ */
current_predicate(A,T) :- current_predicate(A,T) :-
'$ground_module'(T, M, T0), '$ground_module'(T, M, T0),
format('`0 ~w~n', [M:T0]), (
( '$current_predicate'(A, M, T0, _),
'$current_predicate'(A, M, T0, Flags), %TFlags is Flags /\ 0x00004000,
%TFlags is Flags /\ 0x00004000, % format('1 ~w ~16r~n', [M:T0,Flags, TFlags]),
% format('1 ~w ~16r~n', [M:T0,Flags, TFlags]), \+ '$system_predicate'(T0, M)
Flags /\ 0x00004000 =:= 0x0 ;
; '$imported_pred'(T0, M, SourceT, SourceMod),
'$imported_predicate'(A, M, A/_Arity, T0, Flags), functor(T0, A, _),
% format('2 ~w ~16r~n', [M:T0,Flags]), % format('2 ~w ~16r~n', [M:T0,Flags]),
Flags /\ 0x00004000 =:= 0x0 \+ '$system_predicate'(SourceT, SourceMod)
). ).
/** @pred system_predicate( _A_, _P_)
Defines the relation: _P_ is a built-in predicate whose name /** @pred system_predicate( _A_, _P_)
is the atom _A_.
Defines the relation: _P_ is a built-in predicate whose name
is the atom _A_.
*/ */
system_predicate(A,T) :- system_predicate(A,T) :-
@ -1211,15 +1208,17 @@ system_predicate(P) :-
_Na_ is the name of the predicate, and _Ar_ its arity. _Na_ is the name of the predicate, and _Ar_ its arity.
*/ */
current_predicate(F0) :- current_predicate(F0) :-
'$ground_module'(F0, M, F), strip_module(F0, M, F),
( (
'$current_predicate'(N, M, S, _), var(F)
functor( S, N, Ar), ->
F = N/Ar current_predicate(M:A, S),
; functor( S, A, Ar)
'$imported_predicate'(_Name, M, F, S, _) ;
), F = A/Ar,
\+ system_predicate(_, S). current_predicate(M:A, S),
functor( S, A, Ar)
).
'$imported_predicate'(A, ImportingMod, A/Arity, G, Flags) :- '$imported_predicate'(A, ImportingMod, A/Arity, G, Flags) :-
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod), '$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
@ -1227,7 +1226,7 @@ current_predicate(F0) :-
'$pred_exists'(G, ExportingMod), '$pred_exists'(G, ExportingMod),
'$flags'(G0, ExportingMod, Flags, Flags). '$flags'(G0, ExportingMod, Flags, Flags).
/** @pred current_key(? _A_,? _K_) /** @pred current_key(? _A_,? _K_)
Defines the relation: _K_ is a currently defined database key whose Defines the relation: _K_ is a currently defined database key whose
@ -1248,7 +1247,7 @@ current_key(A,K) :-
). ).
/** @pred compile_predicates(: _ListOfNameArity_) /** @pred compile_predicates(: _ListOfNameArity_)
@ -1319,4 +1318,3 @@ clause_property(ClauseRef, predicate(PredicateIndicator)) :-
/** /**
@} @}
*/ */

29
pl/setof.yap
View File

@ -31,7 +31,7 @@ post-process the result of the query in several different ways:
*/ */
:- system_module( '$_setof', [(^)/2, :- system_module( '$_setof', [(^)/2,
@ -61,7 +61,7 @@ _^Goal :-
% existential quantifier on every variable. % existential quantifier on every variable.
/** @pred findall( _T_,+ _G_,- _L_) is iso /** @pred findall( _T_,+ _G_,- _L_) is iso
Unifies _L_ with a list that contains all the instantiations of the Unifies _L_ with a list that contains all the instantiations of the
@ -88,7 +88,7 @@ L = [2,1,2];
no no
~~~~~ ~~~~~
*/ */
findall(Template, Generator, Answers) :- findall(Template, Generator, Answers) :-
@ -105,7 +105,7 @@ findall(Template, Generator, Answers) :-
Similar to findall/3, but appends all answers to list _L0_. Similar to findall/3, but appends all answers to list _L0_.
*/ */
findall(Template, Generator, Answers, SoFar) :- findall(Template, Generator, Answers, SoFar) :-
'$findall'(Template, Generator, SoFar, Answers). '$findall'(Template, Generator, SoFar, Answers).
@ -142,9 +142,9 @@ findall(Template, Generator, Answers, SoFar) :-
'$collect_with_common_vars'([Key-_|Answers], VarList) :- '$collect_with_common_vars'([Key-_|Answers], VarList) :-
'$variables_in_term'(Key, _, VarList), '$variables_in_term'(Key, _, VarList),
'$collect_with_common_vars'(Answers, VarList). '$collect_with_common_vars'(Answers, VarList).
% This is the setof predicate % This is the setof predicate
/** @pred setof( _X_,+ _P_,- _B_) is iso /** @pred setof( _X_,+ _P_,- _B_) is iso
Similar to `bagof( _T_, _G_, _L_)` but sorts list Similar to `bagof( _T_, _G_, _L_)` but sorts list
@ -185,7 +185,7 @@ setof(Template, Generator, Set) :-
% and we need to find the solutions for each instantiation % and we need to find the solutions for each instantiation
% of these variables % of these variables
/** @pred bagof( _T_,+ _G_,- _L_) is iso /** @pred bagof( _T_,+ _G_,- _L_) is iso
For each set of possible instances of the free variables occurring in For each set of possible instances of the free variables occurring in
@ -206,7 +206,7 @@ L = [2];
no no
~~~~~ ~~~~~
*/ */
bagof(Template, Generator, Bag) :- bagof(Template, Generator, Bag) :-
( '$is_list_or_partial_list'(Bag) -> ( '$is_list_or_partial_list'(Bag) ->
@ -254,8 +254,8 @@ bagof(Template, Generator, Bag) :-
% as an alternative to setof you can use the predicate all(Term,Goal,Solutions) % as an alternative to setof you can use the predicate all(Term,Goal,Solutions)
% But this version of all does not allow for repeated answers % But this version of all does not allow for repeated answers
% if you want them use findall % if you want them use findall
/** @pred all( _T_,+ _G_,- _L_) /** @pred all( _T_,+ _G_,- _L_)
Similar to `findall( _T_, _G_, _L_)` but eliminate Similar to `findall( _T_, _G_, _L_)` but eliminate
@ -276,10 +276,10 @@ no
Note that all/3 will fail if no answers are found. Note that all/3 will fail if no answers are found.
*/ */
all(T, G same X,S) :- !, all(T same X,G,Sx), '$$produce'(Sx,S,X). all(T, G same X,S) :- !, all(T same X,G,Sx), '$$produce'(Sx,S,X).
all(T,G,S) :- all(T,G,S) :-
'$init_db_queue'(Ref), '$init_db_queue'(Ref),
( '$catch'(Error,'$clean_findall'(Ref,Error),_), ( '$catch'(Error,'$clean_findall'(Ref,Error),_),
'$execute'(G), '$execute'(G),
@ -290,7 +290,7 @@ all(T,G,S) :-
). ).
% $$set does its best to preserve space % $$set does its best to preserve space
'$$set'(S,R) :- '$$set'(S,R) :-
'$$build'(S0,_,R), '$$build'(S0,_,R),
S0 = [_|_], S0 = [_|_],
S = S0. S = S0.
@ -306,7 +306,7 @@ all(T,G,S) :-
'$$build'(Ns,Hash,R). '$$build'(Ns,Hash,R).
'$$new'(V,El) :- var(V), !, V = n(_,El,_). '$$new'(V,El) :- var(V), !, V = n(_,El,_).
'$$new'(n(R,El0,L),El) :- '$$new'(n(R,El0,L),El) :-
compare(C,El0,El), compare(C,El0,El),
'$$new'(C,R,L,El). '$$new'(C,R,L,El).
@ -327,4 +327,3 @@ all(T,G,S) :-
/** /**
@} @}
*/ */

29
pl/sort.yap
View File

@ -39,7 +39,7 @@
% length of a list. % length of a list.
/** @pred length(? _L_,? _S_) /** @pred length(? _L_,? _S_)
Unify the well-defined list _L_ with its length. The procedure can Unify the well-defined list _L_ with its length. The procedure can
@ -78,13 +78,13 @@ length(L, M) :-
( N =:= O -> NL = []; ( N =:= O -> NL = [];
M is N + 1, NL = [_|L], '$$_length2'(L, O, M) ). M is N + 1, NL = [_|L], '$$_length2'(L, O, M) ).
/** @pred sort(+ _L_,- _S_) is iso /** @pred sort(+ _L_,- _S_) is iso
Unifies _S_ with the list obtained by sorting _L_ and merging Unifies _S_ with the list obtained by sorting _L_ and merging
identical (in the sense of `==`) elements. identical (in the sense of `==`) elements.
*/ */
sort(L,O) :- sort(L,O) :-
'$skip_list'(NL,L,RL), '$skip_list'(NL,L,RL),
@ -113,7 +113,7 @@ sort(L,O) :-
msort(L,O) :- msort(L,O) :-
'$msort'(L,O). '$msort'(L,O).
/** @pred keysort(+ _L_, _S_) is iso /** @pred keysort(+ _L_, _S_) is iso
Assuming L is a list of the form ` _Key_- _Value_`, Assuming L is a list of the form ` _Key_- _Value_`,
@ -130,7 +130,7 @@ would return:
S = [1-b,1-a,1-b,2-c,3-a] S = [1-b,1-a,1-b,2-c,3-a]
~~~~~ ~~~~~
*/ */
keysort(L,O) :- keysort(L,O) :-
'$skip_list'(NL,L,RL), '$skip_list'(NL,L,RL),
@ -159,7 +159,7 @@ keysort(L,O) :-
% Delta with one of <, > or =. If built-in predicate compare/3 is % Delta with one of <, > or =. If built-in predicate compare/3 is
% used, the result is the same as sort/2. See also keysort/2. % used, the result is the same as sort/2. See also keysort/2.
/** @pred predsort(+ _Pred_, + _List_, - _Sorted_) /** @pred predsort(+ _Pred_, + _List_, - _Sorted_)
Sorts similar to sort/2, but determines the order of two terms by Sorts similar to sort/2, but determines the order of two terms by
@ -168,23 +168,23 @@ unify _Delta_ with one of `<`, `>` or `=`. If
built-in predicate compare/3 is used, the result is the same as built-in predicate compare/3 is used, the result is the same as
sort/2. sort/2.
*/ */
predsort(P, L, R) :- predsort(P, L, R) :-
length(L, N), length(L, N),
predsort(P, N, L, _, R1), !, predsort(P, N, L, _, R1), !,
R = R1. R = R1.
predsort(P, 2, [X1, X2|L], L, R) :- !, predsort(P, 2, [X1, X2|L], L, R) :- !,
call(P, Delta, X1, X2), call(P, Delta, X1, X2),
sort2(Delta, X1, X2, R). sort2(Delta, X1, X2, R).
predsort(_, 1, [X|L], L, [X]) :- !. predsort(_, 1, [X|L], L, [X]) :- !.
predsort(_, 0, L, L, []) :- !. predsort(_, 0, L, L, []) :- !.
predsort(P, N, L1, L3, R) :- predsort(P, N, L1, L3, R) :-
N1 is N // 2, N1 is N // 2,
plus(N1, N2, N), plus(N1, N2, N),
predsort(P, N1, L1, L2, R1), predsort(P, N1, L1, L2, R1),
predsort(P, N2, L2, L3, R2), predsort(P, N2, L2, L3, R2),
predmerge(P, R1, R2, R). predmerge(P, R1, R2, R).
sort2(<, X1, X2, [X1, X2]). sort2(<, X1, X2, [X1, X2]).
@ -205,4 +205,3 @@ predmerge(<, P, H1, H2, T1, T2, [H1|R]) :-
predmerge(P, T1, [H2|T2], R). predmerge(P, T1, [H2|T2], R).
%%! @} %%! @}

2
swi/console/edit.c
View File

@ -737,5 +737,3 @@ bind_actions()
} }
} }
} }