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 "absmi.h"
#include "heapgc.h" #include "heapgc.h"
@ -677,12 +679,12 @@ check_alarm_fail_int(int CONT USES_REGS)
} }
static int 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 ) || if ((Int)(Unsigned(YREG) - Unsigned(HR)) < StackGap( PASS_REGS1 ) ||
Yap_get_signal( YAP_STOVF_SIGNAL )) { Yap_get_signal( YAP_STOVF_SIGNAL )) {
S = (CELL *)pe; 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); Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
return 0; return 0;
} }
@ -996,7 +998,7 @@ interrupt_execute( USES_REGS1 )
if ((v = code_overflow(YENV PASS_REGS)) >= 0) { if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v; 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 v;
} }
return interrupt_handler( P->y_u.pp.p PASS_REGS ); 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) { if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v; 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 v;
} }
return interrupt_handlerc( P->y_u.Osbpp.p PASS_REGS ); 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) { if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v; 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; return v;
} }
CP = NEXTOP(P, Osbmp); CP = NEXTOP(P, Osbmp);
@ -1259,7 +1261,7 @@ interrupt_either( USES_REGS1 )
return v; return v;
} }
//P = NEXTOP(P, Osblp); //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); //P = PREVOP(P, Osblp);
return v; return v;
} }
@ -1290,7 +1292,7 @@ interrupt_dexecute( USES_REGS1 )
if ((v = code_overflow(YENV PASS_REGS)) >= 0) { if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v; 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; return v;
} }
/* first, deallocate */ /* first, deallocate */
@ -1636,7 +1638,7 @@ Yap_absmi(int inp)
/************************************************************************/ /************************************************************************/
static void *OpAddress[] = static void *OpAddress[] =
{ {
#define OPCODE(OP,TYPE) && OP #define OPCODE(OP,TYPE) && _##OP
#include "YapOpcodes.h" #include "YapOpcodes.h"
#undef OPCODE #undef OPCODE
}; };

7
C/absmi_insts.h
View File

@ -42,6 +42,13 @@ BOp(Ystop, l);
\************************************************************************/ \************************************************************************/
#if YAP_JIT #if YAP_JIT
static void *OpAddress[] =
{
#define OPCODE(OP,TYPE) && _##OP
#include "YapOpcodes.h"
#undef OPCODE
};
/* native_me */ /* native_me */
BOp(jit_handler, J); BOp(jit_handler, J);
if (!PREG->y_u.J.jh->fi.bcst.c) PREG->y_u.J.jh->mf.isground = IsGround(PREG); 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 bool
Yap_PutAtomTranslation(Atom a, Int i) Yap_PutAtomTranslation(Atom a, arity_t arity, Int i)
{ {
AtomEntry *ae = RepAtom(a); AtomEntry *ae = RepAtom(a);
Prop p0; Prop p0;
@ -1243,6 +1243,7 @@ Yap_PutAtomTranslation(Atom a, Int i)
} }
p->KindOfPE = TranslationProperty; p->KindOfPE = TranslationProperty;
p->Translation = i; p->Translation = i;
p->arity = arity;
AddPropToAtom(RepAtom(a), (PropEntry *)p); AddPropToAtom(RepAtom(a), (PropEntry *)p);
} }
/* take care that the lock for the property will be inited even /* take care that the lock for the property will be inited even
@ -1251,6 +1252,32 @@ Yap_PutAtomTranslation(Atom a, Int i)
return true; 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 bool
Yap_PutAtomMutex(Atom a, void * i) 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 RestoreEntries(PropEntry *, int USES_REGS);
static void CleanCode(PredEntry * USES_REGS); static void CleanCode(PredEntry * USES_REGS);
static void RestoreDBTerm(DBTerm *dbr, int attachments USES_REGS);
#define AtomMarkedBit 1 #define AtomMarkedBit 1
@ -190,6 +191,32 @@ AtomAdjust(Atom a)
#define RestoreSWIHash() #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" #include "rheap.h"
static void static void
@ -228,8 +255,6 @@ RestoreAtomList(Atom atm USES_REGS)
} while (!EndOfPAEntr(at)); } while (!EndOfPAEntr(at));
} }
static void static void
mark_trail(USES_REGS1) 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: case mark_live_regs_op:
if (!ystop_found) { if (!ystop_found) {
code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip); 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); code_p = a_bregs(code_p, pass_no, cip->cpc);
break; break;

48
C/args.c
View File

@ -31,19 +31,16 @@ xarg *
Yap_ArgListToVector (Term listl, const param_t *def, int n) Yap_ArgListToVector (Term listl, const param_t *def, int n)
{ {
CACHE_REGS CACHE_REGS
Term *tailp;
if (!IsPairTerm(listl) && listl != TermNil) { if (!IsPairTerm(listl) && listl != TermNil) {
listl = MkPairTerm( listl, TermNil ); listl = MkPairTerm( listl, TermNil );
} }
Int length = Yap_SkipList( &listl, &tailp );
if (length < 0 )
return NULL;
xarg *a = calloc( n , sizeof(xarg) ); xarg *a = calloc( n , sizeof(xarg) );
while (IsPairTerm(listl)) { while (IsPairTerm(listl)) {
Term hd = HeadOfTerm( listl ); Term hd = HeadOfTerm( listl );
listl = TailOfTerm( listl ); listl = TailOfTerm( listl );
if (IsVarTerm(hd)) { if (IsVarTerm(hd)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = hd;
free( a ); free( a );
return NULL; return NULL;
} }
@ -58,13 +55,15 @@ Yap_ArgListToVector (Term listl, const param_t *def, int n)
} else if (IsApplTerm( hd )) { } else if (IsApplTerm( hd )) {
Functor f = FunctorOfTerm( hd ); Functor f = FunctorOfTerm( hd );
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER; LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
free( a ); LOCAL_Error_Term = hd;
return NULL; free( a );
return NULL;
} }
arity_t arity = ArityOfFunctor( f ); arity_t arity = ArityOfFunctor( f );
if (arity != 1) { if (arity != 1) {
LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE; LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE;
LOCAL_Error_Term = hd;
free( a ); free( a );
return NULL; return NULL;
} }
@ -78,7 +77,7 @@ Yap_ArgListToVector (Term listl, const param_t *def, int n)
} }
} }
return a; return a;
} }
static xarg * static xarg *
matchKey2(Atom key, xarg *e0, int n, const param2_t *def) 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 * xarg *
Yap_ArgList2ToVector (Term listl, const param2_t *def, int n) Yap_ArgList2ToVector (Term listl, const param2_t *def, int n)
{ {
CACHE_REGS CACHE_REGS
Term *tailp;
if (!IsPairTerm(listl) && listl != TermNil) { if (!IsPairTerm(listl) && listl != TermNil) {
listl = MkPairTerm( listl, TermNil ); listl = MkPairTerm( listl, TermNil );
} }
Int length = Yap_SkipList( &listl, &tailp );
if (length < 0 )
return NULL;
xarg *a = calloc( n , sizeof(xarg) ); xarg *a = calloc( n , sizeof(xarg) );
while (IsPairTerm(listl)) { while (IsPairTerm(listl)) {
Term hd = HeadOfTerm( listl ); Term hd = HeadOfTerm( listl );
@ -124,25 +122,41 @@ Yap_ArgList2ToVector (Term listl, const param2_t *def, int n)
} else if (IsApplTerm( hd )) { } else if (IsApplTerm( hd )) {
Functor f = FunctorOfTerm( hd ); Functor f = FunctorOfTerm( hd );
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER; LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
free( a ); LOCAL_Error_Term = hd;
return NULL; free( a );
return NULL;
} }
arity_t arity = ArityOfFunctor( f ); arity_t arity = ArityOfFunctor( f );
if (arity != 1) { if (arity != 1) {
LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE; LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE;
LOCAL_Error_Term = hd;
free( a ); free( a );
return NULL; return NULL;
} }
xarg *na = matchKey2( NameOfFunctor( f ), a, n, def); xarg *na = matchKey2( NameOfFunctor( f ), a, n, def);
na->used = 1; if (na) {
na->tvalue = ArgOfTerm(1, hd); na->used = 1;
na->tvalue = ArgOfTerm(1, hd);
}
} else { } else {
LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER; LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
LOCAL_Error_Term = hd;
free( a ); free( a );
return NULL; return NULL;
} }
listl = TailOfTerm(listl); 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; return a;
} }

2
C/arith1.c
View File

@ -1003,7 +1003,7 @@ p_unary_is( USES_REGS1 )
Term out; Term out;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 1)))) { 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", "functor %s/1 for arithmetic expression",
RepAtom(name)->StrOfAE); RepAtom(name)->StrOfAE);
return FALSE; return FALSE;

2
C/arith2.c
View File

@ -1199,7 +1199,7 @@ p_binary_is( USES_REGS1 )
Term out; Term out;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) { 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", "functor %s/2 for arithmetic expression",
RepAtom(name)->StrOfAE); RepAtom(name)->StrOfAE);
P = FAILCODE; P = FAILCODE;

7
C/arrays.c
View File

@ -316,7 +316,7 @@ GetTermFromArray(DBTerm *ref USES_REGS)
} }
} else { } else {
LOCAL_Error_TYPE = YAP_NO_ERROR; 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); Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return TermNil; return TermNil;
} }
@ -997,7 +997,7 @@ p_create_array( USES_REGS1 )
farray = Yap_MkFunctor(AtomArray, size); farray = Yap_MkFunctor(AtomArray, size);
if (HR+1+size > ASP-1024) { 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); Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage);
return(FALSE); return(FALSE);
} else { } else {
@ -1849,7 +1849,8 @@ p_assign_static( USES_REGS1 )
Yap_Error(TYPE_ERROR_INTEGER,t3,"assign_static"); Yap_Error(TYPE_ERROR_INTEGER,t3,"assign_static");
return (FALSE); return (FALSE);
} }
ptr->ValueOfVE.ints[indx]= i; ptr->
ValueOfVE.ints[indx]= i;
} }
break; break;

2
C/atomic.c
View File

@ -643,6 +643,8 @@ atom_concat3( USES_REGS1 )
} else { } else {
LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1; 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 (at) {
if (Yap_unify(ot, MkAtomTerm(at))) cut_succeed(); 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 CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES; out.type = YAP_STRING_CODES;
if (!Yap_CVT_Text(&inp, &out PASS_REGS)) if (!Yap_CVT_Text(&inp, &out PASS_REGS))
@ -1831,7 +1831,7 @@ YAP_NBufferToString(const char *s, size_t len)
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC; out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len; out.sz = len;
@ -1853,7 +1853,7 @@ YAP_WideBufferToString(const wchar_t *s)
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.w = s; inp.val.w0= s;
inp.type = YAP_STRING_WCHARS; inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES; out.type = YAP_STRING_CODES;
if (!Yap_CVT_Text(&inp, &out PASS_REGS)) if (!Yap_CVT_Text(&inp, &out PASS_REGS))
@ -1873,7 +1873,7 @@ YAP_NWideBufferToString(const wchar_t *s, size_t len)
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.w = s; inp.val.w0 = s;
inp.type = YAP_STRING_WCHARS; inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC; out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len; out.sz = len;
@ -1941,7 +1941,7 @@ YAP_BufferToAtomList(const char *s)
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOMS; out.type = YAP_STRING_ATOMS;
if (!Yap_CVT_Text(&inp, &out PASS_REGS)) if (!Yap_CVT_Text(&inp, &out PASS_REGS))
@ -1961,7 +1961,7 @@ YAP_NBufferToAtomList(const char *s, size_t len)
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC; out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len; out.sz = len;
@ -1983,7 +1983,7 @@ YAP_WideBufferToAtomList(const wchar_t *s)
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.w = s; inp.val.w0 = s;
inp.type = YAP_STRING_WCHARS; inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_ATOMS; out.type = YAP_STRING_ATOMS;
if (!Yap_CVT_Text(&inp, &out PASS_REGS)) if (!Yap_CVT_Text(&inp, &out PASS_REGS))
@ -2003,7 +2003,7 @@ YAP_NWideBufferToAtomList(const wchar_t *s, size_t len)
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.w = s; inp.val.w0 = s;
inp.type = YAP_STRING_WCHARS; inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC; out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len; out.sz = len;
@ -2025,7 +2025,7 @@ YAP_NWideBufferToAtomDiffList(const wchar_t *s, Term t0, size_t len)
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.w = s; inp.val.w0 = s;
inp.type = YAP_STRING_WCHARS; inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF; out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
out.sz = len; out.sz = len;
@ -2048,7 +2048,7 @@ YAP_BufferToDiffList(const char *s, Term t0)
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES|YAP_STRING_DIFF; out.type = YAP_STRING_CODES|YAP_STRING_DIFF;
out.dif = t0; out.dif = t0;
@ -2069,7 +2069,7 @@ YAP_NBufferToDiffList(const char *s, Term t0, size_t len)
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF; out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
out.sz = len; out.sz = len;
@ -2092,7 +2092,7 @@ YAP_WideBufferToDiffList(const wchar_t *s, Term t0)
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.w = s; inp.val.w0 = s;
inp.type = YAP_STRING_WCHARS; inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES|YAP_STRING_DIFF; out.type = YAP_STRING_CODES|YAP_STRING_DIFF;
out.dif = t0; out.dif = t0;
@ -2113,7 +2113,7 @@ YAP_NWideBufferToDiffList(const wchar_t *s, Term t0, size_t len)
CACHE_REGS CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.w = s; inp.val.w0 = s;
inp.type = YAP_STRING_WCHARS; inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF; out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
out.sz = len; out.sz = len;
@ -4036,10 +4036,10 @@ YAP_RequiresExtraStack(size_t sz) {
X_API Int X_API Int
YAP_AtomToInt(Atom At) YAP_AtomToInt(Atom At)
{ {
TranslationEntry *te = Yap_GetTranslationProp(At); TranslationEntry *te = Yap_GetTranslationProp(At,0);
if (te != NIL) return te->Translation; if (te != NIL) return te->Translation;
SWI_Atoms[AtomTranslations] = At; SWI_Atoms[AtomTranslations] = At;
Yap_PutAtomTranslation(At, AtomTranslations); Yap_PutAtomTranslation(At,0, AtomTranslations);
AtomTranslations++; AtomTranslations++;
if (AtomTranslations == MaxAtomTranslations) { if (AtomTranslations == MaxAtomTranslations) {
Atom * nt = (Atom *)malloc(sizeof(Atom)*2*MaxAtomTranslations), *ot = SWI_Atoms; Atom * nt = (Atom *)malloc(sizeof(Atom)*2*MaxAtomTranslations), *ot = SWI_Atoms;
@ -4061,6 +4061,36 @@ YAP_IntToAtom(Int i)
return SWI_Atoms[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 #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 #if HAVE_STRING_H
#include <string.h> #include <string.h>
#endif #endif
#include <heapgc.h>
static void retract_all(PredEntry *, int); 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]; th = Terms[0];
tb = Terms[1]; tb = Terms[1];
tr = Terms[2]; tr = Terms[2];
/* don't do this!! I might have stored a choice-point and changed ASP
Yap_RecoverSlots(3);
*/
if (cl == NULL) { if (cl == NULL) {
UNLOCK(pe->PELock); UNLOCK(pe->PELock);
return FALSE; return FALSE;

1
C/cmppreds.c
View File

@ -1,3 +1,4 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog * * 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; serious = TRUE;
} }
break; 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: case DOMAIN_ERROR_RADIX:
{ {
int i; int i;

6
C/eval.c
View File

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

2
C/exec.c
View File

@ -1687,7 +1687,7 @@ Yap_Reset(yap_reset_t mode)
return res; return res;
} }
static bool bool
is_cleanup_cp(choiceptr cp_b) is_cleanup_cp(choiceptr cp_b)
{ {
PredEntry *pe; 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++) { for (i = 0; i< arity; i++) {
DerefAndCheck(t, tp[0]); DerefAndCheck(t, tp[0]);
*cpc = t; *cpc = t;
Yap_DebugPlWrite(t); fprintf(stderr,"\n"); // Yap_DebugPlWrite(t); fprintf(stderr,"\n");
tp++; tp++;
cpc++; cpc++;
} }
fprintf(stderr,"\n"); //fprintf(stderr,"\n");
return TRUE; return TRUE;
} }

62
C/flags.c
View File

@ -45,6 +45,7 @@ static bool synerr(Term inp);
static bool indexer(Term inp); static bool indexer(Term inp);
static bool getenc(Term inp); static bool getenc(Term inp);
static bool typein( Term inp ); static bool typein( Term inp );
static bool dqf( Term t2 );
static void newFlag( Term fl, Term val ); static void newFlag( Term fl, Term val );
static Int current_prolog_flag(USES_REGS1); static Int current_prolog_flag(USES_REGS1);
@ -86,6 +87,27 @@ static bool indexer( Term inp ) {
return false; 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 ) { static bool isaccess( Term inp ) {
if (inp == TermReadWrite || if (inp == TermReadWrite ||
@ -418,7 +440,7 @@ static bool gc_margin( Term t ) {
} }
static Term mk_argc_list(USES_REGS1) { static Term mk_argc_list(USES_REGS1) {
int i = 0; int i = 1;
Term t = TermNil; Term t = TermNil;
while (i < GLOBAL_argc) { while (i < GLOBAL_argc) {
char *arg = GLOBAL_argv[i]; char *arg = GLOBAL_argv[i];
@ -470,14 +492,24 @@ static Term mk_os_argc_list(USES_REGS1) {
static bool argv(Term inp) { static bool argv(Term inp) {
CACHE_REGS CACHE_REGS
Term t = mk_argc_list(PASS_REGS1); Term t = mk_argc_list(PASS_REGS1);
return Yap_unify(t, inp); 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) { static bool os_argv(Term inp) {
CACHE_REGS CACHE_REGS
Term t = mk_os_argc_list(PASS_REGS1); Term t = mk_os_argc_list(PASS_REGS1);
return Yap_unify(t, inp); 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; return false;
fv = GetFlagProp( AtomOfTerm( tflag ) ); fv = GetFlagProp( AtomOfTerm( tflag ) );
if (!fv && !fv->global) { 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; return FALSE;
} }
if (mod == USER_MODULE && !setYapFlag( tflag, t2) ) if (mod == USER_MODULE && !setYapFlag( tflag, t2) )
@ -792,12 +824,11 @@ static Int prolog_flag(USES_REGS1) {
return cont_prolog_flag( PASS_REGS1 ); return cont_prolog_flag( PASS_REGS1 );
} }
do_cut( 0 ); do_cut( 0 );
{ if (IsVarTerm( Deref(ARG2) ) ) {
Term flag = getYapFlag( Deref(ARG1) ); Term flag = getYapFlag( Deref(ARG1) );
if (flag == 0) if (flag == 0)
return false; return false;
if (Yap_unify( flag, ARG2 ) ) return Yap_unify( flag, ARG2 ) ;
return false;
} }
return setYapFlag( Deref(ARG1), Deref(ARG3) ); return setYapFlag( Deref(ARG1), Deref(ARG3) );
} }
@ -883,7 +914,7 @@ bool setYapFlag( Term tflag, Term t2 )
} else if (fl == TermWarning) { } else if (fl == TermWarning) {
Yap_Warning("Flag %s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE); Yap_Warning("Flag %s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE);
} else { } 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; return FALSE;
} }
@ -935,7 +966,7 @@ Term getYapFlag( Term tflag )
} else if (fl == TermWarning) { } else if (fl == TermWarning) {
Yap_Warning("Flag ~s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE); Yap_Warning("Flag ~s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE);
} else { } 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); RepAtom(AtomOfTerm(fl))->StrOfAE);
} }
return FALSE; return FALSE;
@ -1101,7 +1132,12 @@ setInitialValue( bool bootstrap, flag_func f, const char *s,flag_term *tarr )
if (!t0) if (!t0)
return false; return false;
if (IsAtomTerm(t0) || IsIntTerm(t0)) { if (IsAtomTerm(t0) || IsIntTerm(t0)) {
tarr->at = t0; // do yourself flags
if (t0 == MkAtomTerm(AtomQuery)) {
f(TermNil);
} else {
tarr->at = t0;
}
} else { } else {
tarr->DBT = Yap_StoreTermInDB(t0, 2); tarr->DBT = Yap_StoreTermInDB(t0, 2);
} }
@ -1202,7 +1238,7 @@ do_prolog_flag_property (Term tflag, Term opts USES_REGS)
break; break;
case PROLOG_FLAG_PROPERTY_END: case PROLOG_FLAG_PROPERTY_END:
/* break; */ /* 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 */ /* 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 static void
gc_growtrail(int committed, tr_fr_ptr begsTR, cont *old_cont_top0 USES_REGS) 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 */ /* find all accessible objects on the heap and squeeze out all the rest */
static void static tr_fr_ptr
check_pr_trail(tr_fr_ptr trp USES_REGS) check_pr_trail( tr_fr_ptr rc USES_REGS)
{ {
if ((tr_fr_ptr)LOCAL_TrailTop-TR < 1024) { if ((tr_fr_ptr)LOCAL_TrailTop-TR < 1024) {
size_t n = TR- rc;
if (!Yap_locked_growtrail(0, TRUE) || TRUE) { if (!Yap_locked_growtrail(0, TRUE) || TRUE) {
/* could not find more trail */ /* could not find more trail */
save_machine_regs(); save_machine_regs();
siglongjmp(LOCAL_gc_restore, 2); siglongjmp(LOCAL_gc_restore, 2);
} }
rc = TR-n;
} }
return rc;
} }
/* push the active registers onto the trail for inclusion during gc */ /* 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) push_registers(Int num_regs, yamop *nextop USES_REGS)
{ {
int i; int i;
StaticArrayEntry *sal = LOCAL_StaticArrays; StaticArrayEntry *sal = LOCAL_StaticArrays;
tr_fr_ptr ret = TR;
/* push array entries first */ /* push array entries first */
ArrayEntry *al = LOCAL_DynamicArrays; ArrayEntry *al = LOCAL_DynamicArrays;
GlobalEntry *gl = LOCAL_GlobalVariables; GlobalEntry *gl = LOCAL_GlobalVariables;
TrailTerm(TR++) = LOCAL_GlobalArena; TrailTerm(TR++) = LOCAL_GlobalArena;
while (al) { while (al) {
check_pr_trail(TR PASS_REGS); ret = check_pr_trail(ret PASS_REGS);
TrailTerm(TR++) = al->ValueOfVE; TrailTerm(TR++) = al->ValueOfVE;
al = al->NextAE; al = al->NextAE;
} }
@ -417,7 +428,7 @@ push_registers(Int num_regs, yamop *nextop USES_REGS)
!IsAtomTerm(t) && !IsAtomTerm(t) &&
!IsIntTerm(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); //fprintf(stderr,"in=%s %p\n", gl->AtomOfGE->StrOfAE, gl->global);
TrailTerm(TR++) = t; TrailTerm(TR++) = t;
} }
@ -429,14 +440,14 @@ push_registers(Int num_regs, yamop *nextop USES_REGS)
for (i=0; i < arity; i++) { for (i=0; i < arity; i++) {
Term tlive = sal->ValueOfVE.lterms[i].tlive; Term tlive = sal->ValueOfVE.lterms[i].tlive;
if (!IsVarTerm(tlive) || !IsUnboundVar(&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; TrailTerm(TR++) = tlive;
} }
} }
} }
sal = sal->NextAE; sal = sal->NextAE;
} }
check_pr_trail(TR PASS_REGS); ret = check_pr_trail(ret PASS_REGS);
TrailTerm(TR) = LOCAL_GcGeneration; TrailTerm(TR) = LOCAL_GcGeneration;
TR++; TR++;
TrailTerm(TR) = LOCAL_GcPhase; TrailTerm(TR) = LOCAL_GcPhase;
@ -451,12 +462,12 @@ push_registers(Int num_regs, yamop *nextop USES_REGS)
*topslot = LOCAL_SlotBase + LOCAL_CurSlot; *topslot = LOCAL_SlotBase + LOCAL_CurSlot;
while (curslot < topslot) { while (curslot < topslot) {
// printf("%p <- %p\n", TR, topslot); // printf("%p <- %p\n", TR, topslot);
check_pr_trail(TR PASS_REGS); ret = check_pr_trail(ret PASS_REGS);
TrailTerm(TR++) = *curslot++; TrailTerm(TR++) = *curslot++;
} }
} }
for (i = 1; i <= num_regs; i++) { 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]; TrailTerm(TR++) = (CELL) XREGS[i];
} }
/* push any live registers we might have hanging around */ /* push any live registers we might have hanging around */
@ -474,13 +485,14 @@ push_registers(Int num_regs, yamop *nextop USES_REGS)
lab++; lab++;
} }
if (curr & 1) { if (curr & 1) {
check_pr_trail(TR PASS_REGS); ret = check_pr_trail( ret PASS_REGS);
TrailTerm(TR++) = XREGS[i]; TrailTerm(TR++) = XREGS[i];
} }
curr >>= 1; curr >>= 1;
} }
} }
} }
return ret;
} }
@ -1290,7 +1302,8 @@ mark_variable(CELL_PTR current USES_REGS)
goto begin; goto begin;
#ifdef DEBUG #ifdef DEBUG
} else if (next < (CELL *)LOCAL_GlobalBase || next > (CELL *)LOCAL_TrailTop) { } 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 #endif
} else { } else {
#ifdef COROUTING #ifdef COROUTING
@ -1559,14 +1572,16 @@ Yap_mark_external_reference(CELL *ptr) {
static void static void
mark_regs(tr_fr_ptr old_TR USES_REGS) 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 /* first, whatever we dumped on the trail. Easier just to do
the registers separately? */ 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); 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 */ /* 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; LOCAL_HGEN = H0;
} }
/* fprintf(stderr,"LOCAL_HGEN is %ld, %p, %p/%p\n", IntegerOfTerm(Yap_ReadTimedVar(LOCAL_GcGeneration)), LOCAL_HGEN, H,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); LOCAL_OldTR = old_TR = push_registers(predarity, nextop PASS_REGS);
push_registers(predarity, nextop PASS_REGS);
/* make sure we clean bits after a reset */ /* make sure we clean bits after a reset */
marking_phase(old_TR, current_env, nextop PASS_REGS); marking_phase(old_TR, current_env, nextop PASS_REGS);
if (LOCAL_total_oldies > ((LOCAL_HGEN-H0)*8)/10) { if (LOCAL_total_oldies > ((LOCAL_HGEN-H0)*8)/10) {

15
C/init.c
View File

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

11
C/other.c
View File

@ -60,11 +60,16 @@ Yap_MkNewPairTerm(void)
return (AbsPair(p)); 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 Term
Yap_MkApplTerm(Functor f, arity_t n, const Term *a) Yap_MkApplTerm(Functor f, arity_t n, const Term *a)
/* build compound term with functor f and n {
* args a */
{
CACHE_REGS CACHE_REGS
CELL *t = HR; 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) { inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) {
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) || if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
LOCAL_tokptr->TokInfo != (Term)c) { 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; FAIL;
} }
NextToken; NextToken;
@ -844,6 +844,7 @@ case Var_tok:
FAIL; FAIL;
case Ponctuation_tok: case Ponctuation_tok:
switch ((int)LOCAL_tokptr->TokInfo) { switch ((int)LOCAL_tokptr->TokInfo) {
case '(': case '(':
case 'l': /* non solo ( */ case 'l': /* non solo ( */
@ -1097,6 +1098,7 @@ Term Yap_Parse(UInt prio) {
Volatile Term t; Volatile Term t;
JMPBUFF FailBuff; JMPBUFF FailBuff;
yhandle_t sls = Yap_CurrentSlot(PASS_REGS1);
if (!sigsetjmp(FailBuff.JmpBuff, 0)) { if (!sigsetjmp(FailBuff.JmpBuff, 0)) {
t = ParseTerm(prio, &FailBuff PASS_REGS); t = ParseTerm(prio, &FailBuff PASS_REGS);
if (LOCAL_Error_TYPE == SYNTAX_ERROR) { if (LOCAL_Error_TYPE == SYNTAX_ERROR) {
@ -1105,8 +1107,10 @@ Term Yap_Parse(UInt prio) {
} }
// if (LOCAL_tokptr->Tok != Ord(eot_tok)) // if (LOCAL_tokptr->Tok != Ord(eot_tok))
// return (0L); // return (0L);
Yap_CloseSlots( sls );
return (t); return (t);
} else } else
Yap_CloseSlots( sls );
return (0); 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) #define Yap_op_from_opcode(OP) OpcodeID(OP)
static void RestoreFlags( UInt NFlags )
{
}
#include "rheap.h" #include "rheap.h"
static void static void

4
C/qlyw.c
View File

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

4
C/save.c
View File

@ -1207,6 +1207,10 @@ RestoreSWIHash(void)
} }
static void RestoreFlags( UInt NFlags )
{
}
#include "rheap.h" #include "rheap.h"
/* restore the atom entries which are invisible for the user */ /* 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 #else
static Int p_halt(USES_REGS1); static Int p_halt(USES_REGS1);
#endif #endif
static Int init_current_predicate(USES_REGS1); static Int current_predicate(USES_REGS1);
static Int cont_current_predicate(USES_REGS1); static Int cont_current_predicate(USES_REGS1);
static OpEntry *NextOp(OpEntry *CACHE_TYPE); static OpEntry *NextOp(OpEntry *CACHE_TYPE);
static Int init_current_op(USES_REGS1); 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 static Int
SkipListCodes(Term *l, Term **tailp, Int *atoms, int *wide) SkipListCodes(Term *l, Term **tailp, Int *atoms, bool *wide)
{ {
Int length = 0; Int length = 0;
Term *s; /* slow */ Term *s; /* slow */
@ -193,6 +193,7 @@ SkipListCodes(Term *l, Term **tailp, Int *atoms, int *wide)
do_derefa(v,l,derefa_unk,derefa_nonvar); do_derefa(v,l,derefa_unk,derefa_nonvar);
s = l; s = l;
*wide = false;
if (*l == TermNil) { if (*l == TermNil) {
@ -248,13 +249,13 @@ SkipListCodes(Term *l, Term **tailp, Int *atoms, int *wide)
static void * 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; Int atoms = 0;
CELL *r = NULL; CELL *r = NULL;
Int n; Int n;
*widep = FALSE; *widep = false;
n = SkipListCodes(&t, &r, &atoms, widep); n = SkipListCodes(&t, &r, &atoms, widep);
if (n < 0) { if (n < 0) {
LOCAL_Error_TYPE = -n; 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 * 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; Int atoms = 0;
CELL *r = NULL; CELL *r = NULL;
Int n; Int n;
*widep = FALSE; *widep = false;
n = SkipListCodes(&t, &r, &atoms, widep); n = SkipListCodes(&t, &r, &atoms, widep);
if (n < 0) { if (n < 0) {
LOCAL_Error_TYPE = -n; 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 static yap_error_number
gen_type_error(int flags) { gen_type_error(int flags) {
if ((flags & (YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_ATOMS_CODES|YAP_STRING_BIG)) == if ((flags & (YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_ATOMS_CODES|YAP_STRING_BIG)) ==
@ -400,138 +361,88 @@ Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *l
{ {
char *s; char *s;
wchar_t *ws; wchar_t *ws;
bool wide;
/* we know what the term is */ /* we know what the term is */
switch (inp->type & YAP_TYPE_MASK) { if (inp->type & YAP_STRING_STRING && !IsVarTerm(inp->val.t) && IsStringTerm(inp->val.t)) { const char *s;
case YAP_STRING_STRING: s = StringOfTerm( inp->val.t );
{ const char *s; if ( s == NULL ) {
if (IsVarTerm(inp->val.t)) { return 0L;
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;
} }
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 // this is a term, extract to a sfer, and representation is wide
*minimal = TRUE; *minimal = TRUE;
{ int wide = FALSE;
int wide = FALSE; *enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 );
s = Yap_ListOfCodesToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS);
if (!s) {
return NULL;
}
*enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 );
}
return s; 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 // this is a term, extract to a buffer, and representation is wide
*minimal = TRUE; *minimal = TRUE;
{ s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS);
int wide = FALSE; if (!s) return NULL;
s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS); if (wide) { *enc = ENC_WCHAR; }
if (!s) return NULL; else { *enc = ENC_ISO_LATIN1; }
if (wide) { *enc = ENC_WCHAR; }
else { *enc = ENC_ISO_LATIN1; }
}
return s; return s;
case YAP_STRING_ATOMS_CODES: }
// this is a term, extract to a buffer, and representation is wide if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) {
*minimal = TRUE; if (buf) s = buf;
{ else s = Yap_PreAllocCodeSpace();
int wide = FALSE; AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char);
s = Yap_ListToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS); if (snprintf(s, LOCAL_MAX_SIZE-1, Int_FORMAT, IntegerOfTerm(inp->val.t)) < 0) {
if (!s) { AUX_ERROR( inp->val.t, 2*LOCAL_MAX_SIZE, s, char);
return NULL;
} }
*enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 ); *enc = ENC_ISO_LATIN1;
*lengp = strlen(s);
return s;
} }
return s; if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) {
case YAP_STRING_ATOM: if (buf) s = buf;
// this is a term, extract to a buffer, and representation is wide else s = Yap_PreAllocCodeSpace();
*minimal = TRUE; AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char);
if (IsVarTerm(inp->val.t)) { if ( !Yap_FormatFloat( FloatOfTerm(inp->val.t), &s, LOCAL_MAX_SIZE-1 ) ) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR; AUX_ERROR( inp->val.t, 2*LOCAL_MAX_SIZE, s, char);
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;
} }
*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 #if USE_GMP
case YAP_STRING_BIG: if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) {
if (buf) s = buf; if (buf) s = buf;
else s = Yap_PreAllocCodeSpace(); else s = Yap_PreAllocCodeSpace();
if ( !Yap_mpz_to_string( inp->val.b, s, LOCAL_MAX_SIZE-1 , 10 ) ) { if ( !Yap_mpz_to_string( Yap_BigIntOfTerm(inp->val.t), s, LOCAL_MAX_SIZE-1 , 10 ) ) {
AUX_ERROR( MkIntTerm(0), LOCAL_MAX_SIZE, s, char); 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 #endif
case YAP_STRING_CHARS: if (inp->type & YAP_STRING_TERM)
*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:
{ {
char *s, *o; char *s, *o;
if (buf) s = buf; 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); o = Yap_TermToString(inp->val.t, s, sz, lengp, ENC_ISO_UTF8, 0);
return s; return s;
} }
default: if (inp->type & YAP_STRING_CHARS) {
if (!(inp->type & YAP_STRING_TERM)) { *enc = ENC_ISO_LATIN1;
return NULL; if (inp->type & YAP_STRING_NCHARS)
} else { *lengp = inp->sz;
Term t = inp->val.t; else
if (IsVarTerm(t)) { *lengp = strlen(inp->val.c);
LOCAL_Error_TYPE = INSTANTIATION_ERROR; return (void *)inp->val.c;
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_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 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; return at;
} }
default: 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; 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 static ssize_t
write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS) write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS)
{ {
@ -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); write_number( inp, out, enc, minimal, leng PASS_REGS);
return out->val.t != 0; return out->val.t != 0;
case YAP_STRING_CHARS: case YAP_STRING_CHARS:
out->val.c = inp; {
return 1; size_t sz = write_buffer( inp, out, enc, minimal, leng PASS_REGS);
return((Int)sz > 0);
}
case YAP_STRING_WCHARS: case YAP_STRING_WCHARS:
out->val.w = inp; {
return MkIntTerm(0); size_t sz = write_wbuffer( inp, out, enc, minimal, leng PASS_REGS);
case YAP_STRING_LITERAL: return((Int)sz > 0);
return 0; }
default: default:
if (!(out->type & YAP_STRING_TERM)) if (!(out->type & YAP_STRING_TERM))
return 0; return 0;
if (out->type & (YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG)) 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); out->val.t = MkAtomTerm(at);
return at != NIL; return at != NIL;
} }
if (out->type & (YAP_STRING_LITERAL))
if ((out->val.t = if ((out->val.t =
string_to_term( inp, out, enc, minimal, leng PASS_REGS)) != 0L) string_to_term( inp, out, enc, minimal, leng PASS_REGS)) != 0L)
return out->val.t != 0; return out->val.t != 0;
return FALSE; }
} return FALSE;
} }
int int
@ -1208,7 +1297,6 @@ concat( int n, seq_tv_t *out, void *sv[], encoding_t encv[], size_t lengv[] USES
/* wide atom */ /* wide atom */
wchar_t *buf = (wchar_t *)HR; wchar_t *buf = (wchar_t *)HR;
Atom at; Atom at;
Term t = ARG1;
LOCAL_ERROR( sz+3 ); LOCAL_ERROR( sz+3 );
for (i = 0; i < n ; i ++) { for (i = 0; i < n ; i ++) {
if (encv[i] == ENC_WCHAR) { 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 */ /* atom */
char *buf = (char *)HR; char *buf = (char *)HR;
Atom at; Atom at;
Term t = ARG1;
LOCAL_TERM_ERROR( sz/sizeof(CELL)+3 ); LOCAL_TERM_ERROR( sz/sizeof(CELL)+3 );
for (i = 0; i < n ; i ++) { 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) { if (enc == ENC_WCHAR) {
/* wide atom */ /* wide atom */
wchar_t *nbuf = (wchar_t *)HR; wchar_t *nbuf = (wchar_t *)HR;
Term t = TermNil;
wchar_t *ptr = (wchar_t *)buf + min; wchar_t *ptr = (wchar_t *)buf + min;
if (max>min) { if (max>min) {
LOCAL_ERROR( (max-min)*sizeof(wchar_t) ); 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; char *nbuf = (char *)HR;
if (max>min) { if (max>min) {
Term t = TermNil;
char *ptr = (char *)buf + min; char *ptr = (char *)buf + min;
LOCAL_ERROR( max-min ); LOCAL_ERROR( max-min );
memcpy( nbuf, ptr, (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 { } else {
/* atom */ /* atom */
wchar_t *nbuf = (wchar_t *)HR; wchar_t *nbuf = (wchar_t *)HR;
Term t = ARG1;
const char *ptr = utf8_skip ( (const char *)buf, min ); const char *ptr = utf8_skip ( (const char *)buf, min );
int chr; int chr;

32
C/traced_absmi_insts.h
View File

@ -35,11 +35,11 @@ if (P== NULL) goto NoStackCommitX;
*****************************************************************/ *****************************************************************/
BOp(Ystop, l); BOp(Ystop, l);
goto Ystop; goto _Ystop;
ENDBOp(); ENDBOp();
BOp(Nstop, e); BOp(Nstop, e);
goto Nstop; goto _Nstop;
ENDBOp(); ENDBOp();
/***************************************************************** /*****************************************************************
@ -76,7 +76,7 @@ CACHE_Y(YREG);
ENDOp(); ENDOp();
/* retry_me Label,NArgs */ /* retry_me Label,NArgs */
Op(retry_me, Otapl); Op(retry_me, OBtapl);
EMIT_ENTRY_BLOCK(PREG,RETRY_ME_INSTINIT); EMIT_ENTRY_BLOCK(PREG,RETRY_ME_INSTINIT);
CACHE_Y(B); CACHE_Y(B);
/* After retry, cut should be pointing at the parent /* After retry, cut should be pointing at the parent
@ -14533,43 +14533,43 @@ S_SREG = RepAppl(d0);
} }
BOp(unify_l_string ,ou); BOp(unify_l_string ,ou);
goto Ystop; goto _Ystop;
ENDBOp(); ENDBOp();
BOp(unify_string ,ou); BOp(unify_string ,ou);
goto Ystop; goto _Ystop;
ENDBOp(); ENDBOp();
BOp(get_string ,xu); BOp(get_string ,xu);
goto Ystop; goto _Ystop;
ENDBOp(); ENDBOp();
BOp(get_atom_exo ,x); BOp(get_atom_exo ,x);
goto Ystop; goto _Ystop;
ENDBOp(); ENDBOp();
BOp(retry_exo_udi ,lp); BOp(retry_exo_udi ,lp);
goto Ystop; goto _Ystop;
ENDBOp(); ENDBOp();
BOp(retry_exo ,lp); BOp(retry_exo ,lp);
goto Ystop; goto _Ystop;
ENDBOp(); ENDBOp();
BOp(retry_udi ,p); BOp(retry_udi ,p);
goto Ystop; goto _Ystop;
ENDBOp(); ENDBOp();
BOp(retry_all_exo ,lp); BOp(retry_all_exo ,lp);
goto Ystop; goto _Ystop;
ENDBOp(); ENDBOp();
BOp(enter_exo ,e); BOp(enter_exo ,e);
goto Ystop; goto _Ystop;
ENDBOp(); ENDBOp();
BOp(try_exo ,lp); BOp(try_exo ,lp);
goto Ystop; goto _Ystop;
ENDBOp(); ENDBOp();
BOp(try_exo_udi ,lp); BOp(try_exo_udi ,lp);
goto Ystop; goto _Ystop;
ENDBOp(); ENDBOp();
BOp(try_all_exo ,lp); BOp(try_all_exo ,lp);
goto Ystop; goto _Ystop;
ENDBOp(); ENDBOp();
BOp(try_udi ,p); BOp(try_udi ,p);
goto Ystop; goto _Ystop;
ENDBOp(); 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_complex(CELL *, CELL *, CELL *);
static int OCUnify(register CELL, register CELL); static int OCUnify(register CELL, register CELL);
static Int p_ocunify( USES_REGS1 ); 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 */ /* 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); 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 CACHE_REGS
struct write_globs wglb; struct write_globs wglb;
int sno; 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) if (sno < 0)
return FALSE; return FALSE;
wglb.stream = GLOBAL_Stream+sno;
wrputf(f, &wglb); wrputf(f, &wglb);
GLOBAL_Stream[sno].status = Free_Stream_f; so = Yap_MemExportStreamPtr(sno);
Yap_CloseStream(sno);
*s = so;
return TRUE; return TRUE;
} }
@ -1199,8 +1204,10 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int prio
/* consumer */ /* consumer */
/* write options */ /* write options */
{ {
CACHE_REGS
struct write_globs wglb; struct write_globs wglb;
struct rewind_term rwt; struct rewind_term rwt;
yhandle_t sls = Yap_CurrentSlot(PASS_REGS1);
if (!mywrite) { if (!mywrite) {
CACHE_REGS CACHE_REGS
@ -1235,9 +1242,8 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int prio
if (flags & Fullstop_f) { if (flags & Fullstop_f) {
wrputc('.', wglb.stream); wrputc('.', wglb.stream);
wrputc(' ', wglb.stream); wrputc(' ', wglb.stream);
} else {
wrputc(' ', wglb.stream);
} }
} }
restore_from_write(&rwt, &wglb); 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 */ #endif /* FROZEN_STACKS */
#if !defined(THREADS) #if !defined(THREADS)
/* use actual addresses for regs */ /* use actual addresses for regs */
#define PRECOMPUTE_REGADDRESS 1 #define PRECOMPUTE_REGADDRESS 1

10
H/YapGFlagInfo.h
View File

@ -71,7 +71,7 @@ running on an Apple machine.
*/ */
#endif #endif
YAP_FLAG( ARCH_FLAG, "arch", false, isatom, YAP_ARCH , NULL ), 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( ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true, boolean, "true" , NULL ),
YAP_FLAG( BACKQUOTED_STRING_FLAG, "backquoted_string", true, isatom, "string" , ), /**> YAP_FLAG( BACKQUOTED_STRING_FLAG, "backquoted_string", true, isatom, "string" , ), /**>
If _Value_ is unbound, tell whether a double quoted list of characters 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 If `off` (default) consider the character `$` a control character, if
`on` consider `$` a lower case character. `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 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, 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 ` YAP_FLAG( FAST_FLAG, "fast", true, boolean, "false" , NULL ), /**< `fast `
If `on` allow fast machine code, if `off` (default) disable it. Only 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( 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 C-library `printf()` format specification used by write/1 and
friends to determine how floating point numbers are printed. The 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). libraries (`.DLL` files).
*/ */
YAP_FLAG( OPTIMISE_FLAG, "optimise", true, boolean, "false" , NULL ), 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( PID_FLAG, "pid", false, ro, "0" , NULL ),
YAP_FLAG( PIPE_FLAG, "pipe", true, boolean, "true" , NULL ), YAP_FLAG( PIPE_FLAG, "pipe", true, boolean, "true" , NULL ),
YAP_FLAG( PROFILING_FLAG, "profiling", true, boolean, "false" , NULL ), /**< `profiling ` 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. /// @brief reboot the slot system.
/// Used when wwe start from scratch (Reset). /// Used when wwe start from scratch (Reset).
#define Yap_RebootSlots( wid ) Yap_RebootSlots__( wid PASS_REGS ) #define Yap_RebootSlots( wid ) Yap_RebootSlots__( wid PASS_REGS )
static inline void static inline void
Yap_RebootSlots__( int wid USES_REGS ) { Yap_RebootSlots__( int wid USES_REGS ) {
// fprintf( stderr, " StartSlots = %ld", LOCAL_CurSlot); // // fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot);
REMOTE_CurSlot(wid) = 1; REMOTE_CurSlot(wid) = 1;
} }
@ -65,7 +67,8 @@ Yap_RebootSlots__( int wid USES_REGS ) {
static inline yhandle_t static inline yhandle_t
Yap_StartSlots__( USES_REGS1 ) { Yap_StartSlots__( USES_REGS1 ) {
// fprintf( stderr, " StartSlots = %ld", LOCAL_CurSlot); // // fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot);
// fprintf(stderr,"SS %s:%d\n", __FUNCTION__, __LINE__);;
if (LOCAL_CurSlot < 0) { if (LOCAL_CurSlot < 0) {
Yap_Error( SYSTEM_ERROR, 0L, " StartSlots = %ld", LOCAL_CurSlot); Yap_Error( SYSTEM_ERROR, 0L, " StartSlots = %ld", LOCAL_CurSlot);
} }
@ -78,6 +81,7 @@ if (LOCAL_CurSlot < 0) {
static inline void static inline void
Yap_CloseSlots__( yhandle_t slot USES_REGS ) { Yap_CloseSlots__( yhandle_t slot USES_REGS ) {
// fprintf(stderr,"CS %s:%d\n", __FUNCTION__, __LINE__);;
LOCAL_CurSlot = slot; LOCAL_CurSlot = slot;
} }
@ -92,6 +96,7 @@ Yap_CurrentSlot( USES_REGS1 ) {
static inline Term static inline Term
Yap_GetFromSlot__(yhandle_t slot USES_REGS) Yap_GetFromSlot__(yhandle_t slot USES_REGS)
{ {
// fprintf(stderr,"GS %s:%d\n", __FUNCTION__, __LINE__);;
return(Deref(LOCAL_SlotBase[slot])); return(Deref(LOCAL_SlotBase[slot]));
} }
@ -99,6 +104,7 @@ Yap_GetFromSlot__(yhandle_t slot USES_REGS)
static inline Term static inline Term
Yap_GetDerefedFromSlot(yhandle_t slot USES_REGS) Yap_GetDerefedFromSlot(yhandle_t slot USES_REGS)
{ {
// fprintf(stderr,"GDS %s:%d\n", __FUNCTION__, __LINE__);
return LOCAL_SlotBase[slot]; return LOCAL_SlotBase[slot];
} }
@ -106,6 +112,7 @@ Yap_GetDerefedFromSlot(yhandle_t slot USES_REGS)
static inline Term static inline Term
Yap_GetPtrFromSlot(yhandle_t slot USES_REGS) Yap_GetPtrFromSlot(yhandle_t slot USES_REGS)
{ {
// fprintf(stderr,"GPS %s:%d\n", __FUNCTION__, __LINE__);
return LOCAL_SlotBase[slot]; return LOCAL_SlotBase[slot];
} }
@ -123,6 +130,7 @@ Yap_AddressFromSlot__(yhandle_t slot USES_REGS)
static inline void static inline void
Yap_PutInSlot(yhandle_t slot, Term t USES_REGS) Yap_PutInSlot(yhandle_t slot, Term t USES_REGS)
{ {
// fprintf(stderr,"PS %s:%d\n", __FUNCTION__, __LINE__);
LOCAL_SlotBase[slot] = t; LOCAL_SlotBase[slot] = t;
} }
@ -135,7 +143,9 @@ ensure_slots(int N USES_REGS)
{ {
if (LOCAL_CurSlot+N >= LOCAL_NSlots) { if (LOCAL_CurSlot+N >= LOCAL_NSlots) {
size_t inc = max(16*1024, LOCAL_NSlots/2); // measured in cells 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_SlotBase = (CELL *)realloc( LOCAL_SlotBase, (inc + LOCAL_NSlots )*sizeof(CELL));
LOCAL_NSlots += inc;
if (!LOCAL_SlotBase) { if (!LOCAL_SlotBase) {
unsigned long int kneeds = ((inc + LOCAL_NSlots )*sizeof(CELL))/1024; 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); 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) Yap_InitSlot__(Term t USES_REGS)
{ {
yhandle_t old_slots = LOCAL_CurSlot; yhandle_t old_slots = LOCAL_CurSlot;
// fprintf(stderr,"IS %s:%d\n", __FUNCTION__, __LINE__);
ensure_slots( 1 PASS_REGS); ensure_slots( 1 PASS_REGS);
LOCAL_SlotBase[old_slots] = t; LOCAL_SlotBase[old_slots] = t;
@ -165,10 +176,11 @@ Yap_NewSlots__(int n USES_REGS)
{ {
yhandle_t old_slots = LOCAL_CurSlot; yhandle_t old_slots = LOCAL_CurSlot;
int i; int i;
// fprintf(stderr,"NS %s:%d\n", __FUNCTION__, __LINE__);
ensure_slots(n PASS_REGS); ensure_slots(n PASS_REGS);
for (i = 0; i< n; i++) { for (i = 0; i< n; i++) {
RESET_VARIABLE(Yap_AddressFromSlot(old_slots+i) ); LOCAL_SlotBase[old_slots+i] = MkVarTerm();
} }
LOCAL_CurSlot += n; LOCAL_CurSlot += n;
return old_slots; return old_slots;
@ -182,6 +194,7 @@ Yap_InitSlots__(int n, Term *ts USES_REGS)
{ {
yhandle_t old_slots = LOCAL_CurSlot; yhandle_t old_slots = LOCAL_CurSlot;
int i; int i;
// fprintf(stderr,"1S %s:%d\n", __FUNCTION__, __LINE__);
ensure_slots( n PASS_REGS); ensure_slots( n PASS_REGS);
for (i=0; i< n; i++) for (i=0; i< n; i++)
@ -196,6 +209,7 @@ Yap_RecoverSlots(int n, yhandle_t topSlot USES_REGS)
{ {
if (topSlot + n < LOCAL_CurSlot) if (topSlot + n < LOCAL_CurSlot)
return false; return false;
// fprintf(stderr,"RS %s:%d\n", __FUNCTION__, __LINE__);
#ifdef DEBUG #ifdef DEBUG
if (topSlot + n > LOCAL_CurSlot) { if (topSlot + n > LOCAL_CurSlot) {
Yap_Error(SYSTEM_ERROR, 0 /* TermNil */, "Inconsistent slot state in Yap_RecoverSlots."); Yap_Error(SYSTEM_ERROR, 0 /* TermNil */, "Inconsistent slot state in Yap_RecoverSlots.");

12
H/YapHeap.h
View File

@ -198,6 +198,18 @@ extern struct various_codes *Yap_heap_regs;
//#include "dglobals.h" //#include "dglobals.h"
//#include "dlocals.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 Yap_CurrentModule: access the current module for looking
up predicates up predicates

109
H/YapText.h
View File

@ -28,33 +28,36 @@
* mirroring * mirroring
*/ */
#include "Yap.h"
#include "pl-utf8.h" #include "pl-utf8.h"
// standard strings // standard strings
typedef enum { typedef enum {
YAP_STRING_STRING = 0x1, YAP_STRING_STRING = 0x1, /// target is a string term
YAP_STRING_CODES = 0x2, YAP_STRING_CODES = 0x2, /// target is a list of integer codes
YAP_STRING_ATOMS = 0x4, YAP_STRING_ATOMS = 0x4, /// target is a list of kength-1 atom
YAP_STRING_ATOMS_CODES = 0x6, YAP_STRING_ATOMS_CODES = 0x6, /// targt is list of atoms or codes
YAP_STRING_CHARS = 0x8, YAP_STRING_CHARS = 0x8, /// target is a buffer, with byte-sized units
YAP_STRING_WCHARS = 0x10, YAP_STRING_WCHARS = 0x10, /// target is a buffer of wide chars
YAP_STRING_ATOM = 0x20, YAP_STRING_ATOM = 0x20, /// tarfet is an ayom
YAP_STRING_INT = 0x40, YAP_STRING_INT = 0x40, /// target is an integer term
YAP_STRING_FLOAT = 0x80, YAP_STRING_FLOAT = 0x80, /// target is a floar term
YAP_STRING_BIG = 0x100, YAP_STRING_BIG = 0x100, /// target is an big num term
YAP_STRING_LITERAL = 0x200, YAP_STRING_DATUM = 0x200, /// associated with previous 3, use actual object if type, not tern
YAP_STRING_LENGTH = 0x400, YAP_STRING_LENGTH = 0x400, /// input: length is fixed; output: return integer with length
YAP_STRING_NTH = 0x800, 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; } 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; typedef UInt seq_type_t;
@ -64,8 +67,10 @@ typedef union {
Float f; Float f;
Int i; Int i;
MP_INT *b; MP_INT *b;
const char *c; const char *c0;
const wchar_t *w; const wchar_t *w0;
char *c;
wchar_t *w;
Atom a; Atom a;
size_t l; size_t l;
int d; int d;
@ -80,6 +85,7 @@ typedef struct text_cvt {
size_t sz; // fixed sz, or -1 size_t sz; // fixed sz, or -1
Term dif; // diff-list, usually TermNil Term dif; // diff-list, usually TermNil
size_t max; // max_size size_t max; // max_size
encoding_t enc;
} seq_tv_t; } seq_tv_t;
// string construction // string construction
@ -341,7 +347,7 @@ Yap_CharsToAtom( const char *s USES_REGS )
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.sz = 0; inp.sz = 0;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOM; out.type = YAP_STRING_ATOM;
@ -355,7 +361,7 @@ Yap_CharsToListOfAtoms( const char *s USES_REGS )
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.sz = 0; inp.sz = 0;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOMS; out.type = YAP_STRING_ATOMS;
@ -369,7 +375,7 @@ Yap_CharsToListOfCodes( const char *s USES_REGS )
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.sz = 0; inp.sz = 0;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES; out.type = YAP_STRING_CODES;
@ -383,7 +389,7 @@ Yap_CharsToDiffListOfCodes( const char *s, Term tail USES_REGS )
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.sz = 0; inp.sz = 0;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_DIFF|YAP_STRING_CODES; out.type = YAP_STRING_DIFF|YAP_STRING_CODES;
@ -398,7 +404,7 @@ Yap_CharsToString( const char *s USES_REGS )
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.sz = 0; inp.sz = 0;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_STRING; out.type = YAP_STRING_STRING;
@ -407,12 +413,33 @@ Yap_CharsToString( const char *s USES_REGS )
return out.val.t; 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 static inline Term
Yap_CharsToTDQ( const char *s, Term mod USES_REGS ) Yap_CharsToTDQ( const char *s, Term mod USES_REGS )
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.sz = 0; inp.sz = 0;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
inp.mod = mod; inp.mod = mod;
@ -429,7 +456,7 @@ Yap_CharsToTBQ( const char *s, Term mod USES_REGS )
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.sz = 0; inp.sz = 0;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
inp.mod = mod; inp.mod = mod;
@ -621,7 +648,7 @@ Yap_NCharsToAtom( const char *s, size_t len USES_REGS )
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.sz = len; inp.sz = len;
inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS; inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS;
out.type = YAP_STRING_ATOM; out.type = YAP_STRING_ATOM;
@ -636,7 +663,7 @@ Yap_CharsToDiffListOfAtoms( const char *s, Term tail USES_REGS )
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.type = YAP_STRING_CHARS; inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOMS|YAP_STRING_DIFF; out.type = YAP_STRING_ATOMS|YAP_STRING_DIFF;
out.dif = tail; out.dif = tail;
@ -651,7 +678,7 @@ Yap_NCharsToListOfCodes( const char *s, size_t len USES_REGS )
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.sz = len; inp.sz = len;
inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS; inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS;
out.type = YAP_STRING_CODES; out.type = YAP_STRING_CODES;
@ -666,7 +693,7 @@ Yap_NCharsToString( const char *s, size_t len USES_REGS )
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.sz = len; inp.sz = len;
inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS; inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS;
out.type = YAP_STRING_STRING; 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; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS; inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS;
inp.sz = len; inp.sz = len;
inp.mod = mod; inp.mod = mod;
@ -699,7 +726,7 @@ Yap_NCharsToTBQ( const char *s, size_t len, Term mod USES_REGS )
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.c = s; inp.val.c0 = s;
inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS; inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS;
inp.sz = len; inp.sz = len;
inp.mod = mod; inp.mod = mod;
@ -765,7 +792,7 @@ Yap_NWCharsToAtom( const wchar_t *s, size_t len USES_REGS )
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.w = s; inp.val.w0 = s;
inp.sz = len; inp.sz = len;
inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS; inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS;
out.type = YAP_STRING_ATOM; 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; seq_tv_t inp, out;
inp.val.w = s; inp.val.w0 = s;
inp.sz = len; inp.sz = len;
inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS; inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS;
out.type = YAP_STRING_ATOMS; 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; seq_tv_t inp, out;
inp.val.w = s; inp.val.w0 = s;
inp.sz = len; inp.sz = len;
inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS; inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS;
out.type = YAP_STRING_CODES; 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; seq_tv_t inp, out;
inp.val.w = s; inp.val.w0 = s;
inp.sz = len; inp.sz = len;
inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS; inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS;
out.type = YAP_STRING_STRING; out.type = YAP_STRING_STRING;
@ -940,7 +967,7 @@ static inline Term
Yap_WCharsToListOfCodes(const wchar_t *s USES_REGS) Yap_WCharsToListOfCodes(const wchar_t *s USES_REGS)
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.w = s; inp.val.w0 = s;
inp.sz = 0; inp.sz = 0;
inp.type = YAP_STRING_WCHARS; inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES; out.type = YAP_STRING_CODES;
@ -954,7 +981,7 @@ Yap_WCharsToTDQ( wchar_t *s, Term mod USES_REGS )
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.w = s; inp.val.w0 = s;
inp.type = YAP_STRING_WCHARS; inp.type = YAP_STRING_WCHARS;
inp.sz = 0; inp.sz = 0;
inp.mod = mod; inp.mod = mod;
@ -987,7 +1014,7 @@ static inline Term
Yap_WCharsToString(const wchar_t *s USES_REGS) Yap_WCharsToString(const wchar_t *s USES_REGS)
{ {
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.w = s; inp.val.w0 = s;
inp.sz = 0; inp.sz = 0;
inp.type = YAP_STRING_WCHARS; inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_STRING; 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 ); Int Yap_source_line_no( void );
Atom Yap_source_file_name( 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 void
Yap_install_blobs(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 */ Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */ 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; */ Int Translation; /* used to hash the atom as an integer; */
} TranslationEntry; } TranslationEntry;
@ -1271,11 +1272,11 @@ AbsTranslationProp (TranslationEntry * p)
#endif #endif
#define TranslationProperty 0xfff4 #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; */ /* get translation prop for atom; */
static inline TranslationEntry * static inline TranslationEntry *
Yap_GetTranslationProp(Atom at) Yap_GetTranslationProp(Atom at, arity_t arity)
{ {
Prop p0; Prop p0;
AtomEntry *ae = RepAtom(at); AtomEntry *ae = RepAtom(at);
@ -1283,10 +1284,12 @@ Yap_GetTranslationProp(Atom at)
READ_LOCK(ae->ARWLock); READ_LOCK(ae->ARWLock);
p = RepTranslationProp(p0 = ae->PropsOfAE); p = RepTranslationProp(p0 = ae->PropsOfAE);
while (p0 && p->KindOfPE != TranslationProperty) while (p0 && (p->KindOfPE != TranslationProperty ||
p->arity != arity))
p = RepTranslationProp(p0 = p->NextOfPE); p = RepTranslationProp(p0 = p->NextOfPE);
READ_UNLOCK(ae->ARWLock); READ_UNLOCK(ae->ARWLock);
if (p0 == NIL) return (TranslationEntry *)NULL; if (p0 == NIL) return (TranslationEntry *)NULL;
p->arity = arity;
return p; return p;
} }
@ -1691,7 +1694,7 @@ AbsFlagProp (FlagEntry * p)
#endif #endif
#define FlagProperty ((PropFlags)0xfffc) #define FlagProperty ((PropFlags)0xfff9)
INLINE_ONLY inline EXTERN PropFlags IsFlagProperty (int); 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 #if YAP_JIT
#define Op(Label,Type) \ #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_PROFILED_INTERPRETER) : \
print_instruction(PREG, ON_INTERPRETER); \ print_instruction(PREG, ON_INTERPRETER); \
START_PREFETCH(Type) START_PREFETCH(Type)
#define OpW(Label,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_PROFILED_INTERPRETER) : \
print_instruction(PREG, ON_INTERPRETER); \ print_instruction(PREG, ON_INTERPRETER); \
START_PREFETCH_W(Type) START_PREFETCH_W(Type)
#define BOp(Label,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_PROFILED_INTERPRETER) : \
print_instruction(PREG, ON_INTERPRETER); print_instruction(PREG, ON_INTERPRETER);
#define PBOp(Label,Type) \ #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_PROFILED_INTERPRETER) : \
print_instruction(PREG, ON_INTERPRETER); \ print_instruction(PREG, ON_INTERPRETER); \
INIT_PREFETCH() INIT_PREFETCH()
#define OpRW(Label,Type) \ #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_PROFILED_INTERPRETER) : \
print_instruction(PREG, ON_INTERPRETER); print_instruction(PREG, ON_INTERPRETER);
#else /* YAP_JIT */ #else /* YAP_JIT */
#define Op(Label,Type) \ #define Op(Label,Type) \
Label:{ print_instruction(PREG, ON_INTERPRETER); \ _##Label:{ print_instruction(PREG, ON_INTERPRETER); \
START_PREFETCH(Type) START_PREFETCH(Type)
#define OpW(Label,Type) \ #define OpW(Label,Type) \
Label:{ print_instruction(PREG, ON_INTERPRETER); \ _##Label:{ print_instruction(PREG, ON_INTERPRETER); \
START_PREFETCH_W(Type) START_PREFETCH_W(Type)
#define BOp(Label,Type) \ #define BOp(Label,Type) \
Label:{ print_instruction(PREG, ON_INTERPRETER); _##Label:{ print_instruction(PREG, ON_INTERPRETER);
#define PBOp(Label,Type) \ #define PBOp(Label,Type) \
Label:{ print_instruction(PREG, ON_INTERPRETER); \ _##Label:{ print_instruction(PREG, ON_INTERPRETER); \
INIT_PREFETCH() INIT_PREFETCH()
#define OpRW(Label,Type) \ #define OpRW(Label,Type) \
Label:{ print_instruction(PREG, ON_INTERPRETER); _##Label:{ print_instruction(PREG, ON_INTERPRETER);
#endif /* YAP_JIT */ #endif /* YAP_JIT */
#else /* YAP_DBG_PREDS */ #else /* YAP_DBG_PREDS */
#define Op(Label,Type) \ #define Op(Label,Type) \
Label:{ START_PREFETCH(Type) _##Label:{ START_PREFETCH(Type)
#define OpW(Label,Type) \ #define OpW(Label,Type) \
Label:{ START_PREFETCH_W(Type) _##Label:{ START_PREFETCH_W(Type)
#define BOp(Label,Type) \ #define BOp(Label,Type) \
Label:{ _##Label:{
#define PBOp(Label,Type) \ #define PBOp(Label,Type) \
Label:{ INIT_PREFETCH() _##Label:{ INIT_PREFETCH()
#define OpRW(Label,Type) \ #define OpRW(Label,Type) \
Label:{ _##Label:{
#endif /* YAP_DBG_PREDS */ #endif /* YAP_DBG_PREDS */
@ -1723,7 +1724,7 @@ typedef struct v_record {
Term old; Term old;
} v_record; } 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 static int
@ -1922,7 +1923,7 @@ IUnify_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
#endif #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 static int
iequ_complex(register CELL *pt0, register CELL *pt0_end, 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)) #define absmadr(i) ((OPCODE)(i))
#endif #endif
bool is_cleanup_cp(choiceptr cp_b);
#if DEPTH_LIMIT #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" /* This file, dglobals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/GLOBALS instead */ please do not update, update misc/GLOBALS instead */
@ -78,9 +78,6 @@
#define GLOBAL_argv Yap_global->argv_ #define GLOBAL_argv Yap_global->argv_
#define GLOBAL_argc Yap_global->argc_ #define GLOBAL_argc Yap_global->argc_
#define GLOBAL_Flags Yap_global->Flags_
#define GLOBAL_flagCount Yap_global->flagCount_
#ifdef COROUTINING #ifdef COROUTINING
#define GLOBAL_attas Yap_global->attas_ #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 ORLAST_OPCODE Yap_heap_regs->orlast_op
#define UNDEF_OPCODE Yap_heap_regs->undef_op #define UNDEF_OPCODE Yap_heap_regs->undef_op
#define RETRY_USERC_OPCODE Yap_heap_regs->retry_userc_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 NOfAtoms Yap_heap_regs->n_of_atoms
#define AtomHashTableSize Yap_heap_regs->atom_hash_table_size #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 #define Yap_ExecutionMode Yap_heap_regs->execution_mode
@ -332,6 +332,9 @@
#define AtomTranslations Yap_heap_regs->atom_translations #define AtomTranslations Yap_heap_regs->atom_translations
#define MaxAtomTranslations Yap_heap_regs->max_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 EmptyWakeups Yap_heap_regs->empty_wakeups
#define MaxEmptyWakeups Yap_heap_regs->max_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" /* This file, dlocals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/LOCALS instead */ 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; return YAP_NO_ERROR;
} }
static inline Term takeName(Term t) { static inline Term takeIndicator(Term t) {
if (IsAtomTerm(t)) return t; Term ts[2];
MkAtomTerm(NameOfFunctor(FunctorOfTerm(t))); if (IsAtomTerm(t)) { ts[0] = t; ts[1] = MkIntTerm(0); }
if (IsPairTerm(t)) return TermNil; else if (IsPairTerm(t)) { ts[0] = TermNil; ts[1] = MkIntTerm(2); }
return t; 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); 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; return mcell(ptr) & RMARK_BIT;
} }
/* is the object pointed to by ptr marked as in a relocation chain? */ /* is the object pointed to by ptr marked as in a relocation chain? */
#if LONG_ADDRESSES #if LONG_ADDRESSES
@ -171,4 +170,3 @@ void Yap_mark_external_reference(CELL *);
void Yap_inc_mark_variable(void); 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" /* This file, hglobals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/GLOBALS instead */ please do not update, update misc/GLOBALS instead */
@ -78,9 +78,6 @@ typedef struct global_data {
char** argv_; char** argv_;
int argc_; int argc_;
union flagTerm* Flags_;
UInt flagCount_;
#ifdef COROUTINING #ifdef COROUTINING
ext_op attas_[attvars_ext+1]; 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" /* This file, hlocals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/LOCALS instead */ please do not update, update misc/LOCALS instead */
typedef struct worker_local { typedef struct worker_local {

9
H/hstruct.h
View File

@ -72,6 +72,7 @@
OPCODE orlast_op; OPCODE orlast_op;
OPCODE undef_op; OPCODE undef_op;
OPCODE retry_userc_op; OPCODE retry_userc_op;
OPCODE execute_cpred_op;
UInt n_of_atoms; UInt n_of_atoms;
UInt atom_hash_table_size; UInt atom_hash_table_size;
@ -156,9 +157,8 @@
union flagTerm* GLOBAL_Flags_;
UInt GLOBAL_flagCount_;
yap_exec_mode execution_mode; yap_exec_mode execution_mode;
@ -332,6 +332,9 @@
Int atom_translations; Int atom_translations;
Int max_atom_translations; Int max_atom_translations;
Int functor_translations;
Int max_functor_translations;
Atom empty_wakeups[MAX_EMPTY_WAKEUPS]; Atom empty_wakeups[MAX_EMPTY_WAKEUPS];
int 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 */ please do not update, update misc/ATOMS instead */
Atom3Dots = Yap_LookupAtom("..."); 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" /* This file, iglobals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/GLOBALS instead */ please do not update, update misc/GLOBALS instead */
@ -78,9 +78,6 @@ static void InitGlobal(void) {
#ifdef COROUTINING #ifdef COROUTINING

7
H/ihstruct.h
View File

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

6
H/ilocals.h
View File

@ -1,6 +1,6 @@

/* This file, ilocals.h, was generated automatically by "yap -L misc/buildlocalglobal" /* This file, ilocals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/LOCALS instead */ please do not update, update misc/LOCALS instead */
static void InitWorker(int wid) { 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 */ please do not update, update misc/ATOMS instead */
Atom3Dots = AtomAdjust(Atom3Dots); 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" /* This file, rglobals.h , was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/GLOBALS instead */ please do not update, update misc/GLOBALS instead */
@ -78,9 +78,6 @@ static void RestoreGlobal(void) {
#ifdef COROUTINING #ifdef COROUTINING

16
H/rheap.h
View File

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

7
H/rhstruct.h
View File

@ -72,6 +72,7 @@
ORLAST_OPCODE = Yap_opcode(_or_last); ORLAST_OPCODE = Yap_opcode(_or_last);
UNDEF_OPCODE = Yap_opcode(_undef_p); UNDEF_OPCODE = Yap_opcode(_undef_p);
RETRY_USERC_OPCODE = Yap_opcode(_retry_userc); 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(); RestoreEmptyWakeups();

6
H/rlocals.h
View File

@ -1,6 +1,6 @@

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

198
H/sshift.h
View File

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

43
JIT/CMakeLists.txt
View File

@ -4,21 +4,28 @@ set(LIBJIT_PATCH_VERSION 0)
set(LIBJIT_FULL_VERSION set(LIBJIT_FULL_VERSION
${LIBJIT_MAJOR_VERSION}.${LIBJIT_MINOR_VERSION}.${LIBJIT_PATCH_VERSION}) ${LIBJIT_MAJOR_VERSION}.${LIBJIT_MINOR_VERSION}.${LIBJIT_PATCH_VERSION})
set(LIBJIT_SOURCES set(LIBJIT_SOURCES
jit_analysispreds.c jit_analysispreds.c
jit_configpreds.c jit_configpreds.c
jit_statisticpreds.c jit_statisticpreds.c
jit_codegenpreds.c jit_codegenpreds.c
jit_debugpreds.c jit_debugpreds.c
jit_traced.c jit_traced.c
jit_transformpreds.c jit_transformpreds.c
JIT_Compiler.cpp JIT_Compiler.cpp
JIT_Init.cpp JIT_Init.cpp
HPP/JIT.hpp
HPP/JIT_Compiler.hpp
HPP/jit_predicates.hpp
) )
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: # The following variables are defined:
# LLVM_FOUND - true if LLVM was found # LLVM_FOUND - true if LLVM was found
# LLVM_CXXFLAGS - C++ compiler flags for files that include LLVM headers. # 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() # system default locations such as /usr/local/bin. Executing find_program()
# multiples times is the approach recommended in the docs. # 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 (POSITION_INDEPENDENT_CODE TRUE)
set(CMAKE_CXX_FLAGS ${CMAKE_CXX_FLAGS} ${LLVM_CXXFLAGS}) set(CMAKE_CXX_FLAGS ${CMAKE_CXX_FLAGS} ${LLVM_CXXFLAGS})
add_library (libyapjit SHARED add_library (libyapjit SHARED
${LIBJIT_SOURCES}) ${LIBJIT_SOURCES}
${LIBJIT_HEADERS}
)
set_target_properties(libyapjit set_target_properties(libyapjit
PROPERTIES PROPERTIES

2
JIT/JIT_Init.cpp
View File

@ -31,6 +31,8 @@ extern "C" void shutdown_llvm() { llvm_shutdown(); }
extern "C" Int traced_absmi(); extern "C" Int traced_absmi();
#define JIT_CODE 1
static void static void
initJit(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 push
#pragma GCC diagnostic ignored "-Wimplicit-function-declaration" #pragma GCC diagnostic ignored "-Wimplicit-function-declaration"
#define JIT_CODE 1
static Int static Int
p_disable_analysis_pass( USES_REGS1 ) p_disable_analysis_pass( USES_REGS1 )
{ {

2
JIT/jit_configpreds.c
View File

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

2
JIT/jit_debugpreds.c
View File

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

2
JIT/jit_statisticpreds.c
View File

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

46
JIT/jit_traced.c
View File

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

2
JIT/jit_transformpreds.c
View File

@ -15,6 +15,8 @@
* Last rev: 2013-10-18 * * Last rev: 2013-10-18 *
*************************************************************************/ *************************************************************************/
#define JIT_CODE 1
#include "jit_predicates.hpp" #include "jit_predicates.hpp"
#define N_TRANSFORM_PASSES 69 #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 */ return (TRUE); /* predicate already tabled */
if (pe->cs.p_code.FirstClause) if (pe->cs.p_code.FirstClause)
return (FALSE); /* predicate already compiled */ return (FALSE); /* predicate already compiled */
pe->PredFlags |= TabledPredFlag; if (!(pe->PredFlags & TabledPredFlag)) {
new_table_entry(tab_ent, pe, at, arity, mode_directed); pe->PredFlags |= TabledPredFlag;
pe->TableOfPred = tab_ent; new_table_entry(tab_ent, pe, at, arity, mode_directed);
pe->TableOfPred = tab_ent;
}
return (TRUE); return (TRUE);
} }

6
OPTYap/tab.insts.h
View File

@ -472,7 +472,9 @@
check_trail(TR); check_trail(TR);
tab_ent = PREG->y_u.Otapl.te; tab_ent = PREG->y_u.Otapl.te;
YENV2MEM; YENV2MEM;
sg_fr = subgoal_search(PREG, YENV_ADDRESS); saveregs();
sg_fr = subgoal_search(PREG, YENV_ADDRESS);
setregs();
MEM2YENV; MEM2YENV;
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
if (SgFr_state(sg_fr) <= ready) { if (SgFr_state(sg_fr) <= ready) {
@ -640,7 +642,9 @@
check_trail(TR); check_trail(TR);
tab_ent = PREG->y_u.Otapl.te; tab_ent = PREG->y_u.Otapl.te;
YENV2MEM; YENV2MEM;
saveregs();
sg_fr = subgoal_search(PREG, YENV_ADDRESS); sg_fr = subgoal_search(PREG, YENV_ADDRESS);
setregs();
MEM2YENV; MEM2YENV;
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
if (SgFr_state(sg_fr) <= ready) { 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/attvar.c
C/bignum.c C/bignum.c
C/bb.c C/bb.c
C/blobs.c C/blobs.c
C/cdmgr.c C/cdmgr.c
C/cmppreds.c C/cmppreds.c
C/compiler.c C/compiler.c
@ -114,6 +114,9 @@ set(C_INTERFACE_SOURCES
H/Regs.h H/Regs.h
H/Yapproto.h H/Yapproto.h
H/absmi.h H/absmi.h
H/absmi-switch.h
H/absmi-threaded.h
H/absmi-traced.h
H/alloc.h H/alloc.h
H/amidefs.h H/amidefs.h
H/amiops.h H/amiops.h

37
config.h.cmake
View File

@ -14,6 +14,36 @@
#cmakedefine AC_APPLE_UNIVERSAL_BUILD "${AC_APPLE_UNIVERSAL_BUILD}" #cmakedefine AC_APPLE_UNIVERSAL_BUILD "${AC_APPLE_UNIVERSAL_BUILD}"
#endif #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. */ /* longs should be in addresses that are multiple of four. */
#ifndef ALIGN_LONGS #ifndef ALIGN_LONGS
#define ALIGN_LONGS 1 #define ALIGN_LONGS 1
@ -1581,7 +1611,7 @@ signal. */
#endif #endif
/* max number of threads, default 1 or 1024 */ /* max number of threads, default 1 or 1024 */
#ifndef MAX_THREADS #ifndef MAX_THRADS
#cmakedefine MAX_THREADS ${MAX_THREADS} #cmakedefine MAX_THREADS ${MAX_THREADS}
#endif #endif
@ -1815,11 +1845,6 @@ signal. */
#cmakedefine USE_SYSTEM_SHM ${USE_SYSTEM_SHM} #cmakedefine USE_SYSTEM_SHM ${USE_SYSTEM_SHM}
#endif #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 */ /* Whether daylight savings time offset is set via the altzone variable */
#ifndef USE_TIME_ALTZONE #ifndef USE_TIME_ALTZONE
#cmakedefine USE_TIME_ALTZONE ${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_OUT_OF_RANGE,
DOMAIN_ERROR_OPERATOR_PRIORITY, DOMAIN_ERROR_OPERATOR_PRIORITY,
DOMAIN_ERROR_OPERATOR_SPECIFIER, DOMAIN_ERROR_OPERATOR_SPECIFIER,
DOMAIN_ERROR_PROLOG_FLAG,
DOMAIN_ERROR_RADIX, DOMAIN_ERROR_RADIX,
DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW,
DOMAIN_ERROR_SOURCE_SINK, DOMAIN_ERROR_SOURCE_SINK,
@ -137,7 +138,7 @@ typedef enum
#define JMP_LOCAL_ERROR(v, LAB) \ #define JMP_LOCAL_ERROR(v, LAB) \
if (H + 2*(v) > ASP-1024) { \ if (H + 2*(v) > ASP-1024) { \
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;\ LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;\
LOCAL_Error_Term = t;\ LOCAL_Error_Term = TermNilnnnnnnnnnnnnnnnnnnnnnnnnnn;\
LOCAL_Error_Size = 2*(v)*sizeof(CELL);\ LOCAL_Error_Size = 2*(v)*sizeof(CELL);\
goto LAB; \ goto LAB; \
} }
@ -145,15 +146,14 @@ typedef enum
#define LOCAL_ERROR(v) \ #define LOCAL_ERROR(v) \
if (HR + (v) > ASP-1024) { \ if (HR + (v) > ASP-1024) { \
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;\ LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;\
LOCAL_Error_Term = t;\ LOCAL_Error_Term = TermNil;\
LOCAL_Error_Size = 2*(v)*sizeof(CELL);\ LOCAL_Error_Size = 2*(v)*sizeof(CELL);\
return NULL; \ return NULL; \
} }
#define LOCAL_TERM_ERROR(v) \ #define LOCAL_TERM_ERROR(v) \
if (HR + (v) > ASP-1024) { \ if (HR + (v) > ASP-1024) { \
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;\ ;\
LOCAL_Error_Term = t;\
LOCAL_Error_Size = 2*(v)*sizeof(CELL);\ LOCAL_Error_Size = 2*(v)*sizeof(CELL);\
return 0L; \ 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_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) #define YAP_InitCPred(N,A,F) YAP_UserCPredicate(N,F,A)
__END_DECLS __END_DECLS

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

@ -113,19 +113,6 @@ YAP_PLArityOfSWIFunctor(functor_t f) {
return ArityOfFunctor((Functor)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 static void
UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int flags) 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) */ /* void PL_agc_hook(void) */
/** @brief Atom garbage collection hook /** @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 X_API int
PL_get_nchars(term_t l, size_t *lengthp, char **s, unsigned flags) PL_get_nchars(term_t l, size_t *lengthp, char **s, unsigned flags)
{ CACHE_REGS { CACHE_REGS
seq_tv_t inp; seq_tv_t inp, out;
size_t leng; size_t leng;
encoding_t enc; encoding_t enc;
int minimal; int minimal;
void *buf; void *buf = NULL;
char b[1024];
buf = b;
inp.val.t = Yap_GetFromSlot( l ); inp.val.t = Yap_GetFromSlot( l );
inp.type = 0; inp.type = cvtFlags( flags );
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;
}
if (flags & (BUF_DISCARDABLE|BUF_RING)) { if (flags & (BUF_DISCARDABLE|BUF_RING)) {
inp.val.c = LOCAL_FileNameBuf; buf = LOCAL_FileNameBuf;
leng = YAP_FILENAME_MAX-1; leng = YAP_FILENAME_MAX-1;
} else {
buf = NULL;
} }
if (flags & BUF_MALLOC) { out.type = YAP_STRING_CHARS;
inp.val.c = PL_malloc(1024); if (flags & (REP_UTF8|REP_MB)) {
leng = 1023; out.enc = ENC_ISO_UTF8;
} else {
out.enc = ENC_ISO_LATIN1;
} }
if (!Yap_readText( buf , &inp, & enc, &minimal, & leng PASS_REGS) ) if (flags & BUF_MALLOC)
return false; out.type |= YAP_STRING_MALLOC;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
if (enc == ENC_ISO_UTF8) { return false;
if (flags & REP_UTF8) { *s = out.val.c;
*s = buf; if (lengthp)
*lengthp = leng; *lengthp = out.sz;
return true; 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;
} }
@ -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) int PL_get_wchars(term_t l, size_t *lengthp, wchar_t **s, unsigned flags)
{ {
CACHE_REGS CACHE_REGS
seq_tv_t inp; seq_tv_t inp, out;
size_t leng; size_t leng;
encoding_t enc; encoding_t enc;
int minimal; int minimal;
void *buf; void *buf = NULL;
char b[1024];
buf = b;
inp.val.t = Yap_GetFromSlot( l ); inp.val.t = Yap_GetFromSlot( l );
inp.type = 0; inp.type = cvtFlags( flags );
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;
}
if (flags & (BUF_DISCARDABLE|BUF_RING)) { if (flags & (BUF_DISCARDABLE|BUF_RING)) {
inp.val.c = LOCAL_FileNameBuf; buf = LOCAL_FileNameBuf;
leng = YAP_FILENAME_MAX-1; leng = YAP_FILENAME_MAX-1;
} else {
buf = NULL;
} }
if (flags & BUF_MALLOC) { out.type = YAP_STRING_WCHARS;
inp.val.w = PL_malloc(1024*SIZEOF_WCHAR_T); if (flags & BUF_MALLOC)
leng = 1023; out.type |= YAP_STRING_MALLOC;
} if (!Yap_CVT_Text(&inp, &out PASS_REGS))
if (!Yap_readText( buf , &inp, & enc, &minimal, & leng PASS_REGS) ) return false;
return false; *s = out.val.w;
if (lengthp)
if (enc == ENC_ISO_UTF8) { *lengthp = out.sz;
if (flags & REP_UTF8) { return true;
*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;
} }
X_API int 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; seq_tv_t inp, out;
if (flags & REP_UTF8) { if (flags & REP_UTF8) {
inp.val.c = s; inp.val.c0 = s;
if (length != (size_t)-1) { if (length != (size_t)-1) {
inp.sz = length; inp.sz = length;
inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS; 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; out.max = length;
} }
if (!Yap_CVT_Text(&inp, &out PASS_REGS)) if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L; return 0L;
return out.val.t; 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; 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 static inline Term
SWIModuleToModule(module_t m) SWIModuleToModule(module_t m)
@ -89,7 +77,7 @@ AtomToSWIAtom(Atom at)
{ {
TranslationEntry *p; 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)(p->Translation*2+1);
return (atom_t)at; return (atom_t)at;
} }
@ -104,25 +92,25 @@ SWIAtomToAtom(atom_t at)
return (Atom)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 static inline Functor
SWIFunctorToFunctor(functor_t f) SWIFunctorToFunctor(functor_t f)
{ {
if (((CELL)(f) & 2) && ((CELL)f) < N_SWI_FUNCTORS*4+2) if ((CELL)f & 1)
return SWI_Functors[((CELL)f)/4]; return SWI_Functors[f/2];
return (Functor)f; 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 #define isDefinedProcedure(pred) TRUE // TBD
int Yap_write_blob(AtomEntry *ref, FILE *stream); int Yap_write_blob(AtomEntry *ref, FILE *stream);

4
misc/GLOBALS
View File

@ -88,10 +88,6 @@ lockvar StreamDescLock MkLock
char** argv void char** argv void
int argc void int argc void
// Prolog execution and state flags
union flagTerm* Flags void
UInt flagCount void
// extensions to Terms // extensions to Terms
#ifdef COROUTINING #ifdef COROUTINING
/* array with the ops for your favourite extensions */ /* 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 UInt MaxTrail_ MaxTrail =0 void
/* execution info */ /* execution info */
/* OPCODE TABLE, needed to recover op tables */ /* OPCODE REVERSE TABLE, needed to recover op tables */
#if USE_THREADED_CODE #if USE_THREADED_CODE
op_entry *op_rtable OP_RTABLE void OpRTableAdjust op_entry *op_rtable OP_RTABLE void OpRTableAdjust
#endif #endif
@ -71,6 +71,7 @@ OPCODE lockpred_op LOCKPRED_OPCODE MkOp _lock_pred
OPCODE orlast_op ORLAST_OPCODE MkOp _or_last OPCODE orlast_op ORLAST_OPCODE MkOp _or_last
OPCODE undef_op UNDEF_OPCODE MkOp _undef_p OPCODE undef_op UNDEF_OPCODE MkOp _undef_p
OPCODE retry_userc_op RETRY_USERC_OPCODE MkOp _retry_userc OPCODE retry_userc_op RETRY_USERC_OPCODE MkOp _retry_userc
OPCODE execute_cpred_op EXECUTE_CPRED_OPCODE MkOp _execute_cpred
/* atom tables */ /* atom tables */
UInt n_of_atoms NOfAtoms void void 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 // don't actually want to define a field
void void void Yap_InitPlIO() void void void void Yap_InitPlIO() void
// make sure we have the flags set at this point. union flagTerm* GLOBAL_Flags_ GLOBAL_Flags =0 void
// don't actually want to define a field UInt GLOBAL_flagCount_ GLOBAL_flagCount Yap_InitFlags(true) RestoreFlags(GLOBAL_flagCount)
void void void Yap_InitFlags(true) void
/* Anderson's JIT */ /* Anderson's JIT */
yap_exec_mode execution_mode Yap_ExecutionMode =INTERPRETED void 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 atom_translations AtomTranslations void void
Int max_atom_translations MaxAtomTranslations 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() Atom empty_wakeups[MAX_EMPTY_WAKEUPS] EmptyWakeups InitEmptyWakeups() RestoreEmptyWakeups()
int max_empty_wakeups MaxEmptyWakeups =0 int max_empty_wakeups MaxEmptyWakeups =0

12
os/charsio.c
View File

@ -447,7 +447,7 @@ put_char ( USES_REGS1 )
int ch; int ch;
int sno; int sno;
if (IsVarTerm(t2 = Deref(ARG1))) { if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1"); Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1");
return FALSE; return FALSE;
} else if (!IsAtomTerm (t2)) { } else if (!IsAtomTerm (t2)) {
@ -480,7 +480,7 @@ tab_1 ( USES_REGS1 )
int sno = LOCAL_c_output_stream; int sno = LOCAL_c_output_stream;
Term t2; Term t2;
Int tabs, i; Int tabs, i;
if (IsVarTerm(t2 = Deref(ARG1))) { if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1"); Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1");
return FALSE; return FALSE;
} else if (!IsIntegerTerm (t2)) { } else if (!IsIntegerTerm (t2)) {
@ -514,7 +514,7 @@ tab ( USES_REGS1 )
int sno = LOCAL_c_output_stream; int sno = LOCAL_c_output_stream;
Term t2; Term t2;
Int tabs, i; Int tabs, i;
if (IsVarTerm(t2 = Deref(ARG1))) { if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1"); Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1");
return FALSE; return FALSE;
} else if (!IsIntegerTerm (t2)) { } else if (!IsIntegerTerm (t2)) {
@ -588,7 +588,7 @@ put_byte ( USES_REGS1 )
{ /* '$put_byte'(Stream,N) */ { /* '$put_byte'(Stream,N) */
Term t2; Term t2;
Int ch; Int ch;
if (IsVarTerm(t2 = Deref(ARG1))) { if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1"); Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1");
return FALSE; return FALSE;
} else if (!IsIntegerTerm (t2)) { } else if (!IsIntegerTerm (t2)) {
@ -653,7 +653,7 @@ skip_1 ( USES_REGS1 )
int sno; int sno;
int ch; int ch;
if (IsVarTerm(t2 = Deref(ARG1))) { if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "skip/2"); Yap_Error(INSTANTIATION_ERROR, t2, "skip/2");
return FALSE; return FALSE;
} else if (!IsIntegerTerm (t2)) { } else if (!IsIntegerTerm (t2)) {
@ -843,7 +843,7 @@ peek_code_1 ( USES_REGS1 )
if ((ch = dopeek( sno )) < 0) if ((ch = dopeek( sno )) < 0)
return false; return false;
UNLOCK(GLOBAL_Stream[sno].streamlock); 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; int sno;
Term t; 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) if (sno < 0)
return FALSE; return FALSE;
GLOBAL_Stream[sno].encoding = enc; 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) Yap_TermToString(Term t, char *s, size_t sz, size_t *length, encoding_t encp, int flags)
{ {
CACHE_REGS 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; int old_output_stream = LOCAL_c_output_stream;
if (sno < 0) if (sno < 0)
@ -118,28 +118,59 @@ char *
return NULL; 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) DefaultEncoding(void)
{ {
char *s = getenv("LANG"); CACHE_REGS
size_t sz; int i = 0, j;
char *enc;
/* if we don't have a LANG then just use ISO_LATIN1 */ while (encvs[i]) {
if (s == NULL) char *v = getenv(encvs[i]);
s = getenv("LC_CTYPE"); if (v) {
if (s == NULL) enc = strrchr(v, '.');
return ENC_ISO_LATIN1; /* that's how it is supposed to be, except in OSX */
sz = strlen(s); if (!enc) enc = v;
if (sz >= 5) { // now that we have one name, try to match it
if (s[sz-5] == 'U' && j= 0;
s[sz-4] == 'T' && while (ematches[j].s != NULL) {
s[sz-3] == 'F' && if (!strcmp(ematches[j].s, enc)) {
s[sz-2] == '-' && return LOCAL_encoding = ematches[j].e;
s[sz-1] == '8') { } else {
return ENC_ISO_UTF8; 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 encoding_t

12
os/encoding.h
View File

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

2
os/files.c
View File

@ -565,7 +565,7 @@ same_file( USES_REGS1 ) {
int out; int out;
struct stat *b1, *b2; struct stat *b1, *b2;
while ((char *)HR+sizeof(struct stat)*2 > (char *)(ASP-1024)) { 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); Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return FALSE; return FALSE;
} }

80
os/format.c
View File

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

3
os/iopreds.h
View File

@ -211,6 +211,7 @@ typedef struct stream_desc
} }
StreamDesc; StreamDesc;
static inline bool static inline bool
IsStreamTerm(Term t) IsStreamTerm(Term t)
{ {
@ -255,12 +256,12 @@ Term Yap_MkStream (int n);
bool Yap_PrintWarning( Term twarning ); bool Yap_PrintWarning( Term twarning );
char *Yap_MemExportStreamPtr( int sno );
Int Int
PlIOError (yap_error_number type, Term culprit, const char *who, ...); PlIOError (yap_error_number type, Term culprit, const char *who, ...);
void Yap_plwrite(Term, struct stream_desc *, int, int, int); 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); void Yap_WriteAtom(struct stream_desc *s, Atom atom);
Term Yap_scan_num(struct stream_desc *); 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 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; int sno;
StreamDesc *st; StreamDesc *st;
char *nbuf = NULL;
size_t nchars = 0;
sno = GetFreeStreamD();
if (nbufp) if (sno < 0)
nbuf = *nbufp; return -1;
if (ncharsp) if (!buf) {
nchars = *ncharsp; if (!nchars) {
if (!nchars) nchars = Yap_page_size;
nchars = 256; }
if (!nbuf) { buf = malloc( nchars );
if (!nchars) {
nchars = Yap_page_size;
} }
nbuf = malloc( nchars ); st = GLOBAL_Stream+sno;
if(!nbuf) { st->nbuf = buf;
if(!st->nbuf) {
return -1; return -1;
} }
} st->nsize = nchars;
sno = GetFreeStreamD(); /* currently these streams are not seekable */
if (sno < 0) st->linepos = 0;
return -1; st->charcount = 0;
st = &GLOBAL_Stream[sno]; st->linecount = 1;
/* currently these streams are not seekable */ st->encoding = enc;
st->linepos = 0; Yap_DefaultStreamOps( st );
st->charcount = 0;
st->linecount = 1;
Yap_DefaultStreamOps( st );
#if MAY_WRITE #if MAY_WRITE
st->file = open_memstream(&st->nbuf, &st->nsize); st->file = open_memstream(&st->nbuf, &st->nsize);
st->status = Output_Stream_f | InMemory_Stream_f|Seekable_Stream_f; st->status = Output_Stream_f | InMemory_Stream_f|Seekable_Stream_f;
#else #else
st->u.mem_string.pos = 0; st->u.mem_string.pos = 0;
st->u.mem_string.buf = nbuf; st->u.mem_string.buf = nbuf;
st->u.mem_string.max_size = nchars; st->u.mem_string.max_size = nchars;
st->status = Output_Stream_f | InMemory_Stream_f; st->status = Output_Stream_f | InMemory_Stream_f;
#endif #endif
Yap_MemOps( st ); Yap_MemOps( st );
UNLOCK(st->streamlock); UNLOCK(st->streamlock);
*nbufp = nbuf; return sno;
return sno;
} }
int int
@ -292,7 +287,7 @@ Yap_OpenBufWriteStream( USES_REGS1 )
return -1; 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 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 * @return temporary buffer, discarded by close and may be moved away
* by other writes.. * by other writes..
*/ */
memHandle * char *
Yap_MemExportStreamPtrs( int sno ) Yap_MemExportStreamPtr( int sno )
{ {
char *s;
#if MAY_WRITE #if MAY_WRITE
if (fflush(GLOBAL_Stream[sno].file) == 0) { if (fflush(GLOBAL_Stream[sno].file) == 0 &&
GLOBAL_Stream[sno].nbuf[GLOBAL_Stream[sno].nsize] = '\0'; (s = GLOBAL_Stream[sno].nbuf)) {
return (memHandle *)GLOBAL_Stream[sno].nbuf; s[ftell(GLOBAL_Stream[sno].file)] = '\0';
} return s;
}
return NULL; return NULL;
#else #else
return &GLOBAL_Stream[sno].u.mem_string; return &GLOBAL_Stream[sno].u.mem_string;
@ -360,7 +357,7 @@ peek_mem_write_stream ( USES_REGS1 )
if (HR + 1024 >= ASP) { if (HR + 1024 >= ASP) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
HR = HI; 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); UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return(FALSE); return(FALSE);

7
os/readterm.c
View File

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

2
os/readutil.c
View File

@ -127,7 +127,7 @@ p_stream_to_codes(USES_REGS1)
RESET_VARIABLE(h0); RESET_VARIABLE(h0);
ARG4 = AbsPair(HBASE); ARG4 = AbsPair(HBASE);
ARG5 = (CELL)h0; 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"); Yap_Error(OUT_OF_STACK_ERROR, ARG1, "read_stream_to_codes/3");
return FALSE; return FALSE;
} }

12
os/streams.c
View File

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

6
os/yapio.h
View File

@ -141,14 +141,14 @@ typedef enum mem_buf_source {
MEM_BUF_USER=4 MEM_BUF_USER=4
} memBufSource; } 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_StringToTerm(const char *s, size_t len, encoding_t enc, int prio, Term *bindings_p);
extern Term Yap_StringToNumberTerm(char *s, encoding_t encp); 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_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); 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_GetInputStream(Term t, const char *m);
FILE *Yap_GetOutputStream(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); 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+. # Only available for CUDA version 3.2+.
# Windows only. # Windows only.
# #
macro_optional_find_package (FindThrust ON) macro_optional_find_package (Thrust ON)
set (CUDA_SOURCES set (CUDA_SOURCES
lista.cu lista.cu
@ -65,9 +65,9 @@ if (CUDA_FOUND)
cuda_add_library (libcuda SHARED ${CUDA_SOURCES}) cuda_add_library (libcuda SHARED ${CUDA_SOURCES})
target_link_libraries(libcuda libYap target_link_libraries(libcuda libYap
${CUDA_LIBRARIES} ${CUDA_npp_LIBRARY} ${CUDA_nppc_LIBRARY} ${CUDA_LIBRARIES} ${CUDA_npp_LIBRARY} # ${CUDA_nppc_LIBRARY}
stdc++ ) )
if( THRUST_INCLUDE_DIR ) if( THRUST_INCLUDE_DIR )
list( REMOVE_DUPLICATES THRUST_INCLUDE_DIR ) list( REMOVE_DUPLICATES THRUST_INCLUDE_DIR )

6
packages/python/CMakeLists.txt
View File

@ -3,6 +3,12 @@
set (PYTHON_SOURCES set (PYTHON_SOURCES
python.c) 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(PythonInterp ON)
macro_optional_find_package (PythonLibs ON) macro_optional_find_package (PythonLibs ON)
macro_log_feature (PYTHONLIBS_FOUND "Python" 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: case PL_VARIABLE:
return NULL; return NULL;
case PL_ATOM: case PL_ATOM:
case PL_STRING:
{ {
char *s;
atom_t at; atom_t at;
if (PL_get_atom(t, &at)) { if (PL_get_atom(t, &at)) {
if (at == ATOM_true) return Py_True; if (at == ATOM_true) return Py_True;
if (at == ATOM_false) return Py_False; 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: case PL_INTEGER:
{ {
int64_t j; int64_t j;
@ -1044,6 +1055,35 @@ assign_python(PyObject *root, term_t t, PyObject *e)
case PL_VARIABLE: case PL_VARIABLE:
return -1; return -1;
case PL_ATOM: 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; char *s;
@ -1067,8 +1107,8 @@ assign_python(PyObject *root, term_t t, PyObject *e)
return PyObject_SetAttr(root, wo, e); return PyObject_SetAttr(root, wo, e);
} }
} }
break;
case PL_INTEGER: case PL_INTEGER:
case PL_STRING:
case PL_FLOAT: case PL_FLOAT:
return -1; return -1;
case PL_TERM: case PL_TERM:
@ -1278,6 +1318,8 @@ python_import(term_t mname, term_t mod)
pModule = PyImport_Import(pName); pModule = PyImport_Import(pName);
Py_DECREF(pName); Py_DECREF(pName);
if (pModule == NULL) { if (pModule == NULL) {
if (PyErr_Occurred())
PyErr_Print();
PyErr_Clear(); PyErr_Clear();
return FALSE; return FALSE;
} }
@ -1387,8 +1429,28 @@ python_apply(term_t tin, term_t targs, term_t keywds, term_t tf)
foreign_t out; foreign_t out;
term_t targ = PL_new_term_ref(); term_t targ = PL_new_term_ref();
pF = term_to_python(tin); pF = term_t
'o_python(tin);
if ( pF == NULL ) { if ( pF == NULL ) {
PYError()
return FALSE; return FALSE;
} }
if (PL_is_atom(keywds) ) if (PL_is_atom(keywds) )
@ -1623,10 +1685,10 @@ end_python(void)
return TRUE; return TRUE;
} }
install_t install_python(void); install_t install_libpython(void);
install_t install_t
install_python(void) install_libpython(void)
{ // FUNCTOR_dot2 = PL_new_functor(PL_new_atom("."), 2); { // FUNCTOR_dot2 = PL_new_functor(PL_new_atom("."), 2);
// FUNCTOR_equal2 = 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); // 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_range2 = PL_new_functor(PL_new_atom("range"), 2);
FUNCTOR_range3 = PL_new_functor(PL_new_atom("range"), 3); FUNCTOR_range3 = PL_new_functor(PL_new_atom("range"), 3);
FUNCTOR_sum1 = PL_new_functor(PL_new_atom("sum"), 1); 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_plus2 = PL_new_functor(PL_new_atom("+"), 2);
FUNCTOR_sub2 = 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); FUNCTOR_mul2 = PL_new_functor(PL_new_atom("*"), 2);

108
packages/python/python.pl
View File

@ -13,19 +13,29 @@
%%% %%%
:- module(python, [ :- module(python,
init_python/0, [
end_python/0, init_python/0,
python_command/1, end_python/0,
python_assign/3, python_command/1,
python_import/1, python_assign/3,
python/2, python_import/1,
op(100,fy,$), python/2,
op(950,fy,:=), (:=)/2,
op(950,yfx,:=), (:=)/1,
(:=)/2, (<-)/2,
(:=)/1 (<-)/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 /** <module> python
@ -35,6 +45,22 @@
@version 0:0:5, 2012/10/8 @version 0:0:5, 2012/10/8
@license Perl Artistic License @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 Data types are
Python Prolog Python Prolog
string atoms string atoms
numbers numbers numbers numbers
lists lists lists lists
tuples t(...) tuples t(...)
generic objs __pointer__(Address) generic objs __pointer__(Address)
$var refers to the attribute __main__.var $var refers to the attribute __main__.var
@ -62,18 +88,26 @@ Data types are
:- use_module(library(charsio)). :- use_module(library(charsio)).
:- dynamic python_mref_cache/2, python_obj_cache/2. :- dynamic python_mref_cache/2, python_obj_cache/2.
:- multifile user:(<-)/2.
:= F :- python(F,_). := F :- python(F,_).
V := F :- var(V), !, python(F,V). V := F :- var(V), !, python(F,V).
A := F :- python(F, F1), python_assign(A, F1). A := F :- python(F, F1), python_assign(A, F1).
user:( V <- F ) :-
V := F.
user:((<- F)) :-
<- F.
python_import(Module) :- python_import(Module) :-
python_do_import(Module, _). python_do_import(Module, _).
python_do_import(Module, MRef) :- python_do_import(Module, MRef) :-
python_mref_cache(Module, MRef), !. python_mref_cache(Module, MRef), !.
python_do_import(Module, MRef) :- python_do_import(Module, MRef) :-
python_import(Module, MRef), python_import(Module, MRef),
assert( python_mref_cache(Module, MRef) ). assert( python_mref_cache(Module, MRef) ).
fetch_module(M:E, M1, E1, 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), atom_concat([M0,'.',M], MM),
python_import(MM, MRef1), !, python_import(MM, MRef1), !,
module_extend(MM, E, MF, EF, MRef1, MRef). 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). module_extend(M, E, M, E, MRef, MRef).
object_prefix('__obj__'(_)). object_prefix('__obj__'(_)).
object_prefix('$'(_)). object_prefix('$'(_)).
object_prefix('__obj__'(_):_). object_prefix('__obj__'(_):_).
object_prefix('$'(_):_). object_prefix('$'(_):_).
object_prefix('__obj__'(_)._).
object_prefix('$'(_)._).
% from an exp take an object, and its corresponding Prolog representation % from an exp take an object, and its corresponding Prolog representation
descend_exp(V, _Obj, _F, _S) :- descend_exp(V, _Obj, _F, _S) :-
@ -108,9 +148,13 @@ descend_exp(Exp, Obj, F, S) :-
python_mref_cache(_, MObj), python_mref_cache(_, MObj),
python_field(MObj:Exp, Obj, F, S), !. python_field(MObj:Exp, Obj, F, S), !.
descend_exp(Mod:Exp, Obj, F, S) :- descend_exp(Mod:Exp, Obj, F, S) :-
atom(Mod), atom(Mod),
python_import(Mod, MObj), 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_class(Obj) :-
python_obj_cache(inspect:isclass(_), F), 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('__obj__'(Obj), '__obj__'(Obj)) :- !.
python_eval_term($Name, Obj) :- !, python_eval_term($Name, Obj) :- !,
python_is($Name, Obj). python_is($Name, Obj).
python_eval_term([H|T], [NH|NT]) :- !, python_eval_term([H|T], NL) :-
python_eval_term(H, NH), is_list(T), !,
python_eval_term(T, NT). maplist( python_eval_term, [H|T], NL).
python_eval_term(N, N) :- atomic(N), !. python_eval_term(N, N) :- atomic(N), !.
python_eval_term(N, N) :- string(N), !.
python_eval_term(Exp, O) :- python_eval_term(Exp, O) :-
descend_exp(Exp, Obj, _Old, S), !, descend_exp(Exp, Obj, _Old, S), !,
(functor(S, _, 0) -> (functor(S, _, 0) ->
O = Obj O = Obj
; ;
python_check_args(S, NS, Dict), python_check_args(S, NS, Dict),
python_apply(Obj, NS, Dict, O) python_apply(Obj, NS, Dict, O)
). ).
python_eval_term(S, O) :- python_eval_term(S, O) :-
python_check_args(S, NS, {}), python_check_args(S, NS, {}),
python_is(NS, O). python_is(NS, O).
python_check_args(Exp, t, {}) :- python_check_args(Exp, t, {}) :-
Exp =.. [_,V], var(V), !. Exp =.. [_,V], var(V), !.
@ -217,14 +262,13 @@ add_cwd_to_python :-
atom_concat(['sys.path.append(\"',Dir,'\")'], Command), atom_concat(['sys.path.append(\"',Dir,'\")'], Command),
python_command(Command), python_command(Command),
python_command("sys.argv = [\"yap\"]"). python_command("sys.argv = [\"yap\"]").
% done % done
python_assign(Name, Exp, '$'(Name)) :- python_assign(Name, Exp, '$'(Name)) :-
python_assign(Name, Exp). python_assign(Name, Exp).
:- initialization( use_foreign_library(foreign(python)), now ). :- initialization( use_foreign_library(foreign(libpython)), now ).
:- initialization(start_python, now). :- initialization(start_python, now).
:- initialization(add_cwd_to_python). :- 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 # 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}) 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) 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 macro_optional_find_package(Java ON)
${SOURCES}
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}) set( CMAKE_CXX_FAGS "${CMAKE_CXX_FLAGS} -Wno-missing-declarations")
# install_jni_symlink(YAPjar .)
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'([]).
'$write_output_vars'([V|VL]) :- '$write_output_vars'([V|VL]) :-
format(user_error,' = ~s',[V]), format(user_error,' = ~a',[V]),
'$write_output_vars'(VL). '$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_) @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: following flags:
+ consult(+ _Mode_) + consult(+ _Mode_)
@ -873,7 +873,7 @@ db_files(Fs) :-
'$init_win_graphics', '$init_win_graphics',
fail. fail.
'$do_startup_reconsult'(X) :- '$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)) '$system_catch'(load_files(X, [silent(true)]), Module, Error, '$Error'(Error))
; ;
set_prolog_flag(verbose, silent), set_prolog_flag(verbose, silent),
@ -882,7 +882,7 @@ db_files(Fs) :-
true true
), ),
!, !,
( current_prolog_flag(language_mode, yap) -> true ; halt). ( current_prolog_flag(halt_after_consult, false) -> true ; halt).
'$do_startup_reconsult'(_). '$do_startup_reconsult'(_).
'$skip_unix_header'(Stream) :- '$skip_unix_header'(Stream) :-
@ -1026,10 +1026,13 @@ prolog_load_context(stream, Stream) :-
% module can be reexported. % module can be reexported.
'$ensure_file_unchanged'(F, M) :- '$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), 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), '$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,_),_) ), !. ( M == NM -> true ; recorded('$module','$module'(F,NM,_Source,_P,_),_) ), !.
'$file_is_unchanged'(F, R, Age) :- '$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) ), ( F == user_input -> working_directory(Dir,Dir) ; file_directory_name(F, Dir) ),
nb_setval('$consulting_file', F ), nb_setval('$consulting_file', F ),
( (
Reconsult0 \== consult, % if we are reconsulting, always start from scratch
Reconsult0 \== not_loaded, Reconsult0 \== consult,
Reconsult \== changed, Reconsult0 \== not_loaded,
Reconsult0 \== changed,
recorded('$source_file','$source_file'(F, _,_),R), recorded('$source_file','$source_file'(F, _,_),R),
erase(R), erase(R),
fail fail
; ;
var(Reconsult0) var(Reconsult0)
-> ->
Reconsult = consult Reconsult = consult
; ;
Reconsult = Reconsult0 Reconsult = Reconsult0
), ),
( (
Reconsult \== consult, Reconsult \== consult,

2
pl/debug.yap
View File

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

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