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

fix regression tests

This commit is contained in:
Vítor Santos Costa 2015-08-07 16:57:53 -05:00
parent dbdae6a930
commit b164f53191
102 changed files with 4996 additions and 1214 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
C/absmi.c
View File

@ -514,10 +514,12 @@ loop(Env) :-
#define IN_ABSMI_C 1
#define HAS_CACHE_REGS 1
#define IN_ABSMI_C 1
#define _INATIVE 1
#define HAS_CACHE_REGS 1
#include "absmi.h"
#include "heapgc.h"
@ -677,12 +679,12 @@ check_alarm_fail_int(int CONT USES_REGS)
}
static int
stack_overflow( PredEntry *pe, CELL *env, yamop *cp USES_REGS )
stack_overflow( PredEntry *pe, CELL *env, yamop *cp USES_REGS, arity_t nargs )
{
if ((Int)(Unsigned(YREG) - Unsigned(HR)) < StackGap( PASS_REGS1 ) ||
Yap_get_signal( YAP_STOVF_SIGNAL )) {
S = (CELL *)pe;
if (!Yap_locked_gc(pe->ArityOfPE, env, cp)) {
if (!Yap_locked_gc(nargs, env, cp)) {
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
return 0;
}
@ -996,7 +998,7 @@ interrupt_execute( USES_REGS1 )
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v;
}
if ((v = stack_overflow(P->y_u.pp.p, ENV, CP PASS_REGS )) >= 0) {
if ((v = stack_overflow(P->y_u.pp.p, ENV, CP, P->y_u.pp.p->ArityOfPE PASS_REGS )) >= 0) {
return v;
}
return interrupt_handler( P->y_u.pp.p PASS_REGS );
@ -1024,7 +1026,7 @@ interrupt_call( USES_REGS1 )
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v;
}
if ((v = stack_overflow( P->y_u.Osbpp.p, YENV, NEXTOP(P, Osbpp) PASS_REGS )) >= 0) {
if ((v = stack_overflow( P->y_u.Osbpp.p, YENV, NEXTOP(P, Osbpp), P->y_u.Osbpp.p->ArityOfPE PASS_REGS )) >= 0) {
return v;
}
return interrupt_handlerc( P->y_u.Osbpp.p PASS_REGS );
@ -1053,7 +1055,7 @@ interrupt_pexecute( PredEntry *pen USES_REGS )
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v;
}
if ((v = stack_overflow( pen, ENV, NEXTOP(P, Osbmp) PASS_REGS )) >= 0) {
if ((v = stack_overflow( pen, ENV, NEXTOP(P, Osbmp), pen->ArityOfPE PASS_REGS )) >= 0) {
return v;
}
CP = NEXTOP(P, Osbmp);
@ -1259,7 +1261,7 @@ interrupt_either( USES_REGS1 )
return v;
}
//P = NEXTOP(P, Osblp);
if ((v = stack_overflow(RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1,0)), YENV, NEXTOP(P,Osblp) PASS_REGS )) >= 0) {
if ((v = stack_overflow(RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1,0)), YENV, NEXTOP(P,Osblp), 0 PASS_REGS )) >= 0) {
//P = PREVOP(P, Osblp);
return v;
}
@ -1290,7 +1292,7 @@ interrupt_dexecute( USES_REGS1 )
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v;
}
if ((v = stack_overflow( P->y_u.pp.p, (CELL *)YENV[E_E], (yamop *)YENV[E_CP] PASS_REGS )) >= 0) {
if ((v = stack_overflow( P->y_u.pp.p, (CELL *)YENV[E_E], (yamop *)YENV[E_CP], P->y_u.pp.p->ArityOfPE PASS_REGS )) >= 0) {
return v;
}
/* first, deallocate */
@ -1636,7 +1638,7 @@ Yap_absmi(int inp)
/************************************************************************/
static void *OpAddress[] =
{
#define OPCODE(OP,TYPE) && OP
#define OPCODE(OP,TYPE) && _##OP
#include "YapOpcodes.h"
#undef OPCODE
};

7
C/absmi_insts.h
View File

@ -42,6 +42,13 @@ BOp(Ystop, l);
\************************************************************************/
#if YAP_JIT
static void *OpAddress[] =
{
#define OPCODE(OP,TYPE) && _##OP
#include "YapOpcodes.h"
#undef OPCODE
};
/* native_me */
BOp(jit_handler, J);
if (!PREG->y_u.J.jh->fi.bcst.c) PREG->y_u.J.jh->mf.isground = IsGround(PREG);

29
C/adtdefs.c
View File

@ -1227,7 +1227,7 @@ Yap_PutValue(Atom a, Term v)
}
bool
Yap_PutAtomTranslation(Atom a, Int i)
Yap_PutAtomTranslation(Atom a, arity_t arity, Int i)
{
AtomEntry *ae = RepAtom(a);
Prop p0;
@ -1243,6 +1243,7 @@ Yap_PutAtomTranslation(Atom a, Int i)
}
p->KindOfPE = TranslationProperty;
p->Translation = i;
p->arity = arity;
AddPropToAtom(RepAtom(a), (PropEntry *)p);
}
/* take care that the lock for the property will be inited even
@ -1251,6 +1252,32 @@ Yap_PutAtomTranslation(Atom a, Int i)
return true;
}
bool
Yap_PutFunctorTranslation(Atom a, arity_t arity, Int i)
{
AtomEntry *ae = RepAtom(a);
Prop p0;
TranslationEntry *p;
WRITE_LOCK(ae->ARWLock);
p0 = GetAPropHavingLock(ae, TranslationProperty);
if (p0 == NIL) {
p = (TranslationEntry *) Yap_AllocAtomSpace(sizeof(TranslationEntry));
if (p == NULL) {
WRITE_UNLOCK(ae->ARWLock);
return false;
}
p->KindOfPE = TranslationProperty;
p->Translation = i;
p->arity = arity;
AddPropToAtom(RepAtom(a), (PropEntry *)p);
}
/* take care that the lock for the property will be inited even
if someone else searches for the property */
WRITE_UNLOCK(ae->ARWLock);
return true;
}
bool
Yap_PutAtomMutex(Atom a, void * i)
{

29
C/agc.c
View File

@ -34,6 +34,7 @@ static char SccsId[] = "@(#)agc.c 1.3 3/15/90";
static void RestoreEntries(PropEntry *, int USES_REGS);
static void CleanCode(PredEntry * USES_REGS);
static void RestoreDBTerm(DBTerm *dbr, int attachments USES_REGS);
#define AtomMarkedBit 1
@ -190,6 +191,32 @@ AtomAdjust(Atom a)
#define RestoreSWIHash()
static void
AdjustTermFlag(flag_term *tarr, UInt i)
{
CACHE_REGS
if (IsVarTerm(tarr[i].at)) {
RestoreDBTerm( tarr[i].DBT, 0 PASS_REGS );
} else if (IsAtomTerm( tarr[i].at ) )
tarr[i].at = AtomTermAdjust(tarr[i].at);
}
static void RestoreFlags( UInt NFlags )
{
CACHE_REGS
size_t i;
flag_term *tarr = GLOBAL_Flags;
if (worker_id == 0)
for (i=0; i<GLOBAL_flagCount; i++) {
AdjustTermFlag( tarr, i);
}
tarr = LOCAL_Flags;
for (i=0; i<LOCAL_flagCount; i++) {
AdjustTermFlag( tarr, i);
}
}
#include "rheap.h"
static void
@ -228,8 +255,6 @@ RestoreAtomList(Atom atm USES_REGS)
} while (!EndOfPAEntr(at));
}
static void
mark_trail(USES_REGS1)
{

3
C/amasm.c
View File

@ -3628,7 +3628,8 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case mark_live_regs_op:
if (!ystop_found) {
code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip);
ystop_found = TRUE;
printf("-> %p\n", code_p->y_u.l.l);
ystop_found = TRUE;
}
code_p = a_bregs(code_p, pass_no, cip->cpc);
break;

48
C/args.c
View File

@ -31,19 +31,16 @@ xarg *
Yap_ArgListToVector (Term listl, const param_t *def, int n)
{
CACHE_REGS
Term *tailp;
if (!IsPairTerm(listl) && listl != TermNil) {
listl = MkPairTerm( listl, TermNil );
}
Int length = Yap_SkipList( &listl, &tailp );
if (length < 0 )
return NULL;
xarg *a = calloc( n , sizeof(xarg) );
while (IsPairTerm(listl)) {
Term hd = HeadOfTerm( listl );
listl = TailOfTerm( listl );
if (IsVarTerm(hd)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = hd;
free( a );
return NULL;
}
@ -58,13 +55,15 @@ Yap_ArgListToVector (Term listl, const param_t *def, int n)
} else if (IsApplTerm( hd )) {
Functor f = FunctorOfTerm( hd );
if (IsExtensionFunctor(f)) {
LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
free( a );
return NULL;
LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
LOCAL_Error_Term = hd;
free( a );
return NULL;
}
arity_t arity = ArityOfFunctor( f );
if (arity != 1) {
LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE;
LOCAL_Error_Term = hd;
free( a );
return NULL;
}
@ -78,7 +77,7 @@ Yap_ArgListToVector (Term listl, const param_t *def, int n)
}
}
return a;
}
}
static xarg *
matchKey2(Atom key, xarg *e0, int n, const param2_t *def)
@ -95,17 +94,16 @@ matchKey2(Atom key, xarg *e0, int n, const param2_t *def)
}
/// Yap_ArgList2ToVector is much the same as before,
/// but assumes parameters also have something called a
/// scope
xarg *
Yap_ArgList2ToVector (Term listl, const param2_t *def, int n)
{
CACHE_REGS
Term *tailp;
if (!IsPairTerm(listl) && listl != TermNil) {
listl = MkPairTerm( listl, TermNil );
}
Int length = Yap_SkipList( &listl, &tailp );
if (length < 0 )
return NULL;
xarg *a = calloc( n , sizeof(xarg) );
while (IsPairTerm(listl)) {
Term hd = HeadOfTerm( listl );
@ -124,25 +122,41 @@ Yap_ArgList2ToVector (Term listl, const param2_t *def, int n)
} else if (IsApplTerm( hd )) {
Functor f = FunctorOfTerm( hd );
if (IsExtensionFunctor(f)) {
LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
free( a );
return NULL;
LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
LOCAL_Error_Term = hd;
free( a );
return NULL;
}
arity_t arity = ArityOfFunctor( f );
if (arity != 1) {
LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE;
LOCAL_Error_Term = hd;
free( a );
return NULL;
}
xarg *na = matchKey2( NameOfFunctor( f ), a, n, def);
na->used = 1;
na->tvalue = ArgOfTerm(1, hd);
if (na) {
na->used = 1;
na->tvalue = ArgOfTerm(1, hd);
}
} else {
LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
LOCAL_Error_Term = hd;
free( a );
return NULL;
}
listl = TailOfTerm(listl);
}
if (IsVarTerm(listl)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
free( a );
return NULL;
}
if (TermNil != listl) {
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
LOCAL_Error_Term = listl;
free( a );
return NULL;
}
return a;
}

2
C/arith1.c
View File

@ -1003,7 +1003,7 @@ p_unary_is( USES_REGS1 )
Term out;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 1)))) {
Yap_EvalError(TYPE_ERROR_EVALUABLE, takeName(t),
Yap_EvalError(TYPE_ERROR_EVALUABLE, takeIndicator(t),
"functor %s/1 for arithmetic expression",
RepAtom(name)->StrOfAE);
return FALSE;

2
C/arith2.c
View File

@ -1199,7 +1199,7 @@ p_binary_is( USES_REGS1 )
Term out;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
Yap_EvalError(TYPE_ERROR_EVALUABLE, takeName(t),
Yap_EvalError(TYPE_ERROR_EVALUABLE, takeIndicator(t),
"functor %s/2 for arithmetic expression",
RepAtom(name)->StrOfAE);
P = FAILCODE;

7
C/arrays.c
View File

@ -316,7 +316,7 @@ GetTermFromArray(DBTerm *ref USES_REGS)
}
} else {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 3, ENV, gc_P(P,CP))) {
if (!Yap_gcl(LOCAL_Error_Size, 3, ENV, Yap_gcP())) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return TermNil;
}
@ -997,7 +997,7 @@ p_create_array( USES_REGS1 )
farray = Yap_MkFunctor(AtomArray, size);
if (HR+1+size > ASP-1024) {
if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, Yap_gcP())) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage);
return(FALSE);
} else {
@ -1849,7 +1849,8 @@ p_assign_static( USES_REGS1 )
Yap_Error(TYPE_ERROR_INTEGER,t3,"assign_static");
return (FALSE);
}
ptr->ValueOfVE.ints[indx]= i;
ptr->
ValueOfVE.ints[indx]= i;
}
break;

2
C/atomic.c
View File

@ -643,6 +643,8 @@ atom_concat3( USES_REGS1 )
} else {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1;
Yap_Error( INSTANTIATION_ERROR, IsVarTerm(t1) ? t1 : t2, "got atom_concat(X,atom,Z) or atom_concat(,atom,Y,Z)" );
return false;
}
if (at) {
if (Yap_unify(ot, MkAtomTerm(at))) cut_succeed();

60
C/c_interface.c
View File

@ -1811,7 +1811,7 @@ YAP_BufferToString(const char *s)
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
@ -1831,7 +1831,7 @@ YAP_NBufferToString(const char *s, size_t len)
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
@ -1853,7 +1853,7 @@ YAP_WideBufferToString(const wchar_t *s)
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.val.w0= s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
@ -1873,7 +1873,7 @@ YAP_NWideBufferToString(const wchar_t *s, size_t len)
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.val.w0 = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
@ -1941,7 +1941,7 @@ YAP_BufferToAtomList(const char *s)
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOMS;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
@ -1961,7 +1961,7 @@ YAP_NBufferToAtomList(const char *s, size_t len)
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
@ -1983,7 +1983,7 @@ YAP_WideBufferToAtomList(const wchar_t *s)
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.val.w0 = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_ATOMS;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
@ -2003,7 +2003,7 @@ YAP_NWideBufferToAtomList(const wchar_t *s, size_t len)
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.val.w0 = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
@ -2025,7 +2025,7 @@ YAP_NWideBufferToAtomDiffList(const wchar_t *s, Term t0, size_t len)
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.val.w0 = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
out.sz = len;
@ -2048,7 +2048,7 @@ YAP_BufferToDiffList(const char *s, Term t0)
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES|YAP_STRING_DIFF;
out.dif = t0;
@ -2069,7 +2069,7 @@ YAP_NBufferToDiffList(const char *s, Term t0, size_t len)
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
out.sz = len;
@ -2092,7 +2092,7 @@ YAP_WideBufferToDiffList(const wchar_t *s, Term t0)
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.val.w0 = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES|YAP_STRING_DIFF;
out.dif = t0;
@ -2113,7 +2113,7 @@ YAP_NWideBufferToDiffList(const wchar_t *s, Term t0, size_t len)
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.val.w0 = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
out.sz = len;
@ -4036,10 +4036,10 @@ YAP_RequiresExtraStack(size_t sz) {
X_API Int
YAP_AtomToInt(Atom At)
{
TranslationEntry *te = Yap_GetTranslationProp(At);
TranslationEntry *te = Yap_GetTranslationProp(At,0);
if (te != NIL) return te->Translation;
SWI_Atoms[AtomTranslations] = At;
Yap_PutAtomTranslation(At, AtomTranslations);
Yap_PutAtomTranslation(At,0, AtomTranslations);
AtomTranslations++;
if (AtomTranslations == MaxAtomTranslations) {
Atom * nt = (Atom *)malloc(sizeof(Atom)*2*MaxAtomTranslations), *ot = SWI_Atoms;
@ -4061,6 +4061,36 @@ YAP_IntToAtom(Int i)
return SWI_Atoms[i];
}
X_API Int
YAP_FunctorToInt(Functor f)
{
Atom At = NameOfFunctor( f );
arity_t arity = ArityOfFunctor( f );
TranslationEntry *te = Yap_GetTranslationProp(At, arity);
if (te != NIL) return te->Translation;
SWI_Functors[FunctorTranslations] = f;
Yap_PutAtomTranslation(At, arity, FunctorTranslations);
FunctorTranslations++;
if (FunctorTranslations == MaxFunctorTranslations) {
Functor * nt = (Functor *)malloc(sizeof(Functor)*2*MaxFunctorTranslations), *ot = SWI_Functors;
if (nt == NULL) {
Yap_Error(SYSTEM_ERROR,MkAtomTerm(At),"No more room for translations");
return -1;
}
memcpy(nt, ot, sizeof(Functor)*MaxFunctorTranslations);
SWI_Functors = nt;
free( ot );
MaxFunctorTranslations *= 2;
}
return FunctorTranslations-1;
}
X_API Functor
YAP_IntToFunctor(Int i)
{
return SWI_Functors[i];
}
#endif // C_INTERFACE_C
/**

4
C/cdmgr.c
View File

@ -471,6 +471,7 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#if HAVE_STRING_H
#include <string.h>
#endif
#include <heapgc.h>
static void retract_all(PredEntry *, int);
@ -4868,9 +4869,6 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
th = Terms[0];
tb = Terms[1];
tr = Terms[2];
/* don't do this!! I might have stored a choice-point and changed ASP
Yap_RecoverSlots(3);
*/
if (cl == NULL) {
UNLOCK(pe->PELock);
return FALSE;

1
C/cmppreds.c
View File

@ -1,3 +1,4 @@
/*************************************************************************
* *
* YAP Prolog *

14
C/errors.c
View File

@ -999,6 +999,20 @@ Yap_Error(yap_error_number type, Term where, const char *format,...)
serious = TRUE;
}
break;
case DOMAIN_ERROR_PROLOG_FLAG:
{
int i;
Term ti[2];
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(Yap_LookupAtom("prolog_flag"));
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
psize -= i;
fun = FunctorError;
serious = TRUE;
}
break;
case DOMAIN_ERROR_RADIX:
{
int i;

6
C/eval.c
View File

@ -106,7 +106,7 @@ Eval(Term t USES_REGS)
Atom name = AtomOfTerm(t);
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) {
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
return Yap_ArithError(TYPE_ERROR_EVALUABLE, takeIndicator(t),
"atom %s in arithmetic expression",
RepAtom(name)->StrOfAE);
}
@ -129,7 +129,7 @@ Eval(Term t USES_REGS)
Term t1, t2;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) {
return Yap_ArithError(TYPE_ERROR_EVALUABLE, takeName(t),
return Yap_ArithError(TYPE_ERROR_EVALUABLE, takeIndicator(t),
"functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,n);
}
@ -225,7 +225,7 @@ p_is( USES_REGS1 )
return FALSE;
}
} else {
Yap_EvalError(err, ARG2, "X is Exp");
Yap_EvalError(err, takeIndicator( ARG2 ), "X is Exp");
return FALSE;
}
} while (TRUE);

2
C/exec.c
View File

@ -1687,7 +1687,7 @@ Yap_Reset(yap_reset_t mode)
return res;
}
static bool
bool
is_cleanup_cp(choiceptr cp_b)
{
PredEntry *pe;

4
C/exo.c
View File

@ -720,11 +720,11 @@ store_exo(yamop *pc, UInt arity, Term t0)
for (i = 0; i< arity; i++) {
DerefAndCheck(t, tp[0]);
*cpc = t;
Yap_DebugPlWrite(t); fprintf(stderr,"\n");
// Yap_DebugPlWrite(t); fprintf(stderr,"\n");
tp++;
cpc++;
}
fprintf(stderr,"\n");
//fprintf(stderr,"\n");
return TRUE;
}

62
C/flags.c
View File

@ -45,6 +45,7 @@ static bool synerr(Term inp);
static bool indexer(Term inp);
static bool getenc(Term inp);
static bool typein( Term inp );
static bool dqf( Term t2 );
static void newFlag( Term fl, Term val );
static Int current_prolog_flag(USES_REGS1);
@ -86,6 +87,27 @@ static bool indexer( Term inp ) {
return false;
}
static bool dqf( Term t2 ) {
CACHE_REGS
ModEntry *new = Yap_GetModuleEntry(CurrentModule);
new->flags &= ~(DBLQ_CHARS|DBLQ_CODES|DBLQ_ATOM|DBLQ_STRING);
if (t2 == TermString) {
new->flags |= DBLQ_STRING;
return true;
} else if (t2 == TermAtom) {
new->flags |= DBLQ_ATOM;
return true;
} else if (t2 == TermCodes) {
new->flags |= DBLQ_CODES;
return true;
} else if (t2 == TermChars) {
new->flags |= DBLQ_CHARS;
return true;
}
Yap_Error(TYPE_ERROR_ATOM, t2, "set_prolog_flag(double_quotes, {string,atom,codes,chars}");
return false;
}
static bool isaccess( Term inp ) {
if (inp == TermReadWrite ||
@ -418,7 +440,7 @@ static bool gc_margin( Term t ) {
}
static Term mk_argc_list(USES_REGS1) {
int i = 0;
int i = 1;
Term t = TermNil;
while (i < GLOBAL_argc) {
char *arg = GLOBAL_argv[i];
@ -470,14 +492,24 @@ static Term mk_os_argc_list(USES_REGS1) {
static bool argv(Term inp) {
CACHE_REGS
Term t = mk_argc_list(PASS_REGS1);
return Yap_unify(t, inp);
Term t = mk_argc_list(PASS_REGS1);
if (IsAtomOrIntTerm(t))
GLOBAL_Flags[ARGV_FLAG].at = t;
else {
GLOBAL_Flags[ARGV_FLAG].DBT = Yap_StoreTermInDB(t, 2);
}
return false;
}
static bool os_argv(Term inp) {
CACHE_REGS
Term t = mk_os_argc_list(PASS_REGS1);
return Yap_unify(t, inp);
Term t = mk_os_argc_list(PASS_REGS1);
if (IsAtomOrIntTerm(t))
GLOBAL_Flags[OS_ARGV_FLAG].at = t;
else {
GLOBAL_Flags[OS_ARGV_FLAG].DBT = Yap_StoreTermInDB(t, 2);
}
return false;
}
@ -559,7 +591,7 @@ static bool setYapFlagInModule( Term tflag, Term t2, Term mod )
return false;
fv = GetFlagProp( AtomOfTerm( tflag ) );
if (!fv && !fv->global) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "trying to set unknown flag");
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag, "trying to set unknown module flag");
return FALSE;
}
if (mod == USER_MODULE && !setYapFlag( tflag, t2) )
@ -792,12 +824,11 @@ static Int prolog_flag(USES_REGS1) {
return cont_prolog_flag( PASS_REGS1 );
}
do_cut( 0 );
{
if (IsVarTerm( Deref(ARG2) ) ) {
Term flag = getYapFlag( Deref(ARG1) );
if (flag == 0)
return false;
if (Yap_unify( flag, ARG2 ) )
return false;
return Yap_unify( flag, ARG2 ) ;
}
return setYapFlag( Deref(ARG1), Deref(ARG3) );
}
@ -883,7 +914,7 @@ bool setYapFlag( Term tflag, Term t2 )
} else if (fl == TermWarning) {
Yap_Warning("Flag %s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE);
} else {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, fl, "trying to set unknown flag ~s", AtomName(AtomOfTerm(fl)));
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, fl, "trying to set unknown flag ~s", AtomName(AtomOfTerm(fl)));
}
return FALSE;
}
@ -935,7 +966,7 @@ Term getYapFlag( Term tflag )
} else if (fl == TermWarning) {
Yap_Warning("Flag ~s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE);
} else {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, fl, "trying to read unknown flag %s",
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, fl, "trying to read unknown flag %s",
RepAtom(AtomOfTerm(fl))->StrOfAE);
}
return FALSE;
@ -1101,7 +1132,12 @@ setInitialValue( bool bootstrap, flag_func f, const char *s,flag_term *tarr )
if (!t0)
return false;
if (IsAtomTerm(t0) || IsIntTerm(t0)) {
tarr->at = t0;
// do yourself flags
if (t0 == MkAtomTerm(AtomQuery)) {
f(TermNil);
} else {
tarr->at = t0;
}
} else {
tarr->DBT = Yap_StoreTermInDB(t0, 2);
}
@ -1202,7 +1238,7 @@ do_prolog_flag_property (Term tflag, Term opts USES_REGS)
break;
case PROLOG_FLAG_PROPERTY_END:
/* break; */
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, opts, "Flag not supported by YAP");
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, opts, "Flag not supported by YAP");
}
}
}

44
C/heapgc.c
View File

@ -104,6 +104,13 @@ typedef struct RB_red_blk_node {
/* support for hybrid garbage collection scheme */
yamop * Yap_gcP(void) {
CACHE_REGS
return gc_P(P,CP);
}
/* support for hybrid garbage collection scheme */
static void
gc_growtrail(int committed, tr_fr_ptr begsTR, cont *old_cont_top0 USES_REGS)
{
@ -382,32 +389,36 @@ GC_NEW_MAHASH(gc_ma_hash_entry *top USES_REGS) {
/* find all accessible objects on the heap and squeeze out all the rest */
static void
check_pr_trail(tr_fr_ptr trp USES_REGS)
static tr_fr_ptr
check_pr_trail( tr_fr_ptr rc USES_REGS)
{
if ((tr_fr_ptr)LOCAL_TrailTop-TR < 1024) {
size_t n = TR- rc;
if (!Yap_locked_growtrail(0, TRUE) || TRUE) {
/* could not find more trail */
save_machine_regs();
siglongjmp(LOCAL_gc_restore, 2);
}
rc = TR-n;
}
return rc;
}
/* push the active registers onto the trail for inclusion during gc */
static void
static tr_fr_ptr
push_registers(Int num_regs, yamop *nextop USES_REGS)
{
int i;
StaticArrayEntry *sal = LOCAL_StaticArrays;
tr_fr_ptr ret = TR;
/* push array entries first */
ArrayEntry *al = LOCAL_DynamicArrays;
GlobalEntry *gl = LOCAL_GlobalVariables;
TrailTerm(TR++) = LOCAL_GlobalArena;
while (al) {
check_pr_trail(TR PASS_REGS);
ret = check_pr_trail(ret PASS_REGS);
TrailTerm(TR++) = al->ValueOfVE;
al = al->NextAE;
}
@ -417,7 +428,7 @@ push_registers(Int num_regs, yamop *nextop USES_REGS)
!IsAtomTerm(t) &&
!IsIntTerm(t)
) {
check_pr_trail(TR PASS_REGS);
ret = check_pr_trail(ret PASS_REGS);
//fprintf(stderr,"in=%s %p\n", gl->AtomOfGE->StrOfAE, gl->global);
TrailTerm(TR++) = t;
}
@ -429,14 +440,14 @@ push_registers(Int num_regs, yamop *nextop USES_REGS)
for (i=0; i < arity; i++) {
Term tlive = sal->ValueOfVE.lterms[i].tlive;
if (!IsVarTerm(tlive) || !IsUnboundVar(&sal->ValueOfVE.lterms[i].tlive)) {
check_pr_trail(TR PASS_REGS);
ret = check_pr_trail(ret PASS_REGS);
TrailTerm(TR++) = tlive;
}
}
}
sal = sal->NextAE;
}
check_pr_trail(TR PASS_REGS);
ret = check_pr_trail(ret PASS_REGS);
TrailTerm(TR) = LOCAL_GcGeneration;
TR++;
TrailTerm(TR) = LOCAL_GcPhase;
@ -451,12 +462,12 @@ push_registers(Int num_regs, yamop *nextop USES_REGS)
*topslot = LOCAL_SlotBase + LOCAL_CurSlot;
while (curslot < topslot) {
// printf("%p <- %p\n", TR, topslot);
check_pr_trail(TR PASS_REGS);
ret = check_pr_trail(ret PASS_REGS);
TrailTerm(TR++) = *curslot++;
}
}
for (i = 1; i <= num_regs; i++) {
check_pr_trail(TR PASS_REGS);
ret = check_pr_trail(ret PASS_REGS);
TrailTerm(TR++) = (CELL) XREGS[i];
}
/* push any live registers we might have hanging around */
@ -474,13 +485,14 @@ push_registers(Int num_regs, yamop *nextop USES_REGS)
lab++;
}
if (curr & 1) {
check_pr_trail(TR PASS_REGS);
ret = check_pr_trail( ret PASS_REGS);
TrailTerm(TR++) = XREGS[i];
}
curr >>= 1;
}
}
}
return ret;
}
@ -1290,7 +1302,8 @@ mark_variable(CELL_PTR current USES_REGS)
goto begin;
#ifdef DEBUG
} else if (next < (CELL *)LOCAL_GlobalBase || next > (CELL *)LOCAL_TrailTop) {
fprintf(stderr, "OOPS in GC: marking, current=%p, *current=" UInt_FORMAT " next=%p\n", current, ccur, next);
fprintf(stderr,
"OOPS in GC: marking, TR=%p, current=%p, *current=" UInt_FORMAT " next=%p\n", TR, current, ccur, next);
#endif
} else {
#ifdef COROUTING
@ -1559,14 +1572,16 @@ Yap_mark_external_reference(CELL *ptr) {
static void
mark_regs(tr_fr_ptr old_TR USES_REGS)
{
tr_fr_ptr trail_ptr;
tr_fr_ptr trail_ptr, tr = TR;
/* first, whatever we dumped on the trail. Easier just to do
the registers separately? */
for (trail_ptr = old_TR; trail_ptr < TR; trail_ptr++) {
for (trail_ptr = old_TR; trail_ptr < tr; trail_ptr++) {
mark_external_reference(&TrailTerm(trail_ptr) PASS_REGS);
}
printf(" %p TR=%p\n",trail_ptr,TR);
}
/* mark all heap objects accessible from a chain of environments */
@ -4048,8 +4063,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS)
LOCAL_HGEN = H0;
}
/* fprintf(stderr,"LOCAL_HGEN is %ld, %p, %p/%p\n", IntegerOfTerm(Yap_ReadTimedVar(LOCAL_GcGeneration)), LOCAL_HGEN, H,H0);*/
LOCAL_OldTR = (tr_fr_ptr)(old_TR = TR);
push_registers(predarity, nextop PASS_REGS);
LOCAL_OldTR = old_TR = push_registers(predarity, nextop PASS_REGS);
/* make sure we clean bits after a reset */
marking_phase(old_TR, current_env, nextop PASS_REGS);
if (LOCAL_total_oldies > ((LOCAL_HGEN-H0)*8)/10) {

15
C/init.c
View File

@ -1071,19 +1071,10 @@ InitLogDBErasedMarker(void)
static void
InitSWIAtoms(void)
{
/* extern atom_t ATOM_;FUNV
int j=0;
MaxAtomTranslations = 2*N_SWI_ATOMS ;
MaxAtomTranslations = N_SWI_ATOMS ;
MaxFunctorTranslations = N_SWI_FUNCTORS ;
SWI_Atoms = (Atom *)malloc(sizeof(Atom)*MaxAtomTranslations);
SWI_Functors = (Functor *)malloc(sizeof(Functor)*2*N_SWI_ATOMS);
#include "i
atoms.h"
Yap_InitSWIHash();
ATOM_ = PL_new_atom("");
*/
}
static void
@ -1337,7 +1328,7 @@ InitCodes(void)
modp->PredFlags |= MetaPredFlag;
}
#ifdef YAPOR
v Yap_heap_regs->getwork_code->y_u.Otapl.p = RepPredProp(PredPropByAtom(AtomGetwork, PROLOG_MODULE));
Yap_heap_regs->getwork_code->y_u.Otapl.p = RepPredProp(PredPropByAtom(AtomGetwork, PROLOG_MODULE));
Yap_heap_regs->getwork_seq_code->y_u.Otapl.p = RepPredProp(PredPropByAtom(AtomGetworkSeq, PROLOG_MODULE));
#endif /* YAPOR */

11
C/other.c
View File

@ -60,11 +60,16 @@ Yap_MkNewPairTerm(void)
return (AbsPair(p));
}
/** compound term constructor, builds a compound term with functor f and n
* args.
*
*
* Room for the new term is allocated from the heap: the functor and arguments are copied there.
*
*/
Term
Yap_MkApplTerm(Functor f, arity_t n, const Term *a)
/* build compound term with functor f and n
* args a */
{
{
CACHE_REGS
CELL *t = HR;

6
C/parser.c
View File

@ -505,7 +505,7 @@ inline static void GNextToken(USES_REGS1) {
inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) {
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
LOCAL_tokptr->TokInfo != (Term)c) {
syntax_msg("expected to find \'%c\', found %s", tokRep(LOCAL_tokptr));
syntax_msg("expected to find \'%c\', found %s", c, tokRep(LOCAL_tokptr));
FAIL;
}
NextToken;
@ -844,6 +844,7 @@ case Var_tok:
FAIL;
case Ponctuation_tok:
switch ((int)LOCAL_tokptr->TokInfo) {
case '(':
case 'l': /* non solo ( */
@ -1097,6 +1098,7 @@ Term Yap_Parse(UInt prio) {
Volatile Term t;
JMPBUFF FailBuff;
yhandle_t sls = Yap_CurrentSlot(PASS_REGS1);
if (!sigsetjmp(FailBuff.JmpBuff, 0)) {
t = ParseTerm(prio, &FailBuff PASS_REGS);
if (LOCAL_Error_TYPE == SYNTAX_ERROR) {
@ -1105,8 +1107,10 @@ Term Yap_Parse(UInt prio) {
}
// if (LOCAL_tokptr->Tok != Ord(eot_tok))
// return (0L);
Yap_CloseSlots( sls );
return (t);
} else
Yap_CloseSlots( sls );
return (0);
}

4
C/qlyr.c
View File

@ -638,6 +638,10 @@ XAdjust__ (wamreg reg USES_REGS)
#define Yap_op_from_opcode(OP) OpcodeID(OP)
static void RestoreFlags( UInt NFlags )
{
}
#include "rheap.h"
static void

4
C/qlyw.c
View File

@ -507,6 +507,10 @@ DBRefAdjust__ (DBRef dbt USES_REGS)
#define RestoreSWIHash()
static void RestoreFlags( UInt NFlags )
{
}
#include "rheap.h"
static void

4
C/save.c
View File

@ -1207,6 +1207,10 @@ RestoreSWIHash(void)
}
static void RestoreFlags( UInt NFlags )
{
}
#include "rheap.h"
/* restore the atom entries which are invisible for the user */

2
C/stdpreds.c
View File

@ -319,7 +319,7 @@ Int p_halt(USES_REGS1);
#else
static Int p_halt(USES_REGS1);
#endif
static Int init_current_predicate(USES_REGS1);
static Int current_predicate(USES_REGS1);
static Int cont_current_predicate(USES_REGS1);
static OpEntry *NextOp(OpEntry *CACHE_TYPE);
static Int init_current_op(USES_REGS1);

588
C/text.c
View File

@ -185,7 +185,7 @@ get_wide_from_list( Term t, seq_tv_t *inp, wchar_t *s, int atoms USES_REGS)
static Int
SkipListCodes(Term *l, Term **tailp, Int *atoms, int *wide)
SkipListCodes(Term *l, Term **tailp, Int *atoms, bool *wide)
{
Int length = 0;
Term *s; /* slow */
@ -193,6 +193,7 @@ SkipListCodes(Term *l, Term **tailp, Int *atoms, int *wide)
do_derefa(v,l,derefa_unk,derefa_nonvar);
s = l;
*wide = false;
if (*l == TermNil) {
@ -248,13 +249,13 @@ SkipListCodes(Term *l, Term **tailp, Int *atoms, int *wide)
static void *
Yap_ListOfAtomsToBuffer(void *buf, Term t, seq_tv_t *inp, int *widep, size_t *lenp USES_REGS)
Yap_ListOfAtomsToBuffer(void *buf, Term t, seq_tv_t *inp, bool *widep, size_t *lenp USES_REGS)
{
Int atoms = 0;
CELL *r = NULL;
Int n;
*widep = FALSE;
*widep = false;
n = SkipListCodes(&t, &r, &atoms, widep);
if (n < 0) {
LOCAL_Error_TYPE = -n;
@ -294,13 +295,13 @@ Yap_ListOfAtomsToBuffer(void *buf, Term t, seq_tv_t *inp, int *widep, size_t *le
}
static void *
Yap_ListOfCodesToBuffer(void *buf, Term t, seq_tv_t *inp, int *widep, size_t *lenp USES_REGS)
Yap_ListOfCodesToBuffer(void *buf, Term t, seq_tv_t *inp, bool *widep, size_t *lenp USES_REGS)
{
Int atoms = 0;
CELL *r = NULL;
Int n;
*widep = FALSE;
*widep = false;
n = SkipListCodes(&t, &r, &atoms, widep);
if (n < 0) {
LOCAL_Error_TYPE = -n;
@ -335,46 +336,6 @@ Yap_ListOfCodesToBuffer(void *buf, Term t, seq_tv_t *inp, int *widep, size_t *le
}
}
static void *
Yap_ListToBuffer(void *buf, Term t, seq_tv_t *inp, int *widep, size_t *lenp USES_REGS)
{
Int atoms = 0;
CELL *r = NULL;
Int n;
*widep = FALSE;
n = SkipListCodes(&t, &r, &atoms, widep);
if (n < 0) {
LOCAL_Error_TYPE = -n;
LOCAL_Error_Term = *r;
return NULL;
}
if (*r != TermNil) {
if (IsVarTerm(*r))
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
else
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
LOCAL_Error_Term = *r;
return NULL;
}
*lenp = n;
if (*widep) {
wchar_t *s;
if (buf) s = buf;
else s = ((AtomEntry *)Yap_PreAllocCodeSpace())->WStrOfAE;
AUX_ERROR( t, 2*(n+1), s, wchar_t);
s = get_wide_from_list( t, inp, s, atoms PASS_REGS);
return s;
} else {
char *s;
if (buf) s = buf;
else s = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE;
AUX_ERROR( t, 2*(n+1), s, char);
s = get_string_from_list( t, inp, s, atoms PASS_REGS);
return s;
}
}
static yap_error_number
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)) ==
@ -400,138 +361,88 @@ Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *l
{
char *s;
wchar_t *ws;
bool wide;
/* we know what the term is */
switch (inp->type & YAP_TYPE_MASK) {
case YAP_STRING_STRING:
{ const char *s;
if (IsVarTerm(inp->val.t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = inp->val.t;
return 0L;
}
if (!IsStringTerm(inp->val.t)) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING;
LOCAL_Error_Term = inp->val.t;
return 0L;
}
s = StringOfTerm( inp->val.t );
if ( s == NULL ) {
return 0L;
}
// this is a term, extract the UTF8 representation
*enc = ENC_ISO_UTF8;
*minimal = FALSE;
*lengp = strlen(s);
return (void *)s;
if (inp->type & YAP_STRING_STRING && !IsVarTerm(inp->val.t) && IsStringTerm(inp->val.t)) { const char *s;
s = StringOfTerm( inp->val.t );
if ( s == NULL ) {
return 0L;
}
case YAP_STRING_CODES:
// this is a term, extract the UTF8 representation
*enc = ENC_ISO_UTF8;
*minimal = FALSE;
if (lengp)
*lengp = strlen(s);
return (void *)s;
}
if (inp->type & YAP_STRING_ATOM && !IsVarTerm(inp->val.t) && IsAtomTerm(inp->val.t)) {
// this is a term, extract to a buffer, and representation is wide
*minimal = TRUE;
Atom at = AtomOfTerm(inp->val.t);
if (IsWideAtom(at)) {
ws = at->WStrOfAE;
*lengp = wcslen(ws);
*enc = ENC_WCHAR;
return ws;
} else {
s = at->StrOfAE;
*lengp = strlen(s);
*enc = ENC_ISO_LATIN1;
return s;
}
}
if (inp->type & YAP_STRING_CODES && !IsVarTerm(inp->val.t) && (s = Yap_ListOfCodesToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS))) {
// this is a term, extract to a sfer, and representation is wide
*minimal = TRUE;
{
int wide = FALSE;
s = Yap_ListOfCodesToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS);
if (!s) {
return NULL;
}
*enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 );
}
int wide = FALSE;
*enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 );
return s;
case YAP_STRING_ATOMS:
}
if (inp->type & YAP_STRING_ATOMS && !IsVarTerm(inp->val.t) && (s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS))) {
// this is a term, extract to a buffer, and representation is wide
*minimal = TRUE;
{
int wide = FALSE;
s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS);
if (!s) return NULL;
if (wide) { *enc = ENC_WCHAR; }
else { *enc = ENC_ISO_LATIN1; }
}
s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS);
if (!s) return NULL;
if (wide) { *enc = ENC_WCHAR; }
else { *enc = ENC_ISO_LATIN1; }
return s;
case YAP_STRING_ATOMS_CODES:
// this is a term, extract to a buffer, and representation is wide
*minimal = TRUE;
{
int wide = FALSE;
s = Yap_ListToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS);
if (!s) {
return NULL;
}
if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) {
if (buf) s = buf;
else s = Yap_PreAllocCodeSpace();
AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char);
if (snprintf(s, LOCAL_MAX_SIZE-1, Int_FORMAT, IntegerOfTerm(inp->val.t)) < 0) {
AUX_ERROR( inp->val.t, 2*LOCAL_MAX_SIZE, s, char);
}
*enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 );
*enc = ENC_ISO_LATIN1;
*lengp = strlen(s);
return s;
}
return s;
case YAP_STRING_ATOM:
// this is a term, extract to a buffer, and representation is wide
*minimal = TRUE;
if (IsVarTerm(inp->val.t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = inp->val.t;
return 0L;
} else if (!IsAtomTerm(inp->val.t)) {
LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
LOCAL_Error_Term = inp->val.t;
return NULL;
} else {
Atom at = AtomOfTerm(inp->val.t);
if (IsWideAtom(at)) {
ws = at->WStrOfAE;
*lengp = wcslen(ws);
*enc = ENC_WCHAR;
return ws;
} else {
s = at->StrOfAE;
*lengp = strlen(s);
*enc = ENC_ISO_LATIN1;
return s;
if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) {
if (buf) s = buf;
else s = Yap_PreAllocCodeSpace();
AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char);
if ( !Yap_FormatFloat( FloatOfTerm(inp->val.t), &s, LOCAL_MAX_SIZE-1 ) ) {
AUX_ERROR( inp->val.t, 2*LOCAL_MAX_SIZE, s, char);
}
*lengp = strlen(s);
*enc = ENC_ISO_LATIN1;
return s;
}
break;
case YAP_STRING_INT:
if (buf) s = buf;
else s = Yap_PreAllocCodeSpace();
AUX_ERROR( MkIntTerm(inp->val.i), LOCAL_MAX_SIZE, s, char);
if (snprintf(s, LOCAL_MAX_SIZE-1, Int_FORMAT, inp->val.i) < 0) {
AUX_ERROR( MkIntTerm(inp->val.i), 2*LOCAL_MAX_SIZE, s, char);
}
*enc = ENC_ISO_LATIN1;
*lengp = strlen(s);
return s;
case YAP_STRING_FLOAT:
if (buf) s = buf;
else s = Yap_PreAllocCodeSpace();
AUX_ERROR( MkFloatTerm(inp->val.f), LOCAL_MAX_SIZE, s, char);
if ( !Yap_FormatFloat( inp->val.f, s, LOCAL_MAX_SIZE-1 ) ) {
AUX_ERROR( MkFloatTerm(inp->val.f), 2*LOCAL_MAX_SIZE, s, char);
}
*lengp = strlen(s);
*enc = ENC_ISO_LATIN1;
return s;
#if USE_GMP
case YAP_STRING_BIG:
if (buf) s = buf;
else s = Yap_PreAllocCodeSpace();
if ( !Yap_mpz_to_string( inp->val.b, s, LOCAL_MAX_SIZE-1 , 10 ) ) {
AUX_ERROR( MkIntTerm(0), LOCAL_MAX_SIZE, s, char);
if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) {
if (buf) s = buf;
else s = Yap_PreAllocCodeSpace();
if ( !Yap_mpz_to_string( Yap_BigIntOfTerm(inp->val.t), s, LOCAL_MAX_SIZE-1 , 10 ) ) {
AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char);
}
*enc = ENC_ISO_LATIN1;
*lengp = strlen(s);
return s;
}
*enc = ENC_ISO_LATIN1;
*lengp = strlen(s);
return s;
#endif
case YAP_STRING_CHARS:
*enc = ENC_ISO_LATIN1;
if (inp->type & YAP_STRING_NCHARS)
*lengp = inp->sz;
else
*lengp = strlen(inp->val.c);
return (void *)inp->val.c;
case YAP_STRING_WCHARS:
*enc = ENC_WCHAR;
if (inp->type & YAP_STRING_NCHARS)
*lengp = inp->sz;
else
*lengp = wcslen(inp->val.w);
return (void *)inp->val.w;
case YAP_STRING_LITERAL:
if (inp->type & YAP_STRING_TERM)
{
char *s, *o;
if (buf) s = buf;
@ -540,82 +451,23 @@ Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *l
o = Yap_TermToString(inp->val.t, s, sz, lengp, ENC_ISO_UTF8, 0);
return s;
}
default:
if (!(inp->type & YAP_STRING_TERM)) {
return NULL;
} else {
Term t = inp->val.t;
if (IsVarTerm(t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t;
return NULL;
} else if (IsStringTerm(t)) {
if (inp->type & (YAP_STRING_STRING)) {
inp->type &= (YAP_STRING_STRING);
return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS);
} else {
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
}
} else if (IsPairTerm(t) ) {
if (inp->type & (YAP_STRING_CODES|YAP_STRING_ATOMS)) {
inp->type &= (YAP_STRING_CODES|YAP_STRING_ATOMS);
return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS);
} else {
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
}
} else if (IsAtomTerm(t)) {
if (t == TermNil && inp->type & (YAP_STRING_CODES|YAP_STRING_ATOMS)) {
inp->type &= (YAP_STRING_CODES|YAP_STRING_ATOMS);
return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS);
} else if (inp->type & (YAP_STRING_ATOM)) {
inp->type &= (YAP_STRING_ATOM);
inp->val.t = t;
return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS);
// [] is special...
} else {
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
}
} else if (IsIntegerTerm(t)) {
if (inp->type & (YAP_STRING_INT)) {
inp->type &= (YAP_STRING_INT);
inp->val.i = IntegerOfTerm(t);
return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS);
} else {
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
}
} else if (IsFloatTerm(t)) {
if (inp->type & (YAP_STRING_FLOAT)) {
inp->type &= (YAP_STRING_FLOAT);
inp->val.f = FloatOfTerm(t);
return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS);
} else {
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
}
#if USE_GMP
} else if (IsBigIntTerm(t)) {
if (inp->type & (YAP_STRING_BIG)) {
inp->type &= (YAP_STRING_BIG);
inp->val.b = Yap_BigIntOfTerm(t);
return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS);
} else {
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
}
#endif
} else {
if (!Yap_IsGroundTerm(t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t;
}
}
return NULL;
if (inp->type & YAP_STRING_CHARS) {
*enc = ENC_ISO_LATIN1;
if (inp->type & YAP_STRING_NCHARS)
*lengp = inp->sz;
else
*lengp = strlen(inp->val.c);
return (void *)inp->val.c;
}
}
if (inp->type & YAP_STRING_WCHARS) {
*enc = ENC_WCHAR;
if (inp->type & YAP_STRING_NCHARS)
*lengp = inp->sz;
else
*lengp = wcslen(inp->val.w);
return (void *)inp->val.w;
}
return NULL;
}
static Term
@ -915,12 +767,248 @@ write_atom( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng US
return at;
}
default:
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__);
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc));
}
return NULL;
}
static size_t
write_wbuffer( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS)
{
size_t min = 0, max = leng, sz_end, sz;
out->enc = ENC_WCHAR;
if (out->type & (YAP_STRING_NCHARS|YAP_STRING_TRUNC)) {
if (out->type & YAP_STRING_NCHARS) min = out->sz;
if (out->type & YAP_STRING_TRUNC && out->max < max) max = out->max;
}
if (out->enc != enc || out->type & (YAP_STRING_WITH_BUFFER|YAP_STRING_MALLOC)) {
if (enc != ENC_WCHAR) {
sz = strlen((char *)s0);
} else {
sz = wcslen((wchar_t *)s0);
}
if (sz < min) sz = min;
sz *= sizeof(wchar_t);
if (out->type & (YAP_STRING_MALLOC)) {
out->val.w = malloc(sz);
} else if (!(out->type & (YAP_STRING_WITH_BUFFER))) {
if (ASP-(sz/sizeof(CELL)+1) > HR+1024) {
out->val.w = (wchar_t *)(ASP-((sz*sizeof(wchar_t *)/sizeof(CELL)+1)));
} else
return -1;
}
} else {
out->val.w = s0;
sz_end = (wcslen( s0 )+1)*sizeof(wchar_t);
}
if (out->enc == ENC_WCHAR) {
switch (enc) {
case ENC_WCHAR:
if (out->type & (YAP_STRING_WITH_BUFFER|YAP_STRING_MALLOC) ) {
wchar_t *s = s0;
size_t n = wcslen( s );
if (n < min) n = min;
memcpy( out->val.c, s0, n*sizeof(wchar_t));
out->val.w[n] = '\0';
sz_end = n+1;
}
case ENC_ISO_UTF8:
{
char *s = s0, *lim = s + (max = strnlen(s, max));
char *cp = s;
wchar_t *buf0, *buf;
buf = buf0 = out->val.w;
if (!buf)
return -1;
while (*cp && cp < lim) {
int chr;
cp = utf8_get_char(cp, &chr);
*buf++ = chr;
}
if (max >= min) *buf++ = '\0';
else while (max < min) {
int chr;
max++;
cp = utf8_get_char(cp, &chr);
*buf++ = chr;
}
*buf = '\0';
sz_end = (buf-buf0)+1;
}
break;
case ENC_ISO_LATIN1:
{
char *s = s0;
size_t n = strlen( s ), i;
if (n < min) n = min;
for (i = 0; i < n; i++)
out->val.w[i] = s[i];
out->val.w[n] = '\0';
sz_end = n+1;
}
break;
default:
sz_end = -1;
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__);
}
}
sz_end *= sizeof( wchar_t );
if (out->type & (YAP_STRING_MALLOC)) {
out->val.c = realloc(out->val.c,sz_end);
}
out->sz = sz_end;
return sz_end;
}
static size_t
write_buffer( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS)
{
size_t min = 0, max = leng, sz_end;
if (out->type & (YAP_STRING_NCHARS|YAP_STRING_TRUNC)) {
if (out->type & YAP_STRING_NCHARS) min = out->sz;
if (out->type & YAP_STRING_TRUNC && out->max < max) max = out->max;
}
if (out->enc != enc || out->type & (YAP_STRING_WITH_BUFFER|YAP_STRING_MALLOC)) {
size_t sz;
if (enc != ENC_WCHAR)
sz = strlen((char *)s0);
else
sz = wcslen((wchar_t *)s0);
if (sz < min) sz = min;
if (!minimal) sz *= 4;
if (out->type & (YAP_STRING_MALLOC)) {
out->val.c = malloc(sz);
} else if (!(out->type & (YAP_STRING_WITH_BUFFER))) {
if (ASP-(sz/sizeof(CELL)+1) > HR+1024) {
out->val.c = (char *)(ASP-(sz/sizeof(CELL)+1));
}
}
} else {
out->val.c = s0;
}
if (out->enc == ENC_ISO_UTF8) {
switch (enc) {
case ENC_ISO_UTF8:
if (out->type & (YAP_STRING_WITH_BUFFER|YAP_STRING_MALLOC) ) {
char *s = s0;
size_t n = strlen( s );
memcpy( out->val.c, s0, n*sizeof(wchar_t));
out->val.c[n] = '\0';
sz_end = n+1;
} else {
sz_end = strlen(out->val.c)+1;
}
break;
case ENC_ISO_LATIN1:
{
char *s = s0, *lim = s + (max = strnlen(s, max));
char *cp = s, *buf0, *buf;
buf = buf0 = out->val.c;
if (!buf)
return -1;
while (*cp && cp < lim) {
int chr;
chr = *cp++;
buf = utf8_put_char(buf, chr);
}
if (max >= min) *buf++ = '\0';
else while (max < min) {
max++;
int chr;
chr = *cp++;
buf = utf8_put_char(buf, chr);
}
buf[0] = '\0';
sz_end = (buf+1)-buf0;
}
break;
case ENC_WCHAR:
{
wchar_t *s = s0;
char *buf = out->val.c;
size_t n = wcslen( s ), i;
if (n < min) n = min;
for (i = 0; i < n; i++) {
int chr = s[i];
buf = utf8_put_char(buf, chr);
}
*buf++ = '\0';
sz_end = (buf+1)-out->val.c;
}
break;
default:
sz_end = -1;
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__);
}
}else if (out->enc == ENC_ISO_LATIN1) {
switch (enc) {
case ENC_ISO_LATIN1:
if (out->type & YAP_STRING_WITH_BUFFER) {
char *s = s0;
size_t n = strlen( s ), i;
if (n < min) n = min;
memcpy( out->val.c, s0, n);
for (i = 0; i < n; i++)
out->val.w[i] = s[i];
out->val.w[n] = '\0';
sz_end = (n+1)*sizeof(wchar_t);
} else {
sz_end = strlen( out->val.c ) + 1;
}
break;
case ENC_ISO_UTF8:
{
char *s = s0, *lim = s + (max = strnlen(s, max));
char *cp = s;
char *buf0, *buf;
buf = buf0 = out->val.c;
if (!buf)
return -1;
while (*cp && cp < lim) {
int chr;
cp = utf8_get_char(cp, &chr);
*buf++ = chr;
}
if (max >= min) *buf++ = '\0';
else while (max < min) {
int chr;
max++;
cp = utf8_get_char(cp, &chr);
*buf++ = chr;
}
sz_end = buf-out->val.c;
}
break;
case ENC_WCHAR:
{
wchar_t *s = s0;
size_t n = wcslen( s ), i;
if (n < min) n = min;
for (i = 0; i < n; i++)
out->val.c[i] = s[i];
out->val.c[n] = '\0';
sz_end = n+1;
}
break;
default:
sz_end = -1;
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__);
}
}
if (out->type & (YAP_STRING_MALLOC)) {
out->val.c = realloc(out->val.c,sz_end);
}
out->sz = sz_end;
return sz_end;
}
static ssize_t
write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS)
{
@ -998,14 +1086,16 @@ write_Text( void *inp, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
write_number( inp, out, enc, minimal, leng PASS_REGS);
return out->val.t != 0;
case YAP_STRING_CHARS:
out->val.c = inp;
return 1;
{
size_t sz = write_buffer( inp, out, enc, minimal, leng PASS_REGS);
return((Int)sz > 0);
}
case YAP_STRING_WCHARS:
out->val.w = inp;
return MkIntTerm(0);
case YAP_STRING_LITERAL:
return 0;
default:
{
size_t sz = write_wbuffer( inp, out, enc, minimal, leng PASS_REGS);
return((Int)sz > 0);
}
default:
if (!(out->type & YAP_STRING_TERM))
return 0;
if (out->type & (YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG))
@ -1019,12 +1109,11 @@ write_Text( void *inp, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
out->val.t = MkAtomTerm(at);
return at != NIL;
}
if (out->type & (YAP_STRING_LITERAL))
if ((out->val.t =
string_to_term( inp, out, enc, minimal, leng PASS_REGS)) != 0L)
return out->val.t != 0;
return FALSE;
}
}
return FALSE;
}
int
@ -1208,7 +1297,6 @@ concat( int n, seq_tv_t *out, void *sv[], encoding_t encv[], size_t lengv[] USES
/* wide atom */
wchar_t *buf = (wchar_t *)HR;
Atom at;
Term t = ARG1;
LOCAL_ERROR( sz+3 );
for (i = 0; i < n ; i ++) {
if (encv[i] == ENC_WCHAR) {
@ -1232,7 +1320,6 @@ concat( int n, seq_tv_t *out, void *sv[], encoding_t encv[], size_t lengv[] USES
/* atom */
char *buf = (char *)HR;
Atom at;
Term t = ARG1;
LOCAL_TERM_ERROR( sz/sizeof(CELL)+3 );
for (i = 0; i < n ; i ++) {
@ -1279,7 +1366,6 @@ slice( size_t min, size_t max, void *buf, seq_tv_t *out, encoding_t enc USES_REG
if (enc == ENC_WCHAR) {
/* wide atom */
wchar_t *nbuf = (wchar_t *)HR;
Term t = TermNil;
wchar_t *ptr = (wchar_t *)buf + min;
if (max>min) {
LOCAL_ERROR( (max-min)*sizeof(wchar_t) );
@ -1292,7 +1378,6 @@ slice( size_t min, size_t max, void *buf, seq_tv_t *out, encoding_t enc USES_REG
char *nbuf = (char *)HR;
if (max>min) {
Term t = TermNil;
char *ptr = (char *)buf + min;
LOCAL_ERROR( max-min );
memcpy( nbuf, ptr, (max - min));
@ -1302,7 +1387,6 @@ slice( size_t min, size_t max, void *buf, seq_tv_t *out, encoding_t enc USES_REG
} else {
/* atom */
wchar_t *nbuf = (wchar_t *)HR;
Term t = ARG1;
const char *ptr = utf8_skip ( (const char *)buf, min );
int chr;

32
C/traced_absmi_insts.h
View File

@ -35,11 +35,11 @@ if (P== NULL) goto NoStackCommitX;
*****************************************************************/
BOp(Ystop, l);
goto Ystop;
goto _Ystop;
ENDBOp();
BOp(Nstop, e);
goto Nstop;
goto _Nstop;
ENDBOp();
/*****************************************************************
@ -76,7 +76,7 @@ CACHE_Y(YREG);
ENDOp();
/* retry_me Label,NArgs */
Op(retry_me, Otapl);
Op(retry_me, OBtapl);
EMIT_ENTRY_BLOCK(PREG,RETRY_ME_INSTINIT);
CACHE_Y(B);
/* After retry, cut should be pointing at the parent
@ -14533,43 +14533,43 @@ S_SREG = RepAppl(d0);
}
BOp(unify_l_string ,ou);
goto Ystop;
goto _Ystop;
ENDBOp();
BOp(unify_string ,ou);
goto Ystop;
goto _Ystop;
ENDBOp();
BOp(get_string ,xu);
goto Ystop;
goto _Ystop;
ENDBOp();
BOp(get_atom_exo ,x);
goto Ystop;
goto _Ystop;
ENDBOp();
BOp(retry_exo_udi ,lp);
goto Ystop;
goto _Ystop;
ENDBOp();
BOp(retry_exo ,lp);
goto Ystop;
goto _Ystop;
ENDBOp();
BOp(retry_udi ,p);
goto Ystop;
goto _Ystop;
ENDBOp();
BOp(retry_all_exo ,lp);
goto Ystop;
goto _Ystop;
ENDBOp();
BOp(enter_exo ,e);
goto Ystop;
goto _Ystop;
ENDBOp();
BOp(try_exo ,lp);
goto Ystop;
goto _Ystop;
ENDBOp();
BOp(try_exo_udi ,lp);
goto Ystop;
goto _Ystop;
ENDBOp();
BOp(try_all_exo ,lp);
goto Ystop;
goto _Ystop;
ENDBOp();
BOp(try_udi ,p);
goto Ystop;
goto _Ystop;
ENDBOp();

4
C/unify.c
View File

@ -54,10 +54,6 @@ int Yap_rational_tree_loop(CELL *, CELL *, CELL **, CELL **);
static int OCUnify_complex(CELL *, CELL *, CELL *);
static int OCUnify(register CELL, register CELL);
static Int p_ocunify( USES_REGS1 );
#ifdef THREADED_CODE
static int rtable_hash_op(OPCODE);
static void InitReverseLookupOpcode(void);
#endif
/* support for rational trees and unification with occur checking */

16
C/write.c
View File

@ -381,15 +381,20 @@ static void wrputf(Float f, struct write_globs *wglb) /* writes a float */
protect_close_number(wglb, ob);
}
int Yap_FormatFloat(Float f, const char *s, size_t sz) {
int Yap_FormatFloat(Float f, char **s, size_t sz) {
CACHE_REGS
struct write_globs wglb;
int sno;
sno = Yap_open_buf_read_stream(s, strlen(s)+1, LOCAL_encoding, MEM_BUF_USER);
char *so;
sno = Yap_open_buf_write_stream(*s, sz, GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0);
if (sno < 0)
return FALSE;
wglb.stream = GLOBAL_Stream+sno;
wrputf(f, &wglb);
GLOBAL_Stream[sno].status = Free_Stream_f;
so = Yap_MemExportStreamPtr(sno);
Yap_CloseStream(sno);
*s = so;
return TRUE;
}
@ -1199,8 +1204,10 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int prio
/* consumer */
/* write options */
{
CACHE_REGS
struct write_globs wglb;
struct rewind_term rwt;
yhandle_t sls = Yap_CurrentSlot(PASS_REGS1);
if (!mywrite) {
CACHE_REGS
@ -1235,9 +1242,8 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int prio
if (flags & Fullstop_f) {
wrputc('.', wglb.stream);
wrputc(' ', wglb.stream);
} else {
wrputc(' ', wglb.stream);
}
}
restore_from_write(&rwt, &wglb);
Yap_CloseSlots( sls );
}

3389
CMakeLists.txt
View File

File diff suppressed because it is too large Load Diff

1
H/Regs.h
View File

@ -722,7 +722,6 @@ INLINE_ONLY EXTERN inline void restore_B(void) {
#endif /* FROZEN_STACKS */
#if !defined(THREADS)
/* use actual addresses for regs */
#define PRECOMPUTE_REGADDRESS 1

10
H/YapGFlagInfo.h
View File

@ -71,7 +71,7 @@ running on an Apple machine.
*/
#endif
YAP_FLAG( ARCH_FLAG, "arch", false, isatom, YAP_ARCH , NULL ),
YAP_FLAG( ARGV_FLAG, "argv", false, isatom, "[]" , argv ),
YAP_FLAG( ARGV_FLAG, "argv", false, argv, "?-" , NULL ),
YAP_FLAG( ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true, boolean, "true" , NULL ),
YAP_FLAG( BACKQUOTED_STRING_FLAG, "backquoted_string", true, isatom, "string" , ), /**>
If _Value_ is unbound, tell whether a double quoted list of characters
@ -133,7 +133,7 @@ YAP_FLAG( DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true, boolean, "fa
If `off` (default) consider the character `$` a control character, if
`on` consider `$` a lower case character.
*/
YAP_FLAG( DOUBLE_QUOTES_FLAG, "double_quotes", true, isatom, "codes" , NULL ), /**< `double_quotes is iso `
YAP_FLAG( DOUBLE_QUOTES_FLAG, "double_quotes", true, isatom, "codes" , dqf ), /**< `double_quotes is iso `
If _Value_ is unbound, tell whether a double quoted list of characters
token is converted to a list of atoms, `chars`, to a list of integers,
@ -148,10 +148,10 @@ original program path.
YAP_FLAG( FAST_FLAG, "fast", true, boolean, "false" , NULL ), /**< `fast `
If `on` allow fast machine code, if `off` (default) disable it. Only
available in experimental implementations.
available in experimental implemexbntations.
*/
YAP_FLAG( FILE_NAME_VARIABLES_FLAG, "file_name_variables", true, boolean, "true" , NULL ),
YAP_FLAG( FLOAT_FORMAT_FLAG, "float_format", true, isatom, "%.15g" , NULL ), /**< + `float_format `
YAP_FLAG( FLOAT_FORMAT_FLAG, "float_format", true, isatom, "%15e" , NULL ), /**< + `float_format `
C-library `printf()` format specification used by write/1 and
friends to determine how floating point numbers are printed. The
@ -254,7 +254,7 @@ providing access to shared libraries (`.so` files) or to dynamic link
libraries (`.DLL` files).
*/
YAP_FLAG( OPTIMISE_FLAG, "optimise", true, boolean, "false" , NULL ),
YAP_FLAG( OS_ARGV_FLAG, "os_argv", false, ro, "[]" , os_argv ),
YAP_FLAG( OS_ARGV_FLAG, "os_argv", false, os_argv, "?-" , NULL ),
YAP_FLAG( PID_FLAG, "pid", false, ro, "0" , NULL ),
YAP_FLAG( PIPE_FLAG, "pipe", true, boolean, "true" , NULL ),
YAP_FLAG( PROFILING_FLAG, "profiling", true, boolean, "false" , NULL ), /**< `profiling `

20
H/YapHandles.h
View File

@ -48,13 +48,15 @@ Slots are not known to the yaam. Instead, A new set of slots is created when the
*************************************************************************************************/
#include <stdio.h>
/// @brief reboot the slot system.
/// Used when wwe start from scratch (Reset).
#define Yap_RebootSlots( wid ) Yap_RebootSlots__( wid PASS_REGS )
static inline void
Yap_RebootSlots__( int wid USES_REGS ) {
// fprintf( stderr, " StartSlots = %ld", LOCAL_CurSlot);
// // fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot);
REMOTE_CurSlot(wid) = 1;
}
@ -65,7 +67,8 @@ Yap_RebootSlots__( int wid USES_REGS ) {
static inline yhandle_t
Yap_StartSlots__( USES_REGS1 ) {
// fprintf( stderr, " StartSlots = %ld", LOCAL_CurSlot);
// // fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot);
// fprintf(stderr,"SS %s:%d\n", __FUNCTION__, __LINE__);;
if (LOCAL_CurSlot < 0) {
Yap_Error( SYSTEM_ERROR, 0L, " StartSlots = %ld", LOCAL_CurSlot);
}
@ -78,6 +81,7 @@ if (LOCAL_CurSlot < 0) {
static inline void
Yap_CloseSlots__( yhandle_t slot USES_REGS ) {
// fprintf(stderr,"CS %s:%d\n", __FUNCTION__, __LINE__);;
LOCAL_CurSlot = slot;
}
@ -92,6 +96,7 @@ Yap_CurrentSlot( USES_REGS1 ) {
static inline Term
Yap_GetFromSlot__(yhandle_t slot USES_REGS)
{
// fprintf(stderr,"GS %s:%d\n", __FUNCTION__, __LINE__);;
return(Deref(LOCAL_SlotBase[slot]));
}
@ -99,6 +104,7 @@ Yap_GetFromSlot__(yhandle_t slot USES_REGS)
static inline Term
Yap_GetDerefedFromSlot(yhandle_t slot USES_REGS)
{
// fprintf(stderr,"GDS %s:%d\n", __FUNCTION__, __LINE__);
return LOCAL_SlotBase[slot];
}
@ -106,6 +112,7 @@ Yap_GetDerefedFromSlot(yhandle_t slot USES_REGS)
static inline Term
Yap_GetPtrFromSlot(yhandle_t slot USES_REGS)
{
// fprintf(stderr,"GPS %s:%d\n", __FUNCTION__, __LINE__);
return LOCAL_SlotBase[slot];
}
@ -123,6 +130,7 @@ Yap_AddressFromSlot__(yhandle_t slot USES_REGS)
static inline void
Yap_PutInSlot(yhandle_t slot, Term t USES_REGS)
{
// fprintf(stderr,"PS %s:%d\n", __FUNCTION__, __LINE__);
LOCAL_SlotBase[slot] = t;
}
@ -135,7 +143,9 @@ ensure_slots(int N USES_REGS)
{
if (LOCAL_CurSlot+N >= LOCAL_NSlots) {
size_t inc = max(16*1024, LOCAL_NSlots/2); // measured in cells
inc = max(inc, N+16); // measured in cells
LOCAL_SlotBase = (CELL *)realloc( LOCAL_SlotBase, (inc + LOCAL_NSlots )*sizeof(CELL));
LOCAL_NSlots += inc;
if (!LOCAL_SlotBase) {
unsigned long int kneeds = ((inc + LOCAL_NSlots )*sizeof(CELL))/1024;
Yap_Error(SYSTEM_ERROR, 0 /* TermNil */, "Out of memory for the term handles (term_t) aka slots, l needed", kneeds);
@ -150,6 +160,7 @@ static inline yhandle_t
Yap_InitSlot__(Term t USES_REGS)
{
yhandle_t old_slots = LOCAL_CurSlot;
// fprintf(stderr,"IS %s:%d\n", __FUNCTION__, __LINE__);
ensure_slots( 1 PASS_REGS);
LOCAL_SlotBase[old_slots] = t;
@ -165,10 +176,11 @@ Yap_NewSlots__(int n USES_REGS)
{
yhandle_t old_slots = LOCAL_CurSlot;
int i;
// fprintf(stderr,"NS %s:%d\n", __FUNCTION__, __LINE__);
ensure_slots(n PASS_REGS);
for (i = 0; i< n; i++) {
RESET_VARIABLE(Yap_AddressFromSlot(old_slots+i) );
LOCAL_SlotBase[old_slots+i] = MkVarTerm();
}
LOCAL_CurSlot += n;
return old_slots;
@ -182,6 +194,7 @@ Yap_InitSlots__(int n, Term *ts USES_REGS)
{
yhandle_t old_slots = LOCAL_CurSlot;
int i;
// fprintf(stderr,"1S %s:%d\n", __FUNCTION__, __LINE__);
ensure_slots( n PASS_REGS);
for (i=0; i< n; i++)
@ -196,6 +209,7 @@ Yap_RecoverSlots(int n, yhandle_t topSlot USES_REGS)
{
if (topSlot + n < LOCAL_CurSlot)
return false;
// fprintf(stderr,"RS %s:%d\n", __FUNCTION__, __LINE__);
#ifdef DEBUG
if (topSlot + n > LOCAL_CurSlot) {
Yap_Error(SYSTEM_ERROR, 0 /* TermNil */, "Inconsistent slot state in Yap_RecoverSlots.");

12
H/YapHeap.h
View File

@ -198,6 +198,18 @@ extern struct various_codes *Yap_heap_regs;
//#include "dglobals.h"
//#include "dlocals.h"
/**
* gc-P: how to start-up the grbage collector in C-code
*/
static inline
yamop *
gc_P(yamop *p, yamop *cp)
{
return (p->opc == EXECUTE_CPRED_OPCODE ? cp : p);
}
/**
Yap_CurrentModule: access the current module for looking
up predicates

109
H/YapText.h
View File

@ -28,33 +28,36 @@
* mirroring
*/
#include "Yap.h"
#include "pl-utf8.h"
// standard strings
typedef enum {
YAP_STRING_STRING = 0x1,
YAP_STRING_CODES = 0x2,
YAP_STRING_ATOMS = 0x4,
YAP_STRING_ATOMS_CODES = 0x6,
YAP_STRING_CHARS = 0x8,
YAP_STRING_WCHARS = 0x10,
YAP_STRING_ATOM = 0x20,
YAP_STRING_INT = 0x40,
YAP_STRING_FLOAT = 0x80,
YAP_STRING_BIG = 0x100,
YAP_STRING_LITERAL = 0x200,
YAP_STRING_LENGTH = 0x400,
YAP_STRING_NTH = 0x800,
YAP_STRING_STRING = 0x1, /// target is a string term
YAP_STRING_CODES = 0x2, /// target is a list of integer codes
YAP_STRING_ATOMS = 0x4, /// target is a list of kength-1 atom
YAP_STRING_ATOMS_CODES = 0x6, /// targt is list of atoms or codes
YAP_STRING_CHARS = 0x8, /// target is a buffer, with byte-sized units
YAP_STRING_WCHARS = 0x10, /// target is a buffer of wide chars
YAP_STRING_ATOM = 0x20, /// tarfet is an ayom
YAP_STRING_INT = 0x40, /// target is an integer term
YAP_STRING_FLOAT = 0x80, /// target is a floar term
YAP_STRING_BIG = 0x100, /// target is an big num term
YAP_STRING_DATUM = 0x200, /// associated with previous 3, use actual object if type, not tern
YAP_STRING_LENGTH = 0x400, /// input: length is fixed; output: return integer with length
YAP_STRING_NTH = 0x800, /// input: ignored; output: nth char
YAP_STRING_TERM = 0x1000, // Generic term, if nothing else given
YAP_STRING_DIFF = 0x2000, // difference list
YAP_STRING_NCHARS = 0x4000, // size of input/result
YAP_STRING_TRUNC = 0x8000, // truncate on maximum size of input/result
YAP_STRING_WQ = 0x10000, // output with write_quote
YAP_STRING_WC = 0x20000, // output with write_canonical
YAP_STRING_WITH_BUFFER = 0x40000, // output on existing buffer
YAP_STRING_MALLOC = 0x80000 // output on malloced buffer
} enum_seq_type_t;
#define YAP_STRING_TERM 0x1000 // joint with other flags that define possible values
#define YAP_STRING_DIFF 0x2000 // difference list
#define YAP_STRING_NCHARS 0x4000 // size of input/result
#define YAP_STRING_TRUNC 0x8000 // truncate on maximum size of input/result
#define YAP_STRING_WQ 0x10000 // output with write_quote
#define YAP_STRING_WC 0x20000 // output with write_canonical
typedef UInt seq_type_t;
@ -64,8 +67,10 @@ typedef union {
Float f;
Int i;
MP_INT *b;
const char *c;
const wchar_t *w;
const char *c0;
const wchar_t *w0;
char *c;
wchar_t *w;
Atom a;
size_t l;
int d;
@ -80,6 +85,7 @@ typedef struct text_cvt {
size_t sz; // fixed sz, or -1
Term dif; // diff-list, usually TermNil
size_t max; // max_size
encoding_t enc;
} seq_tv_t;
// string construction
@ -341,7 +347,7 @@ Yap_CharsToAtom( const char *s USES_REGS )
{
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.sz = 0;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOM;
@ -355,7 +361,7 @@ Yap_CharsToListOfAtoms( const char *s USES_REGS )
{
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.sz = 0;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOMS;
@ -369,7 +375,7 @@ Yap_CharsToListOfCodes( const char *s USES_REGS )
{
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.sz = 0;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES;
@ -383,7 +389,7 @@ Yap_CharsToDiffListOfCodes( const char *s, Term tail USES_REGS )
{
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.sz = 0;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_DIFF|YAP_STRING_CODES;
@ -398,7 +404,7 @@ Yap_CharsToString( const char *s USES_REGS )
{
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.sz = 0;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_STRING;
@ -407,12 +413,33 @@ Yap_CharsToString( const char *s USES_REGS )
return out.val.t;
}
static inline char *
Yap_AtomToUTF8Text( Atom at, const char *s USES_REGS )
{
seq_tv_t inp, out;
inp.val.a = at;
inp.sz = 0;
inp.type = YAP_STRING_ATOM;
out.type = YAP_STRING_CHARS;
out.enc = ENC_ISO_UTF8;
if (s) {
out.val.c0 = s;
out.type |= YAP_STRING_WITH_BUFFER;
} else {
out.val.c = NULL;
}
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
return out.val.c;
}
static inline Term
Yap_CharsToTDQ( const char *s, Term mod USES_REGS )
{
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.sz = 0;
inp.type = YAP_STRING_CHARS;
inp.mod = mod;
@ -429,7 +456,7 @@ Yap_CharsToTBQ( const char *s, Term mod USES_REGS )
{
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.sz = 0;
inp.type = YAP_STRING_CHARS;
inp.mod = mod;
@ -621,7 +648,7 @@ Yap_NCharsToAtom( const char *s, size_t len USES_REGS )
{
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.sz = len;
inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS;
out.type = YAP_STRING_ATOM;
@ -636,7 +663,7 @@ Yap_CharsToDiffListOfAtoms( const char *s, Term tail USES_REGS )
{
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOMS|YAP_STRING_DIFF;
out.dif = tail;
@ -651,7 +678,7 @@ Yap_NCharsToListOfCodes( const char *s, size_t len USES_REGS )
{
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.sz = len;
inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS;
out.type = YAP_STRING_CODES;
@ -666,7 +693,7 @@ Yap_NCharsToString( const char *s, size_t len USES_REGS )
{
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.sz = len;
inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS;
out.type = YAP_STRING_STRING;
@ -681,7 +708,7 @@ Yap_NCharsToTDQ( const char *s, size_t len, Term mod USES_REGS )
{
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS;
inp.sz = len;
inp.mod = mod;
@ -699,7 +726,7 @@ Yap_NCharsToTBQ( const char *s, size_t len, Term mod USES_REGS )
{
seq_tv_t inp, out;
inp.val.c = s;
inp.val.c0 = s;
inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS;
inp.sz = len;
inp.mod = mod;
@ -765,7 +792,7 @@ Yap_NWCharsToAtom( const wchar_t *s, size_t len USES_REGS )
{
seq_tv_t inp, out;
inp.val.w = s;
inp.val.w0 = s;
inp.sz = len;
inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS;
out.type = YAP_STRING_ATOM;
@ -780,7 +807,7 @@ Yap_NWCharsToListOfAtoms( const wchar_t *s, size_t len USES_REGS )
{
seq_tv_t inp, out;
inp.val.w = s;
inp.val.w0 = s;
inp.sz = len;
inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS;
out.type = YAP_STRING_ATOMS;
@ -795,7 +822,7 @@ Yap_NWCharsToListOfCodes( const wchar_t *s, size_t len USES_REGS )
{
seq_tv_t inp, out;
inp.val.w = s;
inp.val.w0 = s;
inp.sz = len;
inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS;
out.type = YAP_STRING_CODES;
@ -810,7 +837,7 @@ Yap_NWCharsToString( const wchar_t *s, size_t len USES_REGS )
{
seq_tv_t inp, out;
inp.val.w = s;
inp.val.w0 = s;
inp.sz = len;
inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS;
out.type = YAP_STRING_STRING;
@ -940,7 +967,7 @@ static inline Term
Yap_WCharsToListOfCodes(const wchar_t *s USES_REGS)
{
seq_tv_t inp, out;
inp.val.w = s;
inp.val.w0 = s;
inp.sz = 0;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES;
@ -954,7 +981,7 @@ Yap_WCharsToTDQ( wchar_t *s, Term mod USES_REGS )
{
seq_tv_t inp, out;
inp.val.w = s;
inp.val.w0 = s;
inp.type = YAP_STRING_WCHARS;
inp.sz = 0;
inp.mod = mod;
@ -987,7 +1014,7 @@ static inline Term
Yap_WCharsToString(const wchar_t *s USES_REGS)
{
seq_tv_t inp, out;
inp.val.w = s;
inp.val.w0 = s;
inp.sz = 0;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_STRING;

8
H/Yapproto.h
View File

@ -483,14 +483,8 @@ void Yap_flush(void);
Int Yap_source_line_no( void );
Atom Yap_source_file_name( void );
static inline
yamop *
gc_P(yamop *p, yamop *cp)
{
return (p->opc == Yap_opcode(_execute_cpred) ? cp : p);
}
void
Yap_install_blobs(void);
yamop * Yap_gcP(void);

11
H/Yatom.h
View File

@ -1223,6 +1223,7 @@ typedef struct translation_entry
{
Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */
arity_t arity; /* refers to atom (0) or functor(N > 0) */
Int Translation; /* used to hash the atom as an integer; */
} TranslationEntry;
@ -1271,11 +1272,11 @@ AbsTranslationProp (TranslationEntry * p)
#endif
#define TranslationProperty 0xfff4
bool Yap_PutAtomTranslation(Atom a, Int i);
bool Yap_PutAtomTranslation(Atom a, arity_t arity, Int i);
/* get translation prop for atom; */
static inline TranslationEntry *
Yap_GetTranslationProp(Atom at)
Yap_GetTranslationProp(Atom at, arity_t arity)
{
Prop p0;
AtomEntry *ae = RepAtom(at);
@ -1283,10 +1284,12 @@ Yap_GetTranslationProp(Atom at)
READ_LOCK(ae->ARWLock);
p = RepTranslationProp(p0 = ae->PropsOfAE);
while (p0 && p->KindOfPE != TranslationProperty)
while (p0 && (p->KindOfPE != TranslationProperty ||
p->arity != arity))
p = RepTranslationProp(p0 = p->NextOfPE);
READ_UNLOCK(ae->ARWLock);
if (p0 == NIL) return (TranslationEntry *)NULL;
p->arity = arity;
return p;
}
@ -1691,7 +1694,7 @@ AbsFlagProp (FlagEntry * p)
#endif
#define FlagProperty ((PropFlags)0xfffc)
#define FlagProperty ((PropFlags)0xfff9)
INLINE_ONLY inline EXTERN PropFlags IsFlagProperty (int);

13
H/absmi-interpretrer.h Normal file
View File

@ -0,0 +1,13 @@
//
// absmi-interpretrer.h
// Project
//
// Created by VITOR SANTOS COSTA on 02/08/15.
//
//
#ifndef Project_absmi_interpretrer_h
#define Project_absmi_interpretrer_h
#endif

35
H/absmi.h
View File

@ -853,72 +853,73 @@ restore_absmi_regs(REGSTORE * old_regs)
#if YAP_JIT
#define Op(Label,Type) \
Label:{ (ExpEnv.config_struc.current_displacement) ? \
_##Label:{ (ExpEnv.config_struc.current_displacement) ? \
print_instruction(PREG, ON_PROFILED_INTERPRETER) : \
print_instruction(PREG, ON_INTERPRETER); \
START_PREFETCH(Type)
#define OpW(Label,Type) \
Label:{ (ExpEnv.config_struc.current_displacement) ? \
_##Label:{ (ExpEnv.config_struc.current_displacement) ? \
print_instruction(PREG, ON_PROFILED_INTERPRETER) : \
print_instruction(PREG, ON_INTERPRETER); \
START_PREFETCH_W(Type)
#define BOp(Label,Type) \
Label:{ (ExpEnv.config_struc.current_displacement) ? \
_##Label:{ (ExpEnv.config_struc.current_displacement) ? \
print_instruction(PREG, ON_PROFILED_INTERPRETER) : \
print_instruction(PREG, ON_INTERPRETER);
#define PBOp(Label,Type) \
Label:{ (ExpEnv.config_struc.current_displacement) ? \
_##Label:{ (ExpEnv.config_struc.current_displacement) ? \
print_instruction(PREG, ON_PROFILED_INTERPRETER) : \
print_instruction(PREG, ON_INTERPRETER); \
INIT_PREFETCH()
#define OpRW(Label,Type) \
Label:{ (ExpEnv.config_struc.current_displacement) ? \
_##Label:{ (ExpEnv.config_struc.current_displacement) ? \
print_instruction(PREG, ON_PROFILED_INTERPRETER) : \
print_instruction(PREG, ON_INTERPRETER);
#else /* YAP_JIT */
#define Op(Label,Type) \
Label:{ print_instruction(PREG, ON_INTERPRETER); \
_##Label:{ print_instruction(PREG, ON_INTERPRETER); \
START_PREFETCH(Type)
#define OpW(Label,Type) \
Label:{ print_instruction(PREG, ON_INTERPRETER); \
_##Label:{ print_instruction(PREG, ON_INTERPRETER); \
START_PREFETCH_W(Type)
#define BOp(Label,Type) \
Label:{ print_instruction(PREG, ON_INTERPRETER);
_##Label:{ print_instruction(PREG, ON_INTERPRETER);
#define PBOp(Label,Type) \
Label:{ print_instruction(PREG, ON_INTERPRETER); \
_##Label:{ print_instruction(PREG, ON_INTERPRETER); \
INIT_PREFETCH()
#define OpRW(Label,Type) \
Label:{ print_instruction(PREG, ON_INTERPRETER);
_##Label:{ print_instruction(PREG, ON_INTERPRETER);
#endif /* YAP_JIT */
#else /* YAP_DBG_PREDS */
#define Op(Label,Type) \
Label:{ START_PREFETCH(Type)
_##Label:{ START_PREFETCH(Type)
#define OpW(Label,Type) \
Label:{ START_PREFETCH_W(Type)
_##Label:{ START_PREFETCH_W(Type)
#define BOp(Label,Type) \
Label:{
_##Label:{
#define PBOp(Label,Type) \
Label:{ INIT_PREFETCH()
_##Label:{ INIT_PREFETCH()
#define OpRW(Label,Type) \
Label:{
_##Label:{
#endif /* YAP_DBG_PREDS */
@ -1723,7 +1724,7 @@ typedef struct v_record {
Term old;
} v_record;
#if defined(IN_ABSMI_C) || defined(IN_UNIFY_C)
#if defined(IN_ABSMI_C) || defined(IN_UNIFY_C)|| defined(IN_TRACED_ABSMI_C)
static int
@ -1922,7 +1923,7 @@ IUnify_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
#endif
#if defined(IN_ABSMI_C) || defined(IN_INLINES_C)
#if defined(IN_ABSMI_C) || defined(IN_INLINES_C) || defined(IN_TRACED_ABSMI_C)
static int
iequ_complex(register CELL *pt0, register CELL *pt0_end,

1
H/amidefs.h
View File

@ -1088,6 +1088,7 @@ extern void **Yap_ABSMI_OPCODES;
#define absmadr(i) ((OPCODE)(i))
#endif
bool is_cleanup_cp(choiceptr cp_b);
#if DEPTH_LIMIT
/*

9
H/dglobals.h
View File

@ -1,6 +1,6 @@
/* This file, dglobals.h, was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/GLOBALS instead */

/* This file, dglobals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/GLOBALS instead */
@ -78,9 +78,6 @@
#define GLOBAL_argv Yap_global->argv_
#define GLOBAL_argc Yap_global->argc_
#define GLOBAL_Flags Yap_global->Flags_
#define GLOBAL_flagCount Yap_global->flagCount_
#ifdef COROUTINING
#define GLOBAL_attas Yap_global->attas_

9
H/dhstruct.h
View File

@ -72,6 +72,7 @@
#define ORLAST_OPCODE Yap_heap_regs->orlast_op
#define UNDEF_OPCODE Yap_heap_regs->undef_op
#define RETRY_USERC_OPCODE Yap_heap_regs->retry_userc_op
#define EXECUTE_CPRED_OPCODE Yap_heap_regs->execute_cpred_op
#define NOfAtoms Yap_heap_regs->n_of_atoms
#define AtomHashTableSize Yap_heap_regs->atom_hash_table_size
@ -156,9 +157,8 @@
#define GLOBAL_Flags Yap_heap_regs->GLOBAL_Flags_
#define GLOBAL_flagCount Yap_heap_regs->GLOBAL_flagCount_
#define Yap_ExecutionMode Yap_heap_regs->execution_mode
@ -332,6 +332,9 @@
#define AtomTranslations Yap_heap_regs->atom_translations
#define MaxAtomTranslations Yap_heap_regs->max_atom_translations
#define FunctorTranslations Yap_heap_regs->functor_translations
#define MaxFunctorTranslations Yap_heap_regs->max_functor_translations
#define EmptyWakeups Yap_heap_regs->empty_wakeups
#define MaxEmptyWakeups Yap_heap_regs->max_empty_wakeups

6
H/dlocals.h
View File

@ -1,6 +1,6 @@
/* This file, dlocals.h, was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/LOCALS instead */

/* This file, dlocals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/LOCALS instead */

15
H/eval.h
View File

@ -415,11 +415,16 @@ Yap_FoundArithError__(USES_REGS1)
return YAP_NO_ERROR;
}
static inline Term takeName(Term t) {
if (IsAtomTerm(t)) return t;
MkAtomTerm(NameOfFunctor(FunctorOfTerm(t)));
if (IsPairTerm(t)) return TermNil;
return t;
static inline Term takeIndicator(Term t) {
Term ts[2];
if (IsAtomTerm(t)) { ts[0] = t; ts[1] = MkIntTerm(0); }
else if (IsPairTerm(t)) { ts[0] = TermNil; ts[1] = MkIntTerm(2); }
else {
CACHE_REGS
ts[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(t)));
ts[1] = MkIntegerTerm(ArityOfFunctor(FunctorOfTerm(t)));
}
return Yap_MkApplTerm( FunctorSlash, 2, ts );
}
Atom Yap_NameOfUnaryOp(int i);

2
H/heapgc.h
View File

@ -145,7 +145,6 @@ RMARKED__(CELL* ptr USES_REGS)
return mcell(ptr) & RMARK_BIT;
}
/* is the object pointed to by ptr marked as in a relocation chain? */
#if LONG_ADDRESSES
@ -171,4 +170,3 @@ void Yap_mark_external_reference(CELL *);
void Yap_inc_mark_variable(void);

9
H/hglobals.h
View File

@ -1,6 +1,6 @@
/* This file, hglobals.h, was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/GLOBALS instead */

/* This file, hglobals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/GLOBALS instead */
@ -78,9 +78,6 @@ typedef struct global_data {
char** argv_;
int argc_;
union flagTerm* Flags_;
UInt flagCount_;
#ifdef COROUTINING
ext_op attas_[attvars_ext+1];

6
H/hlocals.h
View File

@ -1,6 +1,6 @@
/* This file, hlocals.h, was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/LOCALS instead */

/* This file, hlocals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/LOCALS instead */
typedef struct worker_local {

9
H/hstruct.h
View File

@ -72,6 +72,7 @@
OPCODE orlast_op;
OPCODE undef_op;
OPCODE retry_userc_op;
OPCODE execute_cpred_op;
UInt n_of_atoms;
UInt atom_hash_table_size;
@ -156,9 +157,8 @@
union flagTerm* GLOBAL_Flags_;
UInt GLOBAL_flagCount_;
yap_exec_mode execution_mode;
@ -332,6 +332,9 @@
Int atom_translations;
Int max_atom_translations;
Int functor_translations;
Int max_functor_translations;
Atom empty_wakeups[MAX_EMPTY_WAKEUPS];
int max_empty_wakeups;

4
H/iatoms.h
View File

@ -1,5 +1,5 @@

/* This file, iatoms.h , was generated automatically by "yap -L misc/buildatoms"
/* This file, iatoms.h, was generated automatically by "yap -L misc/buildatoms"
please do not update, update misc/ATOMS instead */
Atom3Dots = Yap_LookupAtom("...");

9
H/iglobals.h
View File

@ -1,6 +1,6 @@
/* This file, iglobals.h, was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/GLOBALS instead */

/* This file, iglobals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/GLOBALS instead */
@ -78,9 +78,6 @@ static void InitGlobal(void) {
#ifdef COROUTINING

7
H/ihstruct.h
View File

@ -72,6 +72,7 @@
ORLAST_OPCODE = Yap_opcode(_or_last);
UNDEF_OPCODE = Yap_opcode(_undef_p);
RETRY_USERC_OPCODE = Yap_opcode(_retry_userc);
EXECUTE_CPRED_OPCODE = Yap_opcode(_execute_cpred);
@ -156,8 +157,7 @@
Yap_InitPlIO();
GLOBAL_Flags = 0;
Yap_InitFlags(true);
Yap_ExecutionMode = INTERPRETED;
@ -332,6 +332,9 @@
InitEmptyWakeups();
MaxEmptyWakeups = 0;

6
H/ilocals.h
View File

@ -1,6 +1,6 @@
/* This file, ilocals.h, was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/LOCALS instead */

/* This file, ilocals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/LOCALS instead */
static void InitWorker(int wid) {

4
H/ratoms.h
View File

@ -1,5 +1,5 @@

/* This file, ratoms.h , was generated automatically by "yap -L misc/buildatoms"
/* This file, ratoms.h, was generated automatically by "yap -L misc/buildatoms"
please do not update, update misc/ATOMS instead */
Atom3Dots = AtomAdjust(Atom3Dots);

9
H/rglobals.h
View File

@ -1,6 +1,6 @@
/* This file, rglobals.h, was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/GLOBALS instead */

/* This file, rglobals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/GLOBALS instead */
@ -78,9 +78,6 @@ static void RestoreGlobal(void) {
#ifdef COROUTINING

16
H/rheap.h
View File

@ -724,7 +724,7 @@ RestoreSWIAtoms__( USES_REGS1 )
for (i=0; i < AtomTranslations; i++) {
SWI_Atoms[i] = AtomAdjust(SWI_Atoms[i]);
}
for (j=0; j < N_SWI_FUNCTORS; j++) {
for (j=0; j < FunctorTranslations; j++) {
SWI_Functors[j] = FuncAdjust(SWI_Functors[j]);
}
RestoreSWIHash();
@ -1462,6 +1462,13 @@ RestoreEntries(PropEntry *pp, int int_key USES_REGS)
PropAdjust(he->NextOfPE);
}
break;
case MutexProperty:
{
HoldEntry *he = (HoldEntry *)pp;
he->NextOfPE =
PropAdjust(he->NextOfPE);
}
break;
case TranslationProperty:
{
TranslationEntry *he = (TranslationEntry *)pp;
@ -1469,6 +1476,13 @@ RestoreEntries(PropEntry *pp, int int_key USES_REGS)
PropAdjust(he->NextOfPE);
}
break;
case FlagProperty:
{
FlagEntry *he = (FlagEntry *)pp;
he->NextOfPE =
PropAdjust(he->NextOfPE);
}
break;
case ArrayProperty:
{
ArrayEntry *ae = (ArrayEntry *)pp;

7
H/rhstruct.h
View File

@ -72,6 +72,7 @@
ORLAST_OPCODE = Yap_opcode(_or_last);
UNDEF_OPCODE = Yap_opcode(_undef_p);
RETRY_USERC_OPCODE = Yap_opcode(_retry_userc);
EXECUTE_CPRED_OPCODE = Yap_opcode(_execute_cpred);
@ -157,8 +158,7 @@
RestoreFlags(GLOBAL_flagCount);
@ -332,6 +332,9 @@
RestoreEmptyWakeups();

6
H/rlocals.h
View File

@ -1,6 +1,6 @@
/* This file, rlocals.h, was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/LOCALS instead */

/* This file, rlocals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/LOCALS instead */
static void RestoreWorker(int wid USES_REGS) {

198
H/sshift.h
View File

@ -22,101 +22,101 @@
#define CharP(ptr) ((char *) (ptr))
#define CodeAdjust(P) CodeAdjust__(P PASS_REGS)
#define PtoTRAdjust(P) PtoTRAdjust__(P PASS_REGS)
#define BaseAddrAdjust(P) BaseAddrAdjust__(P PASS_REGS)
#define CutCAdjust(P) CutCAdjust__(P PASS_REGS)
#define ChoicePtrAdjust(P) ChoicePtrAdjust__(P PASS_REGS)
#define FuncAdjust(P) FuncAdjust__(P PASS_REGS)
#define AtomTermAdjust(P) AtomTermAdjust__(P PASS_REGS)
#define TermToGlobalOrAtomAdjust(P) TermToGlobalOrAtomAdjust__(P PASS_REGS)
#define AtomAdjust(P) AtomAdjust__(P PASS_REGS)
#define IsOldCode(P) IsOldCode__(P PASS_REGS)
#define IsOldLocal(P) IsOldLocal__(P PASS_REGS)
#define IsOldLocalPtr(P) IsOldLocalPtr__(P PASS_REGS)
#define IsOldCodeCellPtr(P) IsOldCodeCellPtr__(P PASS_REGS)
#define IsOldDelay(P) IsOldDelay__(P PASS_REGS)
#define IsOldDelayPtr(P) IsOldDelayPtr__(P PASS_REGS)
#define IsOldLocalInTR(P) IsOldLocalInTR__(P PASS_REGS)
#define IsOldLocalInTRPtr(P) IsOldLocalInTRPtr__(P PASS_REGS)
#define IsOldGlobal(P) IsOldGlobal__(P PASS_REGS)
#define IsOldGlobalPtr(P) IsOldGlobalPtr__(P PASS_REGS)
#define IsOldTrail(P) IsOldTrail__(P PASS_REGS)
#define IsOldTrailPtr(P) IsOldTrailPtr__(P PASS_REGS)
#define NoAGCAtomAdjust(P) NoAGCAtomAdjust__(P PASS_REGS)
// #define OrArgAdjust(P) OrArgAdjust__(P PASS_REGS)
// #define TabEntryAdjust(P) TabEntryAdjust__(P PASS_REGS)
// #define IntegerAdjust(D) IntegerAdjust__(P PASS_REGS)
#define AddrAdjust(P) AddrAdjust__(P PASS_REGS)
#define BlockAdjust(P) BlockAdjust__(P PASS_REGS)
#define CodeVarAdjust(P) CodeVarAdjust__(P PASS_REGS)
#define ConstantAdjust(P) ConstantAdjust__(P PASS_REGS)
#define ArityAdjust(P) ArityAdjust__(P PASS_REGS)
// #define DoubleInCodeAdjust(P) DoubleInCodeAdjust__(P PASS_REGS)
// #define IntegerInCodeAdjust(P) IntegerInCodeAdjust__(P PASS_REGS)
#define OpcodeAdjust(P) OpcodeAdjust__(P PASS_REGS)
#define ModuleAdjust(P) ModuleAdjust__(P PASS_REGS)
// #define ExternalFunctionAdjust(P) ExternalFunctionAdjust__(P PASS_REGS)
#define DBRecordAdjust(P) DBRecordAdjust__(P PASS_REGS)
#define PredEntryAdjust(P) PredEntryAdjust__(P PASS_REGS)
#define ModEntryPtrAdjust(P) ModEntryPtrAdjust__(P PASS_REGS)
#define AtomEntryAdjust(P) AtomEntryAdjust__(P PASS_REGS)
#define GlobalEntryAdjust(P) GlobalEntryAdjust__(P PASS_REGS)
#define BlobTermInCodeAdjust(P) BlobTermInCodeAdjust__(P PASS_REGS)
#define CellPtoHeapAdjust(P) CellPtoHeapAdjust__(P PASS_REGS)
#define PtoAtomHashEntryAdjust(P) PtoAtomHashEntryAdjust__(P PASS_REGS)
#define CellPtoHeapCellAdjust(P) CellPtoHeapCellAdjust__(P PASS_REGS)
#define CellPtoTRAdjust(P) CellPtoTRAdjust__(P PASS_REGS)
#define CodeAddrAdjust(P) CodeAddrAdjust__(P PASS_REGS)
#define ConsultObjAdjust(P) ConsultObjAdjust__(P PASS_REGS)
#define DelayAddrAdjust(P) DelayAddrAdjust__(P PASS_REGS)
#define DelayAdjust(P) DelayAdjust__(P PASS_REGS)
#define GlobalAdjust(P) GlobalAdjust__(P PASS_REGS)
#define DBRefAdjust(P,C) DBRefAdjust__(P PASS_REGS)
#define DBRefPAdjust(P) DBRefPAdjust__(P PASS_REGS)
#define DBTermAdjust(P) DBTermAdjust__(P PASS_REGS)
#define LUIndexAdjust(P) LUIndexAdjust__(P PASS_REGS)
#define SIndexAdjust(P) SIndexAdjust__(P PASS_REGS)
#define LocalAddrAdjust(P) LocalAddrAdjust__(P PASS_REGS)
#define GlobalAddrAdjust(P) GlobalAddrAdjust__(P PASS_REGS)
#define OpListAdjust(P) OpListAdjust__(P PASS_REGS)
#define PtoLUCAdjust(P) PtoLUCAdjust__(P PASS_REGS)
#define PtoStCAdjust(P) PtoStCAdjust__(P PASS_REGS)
#define PtoArrayEAdjust(P) PtoArrayEAdjust__(P PASS_REGS)
#define PtoArraySAdjust(P) PtoArraySAdjust__(P PASS_REGS)
#define PtoGlobalEAdjust(P) PtoGlobalEAdjust__(P PASS_REGS)
#define PtoDelayAdjust(P) PtoDelayAdjust__(P PASS_REGS)
#define PtoGloAdjust(P) PtoGloAdjust__(P PASS_REGS)
#define PtoLocAdjust(P) PtoLocAdjust__(P PASS_REGS)
#define PtoHeapCellAdjust(P) PtoHeapCellAdjust__(P PASS_REGS)
#define TermToGlobalAdjust(P) TermToGlobalAdjust__(P PASS_REGS)
#define PtoOpAdjust(P) PtoOpAdjust__(P PASS_REGS)
#define PtoLUClauseAdjust(P) PtoLUClauseAdjust__(P PASS_REGS)
#define PtoLUIndexAdjust(P) PtoLUIndexAdjust__(P PASS_REGS)
#define PtoDBTLAdjust(P) PtoDBTLAdjust__(P PASS_REGS)
#define PtoPredAdjust(P) PtoPredAdjust__(P PASS_REGS)
#define PtoPtoPredAdjust(P) PtoPtoPredAdjust__(P PASS_REGS)
#define OpRTableAdjust(P) OpRTableAdjust__(P PASS_REGS)
#define OpEntryAdjust(P) OpEntryAdjust__(P PASS_REGS)
#define PropAdjust(P) PropAdjust__(P PASS_REGS)
#define BlobTypeAdjust(P) BlobTypeAdjust__(P PASS_REGS)
#define TrailAddrAdjust(P) TrailAddrAdjust__(P PASS_REGS)
#define XAdjust(P) XAdjust__(P PASS_REGS)
#define YAdjust(P) YAdjust__(P PASS_REGS)
#define LocalAdjust(P) LocalAdjust__(P PASS_REGS)
#define TrailAdjust(P) TrailAdjust__(P PASS_REGS)
#define HoldEntryAdjust(P) HoldEntryAdjust__(P PASS_REGS)
#define CodeCharPAdjust(P) CodeCharPAdjust__(P PASS_REGS)
#define CodeConstCharPAdjust(P) CodeConstCharPAdjust__(P PASS_REGS)
#define CodeVoidPAdjust(P) CodeVoidPAdjust__(P PASS_REGS)
#define HaltHookAdjust(P) HaltHookAdjust__(P PASS_REGS)
#define TokEntryAdjust(P) TokEntryAdjust__(P PASS_REGS)
#define VarEntryAdjust(P) VarEntryAdjust__(P PASS_REGS)
#define ConsumerChoicePtrAdjust(P) ConsumerChoicePtrAdjust__(P PASS_REGS)
#define GeneratorChoicePtrAdjust(P) GeneratorChoicePtrAdjust__(P PASS_REGS)
#define IsHeapP(P) IsHeapP__(P PASS_REGS)
#define IsOldVarTableTrailPtr(P) IsOldVarTableTrailPtr__(P PASS_REGS)
#define IsOldTokenTrailPtr(P) IsOldTokenTrailPtr__(P PASS_REGS)
#define CodeAdjust(ptr) CodeAdjust__(ptr PASS_REGS)
#define PtoTRAdjust(ptr) PtoTRAdjust__(ptr PASS_REGS)
#define BaseAddrAdjust(ptr) BaseAddrAdjust__(ptr PASS_REGS)
#define CutCAdjust(ptr) CutCAdjust__(ptr PASS_REGS)
#define ChoicePtrAdjust(ptr) ChoicePtrAdjust__(ptr PASS_REGS)
#define FuncAdjust(ptr) FuncAdjust__(ptr PASS_REGS)
#define AtomTermAdjust(ptr) AtomTermAdjust__(ptr PASS_REGS)
#define TermToGlobalOrAtomAdjust(ptr) TermToGlobalOrAtomAdjust__(ptr PASS_REGS)
#define AtomAdjust(ptr) AtomAdjust__(ptr PASS_REGS)
#define IsOldCode(ptr) IsOldCode__(ptr PASS_REGS)
#define IsOldLocal(ptr) IsOldLocal__(ptr PASS_REGS)
#define IsOldLocalPtr(ptr) IsOldLocalPtr__(ptr PASS_REGS)
#define IsOldCodeCellPtr(ptr) IsOldCodeCellPtr__(ptr PASS_REGS)
#define IsOldDelay(ptr) IsOldDelay__(ptr PASS_REGS)
#define IsOldDelayPtr(ptr) IsOldDelayPtr__(ptr PASS_REGS)
#define IsOldLocalInTR(ptr) IsOldLocalInTR__(ptr PASS_REGS)
#define IsOldLocalInTRPtr(ptr) IsOldLocalInTRPtr__(ptr PASS_REGS)
#define IsOldGlobal(ptr) IsOldGlobal__(ptr PASS_REGS)
#define IsOldGlobalPtr(ptr) IsOldGlobalPtr__(ptr PASS_REGS)
#define IsOldTrail(ptr) IsOldTrail__(ptr PASS_REGS)
#define IsOldTrailPtr(ptr) IsOldTrailPtr__(ptr PASS_REGS)
#define NoAGCAtomAdjust(ptr) NoAGCAtomAdjust__(ptr PASS_REGS)
// #define OrArgAdjust(ptr) OrArgAdjust__(ptr PASS_REGS)
// #define TabEntryAdjust(ptr) TabEntryAdjust__(ptr PASS_REGS)
// #define IntegerAdjust(D) IntegerAdjust__(ptr PASS_REGS)
#define AddrAdjust(ptr) AddrAdjust__(ptr PASS_REGS)
#define BlockAdjust(ptr) BlockAdjust__(ptr PASS_REGS)
#define CodeVarAdjust(ptr) CodeVarAdjust__(ptr PASS_REGS)
#define ConstantAdjust(ptr) ConstantAdjust__(ptr PASS_REGS)
#define ArityAdjust(ptr) ArityAdjust__(ptr PASS_REGS)
// #define DoubleInCodeAdjust(ptr) DoubleInCodeAdjust__(ptr PASS_REGS)
// #define IntegerInCodeAdjust(ptr) IntegerInCodeAdjust__(ptr PASS_REGS)
#define OpcodeAdjust(ptr) OpcodeAdjust__(ptr PASS_REGS)
#define ModuleAdjust(ptr) ModuleAdjust__(ptr PASS_REGS)
// #define ExternalFunctionAdjust(ptr) ExternalFunctionAdjust__(ptr PASS_REGS)
#define DBRecordAdjust(ptr) DBRecordAdjust__(ptr PASS_REGS)
#define PredEntryAdjust(ptr) PredEntryAdjust__(ptr PASS_REGS)
#define ModEntryPtrAdjust(ptr) ModEntryPtrAdjust__(ptr PASS_REGS)
#define AtomEntryAdjust(ptr) AtomEntryAdjust__(ptr PASS_REGS)
#define GlobalEntryAdjust(ptr) GlobalEntryAdjust__(ptr PASS_REGS)
#define BlobTermInCodeAdjust(ptr) BlobTermInCodeAdjust__(ptr PASS_REGS)
#define CellPtoHeapAdjust(ptr) CellPtoHeapAdjust__(ptr PASS_REGS)
#define PtoAtomHashEntryAdjust(ptr) PtoAtomHashEntryAdjust__(ptr PASS_REGS)
#define CellPtoHeapCellAdjust(ptr) CellPtoHeapCellAdjust__(ptr PASS_REGS)
#define CellPtoTRAdjust(ptr) CellPtoTRAdjust__(ptr PASS_REGS)
#define CodeAddrAdjust(ptr) CodeAddrAdjust__(ptr PASS_REGS)
#define ConsultObjAdjust(ptr) ConsultObjAdjust__(ptr PASS_REGS)
#define DelayAddrAdjust(ptr) DelayAddrAdjust__(ptr PASS_REGS)
#define DelayAdjust(ptr) DelayAdjust__(ptr PASS_REGS)
#define GlobalAdjust(ptr) GlobalAdjust__(ptr PASS_REGS)
#define DBRefAdjust(ptr,C) DBRefAdjust__(ptr PASS_REGS)
#define DBRefPAdjust(ptr) DBRefPAdjust__(ptr PASS_REGS)
#define DBTermAdjust(ptr) DBTermAdjust__(ptr PASS_REGS)
#define LUIndexAdjust(ptr) LUIndexAdjust__(ptr PASS_REGS)
#define SIndexAdjust(ptr) SIndexAdjust__(ptr PASS_REGS)
#define LocalAddrAdjust(ptr) LocalAddrAdjust__(ptr PASS_REGS)
#define GlobalAddrAdjust(ptr) GlobalAddrAdjust__(ptr PASS_REGS)
#define OpListAdjust(ptr) OpListAdjust__(ptr PASS_REGS)
#define PtoLUCAdjust(ptr) PtoLUCAdjust__(ptr PASS_REGS)
#define PtoStCAdjust(ptr) PtoStCAdjust__(ptr PASS_REGS)
#define PtoArrayEAdjust(ptr) PtoArrayEAdjust__(ptr PASS_REGS)
#define PtoArraySAdjust(ptr) PtoArraySAdjust__(ptr PASS_REGS)
#define PtoGlobalEAdjust(ptr) PtoGlobalEAdjust__(ptr PASS_REGS)
#define PtoDelayAdjust(ptr) PtoDelayAdjust__(ptr PASS_REGS)
#define PtoGloAdjust(ptr) PtoGloAdjust__(ptr PASS_REGS)
#define PtoLocAdjust(ptr) PtoLocAdjust__(ptr PASS_REGS)
#define PtoHeapCellAdjust(ptr) PtoHeapCellAdjust__(ptr PASS_REGS)
#define TermToGlobalAdjust(ptr) TermToGlobalAdjust__(ptr PASS_REGS)
#define PtoOpAdjust(ptr) PtoOpAdjust__(ptr PASS_REGS)
#define PtoLUClauseAdjust(ptr) PtoLUClauseAdjust__(ptr PASS_REGS)
#define PtoLUIndexAdjust(ptr) PtoLUIndexAdjust__(ptr PASS_REGS)
#define PtoDBTLAdjust(ptr) PtoDBTLAdjust__(ptr PASS_REGS)
#define PtoPredAdjust(ptr) PtoPredAdjust__(ptr PASS_REGS)
#define PtoPtoPredAdjust(ptr) PtoPtoPredAdjust__(ptr PASS_REGS)
#define OpRTableAdjust(ptr) OpRTableAdjust__(ptr PASS_REGS)
#define OpEntryAdjust(ptr) OpEntryAdjust__(ptr PASS_REGS)
#define PropAdjust(ptr) PropAdjust__(ptr PASS_REGS)
#define BlobTypeAdjust(ptr) BlobTypeAdjust__(ptr PASS_REGS)
#define TrailAddrAdjust(ptr) TrailAddrAdjust__(ptr PASS_REGS)
#define XAdjust(ptr) XAdjust__(ptr PASS_REGS)
#define YAdjust(ptr) YAdjust__(ptr PASS_REGS)
#define LocalAdjust(ptr) LocalAdjust__(ptr PASS_REGS)
#define TrailAdjust(ptr) TrailAdjust__(ptr PASS_REGS)
#define HoldEntryAdjust(ptr) HoldEntryAdjust__(ptr PASS_REGS)
#define CodeCharPAdjust(ptr) CodeCharPAdjust__(ptr PASS_REGS)
#define CodeConstCharPAdjust(ptr) CodeConstCharPAdjust__(ptr PASS_REGS)
#define CodeVoidPAdjust(ptr) CodeVoidPAdjust__(ptr PASS_REGS)
#define HaltHookAdjust(ptr) HaltHookAdjust__(ptr PASS_REGS)
#define TokEntryAdjust(ptr) TokEntryAdjust__(ptr PASS_REGS)
#define VarEntryAdjust(ptr) VarEntryAdjust__(ptr PASS_REGS)
#define ConsumerChoicePtrAdjust(ptr) ConsumerChoicePtrAdjust__(ptr PASS_REGS)
#define GeneratorChoicePtrAdjust(ptr) GeneratorChoicePtrAdjust__(ptr PASS_REGS)
#define IsHeapP(ptr) IsHeapP__(ptr PASS_REGS)
#define IsOldVarTableTrailPtr(ptr) IsOldVarTableTrailPtr__(ptr PASS_REGS)
#define IsOldTokenTrailPtr(ptr) IsOldTokenTrailPtr__(ptr PASS_REGS)
#include "inline-only.h"
INLINE_ONLY inline EXTERN int IsHeapP__ (CELL * CACHE_TYPE);
@ -131,8 +131,8 @@ IsHeapP__ (CELL * ptr USES_REGS)
#endif
}
#define OrArgAdjust(P)
#define TabEntryAdjust(P)
#define OrArgAdjust(ptr)
#define TabEntryAdjust(ptr)
/* Adjusting cells and pointers to cells */
@ -840,6 +840,8 @@ TermToGlobalOrAtomAdjust__ (Term t USES_REGS)
return t;
}
#if USE_THREADED_CODE
INLINE_ONLY inline EXTERN op_entry *OpRTableAdjust__ (op_entry * CACHE_TYPE);
INLINE_ONLY inline EXTERN op_entry *
@ -848,6 +850,8 @@ OpRTableAdjust__ (op_entry * ptr USES_REGS)
return (op_entry *) (((op_entry *) (CharP (ptr) + LOCAL_HDiff)));
}
#endif // USE_THREADED_CODE
INLINE_ONLY inline EXTERN OpEntry *OpEntryAdjust__ (OpEntry * CACHE_TYPE);
INLINE_ONLY inline EXTERN OpEntry *

4
H/tatoms.h
View File

@ -1,5 +1,5 @@

/* This file, tatoms.h , was generated automatically by "yap -L misc/buildatoms"
/* This file, tatoms.h, was generated automatically by "yap -L misc/buildatoms"
please do not update, update misc/ATOMS instead */
Atom Atom3Dots_;

43
JIT/CMakeLists.txt
View File

@ -4,21 +4,28 @@ set(LIBJIT_PATCH_VERSION 0)
set(LIBJIT_FULL_VERSION
${LIBJIT_MAJOR_VERSION}.${LIBJIT_MINOR_VERSION}.${LIBJIT_PATCH_VERSION})
set(LIBJIT_SOURCES
jit_analysispreds.c
jit_configpreds.c
jit_statisticpreds.c
jit_codegenpreds.c
jit_debugpreds.c
jit_traced.c
jit_transformpreds.c
JIT_Compiler.cpp
JIT_Init.cpp
HPP/JIT.hpp
HPP/JIT_Compiler.hpp
HPP/jit_predicates.hpp
set(LIBJIT_SOURCES
jit_analysispreds.c
jit_configpreds.c
jit_statisticpreds.c
jit_codegenpreds.c
jit_debugpreds.c
jit_traced.c
jit_transformpreds.c
JIT_Compiler.cpp
JIT_Init.cpp
)
set(LIBJIT_HEADERS
HPP/JIT.hpp
HPP/JIT_Compiler.hpp
HPP/jit_predicates.hpp
../OPTYap/traced_or.insts.h
../OPTYap/traced_tab.insts.h
../OPTYap/traced_tab.tries.insts.h
../C/traced_absmi_insts.h
)
# The following variables are defined:
# LLVM_FOUND - true if LLVM was found
# LLVM_CXXFLAGS - C++ compiler flags for files that include LLVM headers.
@ -43,14 +50,20 @@ set(LIBJIT_SOURCES
# system default locations such as /usr/local/bin. Executing find_program()
# multiples times is the approach recommended in the docs.
macro_optional_find_package (LLVM OFF)
macro_log_feature (LLVM_FOUND "LLVM JIT generator"
"The LLVM Compiler Infrastructure" "http://www.llvm.org")
set (YAP_JIT ${LLVM_FOUND} SCOPE GLOBAL)
# ugh
set (POSITION_INDEPENDENT_CODE TRUE)
set(CMAKE_CXX_FLAGS ${CMAKE_CXX_FLAGS} ${LLVM_CXXFLAGS})
add_library (libyapjit SHARED
${LIBJIT_SOURCES})
${LIBJIT_SOURCES}
${LIBJIT_HEADERS}
)
set_target_properties(libyapjit
PROPERTIES

2
JIT/JIT_Init.cpp
View File

@ -31,6 +31,8 @@ extern "C" void shutdown_llvm() { llvm_shutdown(); }
extern "C" Int traced_absmi();
#define JIT_CODE 1
static void
initJit(void)
{

2
JIT/jit_analysispreds.c
View File

@ -78,6 +78,8 @@ static Int p_analysis_output_file( USES_REGS1 );
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wimplicit-function-declaration"
#define JIT_CODE 1
static Int
p_disable_analysis_pass( USES_REGS1 )
{

2
JIT/jit_configpreds.c
View File

@ -15,6 +15,8 @@
* Last rev: 2013-10-18 *
*************************************************************************/
#define JIT_CODE 1
#include "jit_predicates.hpp"
#include <math.h>

2
JIT/jit_debugpreds.c
View File

@ -15,6 +15,8 @@
* Last rev: 2013-10-18 *
*************************************************************************/
#define JIT_CODE 1
#include "jit_predicates.hpp"
#if YAP_DBG_PREDS

2
JIT/jit_statisticpreds.c
View File

@ -15,6 +15,8 @@
* Last rev: 2013-10-18 *
*************************************************************************/
#define JIT_CODE 1
#include "jit_predicates.hpp"
#if YAP_STAT_PREDS

46
JIT/jit_traced.c
View File

@ -10,7 +10,7 @@
* *
* File: jit_traced.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2008-08-13 01:16:26 $,$Author: vsc $ *
* Last: $Date: 2008-08-13 01:16:26 $,$Author: vsc $ *
* *
*************************************************************************/
@ -33,17 +33,20 @@ boils down to a recursive loop of the form:
loop(Env) :-
do_something(Env,NewEnv),
loop(NewEnv).
~~~~~
~~~~
*/
#if YAP_JIT
#define YAP_TRACED 1
#define IN_ABSMI_C 1
//#define __YAP_TRACED 1
#define IN_TRACED_ABSMI_C 1
// #ifndef _NATIVE
#define HAS_CACHE_REGS 1
#include "absmi.h"
#include "heapgc.h"
@ -51,9 +54,7 @@ loop(Env) :-
Int traced_absmi(void);
#ifdef PUSH_X
#else
#ifndef PUSH_X
/* keep X as a global variable */
Term Yap_XREGS[MaxTemps]; /* 29 */
@ -130,7 +131,7 @@ traced_absmi(void)
static void *OpAddress[] =
{
#define OPCODE(OP,TYPE) && OP
#define OPCODE(OP,TYPE) && _##OP
#include "YapOpcodes.h"
#undef OPCODE
};
@ -159,7 +160,7 @@ NativeArea->area.compilation_time = NULL;
NativeArea->area.native_size_bytes = NULL;
NativeArea->area.trace_size_bytes = NULL;
NativeArea->success = NULL;
NativeArea->runs = NULL;
->runs = NULL;
NativeArea->t_runs = NULL;
#endif
NativeArea->n = 0;
@ -191,21 +192,22 @@ CACHE_A1();
op_numbers opcode = _Ystop;
goto critical_lbl;
//nextop_write:
nextop_write:
opcode = Yap_op_from_opcode( PREG->y_u.o.opcw );
goto op_switch;
// nextop:
nextop:
opcode = Yap_op_from_opcode( PREG->opc );
op_switch:
#if !USE_THREADED_CODE
switch (opcode) {
#endif
#if !OS_HANDLES_TR_OVERFLOW
notrailleft:
/* if we are within indexing code, the system may have to
@ -236,12 +238,10 @@ CACHE_A1();
}
}
goto reset_absmi;
#endif /* OS_HANDLES_TR_OVERFLOW */
#endif
// move instructions to separate file
// so that they are easier to analyse.
#if YAP_JIT
#include "../C/traced_absmi_insts.h"
#if YAPOR
#include "../OPTYap/traced_or.insts.h"
@ -250,14 +250,16 @@ CACHE_A1();
#include "../OPTYap/traced_tab.insts.h"
#include "../OPTYap/traced_tab.tries.insts.h"
#endif
#endif
default:
#if _NATIVE
default:
saveregs();
Yap_Error(SYSTEM_ERROR, MkIntegerTerm(opcode), "trying to execute invalid YAAM instruction %d", opcode);
setregs();
FAIL();
}
#endif
}
return (0);

2
JIT/jit_transformpreds.c
View File

@ -15,6 +15,8 @@
* Last rev: 2013-10-18 *
*************************************************************************/
#define JIT_CODE 1
#include "jit_predicates.hpp"
#define N_TRANSFORM_PASSES 69

8
OPTYap/opt.preds.c
View File

@ -379,9 +379,11 @@ static Int p_table( USES_REGS1 ) {
return (TRUE); /* predicate already tabled */
if (pe->cs.p_code.FirstClause)
return (FALSE); /* predicate already compiled */
pe->PredFlags |= TabledPredFlag;
new_table_entry(tab_ent, pe, at, arity, mode_directed);
pe->TableOfPred = tab_ent;
if (!(pe->PredFlags & TabledPredFlag)) {
pe->PredFlags |= TabledPredFlag;
new_table_entry(tab_ent, pe, at, arity, mode_directed);
pe->TableOfPred = tab_ent;
}
return (TRUE);
}

6
OPTYap/tab.insts.h
View File

@ -472,7 +472,9 @@
check_trail(TR);
tab_ent = PREG->y_u.Otapl.te;
YENV2MEM;
sg_fr = subgoal_search(PREG, YENV_ADDRESS);
saveregs();
sg_fr = subgoal_search(PREG, YENV_ADDRESS);
setregs();
MEM2YENV;
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
if (SgFr_state(sg_fr) <= ready) {
@ -640,7 +642,9 @@
check_trail(TR);
tab_ent = PREG->y_u.Otapl.te;
YENV2MEM;
saveregs();
sg_fr = subgoal_search(PREG, YENV_ADDRESS);
setregs();
MEM2YENV;
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
if (SgFr_state(sg_fr) <= ready) {

15
absmi-threaded.h Normal file
View File

@ -0,0 +1,15 @@
//
// Select the best yaam defines
// for threaeded AM execution
//
// Created by VITOR SANTOS COSTA on 02/08/15.
//
//
#ifndef Absmi_Threaded_
#define Absmi_Threaded_hb
#endif

5
cmake/Sources.cmake
View File

@ -34,7 +34,7 @@ set (ENGINE_SOURCES
C/attvar.c
C/bignum.c
C/bb.c
C/blobs.c
C/blobs.c
C/cdmgr.c
C/cmppreds.c
C/compiler.c
@ -114,6 +114,9 @@ set(C_INTERFACE_SOURCES
H/Regs.h
H/Yapproto.h
H/absmi.h
H/absmi-switch.h
H/absmi-threaded.h
H/absmi-traced.h
H/alloc.h
H/amidefs.h
H/amiops.h

37
config.h.cmake
View File

@ -14,6 +14,36 @@
#cmakedefine AC_APPLE_UNIVERSAL_BUILD "${AC_APPLE_UNIVERSAL_BUILD}"
#endif
/* Are we compiling with support for depth limitT? */
#ifndef DEPTH_LIMIT
#define DEPTH_LIMIT 1
#endif
/* Are we compiling with inlined emulator instructionsT? */
#ifndef USE_THREADED_CODE
#define USE_THREADED_CODE 1
#endif
/* Are we compiling with support for TABLINGtT? */
#ifndef TABLING
#define TABLING 1
#endif
/* Are we compiling with support for WAM level tracing? */
#ifndef LOW_LEVEL_TRACER
#define LOW_LEVEL_TRACER 1
#endif
/* Are we compiling with support for threads? */
#ifndef THREADS
#cmakedefine THREADS "$YAP_THREADS"
#endif
/* Are we compiling with support for clause just-in-time compilationT? */
#ifndef YAP_JIT
#cmakedefine YAP_JIT "$YAP_JIT"
#endif
/* longs should be in addresses that are multiple of four. */
#ifndef ALIGN_LONGS
#define ALIGN_LONGS 1
@ -1581,7 +1611,7 @@ signal. */
#endif
/* max number of threads, default 1 or 1024 */
#ifndef MAX_THREADS
#ifndef MAX_THRADS
#cmakedefine MAX_THREADS ${MAX_THREADS}
#endif
@ -1815,11 +1845,6 @@ signal. */
#cmakedefine USE_SYSTEM_SHM ${USE_SYSTEM_SHM}
#endif
/* threaded emulator */
#ifndef USE_THREADED_CODE
#cmakedefine USE_THREADED_CODE ${USE_THREADED_CODE}
#endif
/* Whether daylight savings time offset is set via the altzone variable */
#ifndef USE_TIME_ALTZONE
#cmakedefine USE_TIME_ALTZONE ${USE_TIME_ALTZONE}

8
include/YapError.h
View File

@ -39,6 +39,7 @@ typedef enum
DOMAIN_ERROR_OUT_OF_RANGE,
DOMAIN_ERROR_OPERATOR_PRIORITY,
DOMAIN_ERROR_OPERATOR_SPECIFIER,
DOMAIN_ERROR_PROLOG_FLAG,
DOMAIN_ERROR_RADIX,
DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW,
DOMAIN_ERROR_SOURCE_SINK,
@ -137,7 +138,7 @@ typedef enum
#define JMP_LOCAL_ERROR(v, LAB) \
if (H + 2*(v) > ASP-1024) { \
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;\
LOCAL_Error_Term = t;\
LOCAL_Error_Term = TermNilnnnnnnnnnnnnnnnnnnnnnnnnnn;\
LOCAL_Error_Size = 2*(v)*sizeof(CELL);\
goto LAB; \
}
@ -145,15 +146,14 @@ typedef enum
#define LOCAL_ERROR(v) \
if (HR + (v) > ASP-1024) { \
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;\
LOCAL_Error_Term = t;\
LOCAL_Error_Term = TermNil;\
LOCAL_Error_Size = 2*(v)*sizeof(CELL);\
return NULL; \
}
#define LOCAL_TERM_ERROR(v) \
if (HR + (v) > ASP-1024) { \
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;\
LOCAL_Error_Term = t;\
;\
LOCAL_Error_Size = 2*(v)*sizeof(CELL);\
return 0L; \
}

4
include/YapInterface.h
View File

@ -2151,6 +2151,10 @@ extern X_API YAP_Int YAP_AtomToInt(YAP_Atom At);
extern X_API YAP_Atom YAP_IntToAtom(YAP_Int i);
extern X_API YAP_Int YAP_FunctorToInt(YAP_Functor At);
extern X_API YAP_Functor YAP_IntToFunctor(YAP_Int i);
#define YAP_InitCPred(N,A,F) YAP_UserCPredicate(N,F,A)
__END_DECLS

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

@ -113,19 +113,6 @@ YAP_PLArityOfSWIFunctor(functor_t f) {
return ArityOfFunctor((Functor)f);
}
void
Yap_InitSWIHash(void)
{
int i, j;
for (i=0; i < N_SWI_ATOMS; i++) {
Yap_PutAtomTranslation( SWI_Atoms[i], i );
}
AtomTranslations = N_SWI_ATOMS;
for (j=0; j < N_SWI_FUNCTORS; j++) {
add_to_hash(j, (ADDR)SWI_Functors[j]);
}
}
static void
UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int flags)
{
@ -145,6 +132,41 @@ UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int f
* */
static UInt
cvtFlags( unsigned flags )
{
UInt inptype = 0;
if (flags & CVT_ATOM) {
inptype |= YAP_STRING_ATOM;
}
if (flags & CVT_STRING) {
inptype |= YAP_STRING_STRING;
}
if (flags & CVT_LIST) {
inptype |= (YAP_STRING_CODES|YAP_STRING_ATOMS);
}
if (flags & CVT_INTEGER) {
inptype |= YAP_STRING_INT|YAP_STRING_BIG;
}
if (flags & CVT_FLOAT) {
inptype |= YAP_STRING_FLOAT;
}
if (flags & CVT_VARIABLE) {
inptype |= YAP_STRING_TERM;
}
if (flags & CVT_WRITE) {
inptype |= YAP_STRING_TERM;
}
if (flags & CVT_WRITEQ) {
inptype |= YAP_STRING_TERM|YAP_STRING_WQ;
}
if (flags & CVT_WRITE_CANONICAL) {
inptype |= YAP_STRING_TERM|YAP_STRING_WC;
}
return inptype;
}
/* void PL_agc_hook(void) */
/** @brief Atom garbage collection hook
*
@ -187,92 +209,33 @@ Text is in ISO Latin-1 encoding and the call fails if text cannot be represented
X_API int
PL_get_nchars(term_t l, size_t *lengthp, char **s, unsigned flags)
{ CACHE_REGS
seq_tv_t inp;
seq_tv_t inp, out;
size_t leng;
encoding_t enc;
int minimal;
void *buf;
char b[1024];
buf = b;
void *buf = NULL;
inp.val.t = Yap_GetFromSlot( l );
inp.type = 0;
if (flags & CVT_ATOM) {
inp.type |= YAP_STRING_ATOM;
}
if (flags & CVT_ATOM) {
inp.type |= YAP_STRING_STRING;
}
if (flags & CVT_LIST) {
inp.type |= YAP_STRING_CODES;
}
if (flags & CVT_INTEGER) {
inp.type |= YAP_STRING_INT|YAP_STRING_BIG;
}
if (flags & CVT_FLOAT) {
inp.type |= YAP_STRING_FLOAT;
}
if (flags & CVT_VARIABLE) {
inp.type |= YAP_STRING_TERM;
}
if (flags & CVT_WRITE) {
inp.type |= YAP_STRING_TERM;
}
if (flags & CVT_WRITEQ) {
inp.type |= YAP_STRING_TERM|YAP_STRING_WQ;
}
if (flags & CVT_WRITE_CANONICAL) {
inp.type |= YAP_STRING_TERM|YAP_STRING_WC;
}
inp.type = cvtFlags( flags );
if (flags & (BUF_DISCARDABLE|BUF_RING)) {
inp.val.c = LOCAL_FileNameBuf;
buf = LOCAL_FileNameBuf;
leng = YAP_FILENAME_MAX-1;
} else {
buf = NULL;
}
if (flags & BUF_MALLOC) {
inp.val.c = PL_malloc(1024);
leng = 1023;
out.type = YAP_STRING_CHARS;
if (flags & (REP_UTF8|REP_MB)) {
out.enc = ENC_ISO_UTF8;
} else {
out.enc = ENC_ISO_LATIN1;
}
if (!Yap_readText( buf , &inp, & enc, &minimal, & leng PASS_REGS) )
return false;
if (enc == ENC_ISO_UTF8) {
if (flags & REP_UTF8) {
*s = buf;
*lengthp = leng;
return true;
} else if (flags & REP_ISO_LATIN_1) {
char *nptr = buf;
const char *optr = buf;
int chr;
while ((optr = _PL__utf8_get_char(optr, &chr))) {
if (chr > 255) {
if (flags & BUF_MALLOC) {
return false;
}
}
*nptr++ = chr;
}
*nptr = '\0';
*s = buf;
*lengthp = leng;
} else /* wide */ {
size_t sz = utf8_strlen1(buf)+1;
const char *optr = buf;
wchar_t *nptr, *n = buf;
int chr;
if (sz <= 1024)
n = nptr = (wchar_t *)malloc(sz);
while ((optr = _PL__utf8_get_char(optr, &chr))) {
*nptr++ = chr;
}
*nptr = '\0';
*s = buf;
*lengthp = leng;
// handle encodings ltaer
}
}
return false;
if (flags & BUF_MALLOC)
out.type |= YAP_STRING_MALLOC;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return false;
*s = out.val.c;
if (lengthp)
*lengthp = out.sz;
return true;
}
@ -284,92 +247,28 @@ PL_get_chars(term_t t, char **s, unsigned flags)
int PL_get_wchars(term_t l, size_t *lengthp, wchar_t **s, unsigned flags)
{
CACHE_REGS
seq_tv_t inp;
seq_tv_t inp, out;
size_t leng;
encoding_t enc;
int minimal;
void *buf;
char b[1024];
buf = b;
void *buf = NULL;
inp.val.t = Yap_GetFromSlot( l );
inp.type = 0;
if (flags & CVT_ATOM) {
inp.type |= YAP_STRING_ATOM;
}
if (flags & CVT_ATOM) {
inp.type |= YAP_STRING_STRING;
}
if (flags & CVT_LIST) {
inp.type |= YAP_STRING_CODES;
}
if (flags & CVT_INTEGER) {
inp.type |= YAP_STRING_INT|YAP_STRING_BIG;
}
if (flags & CVT_FLOAT) {
inp.type |= YAP_STRING_FLOAT;
}
if (flags & CVT_VARIABLE) {
inp.type |= YAP_STRING_TERM;
}
if (flags & CVT_WRITE) {
inp.type |= YAP_STRING_TERM;
}
if (flags & CVT_WRITEQ) {
inp.type |= YAP_STRING_TERM|YAP_STRING_WQ;
}
if (flags & CVT_WRITE_CANONICAL) {
inp.type |= YAP_STRING_TERM|YAP_STRING_WC;
}
inp.type = cvtFlags( flags );
if (flags & (BUF_DISCARDABLE|BUF_RING)) {
inp.val.c = LOCAL_FileNameBuf;
buf = LOCAL_FileNameBuf;
leng = YAP_FILENAME_MAX-1;
} else {
buf = NULL;
}
if (flags & BUF_MALLOC) {
inp.val.w = PL_malloc(1024*SIZEOF_WCHAR_T);
leng = 1023;
}
if (!Yap_readText( buf , &inp, & enc, &minimal, & leng PASS_REGS) )
return false;
if (enc == ENC_ISO_UTF8) {
if (flags & REP_UTF8) {
*s = buf;
*lengthp = leng;
return true;
} else if (flags & REP_ISO_LATIN_1) {
char *nptr = buf;
const char *optr = buf;
int chr;
while ((optr = _PL__utf8_get_char(optr, &chr))) {
if (chr > 255) {
if (flags & BUF_MALLOC) {
return false;
}
}
*nptr++ = chr;
}
*nptr = '\0';
*s = buf;
*lengthp = leng;
} else /* wide */ {
size_t sz = utf8_strlen1(buf)+1;
const char *optr = buf;
wchar_t *nptr, *n = buf;
int chr;
if (sz <= 1024)
n = nptr = (wchar_t *)malloc(sz*SIZEOF_WCHAR_T);
while ((optr = _PL__utf8_get_char(optr, &chr))) {
*nptr++ = chr;
}
*nptr = '\0';
*s = buf;
*lengthp = leng;
// handle encodings later
}
}
return false;
out.type = YAP_STRING_WCHARS;
if (flags & BUF_MALLOC)
out.type |= YAP_STRING_MALLOC;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return false;
*s = out.val.w;
if (lengthp)
*lengthp = out.sz;
return true;
}
X_API int
@ -378,7 +277,7 @@ PL_unify_chars(term_t l, int flags, size_t length, const char *s)
seq_tv_t inp, out;
if (flags & REP_UTF8) {
inp.val.c = s;
inp.val.c0 = s;
if (length != (size_t)-1) {
inp.sz = length;
inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS;
@ -399,8 +298,8 @@ PL_unify_chars(term_t l, int flags, size_t length, const char *s)
out.max = length;
}
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
return out.val.t;
return 0L;
return Yap_unify( Yap_GetFromSlot(l), out.val.t );
}

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

@ -57,18 +57,6 @@ add_to_hash(Int i, ADDR key)
SWI_ReverseHash[h].pos = i;
}
static atom_t
in_hash(ADDR key)
{
UInt h = addr_hash(key);
while (SWI_ReverseHash[h].key) {
if (SWI_ReverseHash[h].key == key)
return SWI_ReverseHash[h].pos;
h = (h+1)%N_SWI_HASH;
}
return 0;
}
static inline Term
SWIModuleToModule(module_t m)
@ -89,7 +77,7 @@ AtomToSWIAtom(Atom at)
{
TranslationEntry *p;
if ((p = Yap_GetTranslationProp(at)) != NULL)
if ((p = Yap_GetTranslationProp(at,0)) != NULL)
return (atom_t)(p->Translation*2+1);
return (atom_t)at;
}
@ -104,25 +92,25 @@ SWIAtomToAtom(atom_t at)
return (Atom)at;
}
static inline functor_t
FunctorToSWIFunctor(Functor f)
{
TranslationEntry *p;
Atom at = NameOfFunctor(f);
arity_t ar = ArityOfFunctor(f);
if ((p = Yap_GetTranslationProp(at,ar)) != NULL)
return (functor_t)(p->Translation*2+1);
return (functor_t)f;
}
/* This is silly, but let's keep it like that for now */
static inline Functor
SWIFunctorToFunctor(functor_t f)
{
if (((CELL)(f) & 2) && ((CELL)f) < N_SWI_FUNCTORS*4+2)
return SWI_Functors[((CELL)f)/4];
if ((CELL)f & 1)
return SWI_Functors[f/2];
return (Functor)f;
}
static inline functor_t
FunctorToSWIFunctor(Functor at)
{
atom_t ats;
if ((ats = in_hash((ADDR)at)))
return (functor_t)((CELL)ats*4+2);
return (functor_t)at;
}
#define isDefinedProcedure(pred) TRUE // TBD
int Yap_write_blob(AtomEntry *ref, FILE *stream);

4
misc/GLOBALS
View File

@ -88,10 +88,6 @@ lockvar StreamDescLock MkLock
char** argv void
int argc void
// Prolog execution and state flags
union flagTerm* Flags void
UInt flagCount void
// extensions to Terms
#ifdef COROUTINING
/* array with the ops for your favourite extensions */

12
misc/HEAPFIELDS
View File

@ -57,7 +57,7 @@ UInt MaxStack_ MaxStack =0 void
UInt MaxTrail_ MaxTrail =0 void
/* execution info */
/* OPCODE TABLE, needed to recover op tables */
/* OPCODE REVERSE TABLE, needed to recover op tables */
#if USE_THREADED_CODE
op_entry *op_rtable OP_RTABLE void OpRTableAdjust
#endif
@ -71,6 +71,7 @@ OPCODE lockpred_op LOCKPRED_OPCODE MkOp _lock_pred
OPCODE orlast_op ORLAST_OPCODE MkOp _or_last
OPCODE undef_op UNDEF_OPCODE MkOp _undef_p
OPCODE retry_userc_op RETRY_USERC_OPCODE MkOp _retry_userc
OPCODE execute_cpred_op EXECUTE_CPRED_OPCODE MkOp _execute_cpred
/* atom tables */
UInt n_of_atoms NOfAtoms void void
@ -163,9 +164,8 @@ void void void Yap_InitModules() void
// don't actually want to define a field
void void void Yap_InitPlIO() void
// make sure we have the flags set at this point.
// don't actually want to define a field
void void void Yap_InitFlags(true) void
union flagTerm* GLOBAL_Flags_ GLOBAL_Flags =0 void
UInt GLOBAL_flagCount_ GLOBAL_flagCount Yap_InitFlags(true) RestoreFlags(GLOBAL_flagCount)
/* Anderson's JIT */
yap_exec_mode execution_mode Yap_ExecutionMode =INTERPRETED void
@ -370,6 +370,10 @@ struct swi_reverse_hash swi_reverse_hash[N_SWI_HASH] SWI_ReverseHash void void
Int atom_translations AtomTranslations void void
Int max_atom_translations MaxAtomTranslations void void
/* integer access to functors */
Int functor_translations FunctorTranslations void void
Int max_functor_translations MaxFunctorTranslations void void
Atom empty_wakeups[MAX_EMPTY_WAKEUPS] EmptyWakeups InitEmptyWakeups() RestoreEmptyWakeups()
int max_empty_wakeups MaxEmptyWakeups =0

12
os/charsio.c
View File

@ -447,7 +447,7 @@ put_char ( USES_REGS1 )
int ch;
int sno;
if (IsVarTerm(t2 = Deref(ARG1))) {
if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1");
return FALSE;
} else if (!IsAtomTerm (t2)) {
@ -480,7 +480,7 @@ tab_1 ( USES_REGS1 )
int sno = LOCAL_c_output_stream;
Term t2;
Int tabs, i;
if (IsVarTerm(t2 = Deref(ARG1))) {
if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1");
return FALSE;
} else if (!IsIntegerTerm (t2)) {
@ -514,7 +514,7 @@ tab ( USES_REGS1 )
int sno = LOCAL_c_output_stream;
Term t2;
Int tabs, i;
if (IsVarTerm(t2 = Deref(ARG1))) {
if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1");
return FALSE;
} else if (!IsIntegerTerm (t2)) {
@ -588,7 +588,7 @@ put_byte ( USES_REGS1 )
{ /* '$put_byte'(Stream,N) */
Term t2;
Int ch;
if (IsVarTerm(t2 = Deref(ARG1))) {
if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1");
return FALSE;
} else if (!IsIntegerTerm (t2)) {
@ -653,7 +653,7 @@ skip_1 ( USES_REGS1 )
int sno;
int ch;
if (IsVarTerm(t2 = Deref(ARG1))) {
if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "skip/2");
return FALSE;
} else if (!IsIntegerTerm (t2)) {
@ -843,7 +843,7 @@ peek_code_1 ( USES_REGS1 )
if ((ch = dopeek( sno )) < 0)
return false;
UNLOCK(GLOBAL_Stream[sno].streamlock);
return(Yap_unify_constant(ARG2,MkIntTerm(ch)));
return(Yap_unify_constant(ARG1,MkIntTerm(ch)));
}

71
os/chartypes.c
View File

@ -60,7 +60,7 @@ Term
int sno;
Term t;
sno = Yap_open_buf_read_stream(s, strlen(s)+1, enc, MEM_BUF_USER);
sno = Yap_open_buf_read_stream(s, strlen(s), enc, MEM_BUF_USER);
if (sno < 0)
return FALSE;
GLOBAL_Stream[sno].encoding = enc;
@ -100,7 +100,7 @@ char *
Yap_TermToString(Term t, char *s, size_t sz, size_t *length, encoding_t encp, int flags)
{
CACHE_REGS
int sno = Yap_open_buf_write_stream(&s, &sz);
int sno = Yap_open_buf_write_stream(s, sz, encp, flags);
int old_output_stream = LOCAL_c_output_stream;
if (sno < 0)
@ -118,28 +118,59 @@ char *
return NULL;
}
static encoding_t
const char *encvs[] = { "LANG","LC_ALL","LC_CTYPE", NULL };
// wher we can fins an encoding
typedef struct enc_map {
const char *s;
encoding_t e;
} enc_map_t;
static enc_map_t ematches[] =
{ { "UTF-8", ENC_ISO_UTF8 },
{ "UTF-16", ENC_UTF16_LE }, // ok, this is a very bad name
{ "UCS-2", ENC_UTF16_LE }, // ok, this is probably gone by now
{ "ISO-LATIN1", ENC_ISO_LATIN1 },
{ "ISO-8859-1", ENC_ISO_LATIN1 },
{ "Windows-1252", ENC_ISO_LATIN1 }, // almost, but not quite
{ "CP-1252", ENC_ISO_LATIN1 },
{ "C", ENC_ISO_ASCII },
{ NULL, ENC_OCTET }
};
static encoding_t
DefaultEncoding(void)
{
char *s = getenv("LANG");
size_t sz;
/* if we don't have a LANG then just use ISO_LATIN1 */
if (s == NULL)
s = getenv("LC_CTYPE");
if (s == NULL)
return ENC_ISO_LATIN1;
sz = strlen(s);
if (sz >= 5) {
if (s[sz-5] == 'U' &&
s[sz-4] == 'T' &&
s[sz-3] == 'F' &&
s[sz-2] == '-' &&
s[sz-1] == '8') {
return ENC_ISO_UTF8;
CACHE_REGS
int i = 0, j;
char *enc;
while (encvs[i]) {
char *v = getenv(encvs[i]);
if (v) {
enc = strrchr(v, '.');
/* that's how it is supposed to be, except in OSX */
if (!enc) enc = v;
// now that we have one name, try to match it
j= 0;
while (ematches[j].s != NULL) {
if (!strcmp(ematches[j].s, enc)) {
return LOCAL_encoding = ematches[j].e;
} else {
j++;
}
}
Yap_Warning("System uses unknown default encoding %s (taken from %s)", enc, v );
} else {
i++;
}
}
return ENC_ISO_ANSI;
// by default, return UTF-8
// except in _WIN32
#ifdef _WIN32
return ENC_UTF16_BE;
#else
return ENC_ISO_UTF8;
#endif
}
encoding_t

12
os/encoding.h
View File

@ -29,8 +29,8 @@ typedef enum {
ENC_ISO_ASCII = 2, /// US only
ENC_ISO_ANSI = 4, /// Who cares
ENC_ISO_UTF8 = 8, /// Most everyone nowadays
ENC_UNICODE_BE = 16, /// People who made a mistake
ENC_UNICODE_LE = 32, /// People who made the same mistake
ENC_UTF16_BE = 16, /// People who made a mistake
ENC_UTF16_LE = 32, /// People who made the same mistake
ENC_ISO_UTF32_BE = 64, /// nobody
ENC_ISO_UTF32_LE = 128, /// yes, nobody
} encoding_t;
@ -49,8 +49,8 @@ static inline const char *enc_name(encoding_t enc)
case ENC_ISO_ASCII: return "ascii";
case ENC_ISO_ANSI: return "octet";
case ENC_ISO_UTF8: return "utf8";
case ENC_UNICODE_BE: return "utf16_be";
case ENC_UNICODE_LE: return "utf16_le";
case ENC_UTF16_BE: return "utf16_be";
case ENC_UTF16_LE: return "utf16_le";
case ENC_ISO_UTF32_BE: return "utf32_be";
case ENC_ISO_UTF32_LE: return "utf32_le";
}
@ -65,8 +65,8 @@ encoding_t enc_id(char *s)
if (!strcmp(s, "iso_ascii")) return ENC_ISO_ASCII;
if (!strcmp(s, "iso_ansi")) return ENC_ISO_ANSI;
if (!strcmp(s, "iso_utf8")) return ENC_ISO_UTF8;
if (!strcmp(s, "utf16_be")) return ENC_UNICODE_BE;
if (!strcmp(s, "utf16_le")) return ENC_UNICODE_LE;
if (!strcmp(s, "utf16_be")) return ENC_UTF16_BE;
if (!strcmp(s, "utf16_le")) return ENC_UTF16_LE;
if (!strcmp(s, "utf32_be")) return ENC_ISO_UTF32_BE;
if (!strcmp(s, "utf32_le")) return ENC_ISO_UTF32_LE;
if (!strcmp(s, "default")) return Yap_DefaultEncoding();

2
os/files.c
View File

@ -565,7 +565,7 @@ same_file( USES_REGS1 ) {
int out;
struct stat *b1, *b2;
while ((char *)HR+sizeof(struct stat)*2 > (char *)(ASP-1024)) {
if (!Yap_gcl(2*sizeof(struct stat), 2, ENV, gc_P(P,CP))) {
if (!Yap_gcl(2*sizeof(struct stat), 2, ENV,Yap_gcP() ) ) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return FALSE;
}

80
os/format.c
View File

@ -223,10 +223,11 @@ format_copy_args(Term args, Term *targs, Int tsz)
}
static void
format_clean_up( char *fstr, Term *targs)
format_clean_up( int sno, const char *fstr, Term *targs)
{
if (fstr)
Yap_FreeAtomSpace(fstr);
Yap_FreeAtomSpace((void *)fstr);
if (targs)
Yap_FreeAtomSpace((char *)targs);
}
@ -268,7 +269,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
int column_boundary;
Term mytargs[8], *targs;
Int tnum, targ;
char *fstr = NULL, *fptr;
const char *fstr = NULL, *fptr;
Term args;
Term tail;
int (* f_putc)(int, wchar_t);
@ -317,16 +318,20 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
int sz = 256;
do {
format_cp_res fr;
char *fstr0;
fstr = fptr = Yap_AllocAtomSpace(sz*sizeof(char));
if ((fr = copy_format_string(tail, fstr, sz)) == fst_ok)
fstr = fptr = fstr0 = Yap_AllocAtomSpace(sz*sizeof(char));
if ((fr = copy_format_string(tail, fstr0, sz)) == fst_ok)
break;
if (fr == fst_error) return FALSE;
sz += 256;
Yap_FreeCodeSpace(fstr);
Yap_FreeCodeSpace(fstr0);
} while (TRUE);
} else if (IsAtomTerm(tail)) {
fstr = fptr = RepAtom(AtomOfTerm(tail))->StrOfAE;
} else if (IsStringTerm(tail)) {
fstr = fptr = StringOfTerm(tail);
} else {
Yap_Error(CONSISTENCY_ERROR, tail, "format/2");
return FALSE;
@ -663,11 +668,12 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
if (IsStringTerm(t)) {
if (has_repeats)
goto do_consistency_error;
yhandle_t sl = Yap_StartSlots();
// stream is already locked.
Yap_plwrite (t, GLOBAL_Stream+sno, 0, Handle_vars_f|To_heap_f, 1200);
Yap_CloseSlots(sl);
LOCAL_FormatInfo = &finfo;
const char *pt = StringOfTerm(t);
while(*pt) {
int ch;
pt = utf8_get_char(pt, &ch);
f_putc(sno, ch);
}
} else if (!format_print_str (sno, repeats, has_repeats, t, f_putc)) {
goto do_default_error;
}
@ -739,7 +745,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler;
}
format_clean_up( fstr, targs);
format_clean_up( sno, fstr, targs);
Yap_JumpToEnv(ball);
return FALSE;
}
@ -820,7 +826,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
finfo.pad_entries[finfo.padders].pad = bufp;
bufp = NULL;
sz = 0;
nsno = Yap_open_buf_write_stream(&bufp, &sz);
nsno = Yap_open_buf_write_stream(bufp, sz, GLOBAL_Stream[sno].encoding, 0);
if (osno) {
GLOBAL_Stream[nsno].linepos = GLOBAL_Stream[sno].linepos;
GLOBAL_Stream[nsno].linecount = GLOBAL_Stream[sno].linecount;
@ -877,7 +883,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler;
}
format_clean_up( fstr, targs);
format_clean_up( sno, fstr, targs);
LOCAL_Error_TYPE = YAP_NO_ERROR;
return FALSE;
}
@ -895,7 +901,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
}
// fill_pads( sno, 0, &finfo);
}
if (IsAtomTerm(tail)) {
if (IsAtomTerm(tail) || IsStringTerm(tail)) {
fstr = NULL;
}
if (tnum <= 8)
@ -903,7 +909,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler;
}
format_clean_up( fstr, targs);
format_clean_up( sno, fstr, targs);
return (TRUE);
}
@ -950,8 +956,8 @@ if (IsVarTerm(tin)) {
Term tat;
Term inp = Deref(ARG1);
if (out) {
char *s = GLOBAL_Stream[output_stream].u.mem_string.buf;
s[GLOBAL_Stream[output_stream].u.mem_string.pos] = '\0';
char *s = GLOBAL_Stream[output_stream].nbuf;
s[GLOBAL_Stream[output_stream].nsize] = '\0';
if (f == FunctorAtom) {
tat = MkAtomTerm(Yap_LookupAtom(s));
} else if (f == FunctorCodes) {
@ -974,39 +980,45 @@ if (IsVarTerm(tin)) {
}
static Int
format2(Term tin, Term tf, Term tas USES_REGS)
format(Term tout, Term tf, Term tas USES_REGS)
{
bool mem_stream = false;
int output_stream;
Functor f;
Int out;
if (IsVarTerm(tin)) {
Yap_Error(INSTANTIATION_ERROR,tin,"format/3");
if (IsVarTerm(tout)) {
Yap_Error(INSTANTIATION_ERROR,tout,"format/3");
return false;
}
if (IsApplTerm(tin) &&
(f = FunctorOfTerm(tin)) &&
(f == FunctorAtom || f == FunctorString ||
if (IsApplTerm(tout) &&
(f = FunctorOfTerm(tout)) &&
(f == FunctorAtom || f == FunctorString1 ||
f == FunctorCodes1 || f == FunctorCodes ||
f == FunctorChars1 || f == FunctorChars) ) {
output_stream = Yap_OpenBufWriteStream( PASS_REGS1);
mem_stream = true;
} else {
/* needs to change LOCAL_c_output_stream for write */
output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "format/3");
output_stream = Yap_CheckStream (tout, Output_Stream_f, "format/3");
}
if (output_stream == -1) {
return false;
}
out = doformat(tf,tas,output_stream PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
} else {
yhandle_t sls = Yap_CurrentSlot(PASS_REGS1);
out = doformat(tf,tas,output_stream PASS_REGS);
Yap_CloseSlots( sls );
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
}
if (mem_stream) {
Term tat;
Term inp = Deref(ARG1);
if (out) {
char *s = GLOBAL_Stream[output_stream].u.mem_string.buf;
s[GLOBAL_Stream[output_stream].u.mem_string.pos] = '\0';
char *s = GLOBAL_Stream[output_stream].nbuf;
s[GLOBAL_Stream[output_stream].nsize] = '\0';
if (f == FunctorAtom) {
tat = MkAtomTerm(Yap_LookupAtom(s));
} else if (f == FunctorCodes) {
@ -1031,10 +1043,10 @@ format2(Term tin, Term tf, Term tas USES_REGS)
}
static Int
format( USES_REGS1 )
format2( USES_REGS1 )
{ /* 'format'(Stream,Control,Args) */
Int res;
res = format2(MkAtomTerm(AtomUserOut), Deref(ARG1),Deref(ARG2) PASS_REGS);
res = format(MkAtomTerm(AtomUserOut), Deref(ARG1),Deref(ARG2) PASS_REGS);
return res;
}
@ -1042,14 +1054,14 @@ static Int
format3( USES_REGS1 )
{ /* 'format'(Stream,Control,Args) */
Int res;
res = format2(Deref(ARG1), Deref(ARG2),Deref(ARG3) PASS_REGS);
res = format(Deref(ARG1), Deref(ARG2),Deref(ARG3) PASS_REGS);
return res;
}
void
Yap_InitFormat(void)
{
Yap_InitCPred ("format", 2, format, SyncPredFlag);
Yap_InitCPred ("format", 2, format2, SyncPredFlag);
Yap_InitCPred ("format", 3, format3, SyncPredFlag);
Yap_InitCPred ("with_output_to", 2, with_output_to, SyncPredFlag);
}

18
os/iopreds.c
View File

@ -219,7 +219,7 @@ InitStdStream (int sno, SMALLUNSGN flags, FILE * file)
s->status = flags;
s->linepos = 0;
s->linecount = 1;
s->charcount = 0;
s->charcount = 0.;
s->encoding = LOCAL_encoding;
INIT_LOCK(s->streamlock);
unix_upd_stream_info(s);
@ -877,14 +877,14 @@ get_wchar(int sno)
}
}
break;
case ENC_UNICODE_BE:
case ENC_UTF16_BE:
if (how_many) {
return wch+ch;
}
how_many=1;
wch = ch << 8;
break;
case ENC_UNICODE_LE:
case ENC_UTF16_LE:
if (how_many) {
return wch+(ch<<8);
}
@ -1012,10 +1012,10 @@ put_wchar(int sno, wchar_t ch)
return -1;
}
break;
case ENC_UNICODE_BE:
case ENC_UTF16_BE:
GLOBAL_Stream[sno].stream_putc(sno, (ch>>8));
return GLOBAL_Stream[sno].stream_putc(sno, (ch&0xff));
case ENC_UNICODE_LE:
case ENC_UTF16_LE:
GLOBAL_Stream[sno].stream_putc(sno, (ch&0xff));
return GLOBAL_Stream[sno].stream_putc(sno, (ch>>8));
case ENC_ISO_UTF32_BE:
@ -1128,14 +1128,14 @@ binary_file(char *file_name)
return FALSE;
st->status |= HAS_BOM_f;
return TRUE;
case ENC_UNICODE_BE:
case ENC_UTF16_BE:
if (st->stream_putc(sno,0xFE)<0)
return FALSE;
if (st->stream_putc(sno,0xFF)<0)
return FALSE;
st->status |= HAS_BOM_f;
return TRUE;
case ENC_UNICODE_LE:
case ENC_UTF16_LE:
if (st->stream_putc(sno,0xFF)<0)
return FALSE;
if (st->stream_putc(sno,0xFE)<0)
@ -1223,7 +1223,7 @@ binary_file(char *file_name)
return;
} else {
st->status |= HAS_BOM_f;
st->encoding = ENC_UNICODE_BE;
st->encoding = ENC_UTF16_BE;
return;
}
}
@ -1257,7 +1257,7 @@ binary_file(char *file_name)
}
}
st->status |= HAS_BOM_f;
st->encoding = ENC_UNICODE_LE;
st->encoding = ENC_UTF16_LE;
return;
}
}

3
os/iopreds.h
View File

@ -211,6 +211,7 @@ typedef struct stream_desc
}
StreamDesc;
static inline bool
IsStreamTerm(Term t)
{
@ -255,12 +256,12 @@ Term Yap_MkStream (int n);
bool Yap_PrintWarning( Term twarning );
char *Yap_MemExportStreamPtr( int sno );
Int
PlIOError (yap_error_number type, Term culprit, const char *who, ...);
void Yap_plwrite(Term, struct stream_desc *, int, int, int);
int Yap_FormatFloat( Float f, const char *s, size_t sz );
void Yap_WriteAtom(struct stream_desc *s, Atom atom);
Term Yap_scan_num(struct stream_desc *);

83
os/mem.c
View File

@ -233,50 +233,45 @@ open_mem_read_stream (USES_REGS1) /* $open_mem_read_stream(+List,-Stream) */
}
int
Yap_open_buf_write_stream(char **nbufp, size_t *ncharsp)
Yap_open_buf_write_stream(char *buf, size_t nchars, encoding_t enc, memBufSource sr)
{
int sno;
StreamDesc *st;
char *nbuf = NULL;
size_t nchars = 0;
if (nbufp)
nbuf = *nbufp;
if (ncharsp)
nchars = *ncharsp;
if (!nchars)
nchars = 256;
if (!nbuf) {
if (!nchars) {
nchars = Yap_page_size;
sno = GetFreeStreamD();
if (sno < 0)
return -1;
if (!buf) {
if (!nchars) {
nchars = Yap_page_size;
}
buf = malloc( nchars );
}
nbuf = malloc( nchars );
if(!nbuf) {
st = GLOBAL_Stream+sno;
st->nbuf = buf;
if(!st->nbuf) {
return -1;
}
}
sno = GetFreeStreamD();
if (sno < 0)
return -1;
st = &GLOBAL_Stream[sno];
/* currently these streams are not seekable */
st->linepos = 0;
st->charcount = 0;
st->linecount = 1;
Yap_DefaultStreamOps( st );
st->nsize = nchars;
/* currently these streams are not seekable */
st->linepos = 0;
st->charcount = 0;
st->linecount = 1;
st->encoding = enc;
Yap_DefaultStreamOps( st );
#if MAY_WRITE
st->file = open_memstream(&st->nbuf, &st->nsize);
st->status = Output_Stream_f | InMemory_Stream_f|Seekable_Stream_f;
st->file = open_memstream(&st->nbuf, &st->nsize);
st->status = Output_Stream_f | InMemory_Stream_f|Seekable_Stream_f;
#else
st->u.mem_string.pos = 0;
st->u.mem_string.buf = nbuf;
st->u.mem_string.max_size = nchars;
st->status = Output_Stream_f | InMemory_Stream_f;
st->u.mem_string.pos = 0;
st->u.mem_string.buf = nbuf;
st->u.mem_string.max_size = nchars;
st->status = Output_Stream_f | InMemory_Stream_f;
#endif
Yap_MemOps( st );
UNLOCK(st->streamlock);
*nbufp = nbuf;
return sno;
Yap_MemOps( st );
UNLOCK(st->streamlock);
return sno;
}
int
@ -292,7 +287,7 @@ Yap_OpenBufWriteStream( USES_REGS1 )
return -1;
}
}
return Yap_open_buf_write_stream(&nbuf, &sz);
return Yap_open_buf_write_stream(nbuf, sz, GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0);
}
static Int
@ -316,14 +311,16 @@ open_mem_write_stream (USES_REGS1) /* $open_mem_write_stream(-Stream) */
* @return temporary buffer, discarded by close and may be moved away
* by other writes..
*/
memHandle *
Yap_MemExportStreamPtrs( int sno )
char *
Yap_MemExportStreamPtr( int sno )
{
char *s;
#if MAY_WRITE
if (fflush(GLOBAL_Stream[sno].file) == 0) {
GLOBAL_Stream[sno].nbuf[GLOBAL_Stream[sno].nsize] = '\0';
return (memHandle *)GLOBAL_Stream[sno].nbuf;
}
if (fflush(GLOBAL_Stream[sno].file) == 0 &&
(s = GLOBAL_Stream[sno].nbuf)) {
s[ftell(GLOBAL_Stream[sno].file)] = '\0';
return s;
}
return NULL;
#else
return &GLOBAL_Stream[sno].u.mem_string;
@ -360,7 +357,7 @@ peek_mem_write_stream ( USES_REGS1 )
if (HR + 1024 >= ASP) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
HR = HI;
if (!Yap_gcl((ASP-HI)*sizeof(CELL), 3, ENV, gc_P(P,CP))) {
if (!Yap_gcl((ASP-HI)*sizeof(CELL), 3, ENV, Yap_gcP()) ) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return(FALSE);

7
os/readterm.c
View File

@ -739,6 +739,7 @@ parseError(REnv *re, FEnv *fe, int inp_stream)
Term ParserErrorStyle = re->sy;
if (ParserErrorStyle == TermQuiet) {
/* just fail */
LOCAL_Error_TYPE = YAP_NO_ERROR;
return YAP_PARSING_FINISHED;
} else {
Term terr = Yap_syntax_error(fe->toklast, inp_stream);
@ -748,10 +749,12 @@ parseError(REnv *re, FEnv *fe, int inp_stream)
return YAP_PARSING_FINISHED;
} else {
Yap_PrintWarning(terr);
if (ParserErrorStyle == TermDec10);
return YAP_SCANNING;
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (ParserErrorStyle == TermDec10)
return YAP_SCANNING;
}
}
LOCAL_Error_TYPE = YAP_NO_ERROR;
return YAP_PARSING_FINISHED;
}

2
os/readutil.c
View File

@ -127,7 +127,7 @@ p_stream_to_codes(USES_REGS1)
RESET_VARIABLE(h0);
ARG4 = AbsPair(HBASE);
ARG5 = (CELL)h0;
if (!Yap_gcl((ASP-HBASE)*sizeof(CELL), 5, ENV, gc_P(P,CP))) {
if (!Yap_gcl((ASP-HBASE)*sizeof(CELL), 5, ENV, Yap_gcP())) {
Yap_Error(OUT_OF_STACK_ERROR, ARG1, "read_stream_to_codes/3");
return FALSE;
}

12
os/streams.c
View File

@ -632,8 +632,6 @@ cont_stream_property (USES_REGS1)
++i;
if (i == MaxStreams)
cut_fail();
else
EXTRA_CBACK_ARG (2, 1) = MkIntTerm (i+1);
}
LOCK(GLOBAL_Stream[i].streamlock);
UNLOCK(GLOBAL_StreamDescLock);
@ -645,12 +643,16 @@ cont_stream_property (USES_REGS1)
if (rc) {
if (det)
cut_succeed();
else
return true;
else {
EXTRA_CBACK_ARG (2, 1) = MkIntTerm (i+1);
return true;
}
} else if (det)
cut_fail();
else
else {
EXTRA_CBACK_ARG (2, 1) = MkIntTerm (i+1);
return false;
}
}
static Int

6
os/yapio.h
View File

@ -141,14 +141,14 @@ typedef enum mem_buf_source {
MEM_BUF_USER=4
} memBufSource;
struct mem_desc *Yap_MemExportStreamPtrs( int sno );
char * Yap_MemStreamBuf( int sno );
extern Term Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio, Term *bindings_p);
extern Term Yap_StringToNumberTerm(char *s, encoding_t encp);
int Yap_FormatFloat(Float f, const char *s, size_t sz);
int Yap_FormatFloat(Float f, char **s, size_t sz);
int Yap_open_buf_read_stream(const char *nbuf, size_t nchars, encoding_t enc, memBufSource src);
int Yap_open_buf_write_stream( char *nbuf, size_t nchars, encoding_t enc, memBufSource src);
Term Yap_ReadFromAtom(Atom a, Term opts);
int Yap_open_buf_write_stream(char **nbufp, size_t * szp);
FILE *Yap_GetInputStream(Term t, const char *m);
FILE *Yap_GetOutputStream(Term t,const char *m);
char * Yap_guessFileName(int f, int sno, char *nameb, size_t max);

8
packages/cuda/CMakeLists.txt
View File

@ -51,7 +51,7 @@ if (CUDA_FOUND)
# Only available for CUDA version 3.2+.
# Windows only.
#
macro_optional_find_package (FindThrust ON)
macro_optional_find_package (Thrust ON)
set (CUDA_SOURCES
lista.cu
@ -65,9 +65,9 @@ if (CUDA_FOUND)
cuda_add_library (libcuda SHARED ${CUDA_SOURCES})
target_link_libraries(libcuda libYap
${CUDA_LIBRARIES} ${CUDA_npp_LIBRARY} ${CUDA_nppc_LIBRARY}
stdc++ )
target_link_libraries(libcuda libYap
${CUDA_LIBRARIES} ${CUDA_npp_LIBRARY} # ${CUDA_nppc_LIBRARY}
)
if( THRUST_INCLUDE_DIR )
list( REMOVE_DUPLICATES THRUST_INCLUDE_DIR )

6
packages/python/CMakeLists.txt
View File

@ -3,6 +3,12 @@
set (PYTHON_SOURCES
python.c)
#try to use Brew first
#set ( PYTHON_LIBRARY /Anaconda/lib/libpython2.7.dylib )
#set ( PYTHON_INCLUDE_DIR /Anaconda/include/python2.7 )
set( PYTHON_LIBRARY /usr/local/opt/python/Frameworks/Python.framework/Versions/Current/lib/libpython2.7.dylib) # - path to the python library
set( PYTHON_INCLUDE_DIR /usr/local/opt/python/Frameworks/Python.framework/Versions/Current/include/python2.7 ) # - path to where Python.h is found
macro_optional_find_package(PythonInterp ON)
macro_optional_find_package (PythonLibs ON)
macro_log_feature (PYTHONLIBS_FOUND "Python"

100
packages/python/python.c
View File

@ -659,29 +659,40 @@ term_to_python(term_t t)
case PL_VARIABLE:
return NULL;
case PL_ATOM:
case PL_STRING:
{
char *s;
atom_t at;
if (PL_get_atom(t, &at)) {
if (at == ATOM_true) return Py_True;
if (at == ATOM_false) return Py_False;
}
if (!PL_get_chars(t, &s, REP_UTF8|CVT_ATOM|CVT_STRING|BUF_DISCARDABLE) ) {
return NULL;
{
char *s;
if (!PL_get_atom_chars(t, &s))
return NULL;
/* return __main__,s */
return PyObject_GetAttrString(py_Main, s);
}
#if PY_MAJOR_VERSION < 3
if (proper_ascii_string(s)) {
return PyString_FromStringAndSize(s, strlen(s) );
} else
#endif
{
PyObject *pobj = PyUnicode_DecodeUTF8(s, strlen(s), NULL);
//fprintf(stderr, "%s\n", s);
return pobj;
}
}
break;
case PL_STRING:
{
char *s;
if (!PL_get_chars(t, &s, REP_UTF8|CVT_ATOM|CVT_STRING|BUF_DISCARDABLE) ) {
return NULL;
}
#if PY_MAJOR_VERSION < 3
if (proper_ascii_string(s)) {
return PyString_FromStringAndSize(s, strlen(s) );
} else
#endif
{
PyObject *pobj = PyUnicode_DecodeUTF8(s, strlen(s), NULL);
//fprintf(stderr, "%s\n", s);
return pobj;
}
}
break;
case PL_INTEGER:
{
int64_t j;
@ -1044,6 +1055,35 @@ assign_python(PyObject *root, term_t t, PyObject *e)
case PL_VARIABLE:
return -1;
case PL_ATOM:
{
char *s;
if (!PL_get_atom_chars(t, &s)) {
wchar_t *w;
atom_t at;
size_t len;
PyObject *attr;
if (!PL_get_atom(t, &at)) {
return -1;
}
if (!(w = PL_atom_wchars(at, &len)))
return -1;
attr = PyUnicode_FromWideChar(w, wcslen(w) );
if (!attr)
return -1;
return PyObject_SetAttr(py_Main, attr, e);
}
if (proper_ascii_string(s)) {
return PyObject_SetAttrString(py_Main, s, e);
} else {
PyObject *attr= PyUnicode_DecodeLatin1(s, strlen(s), NULL);
if (!attr)
return -1;
return PyObject_SetAttr(py_Main, attr, e);
}
}
break;
case PL_STRING:
{
char *s;
@ -1067,8 +1107,8 @@ assign_python(PyObject *root, term_t t, PyObject *e)
return PyObject_SetAttr(root, wo, e);
}
}
break;
case PL_INTEGER:
case PL_STRING:
case PL_FLOAT:
return -1;
case PL_TERM:
@ -1278,6 +1318,8 @@ python_import(term_t mname, term_t mod)
pModule = PyImport_Import(pName);
Py_DECREF(pName);
if (pModule == NULL) {
if (PyErr_Occurred())
PyErr_Print();
PyErr_Clear();
return FALSE;
}
@ -1387,8 +1429,28 @@ python_apply(term_t tin, term_t targs, term_t keywds, term_t tf)
foreign_t out;
term_t targ = PL_new_term_ref();
pF = term_to_python(tin);
pF = term_t
'o_python(tin);
if ( pF == NULL ) {
PYError()
return FALSE;
}
if (PL_is_atom(keywds) )
@ -1623,10 +1685,10 @@ end_python(void)
return TRUE;
}
install_t install_python(void);
install_t install_libpython(void);
install_t
install_python(void)
install_libpython(void)
{ // FUNCTOR_dot2 = PL_new_functor(PL_new_atom("."), 2);
// FUNCTOR_equal2 = PL_new_functor(PL_new_atom("="), 2);
// FUNCTOR_boolop1 = PL_new_functor(PL_new_atom("@"), 1);
@ -1653,7 +1715,7 @@ install_python(void)
FUNCTOR_range2 = PL_new_functor(PL_new_atom("range"), 2);
FUNCTOR_range3 = PL_new_functor(PL_new_atom("range"), 3);
FUNCTOR_sum1 = PL_new_functor(PL_new_atom("sum"), 1);
FUNCTOR_complex2 = PL_new_functor(PL_new_atom("complex"), 2);
FUNCTOR_complex2 = PL_new_functor(PL_new_atom("i"), 2);
FUNCTOR_plus2 = PL_new_functor(PL_new_atom("+"), 2);
FUNCTOR_sub2 = PL_new_functor(PL_new_atom("-"), 2);
FUNCTOR_mul2 = PL_new_functor(PL_new_atom("*"), 2);

108
packages/python/python.pl
View File

@ -13,19 +13,29 @@
%%%
:- module(python, [
init_python/0,
end_python/0,
python_command/1,
python_assign/3,
python_import/1,
python/2,
op(100,fy,$),
op(950,fy,:=),
op(950,yfx,:=),
(:=)/2,
(:=)/1
]).
:- module(python,
[
init_python/0,
end_python/0,
python_command/1,
python_assign/3,
python_import/1,
python/2,
(:=)/2,
(:=)/1,
(<-)/2,
(<-)/1,
op(100,fy,$),
op(950,fy,:=),
op(950,yfx,:=),
op(950,fx,<-),
op(950,yfx,<-),
op(50, yf, []),
op(50, yf, '()'),
op(100, xfy, '.'),
op(100, fy, '.')
]).
/** <module> python
@ -35,6 +45,22 @@
@version 0:0:5, 2012/10/8
@license Perl Artistic License
This is an interface to allow calling Python from Prolog. Please look
at the SWIG package if you want to embedd Prolog with Python.
The interface should be activated by consulting the python lybrary. It
immediately boots a Python image.
To best define the interface, one has to address two opposite goals:
- make it as similar to python as possible
- make all embedded language interfaces (python, R, Java) as
similar as possible.
Currently, YAP supports the following translation:
- numbers -> identical
->
*/
@ -45,12 +71,12 @@ Python interface
Data types are
Python Prolog
string atoms
numbers numbers
lists lists
tuples t(...)
generic objs __pointer__(Address)
Python Prolog
string atoms
numbers numbers
lists lists
tuples t(...)
generic objs __pointer__(Address)
$var refers to the attribute __main__.var
@ -62,18 +88,26 @@ Data types are
:- use_module(library(charsio)).
:- dynamic python_mref_cache/2, python_obj_cache/2.
:- multifile user:(<-)/2.
:= F :- python(F,_).
V := F :- var(V), !, python(F,V).
A := F :- python(F, F1), python_assign(A, F1).
user:( V <- F ) :-
V := F.
user:((<- F)) :-
<- F.
python_import(Module) :-
python_do_import(Module, _).
python_do_import(Module, MRef) :-
python_mref_cache(Module, MRef), !.
python_do_import(Module, MRef) :-
python_import(Module, MRef),
python_import(Module, MRef),
assert( python_mref_cache(Module, MRef) ).
fetch_module(M:E, M1, E1, MRef) :-
@ -89,12 +123,18 @@ module_extend(M0, M:E, MF, EF, _MRef0, MRef) :-
atom_concat([M0,'.',M], MM),
python_import(MM, MRef1), !,
module_extend(MM, E, MF, EF, MRef1, MRef).
module_extend(M0, M.E, MF, EF, _MRef0, MRef) :-
MM = M0.M,
python_import(MM, MRef1), !,
module_extend(MM, E, MF, EF, MRef1, MRef).
module_extend(M, E, M, E, MRef, MRef).
object_prefix('__obj__'(_)).
object_prefix('$'(_)).
object_prefix('__obj__'(_):_).
object_prefix('$'(_):_).
object_prefix('__obj__'(_)._).
object_prefix('$'(_)._).
% from an exp take an object, and its corresponding Prolog representation
descend_exp(V, _Obj, _F, _S) :-
@ -108,9 +148,13 @@ descend_exp(Exp, Obj, F, S) :-
python_mref_cache(_, MObj),
python_field(MObj:Exp, Obj, F, S), !.
descend_exp(Mod:Exp, Obj, F, S) :-
atom(Mod),
atom(Mod),
python_import(Mod, MObj),
python_field(MObj:Exp, Obj, F, S), !.
python_field(MObj:Exp, Obj, F, S), !.
descend_exp(Mod.Exp, Obj, F, S) :-
atom(Mod),
python_import(Mod, MObj),
python_field(MObj:Exp, Obj, F, S), !.
python_class(Obj) :-
python_obj_cache(inspect:isclass(_), F),
@ -129,21 +173,22 @@ python_eval_term(Obj, Obj) :-
python_eval_term('__obj__'(Obj), '__obj__'(Obj)) :- !.
python_eval_term($Name, Obj) :- !,
python_is($Name, Obj).
python_eval_term([H|T], [NH|NT]) :- !,
python_eval_term(H, NH),
python_eval_term(T, NT).
python_eval_term([H|T], NL) :-
is_list(T), !,
maplist( python_eval_term, [H|T], NL).
python_eval_term(N, N) :- atomic(N), !.
python_eval_term(N, N) :- string(N), !.
python_eval_term(Exp, O) :-
descend_exp(Exp, Obj, _Old, S), !,
(functor(S, _, 0) ->
(functor(S, _, 0) ->
O = Obj
;
;
python_check_args(S, NS, Dict),
python_apply(Obj, NS, Dict, O)
).
).
python_eval_term(S, O) :-
python_check_args(S, NS, {}),
python_is(NS, O).
python_is(NS, O).
python_check_args(Exp, t, {}) :-
Exp =.. [_,V], var(V), !.
@ -217,14 +262,13 @@ add_cwd_to_python :-
atom_concat(['sys.path.append(\"',Dir,'\")'], Command),
python_command(Command),
python_command("sys.argv = [\"yap\"]").
% done
% done
python_assign(Name, Exp, '$'(Name)) :-
python_assign(Name, Exp).
:- initialization( use_foreign_library(foreign(python)), now ).
:- initialization( use_foreign_library(foreign(libpython)), now ).
:- initialization(start_python, now).
:- initialization(add_cwd_to_python).

55
packages/swig/CMakeLists.txt
View File

@ -11,60 +11,15 @@ if (SWIG_FOUND)
# SWIG_VERSION - the version number of the swig executable
#
# This is a CMake example for Python
# This is a CMake example for Python and Java
INCLUDE(${SWIG_USE_FILE})
FIND_PACKAGE(PythonLibs)
INCLUDE_DIRECTORIES(${PYTHON_INCLUDE_PATH})
add_subdirectory(python)
INCLUDE_DIRECTORIES(${CMAKE_CURRENT_SOURCE_DIR})
add_subdirectory(java)
INCLUDE_DIRECTORIES(${CMAKE_SOURCE_DIR}/CXX)
set_source_files_properties( yap.i
PROPERTIES CPLUSPLUS ON)
SET(CMAKE_SWIG_FLAGS "")
set (CMAKE_SWIG_OUTDIR ${CMAKE_CURRENT_BINARY_DIR}/java )
macro_optional_find_package(Java ON)
find_package(Java COMPONENTS Development)
#find_package(Java COMPONENTS Runtime)
macro_log_feature (Java_Development_FOUND "Java"
"Use Java System"
"http://www.java.org" FALSE)
macro_optional_find_package(JNI ON)
macro_log_feature (JNI_FOUND "JNI"
"Use Java Native Interface"
"http://www.java.org" FALSE)
if (Java_Development_FOUND)
#set (CMAKE_JAVA_CLASS_OUTPUT_PATH java)
include ( UseJava )
SWIG_ADD_MODULE(jSWIG java yap.i )
SWIG_LINK_LIBRARIES(jSWIG ${JAVA_LIBRARIES} ${JNI_LIBRARIES} Yap++)
#include( UseJavaClassFileList)
set_source_files_properties(yap.i PROPERTY CPLUSPLUS ON)
target_include_directories ( jSWIG
PUBLIC ${JAVA_INCLUDE_DIRS} ${JNI_INCLUDE_DIRS})
INCLUDE_DIRECTORIES(${CMAKE_CURRENT_SOURCE_DIR})
#set (CMAKE_JAVA_CLASS_OUTPUT_PATH ${CMAKE_CURRENT_DIR}/java )
#include (UseJavaClassFilelist)
add_subdirectory( java )
endif()
endif (SWIG_FOUND)

109
packages/swig/java/CMakeLists.txt
View File

@ -1,47 +1,70 @@
include ( UseJava )
set (SOURCES
${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_CELL.java
${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_CPredicate.java
${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_Prop.java
${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_Term.java
${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_YAP_tag_t.java
${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_arity_t.java
${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_encoding_t.java
${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_intptr_t.java
${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_void.java
${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_wchar_t.java
${CMAKE_CURRENT_BINARY_DIR}/YAPApplTerm.java
${CMAKE_CURRENT_BINARY_DIR}/YAPAtom.java
${CMAKE_CURRENT_BINARY_DIR}/YAPAtomTerm.java
${CMAKE_CURRENT_BINARY_DIR}/YAPCallback.java
${CMAKE_CURRENT_BINARY_DIR}/YAPEngine.java
${CMAKE_CURRENT_BINARY_DIR}/YAPError.java
${CMAKE_CURRENT_BINARY_DIR}/YAPFLIP.java
${CMAKE_CURRENT_BINARY_DIR}/YAPFunctor.java
${CMAKE_CURRENT_BINARY_DIR}/YAPIntegerTerm.java
${CMAKE_CURRENT_BINARY_DIR}/YAPListTerm.java
${CMAKE_CURRENT_BINARY_DIR}/YAPModule.java
${CMAKE_CURRENT_BINARY_DIR}/YAPModuleProp.java
${CMAKE_CURRENT_BINARY_DIR}/YAPNumberTerm.java
${CMAKE_CURRENT_BINARY_DIR}/YAPPairTerm.java
${CMAKE_CURRENT_BINARY_DIR}/YAPPredicate.java
${CMAKE_CURRENT_BINARY_DIR}/YAPPrologPredicate.java
${CMAKE_CURRENT_BINARY_DIR}/YAPProp.java
${CMAKE_CURRENT_BINARY_DIR}/YAPQuery.java
${CMAKE_CURRENT_BINARY_DIR}/YAPStringTerm.java
${CMAKE_CURRENT_BINARY_DIR}/YAPTerm.java
${CMAKE_CURRENT_BINARY_DIR}/YAPVarTerm.java
${CMAKE_CURRENT_BINARY_DIR}/yap.java
${CMAKE_CURRENT_BINARY_DIR}/yapConstants.java
${CMAKE_CURRENT_BINARY_DIR}/yapJNI.java
)
add_jar(jYAP
${SOURCES}
macro_optional_find_package(Java ON)
find_package(Java COMPONENTS Development)
#find_package(Java COMPONENTS Runtime)
macro_log_feature (Java_Development_FOUND "Java"
"Use Java System"
"http://www.java.org" FALSE)
macro_optional_find_package(JNI ON)
macro_log_feature (JNI_FOUND "JNI"
"Use Java Native Interface"
"http://www.java.org" FALSE)
if (Java_Development_FOUND)
include ( UseJava )
# SET(CMAKE_SWIG_FLAGS -package YAP)
SET(SWIG_SOURCES
../yap.i
)
install_jar( jYAP ${libpl})
# install_jni_symlink(YAPjar .)
set( CMAKE_CXX_FAGS "${CMAKE_CXX_FLAGS} -Wno-missing-declarations")
include_directories (
ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ ${CMAKE_CURRENT_SOURCE_DIR}
${JAVA_INCLUDE_DIRS}
${JNI_INCLUDE_DIRS}
)
set (CMAKE_SWIG_OUTDIR ${CMAKE_CURRENT_BINARY_DIR} )
#set (CMAKE_JAVA_CLASS_OUTPUT_PATH java)
SET_SOURCE_FILES_PROPERTIES(${SWIG_SOURCES} PROPERTIES CPLUSPLUS ON)
# SWIG_ADD_MODULE(jSWIG java ${SWIG_SOURCES} )
# SWIG_LINK_LIBRARIES(jSWIG ${JAVA_LIBRARIES} ${JNI_LIBRARIES} Yap++)
set_source_files_properties(../yap.i PROPERTY CPLUSPLUS ON)
add_jar(JavaYAP
SOURCES JavaYAP.java
ENTRY_POINT JavaYAP
)
install_jar(JavaYAP ${libpl}/JavaYAP)
set(CMAKE_JNI_TARGET TRUE)
ADD_CUSTOM_COMMAND(TARGET JavaYAP
POST_BUILD
COMMAND cmake -E echo "Compiling Java files..."
COMMAND ${Java_JAVAC_EXECUTABLE} *.java
COMMAND cmake -E echo "Creating jar file..."
COMMAND ${Java_JAR_EXECUTABLE} uvf JavaYAP.jar *.class
)
# install_jni_symlink(shibboleet ${JAVA_LIB_INSTALL_DIR})
# SET_TARGET_PROPERTIES(jSWIG PROPERTIES OUTPUT_NAME "JavaYAP")
# add_dependencies(jSWIG JavaYAP)
Endif (Java_Development_FOUND)

2
pl/boot.yap
View File

@ -1053,7 +1053,7 @@ number of steps.
'$write_output_vars'([]).
'$write_output_vars'([V|VL]) :-
format(user_error,' = ~s',[V]),
format(user_error,' = ~a',[V]),
'$write_output_vars'(VL).

34
pl/consult.yap
View File

@ -90,7 +90,7 @@ files and to set-up the Prolog environment. We discuss
@pred load_files(+ _Files_, + _Options_)
General implementation of the consult/1 family. Execution is controlled by the
Implementation of the consult/1 family. Execution is controlled by the
following flags:
+ consult(+ _Mode_)
@ -873,7 +873,7 @@ db_files(Fs) :-
'$init_win_graphics',
fail.
'$do_startup_reconsult'(X) :-
( current_prolog_flag(language_mode, yap) ->
( current_prolog_flag(halt_after_consult, false) ->
'$system_catch'(load_files(X, [silent(true)]), Module, Error, '$Error'(Error))
;
set_prolog_flag(verbose, silent),
@ -882,7 +882,7 @@ db_files(Fs) :-
true
),
!,
( current_prolog_flag(language_mode, yap) -> true ; halt).
( current_prolog_flag(halt_after_consult, false) -> true ; halt).
'$do_startup_reconsult'(_).
'$skip_unix_header'(Stream) :-
@ -1026,10 +1026,13 @@ prolog_load_context(stream, Stream) :-
% module can be reexported.
'$ensure_file_unchanged'(F, M) :-
% loaded from the same module, but does not define a module.
% loaded from the same module, but does not define a module.
recorded('$source_file','$source_file'(F, Age, NM), R),
% make sure: it either defines a new module or it was loaded in the same context
% make sure: it either defines a new module or it was loaded in the same context
'$file_is_unchanged'(F, R, Age),
!,
% ( F = '/usr/local/share/Yap/rbtrees.yap' ->start_low_level_trace ; true),
recorded('$module','$module'(F,NM,_ASource,_P,_),_)
( M == NM -> true ; recorded('$module','$module'(F,NM,_Source,_P,_),_) ), !.
'$file_is_unchanged'(F, R, Age) :-
@ -1042,18 +1045,19 @@ prolog_load_context(stream, Stream) :-
( F == user_input -> working_directory(Dir,Dir) ; file_directory_name(F, Dir) ),
nb_setval('$consulting_file', F ),
(
Reconsult0 \== consult,
Reconsult0 \== not_loaded,
Reconsult \== changed,
% if we are reconsulting, always start from scratch
Reconsult0 \== consult,
Reconsult0 \== not_loaded,
Reconsult0 \== changed,
recorded('$source_file','$source_file'(F, _,_),R),
erase(R),
fail
;
var(Reconsult0)
->
Reconsult = consult
;
Reconsult = Reconsult0
fail
;
var(Reconsult0)
->
Reconsult = consult
;
Reconsult = Reconsult0
),
(
Reconsult \== consult,

2
pl/debug.yap
View File

@ -1043,7 +1043,7 @@ be lost.
'$unleashed'(exception(_)) :- get_value('$leash',L), L /\ 2'0001 =:= 0. %'
'$debugger_write'(Stream, G) :-
recorded('$print_options','$debugger'(OUT),_), !,
current_prolog_flag( debugger_print_options, OUT ), !,
write_term(Stream, G, OUT).
'$debugger_write'(Stream, G) :-
writeq(Stream, G).

Some files were not shown because too many files have changed in this diff Show More