diff --git a/C/absmi.c b/C/absmi.c index 78d89315e..a73464c5d 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -514,10 +514,12 @@ loop(Env) :- -#define IN_ABSMI_C 1 -#define HAS_CACHE_REGS 1 +#define IN_ABSMI_C 1 +#define _INATIVE 1 +#define HAS_CACHE_REGS 1 + #include "absmi.h" #include "heapgc.h" @@ -677,12 +679,12 @@ check_alarm_fail_int(int CONT USES_REGS) } static int -stack_overflow( PredEntry *pe, CELL *env, yamop *cp USES_REGS ) +stack_overflow( PredEntry *pe, CELL *env, yamop *cp USES_REGS, arity_t nargs ) { if ((Int)(Unsigned(YREG) - Unsigned(HR)) < StackGap( PASS_REGS1 ) || Yap_get_signal( YAP_STOVF_SIGNAL )) { S = (CELL *)pe; - if (!Yap_locked_gc(pe->ArityOfPE, env, cp)) { + if (!Yap_locked_gc(nargs, env, cp)) { Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage); return 0; } @@ -996,7 +998,7 @@ interrupt_execute( USES_REGS1 ) if ((v = code_overflow(YENV PASS_REGS)) >= 0) { return v; } - if ((v = stack_overflow(P->y_u.pp.p, ENV, CP PASS_REGS )) >= 0) { + if ((v = stack_overflow(P->y_u.pp.p, ENV, CP, P->y_u.pp.p->ArityOfPE PASS_REGS )) >= 0) { return v; } return interrupt_handler( P->y_u.pp.p PASS_REGS ); @@ -1024,7 +1026,7 @@ interrupt_call( USES_REGS1 ) if ((v = code_overflow(YENV PASS_REGS)) >= 0) { return v; } - if ((v = stack_overflow( P->y_u.Osbpp.p, YENV, NEXTOP(P, Osbpp) PASS_REGS )) >= 0) { + if ((v = stack_overflow( P->y_u.Osbpp.p, YENV, NEXTOP(P, Osbpp), P->y_u.Osbpp.p->ArityOfPE PASS_REGS )) >= 0) { return v; } return interrupt_handlerc( P->y_u.Osbpp.p PASS_REGS ); @@ -1053,7 +1055,7 @@ interrupt_pexecute( PredEntry *pen USES_REGS ) if ((v = code_overflow(YENV PASS_REGS)) >= 0) { return v; } - if ((v = stack_overflow( pen, ENV, NEXTOP(P, Osbmp) PASS_REGS )) >= 0) { + if ((v = stack_overflow( pen, ENV, NEXTOP(P, Osbmp), pen->ArityOfPE PASS_REGS )) >= 0) { return v; } CP = NEXTOP(P, Osbmp); @@ -1259,7 +1261,7 @@ interrupt_either( USES_REGS1 ) return v; } //P = NEXTOP(P, Osblp); - if ((v = stack_overflow(RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1,0)), YENV, NEXTOP(P,Osblp) PASS_REGS )) >= 0) { + if ((v = stack_overflow(RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1,0)), YENV, NEXTOP(P,Osblp), 0 PASS_REGS )) >= 0) { //P = PREVOP(P, Osblp); return v; } @@ -1290,7 +1292,7 @@ interrupt_dexecute( USES_REGS1 ) if ((v = code_overflow(YENV PASS_REGS)) >= 0) { return v; } - if ((v = stack_overflow( P->y_u.pp.p, (CELL *)YENV[E_E], (yamop *)YENV[E_CP] PASS_REGS )) >= 0) { + if ((v = stack_overflow( P->y_u.pp.p, (CELL *)YENV[E_E], (yamop *)YENV[E_CP], P->y_u.pp.p->ArityOfPE PASS_REGS )) >= 0) { return v; } /* first, deallocate */ @@ -1636,7 +1638,7 @@ Yap_absmi(int inp) /************************************************************************/ static void *OpAddress[] = { -#define OPCODE(OP,TYPE) && OP +#define OPCODE(OP,TYPE) && _##OP #include "YapOpcodes.h" #undef OPCODE }; diff --git a/C/absmi_insts.h b/C/absmi_insts.h index a46d63f2c..23b23fb0d 100644 --- a/C/absmi_insts.h +++ b/C/absmi_insts.h @@ -42,6 +42,13 @@ BOp(Ystop, l); \************************************************************************/ #if YAP_JIT + static void *OpAddress[] = + { +#define OPCODE(OP,TYPE) && _##OP +#include "YapOpcodes.h" +#undef OPCODE + }; + /* native_me */ BOp(jit_handler, J); if (!PREG->y_u.J.jh->fi.bcst.c) PREG->y_u.J.jh->mf.isground = IsGround(PREG); diff --git a/C/adtdefs.c b/C/adtdefs.c index a7659dcde..31eb91961 100755 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -1227,7 +1227,7 @@ Yap_PutValue(Atom a, Term v) } bool -Yap_PutAtomTranslation(Atom a, Int i) +Yap_PutAtomTranslation(Atom a, arity_t arity, Int i) { AtomEntry *ae = RepAtom(a); Prop p0; @@ -1243,6 +1243,7 @@ Yap_PutAtomTranslation(Atom a, Int i) } p->KindOfPE = TranslationProperty; p->Translation = i; + p->arity = arity; AddPropToAtom(RepAtom(a), (PropEntry *)p); } /* take care that the lock for the property will be inited even @@ -1251,6 +1252,32 @@ Yap_PutAtomTranslation(Atom a, Int i) return true; } +bool +Yap_PutFunctorTranslation(Atom a, arity_t arity, Int i) +{ + AtomEntry *ae = RepAtom(a); + Prop p0; + TranslationEntry *p; + + WRITE_LOCK(ae->ARWLock); + p0 = GetAPropHavingLock(ae, TranslationProperty); + if (p0 == NIL) { + p = (TranslationEntry *) Yap_AllocAtomSpace(sizeof(TranslationEntry)); + if (p == NULL) { + WRITE_UNLOCK(ae->ARWLock); + return false; + } + p->KindOfPE = TranslationProperty; + p->Translation = i; + p->arity = arity; + AddPropToAtom(RepAtom(a), (PropEntry *)p); + } + /* take care that the lock for the property will be inited even + if someone else searches for the property */ + WRITE_UNLOCK(ae->ARWLock); + return true; +} + bool Yap_PutAtomMutex(Atom a, void * i) { diff --git a/C/agc.c b/C/agc.c index a2663a350..2ae334d97 100755 --- a/C/agc.c +++ b/C/agc.c @@ -34,6 +34,7 @@ static char SccsId[] = "@(#)agc.c 1.3 3/15/90"; static void RestoreEntries(PropEntry *, int USES_REGS); static void CleanCode(PredEntry * USES_REGS); +static void RestoreDBTerm(DBTerm *dbr, int attachments USES_REGS); #define AtomMarkedBit 1 @@ -190,6 +191,32 @@ AtomAdjust(Atom a) #define RestoreSWIHash() +static void +AdjustTermFlag(flag_term *tarr, UInt i) +{ + CACHE_REGS + if (IsVarTerm(tarr[i].at)) { + RestoreDBTerm( tarr[i].DBT, 0 PASS_REGS ); + } else if (IsAtomTerm( tarr[i].at ) ) + tarr[i].at = AtomTermAdjust(tarr[i].at); +} + +static void RestoreFlags( UInt NFlags ) +{ + CACHE_REGS + size_t i; + flag_term *tarr = GLOBAL_Flags; + + if (worker_id == 0) + for (i=0; i %p\n", code_p->y_u.l.l); + ystop_found = TRUE; } code_p = a_bregs(code_p, pass_no, cip->cpc); break; diff --git a/C/args.c b/C/args.c index 62175bac0..f4151db37 100644 --- a/C/args.c +++ b/C/args.c @@ -31,19 +31,16 @@ xarg * Yap_ArgListToVector (Term listl, const param_t *def, int n) { CACHE_REGS - Term *tailp; if (!IsPairTerm(listl) && listl != TermNil) { listl = MkPairTerm( listl, TermNil ); } - Int length = Yap_SkipList( &listl, &tailp ); - if (length < 0 ) - return NULL; xarg *a = calloc( n , sizeof(xarg) ); while (IsPairTerm(listl)) { Term hd = HeadOfTerm( listl ); listl = TailOfTerm( listl ); if (IsVarTerm(hd)) { LOCAL_Error_TYPE = INSTANTIATION_ERROR; + LOCAL_Error_Term = hd; free( a ); return NULL; } @@ -58,13 +55,15 @@ Yap_ArgListToVector (Term listl, const param_t *def, int n) } else if (IsApplTerm( hd )) { Functor f = FunctorOfTerm( hd ); if (IsExtensionFunctor(f)) { - LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER; - free( a ); - return NULL; + LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER; + LOCAL_Error_Term = hd; + free( a ); + return NULL; } arity_t arity = ArityOfFunctor( f ); if (arity != 1) { LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE; + LOCAL_Error_Term = hd; free( a ); return NULL; } @@ -78,7 +77,7 @@ Yap_ArgListToVector (Term listl, const param_t *def, int n) } } return a; -} +} static xarg * matchKey2(Atom key, xarg *e0, int n, const param2_t *def) @@ -95,17 +94,16 @@ matchKey2(Atom key, xarg *e0, int n, const param2_t *def) } +/// Yap_ArgList2ToVector is much the same as before, +/// but assumes parameters also have something called a +/// scope xarg * Yap_ArgList2ToVector (Term listl, const param2_t *def, int n) { CACHE_REGS - Term *tailp; if (!IsPairTerm(listl) && listl != TermNil) { listl = MkPairTerm( listl, TermNil ); } - Int length = Yap_SkipList( &listl, &tailp ); - if (length < 0 ) - return NULL; xarg *a = calloc( n , sizeof(xarg) ); while (IsPairTerm(listl)) { Term hd = HeadOfTerm( listl ); @@ -124,25 +122,41 @@ Yap_ArgList2ToVector (Term listl, const param2_t *def, int n) } else if (IsApplTerm( hd )) { Functor f = FunctorOfTerm( hd ); if (IsExtensionFunctor(f)) { - LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER; - free( a ); - return NULL; + LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER; + LOCAL_Error_Term = hd; + free( a ); + return NULL; } arity_t arity = ArityOfFunctor( f ); if (arity != 1) { LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE; + LOCAL_Error_Term = hd; free( a ); return NULL; } xarg *na = matchKey2( NameOfFunctor( f ), a, n, def); - na->used = 1; - na->tvalue = ArgOfTerm(1, hd); + if (na) { + na->used = 1; + na->tvalue = ArgOfTerm(1, hd); + } } else { LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER; + LOCAL_Error_Term = hd; free( a ); return NULL; } listl = TailOfTerm(listl); + } + if (IsVarTerm(listl)) { + LOCAL_Error_TYPE = INSTANTIATION_ERROR; + free( a ); + return NULL; + } + if (TermNil != listl) { + LOCAL_Error_TYPE = TYPE_ERROR_LIST; + LOCAL_Error_Term = listl; + free( a ); + return NULL; } return a; } diff --git a/C/arith1.c b/C/arith1.c index 3c969e92b..7dd332ed0 100644 --- a/C/arith1.c +++ b/C/arith1.c @@ -1003,7 +1003,7 @@ p_unary_is( USES_REGS1 ) Term out; if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 1)))) { - Yap_EvalError(TYPE_ERROR_EVALUABLE, takeName(t), + Yap_EvalError(TYPE_ERROR_EVALUABLE, takeIndicator(t), "functor %s/1 for arithmetic expression", RepAtom(name)->StrOfAE); return FALSE; diff --git a/C/arith2.c b/C/arith2.c index 711e333ce..69506cd75 100644 --- a/C/arith2.c +++ b/C/arith2.c @@ -1199,7 +1199,7 @@ p_binary_is( USES_REGS1 ) Term out; if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) { - Yap_EvalError(TYPE_ERROR_EVALUABLE, takeName(t), + Yap_EvalError(TYPE_ERROR_EVALUABLE, takeIndicator(t), "functor %s/2 for arithmetic expression", RepAtom(name)->StrOfAE); P = FAILCODE; diff --git a/C/arrays.c b/C/arrays.c index 5e3d3e4e2..541a2b8b0 100644 --- a/C/arrays.c +++ b/C/arrays.c @@ -316,7 +316,7 @@ GetTermFromArray(DBTerm *ref USES_REGS) } } else { LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(LOCAL_Error_Size, 3, ENV, gc_P(P,CP))) { + if (!Yap_gcl(LOCAL_Error_Size, 3, ENV, Yap_gcP())) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return TermNil; } @@ -997,7 +997,7 @@ p_create_array( USES_REGS1 ) farray = Yap_MkFunctor(AtomArray, size); if (HR+1+size > ASP-1024) { - if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { + if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, Yap_gcP())) { Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); return(FALSE); } else { @@ -1849,7 +1849,8 @@ p_assign_static( USES_REGS1 ) Yap_Error(TYPE_ERROR_INTEGER,t3,"assign_static"); return (FALSE); } - ptr->ValueOfVE.ints[indx]= i; + ptr-> + ValueOfVE.ints[indx]= i; } break; diff --git a/C/atomic.c b/C/atomic.c index 71a5019d7..5c11a5e74 100644 --- a/C/atomic.c +++ b/C/atomic.c @@ -643,6 +643,8 @@ atom_concat3( USES_REGS1 ) } else { LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_Term = t1; + Yap_Error( INSTANTIATION_ERROR, IsVarTerm(t1) ? t1 : t2, "got atom_concat(X,atom,Z) or atom_concat(,atom,Y,Z)" ); + return false; } if (at) { if (Yap_unify(ot, MkAtomTerm(at))) cut_succeed(); diff --git a/C/c_interface.c b/C/c_interface.c index 713a61182..1f1e81a96 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -1811,7 +1811,7 @@ YAP_BufferToString(const char *s) CACHE_REGS seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.type = YAP_STRING_CHARS; out.type = YAP_STRING_CODES; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -1831,7 +1831,7 @@ YAP_NBufferToString(const char *s, size_t len) CACHE_REGS seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.type = YAP_STRING_CHARS; out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC; out.sz = len; @@ -1853,7 +1853,7 @@ YAP_WideBufferToString(const wchar_t *s) CACHE_REGS seq_tv_t inp, out; - inp.val.w = s; + inp.val.w0= s; inp.type = YAP_STRING_WCHARS; out.type = YAP_STRING_CODES; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -1873,7 +1873,7 @@ YAP_NWideBufferToString(const wchar_t *s, size_t len) CACHE_REGS seq_tv_t inp, out; - inp.val.w = s; + inp.val.w0 = s; inp.type = YAP_STRING_WCHARS; out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC; out.sz = len; @@ -1941,7 +1941,7 @@ YAP_BufferToAtomList(const char *s) CACHE_REGS seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.type = YAP_STRING_CHARS; out.type = YAP_STRING_ATOMS; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -1961,7 +1961,7 @@ YAP_NBufferToAtomList(const char *s, size_t len) CACHE_REGS seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.type = YAP_STRING_CHARS; out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC; out.sz = len; @@ -1983,7 +1983,7 @@ YAP_WideBufferToAtomList(const wchar_t *s) CACHE_REGS seq_tv_t inp, out; - inp.val.w = s; + inp.val.w0 = s; inp.type = YAP_STRING_WCHARS; out.type = YAP_STRING_ATOMS; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -2003,7 +2003,7 @@ YAP_NWideBufferToAtomList(const wchar_t *s, size_t len) CACHE_REGS seq_tv_t inp, out; - inp.val.w = s; + inp.val.w0 = s; inp.type = YAP_STRING_WCHARS; out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC; out.sz = len; @@ -2025,7 +2025,7 @@ YAP_NWideBufferToAtomDiffList(const wchar_t *s, Term t0, size_t len) CACHE_REGS seq_tv_t inp, out; - inp.val.w = s; + inp.val.w0 = s; inp.type = YAP_STRING_WCHARS; out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF; out.sz = len; @@ -2048,7 +2048,7 @@ YAP_BufferToDiffList(const char *s, Term t0) CACHE_REGS seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.type = YAP_STRING_CHARS; out.type = YAP_STRING_CODES|YAP_STRING_DIFF; out.dif = t0; @@ -2069,7 +2069,7 @@ YAP_NBufferToDiffList(const char *s, Term t0, size_t len) CACHE_REGS seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.type = YAP_STRING_CHARS; out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF; out.sz = len; @@ -2092,7 +2092,7 @@ YAP_WideBufferToDiffList(const wchar_t *s, Term t0) CACHE_REGS seq_tv_t inp, out; - inp.val.w = s; + inp.val.w0 = s; inp.type = YAP_STRING_WCHARS; out.type = YAP_STRING_CODES|YAP_STRING_DIFF; out.dif = t0; @@ -2113,7 +2113,7 @@ YAP_NWideBufferToDiffList(const wchar_t *s, Term t0, size_t len) CACHE_REGS seq_tv_t inp, out; - inp.val.w = s; + inp.val.w0 = s; inp.type = YAP_STRING_WCHARS; out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF; out.sz = len; @@ -4036,10 +4036,10 @@ YAP_RequiresExtraStack(size_t sz) { X_API Int YAP_AtomToInt(Atom At) { - TranslationEntry *te = Yap_GetTranslationProp(At); + TranslationEntry *te = Yap_GetTranslationProp(At,0); if (te != NIL) return te->Translation; SWI_Atoms[AtomTranslations] = At; - Yap_PutAtomTranslation(At, AtomTranslations); + Yap_PutAtomTranslation(At,0, AtomTranslations); AtomTranslations++; if (AtomTranslations == MaxAtomTranslations) { Atom * nt = (Atom *)malloc(sizeof(Atom)*2*MaxAtomTranslations), *ot = SWI_Atoms; @@ -4061,6 +4061,36 @@ YAP_IntToAtom(Int i) return SWI_Atoms[i]; } +X_API Int +YAP_FunctorToInt(Functor f) +{ + Atom At = NameOfFunctor( f ); + arity_t arity = ArityOfFunctor( f ); + TranslationEntry *te = Yap_GetTranslationProp(At, arity); + if (te != NIL) return te->Translation; + SWI_Functors[FunctorTranslations] = f; + Yap_PutAtomTranslation(At, arity, FunctorTranslations); + FunctorTranslations++; + if (FunctorTranslations == MaxFunctorTranslations) { + Functor * nt = (Functor *)malloc(sizeof(Functor)*2*MaxFunctorTranslations), *ot = SWI_Functors; + if (nt == NULL) { + Yap_Error(SYSTEM_ERROR,MkAtomTerm(At),"No more room for translations"); + return -1; + } + memcpy(nt, ot, sizeof(Functor)*MaxFunctorTranslations); + SWI_Functors = nt; + free( ot ); + MaxFunctorTranslations *= 2; + } + return FunctorTranslations-1; +} + +X_API Functor +YAP_IntToFunctor(Int i) +{ + return SWI_Functors[i]; +} + #endif // C_INTERFACE_C /** diff --git a/C/cdmgr.c b/C/cdmgr.c index c465bb052..7c9b5afe3 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -471,6 +471,7 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98"; #if HAVE_STRING_H #include #endif +#include static void retract_all(PredEntry *, int); @@ -4868,9 +4869,6 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya th = Terms[0]; tb = Terms[1]; tr = Terms[2]; - /* don't do this!! I might have stored a choice-point and changed ASP - Yap_RecoverSlots(3); - */ if (cl == NULL) { UNLOCK(pe->PELock); return FALSE; diff --git a/C/cmppreds.c b/C/cmppreds.c index ad85b260a..359437f30 100644 --- a/C/cmppreds.c +++ b/C/cmppreds.c @@ -1,3 +1,4 @@ + /************************************************************************* * * * YAP Prolog * diff --git a/C/errors.c b/C/errors.c index 48229f315..5e0ec138b 100755 --- a/C/errors.c +++ b/C/errors.c @@ -999,6 +999,20 @@ Yap_Error(yap_error_number type, Term where, const char *format,...) serious = TRUE; } break; + case DOMAIN_ERROR_PROLOG_FLAG: + { + int i; + Term ti[2]; + + i = strlen(tmpbuf); + ti[0] = MkAtomTerm(Yap_LookupAtom("prolog_flag")); + ti[1] = where; + nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti); + psize -= i; + fun = FunctorError; + serious = TRUE; + } + break; case DOMAIN_ERROR_RADIX: { int i; diff --git a/C/eval.c b/C/eval.c index 15790af94..fe53901f5 100644 --- a/C/eval.c +++ b/C/eval.c @@ -106,7 +106,7 @@ Eval(Term t USES_REGS) Atom name = AtomOfTerm(t); if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) { - return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, + return Yap_ArithError(TYPE_ERROR_EVALUABLE, takeIndicator(t), "atom %s in arithmetic expression", RepAtom(name)->StrOfAE); } @@ -129,7 +129,7 @@ Eval(Term t USES_REGS) Term t1, t2; if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) { - return Yap_ArithError(TYPE_ERROR_EVALUABLE, takeName(t), + return Yap_ArithError(TYPE_ERROR_EVALUABLE, takeIndicator(t), "functor %s/%d for arithmetic expression", RepAtom(name)->StrOfAE,n); } @@ -225,7 +225,7 @@ p_is( USES_REGS1 ) return FALSE; } } else { - Yap_EvalError(err, ARG2, "X is Exp"); + Yap_EvalError(err, takeIndicator( ARG2 ), "X is Exp"); return FALSE; } } while (TRUE); diff --git a/C/exec.c b/C/exec.c index 02f6c77b0..9b2ba813f 100755 --- a/C/exec.c +++ b/C/exec.c @@ -1687,7 +1687,7 @@ Yap_Reset(yap_reset_t mode) return res; } -static bool +bool is_cleanup_cp(choiceptr cp_b) { PredEntry *pe; diff --git a/C/exo.c b/C/exo.c index 1689164fb..d518bef7b 100755 --- a/C/exo.c +++ b/C/exo.c @@ -720,11 +720,11 @@ store_exo(yamop *pc, UInt arity, Term t0) for (i = 0; i< arity; i++) { DerefAndCheck(t, tp[0]); *cpc = t; - Yap_DebugPlWrite(t); fprintf(stderr,"\n"); + // Yap_DebugPlWrite(t); fprintf(stderr,"\n"); tp++; cpc++; } - fprintf(stderr,"\n"); + //fprintf(stderr,"\n"); return TRUE; } diff --git a/C/flags.c b/C/flags.c index 88d79fe0e..9eb7e7c16 100644 --- a/C/flags.c +++ b/C/flags.c @@ -45,6 +45,7 @@ static bool synerr(Term inp); static bool indexer(Term inp); static bool getenc(Term inp); static bool typein( Term inp ); +static bool dqf( Term t2 ); static void newFlag( Term fl, Term val ); static Int current_prolog_flag(USES_REGS1); @@ -86,6 +87,27 @@ static bool indexer( Term inp ) { return false; } +static bool dqf( Term t2 ) { + CACHE_REGS + ModEntry *new = Yap_GetModuleEntry(CurrentModule); + new->flags &= ~(DBLQ_CHARS|DBLQ_CODES|DBLQ_ATOM|DBLQ_STRING); + if (t2 == TermString) { + new->flags |= DBLQ_STRING; + return true; + } else if (t2 == TermAtom) { + new->flags |= DBLQ_ATOM; + return true; + } else if (t2 == TermCodes) { + new->flags |= DBLQ_CODES; + return true; + } else if (t2 == TermChars) { + new->flags |= DBLQ_CHARS; + return true; + } + Yap_Error(TYPE_ERROR_ATOM, t2, "set_prolog_flag(double_quotes, {string,atom,codes,chars}"); + return false; +} + static bool isaccess( Term inp ) { if (inp == TermReadWrite || @@ -418,7 +440,7 @@ static bool gc_margin( Term t ) { } static Term mk_argc_list(USES_REGS1) { - int i = 0; + int i = 1; Term t = TermNil; while (i < GLOBAL_argc) { char *arg = GLOBAL_argv[i]; @@ -470,14 +492,24 @@ static Term mk_os_argc_list(USES_REGS1) { static bool argv(Term inp) { CACHE_REGS - Term t = mk_argc_list(PASS_REGS1); - return Yap_unify(t, inp); + Term t = mk_argc_list(PASS_REGS1); + if (IsAtomOrIntTerm(t)) + GLOBAL_Flags[ARGV_FLAG].at = t; + else { + GLOBAL_Flags[ARGV_FLAG].DBT = Yap_StoreTermInDB(t, 2); + } + return false; } static bool os_argv(Term inp) { CACHE_REGS - Term t = mk_os_argc_list(PASS_REGS1); - return Yap_unify(t, inp); + Term t = mk_os_argc_list(PASS_REGS1); + if (IsAtomOrIntTerm(t)) + GLOBAL_Flags[OS_ARGV_FLAG].at = t; + else { + GLOBAL_Flags[OS_ARGV_FLAG].DBT = Yap_StoreTermInDB(t, 2); + } + return false; } @@ -559,7 +591,7 @@ static bool setYapFlagInModule( Term tflag, Term t2, Term mod ) return false; fv = GetFlagProp( AtomOfTerm( tflag ) ); if (!fv && !fv->global) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "trying to set unknown flag"); + Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag, "trying to set unknown module flag"); return FALSE; } if (mod == USER_MODULE && !setYapFlag( tflag, t2) ) @@ -792,12 +824,11 @@ static Int prolog_flag(USES_REGS1) { return cont_prolog_flag( PASS_REGS1 ); } do_cut( 0 ); - { + if (IsVarTerm( Deref(ARG2) ) ) { Term flag = getYapFlag( Deref(ARG1) ); if (flag == 0) return false; - if (Yap_unify( flag, ARG2 ) ) - return false; + return Yap_unify( flag, ARG2 ) ; } return setYapFlag( Deref(ARG1), Deref(ARG3) ); } @@ -883,7 +914,7 @@ bool setYapFlag( Term tflag, Term t2 ) } else if (fl == TermWarning) { Yap_Warning("Flag %s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE); } else { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, fl, "trying to set unknown flag ~s", AtomName(AtomOfTerm(fl))); + Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, fl, "trying to set unknown flag ~s", AtomName(AtomOfTerm(fl))); } return FALSE; } @@ -935,7 +966,7 @@ Term getYapFlag( Term tflag ) } else if (fl == TermWarning) { Yap_Warning("Flag ~s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE); } else { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, fl, "trying to read unknown flag %s", + Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, fl, "trying to read unknown flag %s", RepAtom(AtomOfTerm(fl))->StrOfAE); } return FALSE; @@ -1101,7 +1132,12 @@ setInitialValue( bool bootstrap, flag_func f, const char *s,flag_term *tarr ) if (!t0) return false; if (IsAtomTerm(t0) || IsIntTerm(t0)) { - tarr->at = t0; + // do yourself flags + if (t0 == MkAtomTerm(AtomQuery)) { + f(TermNil); + } else { + tarr->at = t0; + } } else { tarr->DBT = Yap_StoreTermInDB(t0, 2); } @@ -1202,7 +1238,7 @@ do_prolog_flag_property (Term tflag, Term opts USES_REGS) break; case PROLOG_FLAG_PROPERTY_END: /* break; */ - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, opts, "Flag not supported by YAP"); + Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, opts, "Flag not supported by YAP"); } } } diff --git a/C/heapgc.c b/C/heapgc.c index 5b1a3228d..298df16af 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -104,6 +104,13 @@ typedef struct RB_red_blk_node { /* support for hybrid garbage collection scheme */ +yamop * Yap_gcP(void) { + CACHE_REGS + return gc_P(P,CP); +} + +/* support for hybrid garbage collection scheme */ + static void gc_growtrail(int committed, tr_fr_ptr begsTR, cont *old_cont_top0 USES_REGS) { @@ -382,32 +389,36 @@ GC_NEW_MAHASH(gc_ma_hash_entry *top USES_REGS) { /* find all accessible objects on the heap and squeeze out all the rest */ -static void -check_pr_trail(tr_fr_ptr trp USES_REGS) +static tr_fr_ptr +check_pr_trail( tr_fr_ptr rc USES_REGS) { if ((tr_fr_ptr)LOCAL_TrailTop-TR < 1024) { + size_t n = TR- rc; if (!Yap_locked_growtrail(0, TRUE) || TRUE) { /* could not find more trail */ save_machine_regs(); siglongjmp(LOCAL_gc_restore, 2); } + rc = TR-n; } + return rc; } /* push the active registers onto the trail for inclusion during gc */ -static void +static tr_fr_ptr push_registers(Int num_regs, yamop *nextop USES_REGS) { int i; StaticArrayEntry *sal = LOCAL_StaticArrays; + tr_fr_ptr ret = TR; /* push array entries first */ ArrayEntry *al = LOCAL_DynamicArrays; GlobalEntry *gl = LOCAL_GlobalVariables; TrailTerm(TR++) = LOCAL_GlobalArena; while (al) { - check_pr_trail(TR PASS_REGS); + ret = check_pr_trail(ret PASS_REGS); TrailTerm(TR++) = al->ValueOfVE; al = al->NextAE; } @@ -417,7 +428,7 @@ push_registers(Int num_regs, yamop *nextop USES_REGS) !IsAtomTerm(t) && !IsIntTerm(t) ) { - check_pr_trail(TR PASS_REGS); + ret = check_pr_trail(ret PASS_REGS); //fprintf(stderr,"in=%s %p\n", gl->AtomOfGE->StrOfAE, gl->global); TrailTerm(TR++) = t; } @@ -429,14 +440,14 @@ push_registers(Int num_regs, yamop *nextop USES_REGS) for (i=0; i < arity; i++) { Term tlive = sal->ValueOfVE.lterms[i].tlive; if (!IsVarTerm(tlive) || !IsUnboundVar(&sal->ValueOfVE.lterms[i].tlive)) { - check_pr_trail(TR PASS_REGS); + ret = check_pr_trail(ret PASS_REGS); TrailTerm(TR++) = tlive; } } } sal = sal->NextAE; } - check_pr_trail(TR PASS_REGS); + ret = check_pr_trail(ret PASS_REGS); TrailTerm(TR) = LOCAL_GcGeneration; TR++; TrailTerm(TR) = LOCAL_GcPhase; @@ -451,12 +462,12 @@ push_registers(Int num_regs, yamop *nextop USES_REGS) *topslot = LOCAL_SlotBase + LOCAL_CurSlot; while (curslot < topslot) { // printf("%p <- %p\n", TR, topslot); - check_pr_trail(TR PASS_REGS); + ret = check_pr_trail(ret PASS_REGS); TrailTerm(TR++) = *curslot++; } } for (i = 1; i <= num_regs; i++) { - check_pr_trail(TR PASS_REGS); + ret = check_pr_trail(ret PASS_REGS); TrailTerm(TR++) = (CELL) XREGS[i]; } /* push any live registers we might have hanging around */ @@ -474,13 +485,14 @@ push_registers(Int num_regs, yamop *nextop USES_REGS) lab++; } if (curr & 1) { - check_pr_trail(TR PASS_REGS); + ret = check_pr_trail( ret PASS_REGS); TrailTerm(TR++) = XREGS[i]; } curr >>= 1; } } } + return ret; } @@ -1290,7 +1302,8 @@ mark_variable(CELL_PTR current USES_REGS) goto begin; #ifdef DEBUG } else if (next < (CELL *)LOCAL_GlobalBase || next > (CELL *)LOCAL_TrailTop) { - fprintf(stderr, "OOPS in GC: marking, current=%p, *current=" UInt_FORMAT " next=%p\n", current, ccur, next); + fprintf(stderr, + "OOPS in GC: marking, TR=%p, current=%p, *current=" UInt_FORMAT " next=%p\n", TR, current, ccur, next); #endif } else { #ifdef COROUTING @@ -1559,14 +1572,16 @@ Yap_mark_external_reference(CELL *ptr) { static void mark_regs(tr_fr_ptr old_TR USES_REGS) { - tr_fr_ptr trail_ptr; + tr_fr_ptr trail_ptr, tr = TR; /* first, whatever we dumped on the trail. Easier just to do the registers separately? */ - for (trail_ptr = old_TR; trail_ptr < TR; trail_ptr++) { + for (trail_ptr = old_TR; trail_ptr < tr; trail_ptr++) { mark_external_reference(&TrailTerm(trail_ptr) PASS_REGS); } + printf(" %p TR=%p\n",trail_ptr,TR); + } /* mark all heap objects accessible from a chain of environments */ @@ -4048,8 +4063,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS) LOCAL_HGEN = H0; } /* fprintf(stderr,"LOCAL_HGEN is %ld, %p, %p/%p\n", IntegerOfTerm(Yap_ReadTimedVar(LOCAL_GcGeneration)), LOCAL_HGEN, H,H0);*/ - LOCAL_OldTR = (tr_fr_ptr)(old_TR = TR); - push_registers(predarity, nextop PASS_REGS); + LOCAL_OldTR = old_TR = push_registers(predarity, nextop PASS_REGS); /* make sure we clean bits after a reset */ marking_phase(old_TR, current_env, nextop PASS_REGS); if (LOCAL_total_oldies > ((LOCAL_HGEN-H0)*8)/10) { diff --git a/C/init.c b/C/init.c index f89e80fdc..b6ac067c8 100755 --- a/C/init.c +++ b/C/init.c @@ -1071,19 +1071,10 @@ InitLogDBErasedMarker(void) static void InitSWIAtoms(void) { - /* extern atom_t ATOM_;FUNV - - int j=0; - MaxAtomTranslations = 2*N_SWI_ATOMS ; + MaxAtomTranslations = N_SWI_ATOMS ; + MaxFunctorTranslations = N_SWI_FUNCTORS ; SWI_Atoms = (Atom *)malloc(sizeof(Atom)*MaxAtomTranslations); SWI_Functors = (Functor *)malloc(sizeof(Functor)*2*N_SWI_ATOMS); -#include "i - - - atoms.h" - Yap_InitSWIHash(); - ATOM_ = PL_new_atom(""); - */ } static void @@ -1337,7 +1328,7 @@ InitCodes(void) modp->PredFlags |= MetaPredFlag; } #ifdef YAPOR -v Yap_heap_regs->getwork_code->y_u.Otapl.p = RepPredProp(PredPropByAtom(AtomGetwork, PROLOG_MODULE)); + Yap_heap_regs->getwork_code->y_u.Otapl.p = RepPredProp(PredPropByAtom(AtomGetwork, PROLOG_MODULE)); Yap_heap_regs->getwork_seq_code->y_u.Otapl.p = RepPredProp(PredPropByAtom(AtomGetworkSeq, PROLOG_MODULE)); #endif /* YAPOR */ diff --git a/C/other.c b/C/other.c index 3d45cf62d..dc121c505 100644 --- a/C/other.c +++ b/C/other.c @@ -60,11 +60,16 @@ Yap_MkNewPairTerm(void) return (AbsPair(p)); } +/** compound term constructor, builds a compound term with functor f and n + * args. + * + * + * Room for the new term is allocated from the heap: the functor and arguments are copied there. + * +*/ Term Yap_MkApplTerm(Functor f, arity_t n, const Term *a) - /* build compound term with functor f and n - * args a */ -{ + { CACHE_REGS CELL *t = HR; diff --git a/C/parser.c b/C/parser.c index 070924683..75ea69055 100755 --- a/C/parser.c +++ b/C/parser.c @@ -505,7 +505,7 @@ inline static void GNextToken(USES_REGS1) { inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) { if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) || LOCAL_tokptr->TokInfo != (Term)c) { - syntax_msg("expected to find \'%c\', found %s", tokRep(LOCAL_tokptr)); + syntax_msg("expected to find \'%c\', found %s", c, tokRep(LOCAL_tokptr)); FAIL; } NextToken; @@ -844,6 +844,7 @@ case Var_tok: FAIL; case Ponctuation_tok: + switch ((int)LOCAL_tokptr->TokInfo) { case '(': case 'l': /* non solo ( */ @@ -1097,6 +1098,7 @@ Term Yap_Parse(UInt prio) { Volatile Term t; JMPBUFF FailBuff; + yhandle_t sls = Yap_CurrentSlot(PASS_REGS1); if (!sigsetjmp(FailBuff.JmpBuff, 0)) { t = ParseTerm(prio, &FailBuff PASS_REGS); if (LOCAL_Error_TYPE == SYNTAX_ERROR) { @@ -1105,8 +1107,10 @@ Term Yap_Parse(UInt prio) { } // if (LOCAL_tokptr->Tok != Ord(eot_tok)) // return (0L); + Yap_CloseSlots( sls ); return (t); } else + Yap_CloseSlots( sls ); return (0); } diff --git a/C/qlyr.c b/C/qlyr.c index 29aa9e0d9..423af89e4 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -638,6 +638,10 @@ XAdjust__ (wamreg reg USES_REGS) #define Yap_op_from_opcode(OP) OpcodeID(OP) +static void RestoreFlags( UInt NFlags ) +{ +} + #include "rheap.h" static void diff --git a/C/qlyw.c b/C/qlyw.c index 321fc2c4d..884526a14 100755 --- a/C/qlyw.c +++ b/C/qlyw.c @@ -507,6 +507,10 @@ DBRefAdjust__ (DBRef dbt USES_REGS) #define RestoreSWIHash() +static void RestoreFlags( UInt NFlags ) +{ +} + #include "rheap.h" static void diff --git a/C/save.c b/C/save.c index 93a8b9a84..fc63538f1 100755 --- a/C/save.c +++ b/C/save.c @@ -1207,6 +1207,10 @@ RestoreSWIHash(void) } +static void RestoreFlags( UInt NFlags ) +{ +} + #include "rheap.h" /* restore the atom entries which are invisible for the user */ diff --git a/C/stdpreds.c b/C/stdpreds.c index 316e5917e..3d1e52445 100755 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -319,7 +319,7 @@ Int p_halt(USES_REGS1); #else static Int p_halt(USES_REGS1); #endif -static Int init_current_predicate(USES_REGS1); +static Int current_predicate(USES_REGS1); static Int cont_current_predicate(USES_REGS1); static OpEntry *NextOp(OpEntry *CACHE_TYPE); static Int init_current_op(USES_REGS1); diff --git a/C/text.c b/C/text.c index 23a6f5e37..efa83c5fc 100644 --- a/C/text.c +++ b/C/text.c @@ -185,7 +185,7 @@ get_wide_from_list( Term t, seq_tv_t *inp, wchar_t *s, int atoms USES_REGS) static Int -SkipListCodes(Term *l, Term **tailp, Int *atoms, int *wide) +SkipListCodes(Term *l, Term **tailp, Int *atoms, bool *wide) { Int length = 0; Term *s; /* slow */ @@ -193,6 +193,7 @@ SkipListCodes(Term *l, Term **tailp, Int *atoms, int *wide) do_derefa(v,l,derefa_unk,derefa_nonvar); s = l; + *wide = false; if (*l == TermNil) { @@ -248,13 +249,13 @@ SkipListCodes(Term *l, Term **tailp, Int *atoms, int *wide) static void * -Yap_ListOfAtomsToBuffer(void *buf, Term t, seq_tv_t *inp, int *widep, size_t *lenp USES_REGS) +Yap_ListOfAtomsToBuffer(void *buf, Term t, seq_tv_t *inp, bool *widep, size_t *lenp USES_REGS) { Int atoms = 0; CELL *r = NULL; Int n; - *widep = FALSE; + *widep = false; n = SkipListCodes(&t, &r, &atoms, widep); if (n < 0) { LOCAL_Error_TYPE = -n; @@ -294,13 +295,13 @@ Yap_ListOfAtomsToBuffer(void *buf, Term t, seq_tv_t *inp, int *widep, size_t *le } static void * -Yap_ListOfCodesToBuffer(void *buf, Term t, seq_tv_t *inp, int *widep, size_t *lenp USES_REGS) +Yap_ListOfCodesToBuffer(void *buf, Term t, seq_tv_t *inp, bool *widep, size_t *lenp USES_REGS) { Int atoms = 0; CELL *r = NULL; Int n; - *widep = FALSE; + *widep = false; n = SkipListCodes(&t, &r, &atoms, widep); if (n < 0) { LOCAL_Error_TYPE = -n; @@ -335,46 +336,6 @@ Yap_ListOfCodesToBuffer(void *buf, Term t, seq_tv_t *inp, int *widep, size_t *le } } -static void * -Yap_ListToBuffer(void *buf, Term t, seq_tv_t *inp, int *widep, size_t *lenp USES_REGS) -{ - Int atoms = 0; - CELL *r = NULL; - Int n; - - *widep = FALSE; - n = SkipListCodes(&t, &r, &atoms, widep); - if (n < 0) { - LOCAL_Error_TYPE = -n; - LOCAL_Error_Term = *r; - return NULL; - } - if (*r != TermNil) { - if (IsVarTerm(*r)) - LOCAL_Error_TYPE = INSTANTIATION_ERROR; - else - LOCAL_Error_TYPE = TYPE_ERROR_LIST; - LOCAL_Error_Term = *r; - return NULL; - } - *lenp = n; - if (*widep) { - wchar_t *s; - if (buf) s = buf; - else s = ((AtomEntry *)Yap_PreAllocCodeSpace())->WStrOfAE; - AUX_ERROR( t, 2*(n+1), s, wchar_t); - s = get_wide_from_list( t, inp, s, atoms PASS_REGS); - return s; - } else { - char *s; - if (buf) s = buf; - else s = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE; - AUX_ERROR( t, 2*(n+1), s, char); - s = get_string_from_list( t, inp, s, atoms PASS_REGS); - return s; - } -} - static yap_error_number gen_type_error(int flags) { if ((flags & (YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_ATOMS_CODES|YAP_STRING_BIG)) == @@ -400,138 +361,88 @@ Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *l { char *s; wchar_t *ws; + bool wide; /* we know what the term is */ - switch (inp->type & YAP_TYPE_MASK) { - case YAP_STRING_STRING: - { const char *s; - if (IsVarTerm(inp->val.t)) { - LOCAL_Error_TYPE = INSTANTIATION_ERROR; - LOCAL_Error_Term = inp->val.t; - return 0L; - } - if (!IsStringTerm(inp->val.t)) { - LOCAL_Error_TYPE = TYPE_ERROR_STRING; - LOCAL_Error_Term = inp->val.t; - return 0L; - } - s = StringOfTerm( inp->val.t ); - if ( s == NULL ) { - return 0L; - } - // this is a term, extract the UTF8 representation - *enc = ENC_ISO_UTF8; - *minimal = FALSE; - *lengp = strlen(s); - return (void *)s; + if (inp->type & YAP_STRING_STRING && !IsVarTerm(inp->val.t) && IsStringTerm(inp->val.t)) { const char *s; + s = StringOfTerm( inp->val.t ); + if ( s == NULL ) { + return 0L; } - case YAP_STRING_CODES: + // this is a term, extract the UTF8 representation + *enc = ENC_ISO_UTF8; + *minimal = FALSE; + if (lengp) + *lengp = strlen(s); + return (void *)s; + } + if (inp->type & YAP_STRING_ATOM && !IsVarTerm(inp->val.t) && IsAtomTerm(inp->val.t)) { + // this is a term, extract to a buffer, and representation is wide + *minimal = TRUE; + Atom at = AtomOfTerm(inp->val.t); + if (IsWideAtom(at)) { + ws = at->WStrOfAE; + *lengp = wcslen(ws); + *enc = ENC_WCHAR; + return ws; + } else { + s = at->StrOfAE; + *lengp = strlen(s); + *enc = ENC_ISO_LATIN1; + return s; + } + } + if (inp->type & YAP_STRING_CODES && !IsVarTerm(inp->val.t) && (s = Yap_ListOfCodesToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS))) { // this is a term, extract to a sfer, and representation is wide *minimal = TRUE; - { - int wide = FALSE; - s = Yap_ListOfCodesToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS); - if (!s) { - return NULL; - } - *enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 ); - } + int wide = FALSE; + *enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 ); return s; - case YAP_STRING_ATOMS: + } + if (inp->type & YAP_STRING_ATOMS && !IsVarTerm(inp->val.t) && (s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS))) { // this is a term, extract to a buffer, and representation is wide *minimal = TRUE; - { - int wide = FALSE; - s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS); - if (!s) return NULL; - if (wide) { *enc = ENC_WCHAR; } - else { *enc = ENC_ISO_LATIN1; } - } + s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS); + if (!s) return NULL; + if (wide) { *enc = ENC_WCHAR; } + else { *enc = ENC_ISO_LATIN1; } return s; - case YAP_STRING_ATOMS_CODES: - // this is a term, extract to a buffer, and representation is wide - *minimal = TRUE; - { - int wide = FALSE; - s = Yap_ListToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS); - if (!s) { - return NULL; + } + if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) { + if (buf) s = buf; + else s = Yap_PreAllocCodeSpace(); + AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char); + if (snprintf(s, LOCAL_MAX_SIZE-1, Int_FORMAT, IntegerOfTerm(inp->val.t)) < 0) { + AUX_ERROR( inp->val.t, 2*LOCAL_MAX_SIZE, s, char); } - *enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 ); + *enc = ENC_ISO_LATIN1; + *lengp = strlen(s); + return s; } - return s; - case YAP_STRING_ATOM: - // this is a term, extract to a buffer, and representation is wide - *minimal = TRUE; - if (IsVarTerm(inp->val.t)) { - LOCAL_Error_TYPE = INSTANTIATION_ERROR; - LOCAL_Error_Term = inp->val.t; - return 0L; - } else if (!IsAtomTerm(inp->val.t)) { - LOCAL_Error_TYPE = TYPE_ERROR_ATOM; - LOCAL_Error_Term = inp->val.t; - return NULL; - } else { - Atom at = AtomOfTerm(inp->val.t); - if (IsWideAtom(at)) { - ws = at->WStrOfAE; - *lengp = wcslen(ws); - *enc = ENC_WCHAR; - return ws; - } else { - s = at->StrOfAE; - *lengp = strlen(s); - *enc = ENC_ISO_LATIN1; - return s; + if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) { + if (buf) s = buf; + else s = Yap_PreAllocCodeSpace(); + AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char); + if ( !Yap_FormatFloat( FloatOfTerm(inp->val.t), &s, LOCAL_MAX_SIZE-1 ) ) { + AUX_ERROR( inp->val.t, 2*LOCAL_MAX_SIZE, s, char); } + *lengp = strlen(s); + *enc = ENC_ISO_LATIN1; + return s; } - break; - case YAP_STRING_INT: - if (buf) s = buf; - else s = Yap_PreAllocCodeSpace(); - AUX_ERROR( MkIntTerm(inp->val.i), LOCAL_MAX_SIZE, s, char); - if (snprintf(s, LOCAL_MAX_SIZE-1, Int_FORMAT, inp->val.i) < 0) { - AUX_ERROR( MkIntTerm(inp->val.i), 2*LOCAL_MAX_SIZE, s, char); - } - *enc = ENC_ISO_LATIN1; - *lengp = strlen(s); - return s; - case YAP_STRING_FLOAT: - if (buf) s = buf; - else s = Yap_PreAllocCodeSpace(); - AUX_ERROR( MkFloatTerm(inp->val.f), LOCAL_MAX_SIZE, s, char); - if ( !Yap_FormatFloat( inp->val.f, s, LOCAL_MAX_SIZE-1 ) ) { - AUX_ERROR( MkFloatTerm(inp->val.f), 2*LOCAL_MAX_SIZE, s, char); - } - *lengp = strlen(s); - *enc = ENC_ISO_LATIN1; - return s; #if USE_GMP - case YAP_STRING_BIG: - if (buf) s = buf; - else s = Yap_PreAllocCodeSpace(); - if ( !Yap_mpz_to_string( inp->val.b, s, LOCAL_MAX_SIZE-1 , 10 ) ) { - AUX_ERROR( MkIntTerm(0), LOCAL_MAX_SIZE, s, char); + if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) { + if (buf) s = buf; + else s = Yap_PreAllocCodeSpace(); + if ( !Yap_mpz_to_string( Yap_BigIntOfTerm(inp->val.t), s, LOCAL_MAX_SIZE-1 , 10 ) ) { + AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char); + } + *enc = ENC_ISO_LATIN1; + *lengp = strlen(s); + return s; } - *enc = ENC_ISO_LATIN1; - *lengp = strlen(s); - return s; #endif - case YAP_STRING_CHARS: - *enc = ENC_ISO_LATIN1; - if (inp->type & YAP_STRING_NCHARS) - *lengp = inp->sz; - else - *lengp = strlen(inp->val.c); - return (void *)inp->val.c; - case YAP_STRING_WCHARS: - *enc = ENC_WCHAR; - if (inp->type & YAP_STRING_NCHARS) - *lengp = inp->sz; - else - *lengp = wcslen(inp->val.w); - return (void *)inp->val.w; - case YAP_STRING_LITERAL: + if (inp->type & YAP_STRING_TERM) { char *s, *o; if (buf) s = buf; @@ -540,82 +451,23 @@ Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *l o = Yap_TermToString(inp->val.t, s, sz, lengp, ENC_ISO_UTF8, 0); return s; } - default: - if (!(inp->type & YAP_STRING_TERM)) { - return NULL; - } else { - Term t = inp->val.t; - if (IsVarTerm(t)) { - LOCAL_Error_TYPE = INSTANTIATION_ERROR; - LOCAL_Error_Term = t; - return NULL; - } else if (IsStringTerm(t)) { - if (inp->type & (YAP_STRING_STRING)) { - inp->type &= (YAP_STRING_STRING); - return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS); - } else { - LOCAL_Error_TYPE = gen_type_error( inp->type ); - LOCAL_Error_Term = t; - } - } else if (IsPairTerm(t) ) { - if (inp->type & (YAP_STRING_CODES|YAP_STRING_ATOMS)) { - inp->type &= (YAP_STRING_CODES|YAP_STRING_ATOMS); - return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS); - } else { - LOCAL_Error_TYPE = gen_type_error( inp->type ); - LOCAL_Error_Term = t; - } - } else if (IsAtomTerm(t)) { - if (t == TermNil && inp->type & (YAP_STRING_CODES|YAP_STRING_ATOMS)) { - inp->type &= (YAP_STRING_CODES|YAP_STRING_ATOMS); - return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS); - } else if (inp->type & (YAP_STRING_ATOM)) { - inp->type &= (YAP_STRING_ATOM); - inp->val.t = t; - return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS); - // [] is special... - } else { - LOCAL_Error_TYPE = gen_type_error( inp->type ); - LOCAL_Error_Term = t; - } - } else if (IsIntegerTerm(t)) { - if (inp->type & (YAP_STRING_INT)) { - inp->type &= (YAP_STRING_INT); - inp->val.i = IntegerOfTerm(t); - return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS); - } else { - LOCAL_Error_TYPE = gen_type_error( inp->type ); - LOCAL_Error_Term = t; - } - } else if (IsFloatTerm(t)) { - if (inp->type & (YAP_STRING_FLOAT)) { - inp->type &= (YAP_STRING_FLOAT); - inp->val.f = FloatOfTerm(t); - return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS); - } else { - LOCAL_Error_TYPE = gen_type_error( inp->type ); - LOCAL_Error_Term = t; - } -#if USE_GMP - } else if (IsBigIntTerm(t)) { - if (inp->type & (YAP_STRING_BIG)) { - inp->type &= (YAP_STRING_BIG); - inp->val.b = Yap_BigIntOfTerm(t); - return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS); - } else { - LOCAL_Error_TYPE = gen_type_error( inp->type ); - LOCAL_Error_Term = t; - } -#endif - } else { - if (!Yap_IsGroundTerm(t)) { - LOCAL_Error_TYPE = INSTANTIATION_ERROR; - LOCAL_Error_Term = t; - } - } - return NULL; + if (inp->type & YAP_STRING_CHARS) { + *enc = ENC_ISO_LATIN1; + if (inp->type & YAP_STRING_NCHARS) + *lengp = inp->sz; + else + *lengp = strlen(inp->val.c); + return (void *)inp->val.c; } - } + if (inp->type & YAP_STRING_WCHARS) { + *enc = ENC_WCHAR; + if (inp->type & YAP_STRING_NCHARS) + *lengp = inp->sz; + else + *lengp = wcslen(inp->val.w); + return (void *)inp->val.w; + } + return NULL; } static Term @@ -915,12 +767,248 @@ write_atom( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng US return at; } default: - Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__); + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc)); } return NULL; } +static size_t +write_wbuffer( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS) +{ + size_t min = 0, max = leng, sz_end, sz; + out->enc = ENC_WCHAR; + if (out->type & (YAP_STRING_NCHARS|YAP_STRING_TRUNC)) { + if (out->type & YAP_STRING_NCHARS) min = out->sz; + if (out->type & YAP_STRING_TRUNC && out->max < max) max = out->max; + } + if (out->enc != enc || out->type & (YAP_STRING_WITH_BUFFER|YAP_STRING_MALLOC)) { + if (enc != ENC_WCHAR) { + sz = strlen((char *)s0); + } else { + sz = wcslen((wchar_t *)s0); + } + if (sz < min) sz = min; + sz *= sizeof(wchar_t); + if (out->type & (YAP_STRING_MALLOC)) { + out->val.w = malloc(sz); + } else if (!(out->type & (YAP_STRING_WITH_BUFFER))) { + if (ASP-(sz/sizeof(CELL)+1) > HR+1024) { + out->val.w = (wchar_t *)(ASP-((sz*sizeof(wchar_t *)/sizeof(CELL)+1))); + } else + return -1; + } + } else { + out->val.w = s0; + sz_end = (wcslen( s0 )+1)*sizeof(wchar_t); + } + if (out->enc == ENC_WCHAR) { + switch (enc) { + case ENC_WCHAR: + if (out->type & (YAP_STRING_WITH_BUFFER|YAP_STRING_MALLOC) ) { + wchar_t *s = s0; + size_t n = wcslen( s ); + if (n < min) n = min; + memcpy( out->val.c, s0, n*sizeof(wchar_t)); + out->val.w[n] = '\0'; + sz_end = n+1; + } + case ENC_ISO_UTF8: + { + char *s = s0, *lim = s + (max = strnlen(s, max)); + char *cp = s; + wchar_t *buf0, *buf; + + buf = buf0 = out->val.w; + if (!buf) + return -1; + while (*cp && cp < lim) { + int chr; + cp = utf8_get_char(cp, &chr); + *buf++ = chr; + } + if (max >= min) *buf++ = '\0'; + else while (max < min) { + int chr; + max++; + cp = utf8_get_char(cp, &chr); + *buf++ = chr; + } + *buf = '\0'; + sz_end = (buf-buf0)+1; + } + break; + case ENC_ISO_LATIN1: + { + char *s = s0; + size_t n = strlen( s ), i; + if (n < min) n = min; + for (i = 0; i < n; i++) + out->val.w[i] = s[i]; + out->val.w[n] = '\0'; + sz_end = n+1; + } + break; + default: + sz_end = -1; + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__); + } + } + sz_end *= sizeof( wchar_t ); + if (out->type & (YAP_STRING_MALLOC)) { + out->val.c = realloc(out->val.c,sz_end); + } + out->sz = sz_end; + return sz_end; + } + + +static size_t +write_buffer( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS) +{ + size_t min = 0, max = leng, sz_end; + if (out->type & (YAP_STRING_NCHARS|YAP_STRING_TRUNC)) { + if (out->type & YAP_STRING_NCHARS) min = out->sz; + if (out->type & YAP_STRING_TRUNC && out->max < max) max = out->max; + } + if (out->enc != enc || out->type & (YAP_STRING_WITH_BUFFER|YAP_STRING_MALLOC)) { + size_t sz; + if (enc != ENC_WCHAR) + sz = strlen((char *)s0); + else + sz = wcslen((wchar_t *)s0); + if (sz < min) sz = min; + if (!minimal) sz *= 4; + if (out->type & (YAP_STRING_MALLOC)) { + out->val.c = malloc(sz); + } else if (!(out->type & (YAP_STRING_WITH_BUFFER))) { + if (ASP-(sz/sizeof(CELL)+1) > HR+1024) { + out->val.c = (char *)(ASP-(sz/sizeof(CELL)+1)); + } + } + } else { + out->val.c = s0; + } + if (out->enc == ENC_ISO_UTF8) { + switch (enc) { + case ENC_ISO_UTF8: + if (out->type & (YAP_STRING_WITH_BUFFER|YAP_STRING_MALLOC) ) { + char *s = s0; + size_t n = strlen( s ); + memcpy( out->val.c, s0, n*sizeof(wchar_t)); + out->val.c[n] = '\0'; + sz_end = n+1; + } else { + sz_end = strlen(out->val.c)+1; + } + break; + case ENC_ISO_LATIN1: + { + char *s = s0, *lim = s + (max = strnlen(s, max)); + char *cp = s, *buf0, *buf; + + buf = buf0 = out->val.c; + if (!buf) + return -1; + while (*cp && cp < lim) { + int chr; + chr = *cp++; + buf = utf8_put_char(buf, chr); + } + if (max >= min) *buf++ = '\0'; + else while (max < min) { + max++; + int chr; + chr = *cp++; + buf = utf8_put_char(buf, chr); + } + buf[0] = '\0'; + sz_end = (buf+1)-buf0; + } + break; + case ENC_WCHAR: + { + wchar_t *s = s0; + char *buf = out->val.c; + size_t n = wcslen( s ), i; + if (n < min) n = min; + for (i = 0; i < n; i++) { + int chr = s[i]; + buf = utf8_put_char(buf, chr); + } + *buf++ = '\0'; + sz_end = (buf+1)-out->val.c; + } + break; + default: + sz_end = -1; + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__); + } + }else if (out->enc == ENC_ISO_LATIN1) { + switch (enc) { + case ENC_ISO_LATIN1: + if (out->type & YAP_STRING_WITH_BUFFER) { + char *s = s0; + size_t n = strlen( s ), i; + if (n < min) n = min; + memcpy( out->val.c, s0, n); + for (i = 0; i < n; i++) + out->val.w[i] = s[i]; + out->val.w[n] = '\0'; + sz_end = (n+1)*sizeof(wchar_t); + } else { + sz_end = strlen( out->val.c ) + 1; + } + break; + case ENC_ISO_UTF8: + { + char *s = s0, *lim = s + (max = strnlen(s, max)); + char *cp = s; + char *buf0, *buf; + + buf = buf0 = out->val.c; + if (!buf) + return -1; + while (*cp && cp < lim) { + int chr; + cp = utf8_get_char(cp, &chr); + *buf++ = chr; + } + if (max >= min) *buf++ = '\0'; + else while (max < min) { + int chr; + max++; + cp = utf8_get_char(cp, &chr); + *buf++ = chr; + } + sz_end = buf-out->val.c; + } + break; + case ENC_WCHAR: + { + wchar_t *s = s0; + size_t n = wcslen( s ), i; + if (n < min) n = min; + for (i = 0; i < n; i++) + out->val.c[i] = s[i]; + out->val.c[n] = '\0'; + sz_end = n+1; + } + break; + default: + sz_end = -1; + Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__); + } + } + if (out->type & (YAP_STRING_MALLOC)) { + out->val.c = realloc(out->val.c,sz_end); + } + out->sz = sz_end; + return sz_end; +} + + + static ssize_t write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS) { @@ -998,14 +1086,16 @@ write_Text( void *inp, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U write_number( inp, out, enc, minimal, leng PASS_REGS); return out->val.t != 0; case YAP_STRING_CHARS: - out->val.c = inp; - return 1; + { + size_t sz = write_buffer( inp, out, enc, minimal, leng PASS_REGS); + return((Int)sz > 0); + } case YAP_STRING_WCHARS: - out->val.w = inp; - return MkIntTerm(0); - case YAP_STRING_LITERAL: - return 0; - default: + { + size_t sz = write_wbuffer( inp, out, enc, minimal, leng PASS_REGS); + return((Int)sz > 0); + } + default: if (!(out->type & YAP_STRING_TERM)) return 0; if (out->type & (YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG)) @@ -1019,12 +1109,11 @@ write_Text( void *inp, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U out->val.t = MkAtomTerm(at); return at != NIL; } - if (out->type & (YAP_STRING_LITERAL)) if ((out->val.t = string_to_term( inp, out, enc, minimal, leng PASS_REGS)) != 0L) return out->val.t != 0; - return FALSE; - } + } + return FALSE; } int @@ -1208,7 +1297,6 @@ concat( int n, seq_tv_t *out, void *sv[], encoding_t encv[], size_t lengv[] USES /* wide atom */ wchar_t *buf = (wchar_t *)HR; Atom at; - Term t = ARG1; LOCAL_ERROR( sz+3 ); for (i = 0; i < n ; i ++) { if (encv[i] == ENC_WCHAR) { @@ -1232,7 +1320,6 @@ concat( int n, seq_tv_t *out, void *sv[], encoding_t encv[], size_t lengv[] USES /* atom */ char *buf = (char *)HR; Atom at; - Term t = ARG1; LOCAL_TERM_ERROR( sz/sizeof(CELL)+3 ); for (i = 0; i < n ; i ++) { @@ -1279,7 +1366,6 @@ slice( size_t min, size_t max, void *buf, seq_tv_t *out, encoding_t enc USES_REG if (enc == ENC_WCHAR) { /* wide atom */ wchar_t *nbuf = (wchar_t *)HR; - Term t = TermNil; wchar_t *ptr = (wchar_t *)buf + min; if (max>min) { LOCAL_ERROR( (max-min)*sizeof(wchar_t) ); @@ -1292,7 +1378,6 @@ slice( size_t min, size_t max, void *buf, seq_tv_t *out, encoding_t enc USES_REG char *nbuf = (char *)HR; if (max>min) { - Term t = TermNil; char *ptr = (char *)buf + min; LOCAL_ERROR( max-min ); memcpy( nbuf, ptr, (max - min)); @@ -1302,7 +1387,6 @@ slice( size_t min, size_t max, void *buf, seq_tv_t *out, encoding_t enc USES_REG } else { /* atom */ wchar_t *nbuf = (wchar_t *)HR; - Term t = ARG1; const char *ptr = utf8_skip ( (const char *)buf, min ); int chr; diff --git a/C/traced_absmi_insts.h b/C/traced_absmi_insts.h index 51badeada..b543ece20 100644 --- a/C/traced_absmi_insts.h +++ b/C/traced_absmi_insts.h @@ -35,11 +35,11 @@ if (P== NULL) goto NoStackCommitX; *****************************************************************/ BOp(Ystop, l); - goto Ystop; + goto _Ystop; ENDBOp(); BOp(Nstop, e); - goto Nstop; + goto _Nstop; ENDBOp(); /***************************************************************** @@ -76,7 +76,7 @@ CACHE_Y(YREG); ENDOp(); /* retry_me Label,NArgs */ - Op(retry_me, Otapl); + Op(retry_me, OBtapl); EMIT_ENTRY_BLOCK(PREG,RETRY_ME_INSTINIT); CACHE_Y(B); /* After retry, cut should be pointing at the parent @@ -14533,43 +14533,43 @@ S_SREG = RepAppl(d0); } BOp(unify_l_string ,ou); - goto Ystop; + goto _Ystop; ENDBOp(); BOp(unify_string ,ou); - goto Ystop; + goto _Ystop; ENDBOp(); BOp(get_string ,xu); - goto Ystop; + goto _Ystop; ENDBOp(); BOp(get_atom_exo ,x); - goto Ystop; + goto _Ystop; ENDBOp(); BOp(retry_exo_udi ,lp); - goto Ystop; + goto _Ystop; ENDBOp(); BOp(retry_exo ,lp); - goto Ystop; + goto _Ystop; ENDBOp(); BOp(retry_udi ,p); - goto Ystop; + goto _Ystop; ENDBOp(); BOp(retry_all_exo ,lp); - goto Ystop; + goto _Ystop; ENDBOp(); BOp(enter_exo ,e); - goto Ystop; + goto _Ystop; ENDBOp(); BOp(try_exo ,lp); - goto Ystop; + goto _Ystop; ENDBOp(); BOp(try_exo_udi ,lp); - goto Ystop; + goto _Ystop; ENDBOp(); BOp(try_all_exo ,lp); - goto Ystop; + goto _Ystop; ENDBOp(); BOp(try_udi ,p); - goto Ystop; + goto _Ystop; ENDBOp(); diff --git a/C/unify.c b/C/unify.c index f88af1dcc..4eaf5ef4d 100644 --- a/C/unify.c +++ b/C/unify.c @@ -54,10 +54,6 @@ int Yap_rational_tree_loop(CELL *, CELL *, CELL **, CELL **); static int OCUnify_complex(CELL *, CELL *, CELL *); static int OCUnify(register CELL, register CELL); static Int p_ocunify( USES_REGS1 ); -#ifdef THREADED_CODE -static int rtable_hash_op(OPCODE); -static void InitReverseLookupOpcode(void); -#endif /* support for rational trees and unification with occur checking */ diff --git a/C/write.c b/C/write.c index 75efc9324..81be5a966 100644 --- a/C/write.c +++ b/C/write.c @@ -381,15 +381,20 @@ static void wrputf(Float f, struct write_globs *wglb) /* writes a float */ protect_close_number(wglb, ob); } -int Yap_FormatFloat(Float f, const char *s, size_t sz) { +int Yap_FormatFloat(Float f, char **s, size_t sz) { CACHE_REGS struct write_globs wglb; int sno; - sno = Yap_open_buf_read_stream(s, strlen(s)+1, LOCAL_encoding, MEM_BUF_USER); + char *so; + + sno = Yap_open_buf_write_stream(*s, sz, GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0); if (sno < 0) return FALSE; + wglb.stream = GLOBAL_Stream+sno; wrputf(f, &wglb); - GLOBAL_Stream[sno].status = Free_Stream_f; + so = Yap_MemExportStreamPtr(sno); + Yap_CloseStream(sno); + *s = so; return TRUE; } @@ -1199,8 +1204,10 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int prio /* consumer */ /* write options */ { + CACHE_REGS struct write_globs wglb; struct rewind_term rwt; + yhandle_t sls = Yap_CurrentSlot(PASS_REGS1); if (!mywrite) { CACHE_REGS @@ -1235,9 +1242,8 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int prio if (flags & Fullstop_f) { wrputc('.', wglb.stream); wrputc(' ', wglb.stream); - } else { - wrputc(' ', wglb.stream); } } restore_from_write(&rwt, &wglb); + Yap_CloseSlots( sls ); } diff --git a/CMakeLists.txt b/CMakeLists.txt index fc61e0eb4..599528d06 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -149,7 +149,7 @@ set(YAP_STARTUP startup.yss) string(TIMESTAMP YAP_TIMESTAMP) string( SUBSTRING ${CMAKE_SHARED_LIBRARY_SUFFIX} 1 -1 SO_EXT ) # -include_directories (H include os) +include_directories (H include os JIT/HPP) include_directories (BEFORE ${CMAKE_BINARY_DIR}) # rpath stuff, hopefully it works @@ -240,11 +240,11 @@ message(STATUS "Running with CMAKE_C_FLAGS ${CMAKE_C_FLAGS}") if (HAVE_GCC) # replace instructions codes by the address of their code - option (YAP_THREADED_CODE "threaded code" ON) - if (YAP_THREADED_CODE) + option (THREADED_CODE "threaded code" ON) + if (THREADED_CODE) set (USE_THREADED_CODE 1) - add_definitions(-DTHREADEAD_CODE=1) -endif (YAP_THREADED_CODE) + add_definitions(-DUSE_THREADEAD_CODE=1) + endif (THREADED_CODE) endif (HAVE_GCC) # @@ -304,7 +304,7 @@ endif (YAP_CALL_TRACER) option (YAP_THREADS "support system threads" OFF) -macro_optional_find_package (Threads ON) +macro_optional_find_package (Threads OFF) macro_log_feature (THREADS_FOUND "Threads Support" "GNU Threads Library (or similar)" "http://www.gnu.org/software/threads") @@ -378,45 +378,44 @@ ADD_SUBDIRECTORY(swi/library) # ADD_SUBDIRECTORY(os) # ADD_SUBDIRECTORY(packages) -macro_optional_find_package (LLVM ON) -macro_log_feature (LLVM_FOUND "LLVM JIT generator" - "The LLVM Compiler Infrastructure" "http://www.llvm.org") - -if (LLVM_FOUND) +option (JIT +"just in Time Clause Compilation" OFF) +# macro_optional_find_package (JIT OFF) +# macro_optional_add_subdirectory(JIT OFF) +if (YAP_JIT) +# INCLUDE_DIRECTORIES(JIT JIT/HPP) add_definitions (-DYAP_JIT=1) - INCLUDE_DIRECTORIES(JIT JIT/HPP) - macro_optional_add_subdirectory(JIT) endif() macro_optional_add_subdirectory(library/mpi) -macro_optional_add_subdirectory(library/lammpi) +add_subdirectory(library/lammpi) -macro_optional_add_subdirectory (packages/gecode) +add_subdirectory (packages/gecode) -macro_optional_add_subdirectory (packages/myddas) +add_subdirectory (packages/myddas) -macro_optional_add_subdirectory (packages/real) +add_subdirectory (packages/real) -macro_optional_add_subdirectory (packages/python) +add_subdirectory (packages/python) #add_subdirectory (packages/archive) -macro_optional_add_subdirectory (packages/jpl) +add_subdirectory (packages/jpl) -macro_optional_add_subdirectory (packages/swig) +add_subdirectory (packages/swig) -macro_optional_add_subdirectory (packages/bdd) +add_subdirectory (packages/bdd) -macro_optional_add_subdirectory (packages/CLPBN) +add_subdirectory (packages/CLPBN) -macro_optional_add_subdirectory (packages/CLPBN/horus) +add_subdirectory (packages/CLPBN/horus) -macro_optional_add_subdirectory (packages/Problog) +add_subdirectory (packages/Problog) -macro_optional_add_subdirectory (packages/raptor) +add_subdirectory (packages/raptor) -#macro_optional_add_subdirectory (packages/cuda) +# add_subdirectory (packages/cuda) #add_subdirectory (packages/prosqlite) @@ -424,34 +423,34 @@ macro_optional_add_subdirectory (packages/raptor) #add_subdirectory (packages/zlib) #todo: use cmake target builds -# option (MAXPERFORMANCE +# option (WITH_MAXPERFORMANCE # "try using the best flags for specific architecture" OFF) -# option (MAXMEMORY +# option (WITH_MAXMEMORY # "try using the best flags for using the memory to the most" ON) #TODO: check MAXMEMORY #TODO: use cmake target builds -# option (DEBUGYAP +# option (WITH_DEBUGYAP # "enable C-debugging for YAP" OFF) #TODO: use cmake arch/compiler -# option (CYGWIN +# option (WITH_CYGWIN # "use cygwin library in WIN32" OFF) -option (YAP_PRISM +option (WITH_YAP_PRISM "use PRISM system in YAP" ON) #TODO: -option (YAP_DLL +option (WITH_YAP_DLL "compile YAP as a DLL" ON) #TODO: -option (YAP_STATIC +option (WITH_YAP_STATIC "compile YAP statically" OFF) #TODO: -option (YAP_MALLOC +option (WITH_YAP_MALLOC "use malloc to allocate memory" ON) if (YAP_MALLOC) # use default allocator @@ -540,3 +539,3325 @@ install ( ) macro_display_feature_log() + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/H/Regs.h b/H/Regs.h index 4ce98d349..7c614367a 100755 --- a/H/Regs.h +++ b/H/Regs.h @@ -722,7 +722,6 @@ INLINE_ONLY EXTERN inline void restore_B(void) { #endif /* FROZEN_STACKS */ - #if !defined(THREADS) /* use actual addresses for regs */ #define PRECOMPUTE_REGADDRESS 1 diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index 26b306193..b26aa674d 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -71,7 +71,7 @@ running on an Apple machine. */ #endif YAP_FLAG( ARCH_FLAG, "arch", false, isatom, YAP_ARCH , NULL ), -YAP_FLAG( ARGV_FLAG, "argv", false, isatom, "[]" , argv ), +YAP_FLAG( ARGV_FLAG, "argv", false, argv, "?-" , NULL ), YAP_FLAG( ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true, boolean, "true" , NULL ), YAP_FLAG( BACKQUOTED_STRING_FLAG, "backquoted_string", true, isatom, "string" , ), /**> If _Value_ is unbound, tell whether a double quoted list of characters @@ -133,7 +133,7 @@ YAP_FLAG( DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true, boolean, "fa If `off` (default) consider the character `$` a control character, if `on` consider `$` a lower case character. */ - YAP_FLAG( DOUBLE_QUOTES_FLAG, "double_quotes", true, isatom, "codes" , NULL ), /**< `double_quotes is iso ` + YAP_FLAG( DOUBLE_QUOTES_FLAG, "double_quotes", true, isatom, "codes" , dqf ), /**< `double_quotes is iso ` If _Value_ is unbound, tell whether a double quoted list of characters token is converted to a list of atoms, `chars`, to a list of integers, @@ -148,10 +148,10 @@ original program path. YAP_FLAG( FAST_FLAG, "fast", true, boolean, "false" , NULL ), /**< `fast ` If `on` allow fast machine code, if `off` (default) disable it. Only -available in experimental implementations. +available in experimental implemexbntations. */ YAP_FLAG( FILE_NAME_VARIABLES_FLAG, "file_name_variables", true, boolean, "true" , NULL ), -YAP_FLAG( FLOAT_FORMAT_FLAG, "float_format", true, isatom, "%.15g" , NULL ), /**< + `float_format ` +YAP_FLAG( FLOAT_FORMAT_FLAG, "float_format", true, isatom, "%15e" , NULL ), /**< + `float_format ` C-library `printf()` format specification used by write/1 and friends to determine how floating point numbers are printed. The @@ -254,7 +254,7 @@ providing access to shared libraries (`.so` files) or to dynamic link libraries (`.DLL` files). */ YAP_FLAG( OPTIMISE_FLAG, "optimise", true, boolean, "false" , NULL ), -YAP_FLAG( OS_ARGV_FLAG, "os_argv", false, ro, "[]" , os_argv ), +YAP_FLAG( OS_ARGV_FLAG, "os_argv", false, os_argv, "?-" , NULL ), YAP_FLAG( PID_FLAG, "pid", false, ro, "0" , NULL ), YAP_FLAG( PIPE_FLAG, "pipe", true, boolean, "true" , NULL ), YAP_FLAG( PROFILING_FLAG, "profiling", true, boolean, "false" , NULL ), /**< `profiling ` diff --git a/H/YapHandles.h b/H/YapHandles.h index 67b57da08..019ab3512 100755 --- a/H/YapHandles.h +++ b/H/YapHandles.h @@ -48,13 +48,15 @@ Slots are not known to the yaam. Instead, A new set of slots is created when the *************************************************************************************************/ +#include + /// @brief reboot the slot system. /// Used when wwe start from scratch (Reset). #define Yap_RebootSlots( wid ) Yap_RebootSlots__( wid PASS_REGS ) static inline void Yap_RebootSlots__( int wid USES_REGS ) { - // fprintf( stderr, " StartSlots = %ld", LOCAL_CurSlot); + // // fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot); REMOTE_CurSlot(wid) = 1; } @@ -65,7 +67,8 @@ Yap_RebootSlots__( int wid USES_REGS ) { static inline yhandle_t Yap_StartSlots__( USES_REGS1 ) { - // fprintf( stderr, " StartSlots = %ld", LOCAL_CurSlot); + // // fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot); + // fprintf(stderr,"SS %s:%d\n", __FUNCTION__, __LINE__);; if (LOCAL_CurSlot < 0) { Yap_Error( SYSTEM_ERROR, 0L, " StartSlots = %ld", LOCAL_CurSlot); } @@ -78,6 +81,7 @@ if (LOCAL_CurSlot < 0) { static inline void Yap_CloseSlots__( yhandle_t slot USES_REGS ) { + // fprintf(stderr,"CS %s:%d\n", __FUNCTION__, __LINE__);; LOCAL_CurSlot = slot; } @@ -92,6 +96,7 @@ Yap_CurrentSlot( USES_REGS1 ) { static inline Term Yap_GetFromSlot__(yhandle_t slot USES_REGS) { + // fprintf(stderr,"GS %s:%d\n", __FUNCTION__, __LINE__);; return(Deref(LOCAL_SlotBase[slot])); } @@ -99,6 +104,7 @@ Yap_GetFromSlot__(yhandle_t slot USES_REGS) static inline Term Yap_GetDerefedFromSlot(yhandle_t slot USES_REGS) { + // fprintf(stderr,"GDS %s:%d\n", __FUNCTION__, __LINE__); return LOCAL_SlotBase[slot]; } @@ -106,6 +112,7 @@ Yap_GetDerefedFromSlot(yhandle_t slot USES_REGS) static inline Term Yap_GetPtrFromSlot(yhandle_t slot USES_REGS) { + // fprintf(stderr,"GPS %s:%d\n", __FUNCTION__, __LINE__); return LOCAL_SlotBase[slot]; } @@ -123,6 +130,7 @@ Yap_AddressFromSlot__(yhandle_t slot USES_REGS) static inline void Yap_PutInSlot(yhandle_t slot, Term t USES_REGS) { + // fprintf(stderr,"PS %s:%d\n", __FUNCTION__, __LINE__); LOCAL_SlotBase[slot] = t; } @@ -135,7 +143,9 @@ ensure_slots(int N USES_REGS) { if (LOCAL_CurSlot+N >= LOCAL_NSlots) { size_t inc = max(16*1024, LOCAL_NSlots/2); // measured in cells + inc = max(inc, N+16); // measured in cells LOCAL_SlotBase = (CELL *)realloc( LOCAL_SlotBase, (inc + LOCAL_NSlots )*sizeof(CELL)); + LOCAL_NSlots += inc; if (!LOCAL_SlotBase) { unsigned long int kneeds = ((inc + LOCAL_NSlots )*sizeof(CELL))/1024; Yap_Error(SYSTEM_ERROR, 0 /* TermNil */, "Out of memory for the term handles (term_t) aka slots, l needed", kneeds); @@ -150,6 +160,7 @@ static inline yhandle_t Yap_InitSlot__(Term t USES_REGS) { yhandle_t old_slots = LOCAL_CurSlot; + // fprintf(stderr,"IS %s:%d\n", __FUNCTION__, __LINE__); ensure_slots( 1 PASS_REGS); LOCAL_SlotBase[old_slots] = t; @@ -165,10 +176,11 @@ Yap_NewSlots__(int n USES_REGS) { yhandle_t old_slots = LOCAL_CurSlot; int i; + // fprintf(stderr,"NS %s:%d\n", __FUNCTION__, __LINE__); ensure_slots(n PASS_REGS); for (i = 0; i< n; i++) { - RESET_VARIABLE(Yap_AddressFromSlot(old_slots+i) ); + LOCAL_SlotBase[old_slots+i] = MkVarTerm(); } LOCAL_CurSlot += n; return old_slots; @@ -182,6 +194,7 @@ Yap_InitSlots__(int n, Term *ts USES_REGS) { yhandle_t old_slots = LOCAL_CurSlot; int i; + // fprintf(stderr,"1S %s:%d\n", __FUNCTION__, __LINE__); ensure_slots( n PASS_REGS); for (i=0; i< n; i++) @@ -196,6 +209,7 @@ Yap_RecoverSlots(int n, yhandle_t topSlot USES_REGS) { if (topSlot + n < LOCAL_CurSlot) return false; + // fprintf(stderr,"RS %s:%d\n", __FUNCTION__, __LINE__); #ifdef DEBUG if (topSlot + n > LOCAL_CurSlot) { Yap_Error(SYSTEM_ERROR, 0 /* TermNil */, "Inconsistent slot state in Yap_RecoverSlots."); diff --git a/H/YapHeap.h b/H/YapHeap.h index b4ad56e63..5f84d0576 100755 --- a/H/YapHeap.h +++ b/H/YapHeap.h @@ -198,6 +198,18 @@ extern struct various_codes *Yap_heap_regs; //#include "dglobals.h" //#include "dlocals.h" +/** + * gc-P: how to start-up the grbage collector in C-code + */ + +static inline +yamop * +gc_P(yamop *p, yamop *cp) +{ + return (p->opc == EXECUTE_CPRED_OPCODE ? cp : p); +} + + /** Yap_CurrentModule: access the current module for looking up predicates diff --git a/H/YapText.h b/H/YapText.h index 1a27553f0..e00c3afd4 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -28,33 +28,36 @@ * mirroring */ +#include "Yap.h" #include "pl-utf8.h" // standard strings typedef enum { - YAP_STRING_STRING = 0x1, - YAP_STRING_CODES = 0x2, - YAP_STRING_ATOMS = 0x4, - YAP_STRING_ATOMS_CODES = 0x6, - YAP_STRING_CHARS = 0x8, - YAP_STRING_WCHARS = 0x10, - YAP_STRING_ATOM = 0x20, - YAP_STRING_INT = 0x40, - YAP_STRING_FLOAT = 0x80, - YAP_STRING_BIG = 0x100, - YAP_STRING_LITERAL = 0x200, - YAP_STRING_LENGTH = 0x400, - YAP_STRING_NTH = 0x800, + YAP_STRING_STRING = 0x1, /// target is a string term + YAP_STRING_CODES = 0x2, /// target is a list of integer codes + YAP_STRING_ATOMS = 0x4, /// target is a list of kength-1 atom + YAP_STRING_ATOMS_CODES = 0x6, /// targt is list of atoms or codes + YAP_STRING_CHARS = 0x8, /// target is a buffer, with byte-sized units + YAP_STRING_WCHARS = 0x10, /// target is a buffer of wide chars + YAP_STRING_ATOM = 0x20, /// tarfet is an ayom + YAP_STRING_INT = 0x40, /// target is an integer term + YAP_STRING_FLOAT = 0x80, /// target is a floar term + YAP_STRING_BIG = 0x100, /// target is an big num term + YAP_STRING_DATUM = 0x200, /// associated with previous 3, use actual object if type, not tern + YAP_STRING_LENGTH = 0x400, /// input: length is fixed; output: return integer with length + YAP_STRING_NTH = 0x800, /// input: ignored; output: nth char + YAP_STRING_TERM = 0x1000, // Generic term, if nothing else given + YAP_STRING_DIFF = 0x2000, // difference list + YAP_STRING_NCHARS = 0x4000, // size of input/result + YAP_STRING_TRUNC = 0x8000, // truncate on maximum size of input/result + YAP_STRING_WQ = 0x10000, // output with write_quote + YAP_STRING_WC = 0x20000, // output with write_canonical + YAP_STRING_WITH_BUFFER = 0x40000, // output on existing buffer + YAP_STRING_MALLOC = 0x80000 // output on malloced buffer } enum_seq_type_t; -#define YAP_STRING_TERM 0x1000 // joint with other flags that define possible values -#define YAP_STRING_DIFF 0x2000 // difference list -#define YAP_STRING_NCHARS 0x4000 // size of input/result -#define YAP_STRING_TRUNC 0x8000 // truncate on maximum size of input/result -#define YAP_STRING_WQ 0x10000 // output with write_quote -#define YAP_STRING_WC 0x20000 // output with write_canonical typedef UInt seq_type_t; @@ -64,8 +67,10 @@ typedef union { Float f; Int i; MP_INT *b; - const char *c; - const wchar_t *w; + const char *c0; + const wchar_t *w0; + char *c; + wchar_t *w; Atom a; size_t l; int d; @@ -80,6 +85,7 @@ typedef struct text_cvt { size_t sz; // fixed sz, or -1 Term dif; // diff-list, usually TermNil size_t max; // max_size + encoding_t enc; } seq_tv_t; // string construction @@ -341,7 +347,7 @@ Yap_CharsToAtom( const char *s USES_REGS ) { seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.sz = 0; inp.type = YAP_STRING_CHARS; out.type = YAP_STRING_ATOM; @@ -355,7 +361,7 @@ Yap_CharsToListOfAtoms( const char *s USES_REGS ) { seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.sz = 0; inp.type = YAP_STRING_CHARS; out.type = YAP_STRING_ATOMS; @@ -369,7 +375,7 @@ Yap_CharsToListOfCodes( const char *s USES_REGS ) { seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.sz = 0; inp.type = YAP_STRING_CHARS; out.type = YAP_STRING_CODES; @@ -383,7 +389,7 @@ Yap_CharsToDiffListOfCodes( const char *s, Term tail USES_REGS ) { seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.sz = 0; inp.type = YAP_STRING_CHARS; out.type = YAP_STRING_DIFF|YAP_STRING_CODES; @@ -398,7 +404,7 @@ Yap_CharsToString( const char *s USES_REGS ) { seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.sz = 0; inp.type = YAP_STRING_CHARS; out.type = YAP_STRING_STRING; @@ -407,12 +413,33 @@ Yap_CharsToString( const char *s USES_REGS ) return out.val.t; } +static inline char * +Yap_AtomToUTF8Text( Atom at, const char *s USES_REGS ) +{ + seq_tv_t inp, out; + + inp.val.a = at; + inp.sz = 0; + inp.type = YAP_STRING_ATOM; + out.type = YAP_STRING_CHARS; + out.enc = ENC_ISO_UTF8; + if (s) { + out.val.c0 = s; + out.type |= YAP_STRING_WITH_BUFFER; + } else { + out.val.c = NULL; + } + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return 0L; + return out.val.c; +} + static inline Term Yap_CharsToTDQ( const char *s, Term mod USES_REGS ) { seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.sz = 0; inp.type = YAP_STRING_CHARS; inp.mod = mod; @@ -429,7 +456,7 @@ Yap_CharsToTBQ( const char *s, Term mod USES_REGS ) { seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.sz = 0; inp.type = YAP_STRING_CHARS; inp.mod = mod; @@ -621,7 +648,7 @@ Yap_NCharsToAtom( const char *s, size_t len USES_REGS ) { seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.sz = len; inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS; out.type = YAP_STRING_ATOM; @@ -636,7 +663,7 @@ Yap_CharsToDiffListOfAtoms( const char *s, Term tail USES_REGS ) { seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.type = YAP_STRING_CHARS; out.type = YAP_STRING_ATOMS|YAP_STRING_DIFF; out.dif = tail; @@ -651,7 +678,7 @@ Yap_NCharsToListOfCodes( const char *s, size_t len USES_REGS ) { seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.sz = len; inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS; out.type = YAP_STRING_CODES; @@ -666,7 +693,7 @@ Yap_NCharsToString( const char *s, size_t len USES_REGS ) { seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.sz = len; inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS; out.type = YAP_STRING_STRING; @@ -681,7 +708,7 @@ Yap_NCharsToTDQ( const char *s, size_t len, Term mod USES_REGS ) { seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS; inp.sz = len; inp.mod = mod; @@ -699,7 +726,7 @@ Yap_NCharsToTBQ( const char *s, size_t len, Term mod USES_REGS ) { seq_tv_t inp, out; - inp.val.c = s; + inp.val.c0 = s; inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS; inp.sz = len; inp.mod = mod; @@ -765,7 +792,7 @@ Yap_NWCharsToAtom( const wchar_t *s, size_t len USES_REGS ) { seq_tv_t inp, out; - inp.val.w = s; + inp.val.w0 = s; inp.sz = len; inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS; out.type = YAP_STRING_ATOM; @@ -780,7 +807,7 @@ Yap_NWCharsToListOfAtoms( const wchar_t *s, size_t len USES_REGS ) { seq_tv_t inp, out; - inp.val.w = s; + inp.val.w0 = s; inp.sz = len; inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS; out.type = YAP_STRING_ATOMS; @@ -795,7 +822,7 @@ Yap_NWCharsToListOfCodes( const wchar_t *s, size_t len USES_REGS ) { seq_tv_t inp, out; - inp.val.w = s; + inp.val.w0 = s; inp.sz = len; inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS; out.type = YAP_STRING_CODES; @@ -810,7 +837,7 @@ Yap_NWCharsToString( const wchar_t *s, size_t len USES_REGS ) { seq_tv_t inp, out; - inp.val.w = s; + inp.val.w0 = s; inp.sz = len; inp.type = YAP_STRING_WCHARS|YAP_STRING_NCHARS; out.type = YAP_STRING_STRING; @@ -940,7 +967,7 @@ static inline Term Yap_WCharsToListOfCodes(const wchar_t *s USES_REGS) { seq_tv_t inp, out; - inp.val.w = s; + inp.val.w0 = s; inp.sz = 0; inp.type = YAP_STRING_WCHARS; out.type = YAP_STRING_CODES; @@ -954,7 +981,7 @@ Yap_WCharsToTDQ( wchar_t *s, Term mod USES_REGS ) { seq_tv_t inp, out; - inp.val.w = s; + inp.val.w0 = s; inp.type = YAP_STRING_WCHARS; inp.sz = 0; inp.mod = mod; @@ -987,7 +1014,7 @@ static inline Term Yap_WCharsToString(const wchar_t *s USES_REGS) { seq_tv_t inp, out; - inp.val.w = s; + inp.val.w0 = s; inp.sz = 0; inp.type = YAP_STRING_WCHARS; out.type = YAP_STRING_STRING; diff --git a/H/Yapproto.h b/H/Yapproto.h index b9379fbc7..30e902d2c 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -483,14 +483,8 @@ void Yap_flush(void); Int Yap_source_line_no( void ); Atom Yap_source_file_name( void ); -static inline -yamop * -gc_P(yamop *p, yamop *cp) -{ - return (p->opc == Yap_opcode(_execute_cpred) ? cp : p); -} void Yap_install_blobs(void); - +yamop * Yap_gcP(void); diff --git a/H/Yatom.h b/H/Yatom.h index af0a26508..bdfb453f5 100755 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -1223,6 +1223,7 @@ typedef struct translation_entry { Prop NextOfPE; /* used to chain properties */ PropFlags KindOfPE; /* kind of property */ + arity_t arity; /* refers to atom (0) or functor(N > 0) */ Int Translation; /* used to hash the atom as an integer; */ } TranslationEntry; @@ -1271,11 +1272,11 @@ AbsTranslationProp (TranslationEntry * p) #endif #define TranslationProperty 0xfff4 -bool Yap_PutAtomTranslation(Atom a, Int i); + bool Yap_PutAtomTranslation(Atom a, arity_t arity, Int i); /* get translation prop for atom; */ static inline TranslationEntry * -Yap_GetTranslationProp(Atom at) + Yap_GetTranslationProp(Atom at, arity_t arity) { Prop p0; AtomEntry *ae = RepAtom(at); @@ -1283,10 +1284,12 @@ Yap_GetTranslationProp(Atom at) READ_LOCK(ae->ARWLock); p = RepTranslationProp(p0 = ae->PropsOfAE); - while (p0 && p->KindOfPE != TranslationProperty) + while (p0 && (p->KindOfPE != TranslationProperty || + p->arity != arity)) p = RepTranslationProp(p0 = p->NextOfPE); READ_UNLOCK(ae->ARWLock); if (p0 == NIL) return (TranslationEntry *)NULL; + p->arity = arity; return p; } @@ -1691,7 +1694,7 @@ AbsFlagProp (FlagEntry * p) #endif -#define FlagProperty ((PropFlags)0xfffc) +#define FlagProperty ((PropFlags)0xfff9) INLINE_ONLY inline EXTERN PropFlags IsFlagProperty (int); diff --git a/H/absmi-interpretrer.h b/H/absmi-interpretrer.h new file mode 100644 index 000000000..de3f158d5 --- /dev/null +++ b/H/absmi-interpretrer.h @@ -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 diff --git a/H/absmi.h b/H/absmi.h index f56324845..2e2998a0f 100755 --- a/H/absmi.h +++ b/H/absmi.h @@ -853,72 +853,73 @@ restore_absmi_regs(REGSTORE * old_regs) #if YAP_JIT + #define Op(Label,Type) \ - Label:{ (ExpEnv.config_struc.current_displacement) ? \ + _##Label:{ (ExpEnv.config_struc.current_displacement) ? \ print_instruction(PREG, ON_PROFILED_INTERPRETER) : \ print_instruction(PREG, ON_INTERPRETER); \ START_PREFETCH(Type) #define OpW(Label,Type) \ - Label:{ (ExpEnv.config_struc.current_displacement) ? \ + _##Label:{ (ExpEnv.config_struc.current_displacement) ? \ print_instruction(PREG, ON_PROFILED_INTERPRETER) : \ print_instruction(PREG, ON_INTERPRETER); \ START_PREFETCH_W(Type) #define BOp(Label,Type) \ - Label:{ (ExpEnv.config_struc.current_displacement) ? \ + _##Label:{ (ExpEnv.config_struc.current_displacement) ? \ print_instruction(PREG, ON_PROFILED_INTERPRETER) : \ print_instruction(PREG, ON_INTERPRETER); #define PBOp(Label,Type) \ - Label:{ (ExpEnv.config_struc.current_displacement) ? \ + _##Label:{ (ExpEnv.config_struc.current_displacement) ? \ print_instruction(PREG, ON_PROFILED_INTERPRETER) : \ print_instruction(PREG, ON_INTERPRETER); \ INIT_PREFETCH() #define OpRW(Label,Type) \ - Label:{ (ExpEnv.config_struc.current_displacement) ? \ + _##Label:{ (ExpEnv.config_struc.current_displacement) ? \ print_instruction(PREG, ON_PROFILED_INTERPRETER) : \ print_instruction(PREG, ON_INTERPRETER); #else /* YAP_JIT */ #define Op(Label,Type) \ - Label:{ print_instruction(PREG, ON_INTERPRETER); \ + _##Label:{ print_instruction(PREG, ON_INTERPRETER); \ START_PREFETCH(Type) #define OpW(Label,Type) \ - Label:{ print_instruction(PREG, ON_INTERPRETER); \ + _##Label:{ print_instruction(PREG, ON_INTERPRETER); \ START_PREFETCH_W(Type) #define BOp(Label,Type) \ - Label:{ print_instruction(PREG, ON_INTERPRETER); + _##Label:{ print_instruction(PREG, ON_INTERPRETER); #define PBOp(Label,Type) \ - Label:{ print_instruction(PREG, ON_INTERPRETER); \ + _##Label:{ print_instruction(PREG, ON_INTERPRETER); \ INIT_PREFETCH() #define OpRW(Label,Type) \ - Label:{ print_instruction(PREG, ON_INTERPRETER); + _##Label:{ print_instruction(PREG, ON_INTERPRETER); #endif /* YAP_JIT */ #else /* YAP_DBG_PREDS */ #define Op(Label,Type) \ - Label:{ START_PREFETCH(Type) + _##Label:{ START_PREFETCH(Type) #define OpW(Label,Type) \ - Label:{ START_PREFETCH_W(Type) + _##Label:{ START_PREFETCH_W(Type) #define BOp(Label,Type) \ - Label:{ + _##Label:{ #define PBOp(Label,Type) \ - Label:{ INIT_PREFETCH() + _##Label:{ INIT_PREFETCH() #define OpRW(Label,Type) \ - Label:{ + _##Label:{ #endif /* YAP_DBG_PREDS */ @@ -1723,7 +1724,7 @@ typedef struct v_record { Term old; } v_record; -#if defined(IN_ABSMI_C) || defined(IN_UNIFY_C) +#if defined(IN_ABSMI_C) || defined(IN_UNIFY_C)|| defined(IN_TRACED_ABSMI_C) static int @@ -1922,7 +1923,7 @@ IUnify_complex(CELL *pt0, CELL *pt0_end, CELL *pt1) #endif -#if defined(IN_ABSMI_C) || defined(IN_INLINES_C) +#if defined(IN_ABSMI_C) || defined(IN_INLINES_C) || defined(IN_TRACED_ABSMI_C) static int iequ_complex(register CELL *pt0, register CELL *pt0_end, diff --git a/H/amidefs.h b/H/amidefs.h index 224042104..1a1d14b07 100644 --- a/H/amidefs.h +++ b/H/amidefs.h @@ -1088,6 +1088,7 @@ extern void **Yap_ABSMI_OPCODES; #define absmadr(i) ((OPCODE)(i)) #endif + bool is_cleanup_cp(choiceptr cp_b); #if DEPTH_LIMIT /* diff --git a/H/dglobals.h b/H/dglobals.h index e8a55d98d..946f68b2a 100644 --- a/H/dglobals.h +++ b/H/dglobals.h @@ -1,6 +1,6 @@ - - /* This file, dglobals.h, was generated automatically by "yap -L misc/buildlocalglobal" - please do not update, update misc/GLOBALS instead */ + + /* This file, dglobals.h , was generated automatically by "yap -L misc/buildlocalglobal" + please do not update, update misc/GLOBALS instead */ @@ -78,9 +78,6 @@ #define GLOBAL_argv Yap_global->argv_ #define GLOBAL_argc Yap_global->argc_ -#define GLOBAL_Flags Yap_global->Flags_ -#define GLOBAL_flagCount Yap_global->flagCount_ - #ifdef COROUTINING #define GLOBAL_attas Yap_global->attas_ diff --git a/H/dhstruct.h b/H/dhstruct.h index 70c6f36ed..db3f862a2 100644 --- a/H/dhstruct.h +++ b/H/dhstruct.h @@ -72,6 +72,7 @@ #define ORLAST_OPCODE Yap_heap_regs->orlast_op #define UNDEF_OPCODE Yap_heap_regs->undef_op #define RETRY_USERC_OPCODE Yap_heap_regs->retry_userc_op +#define EXECUTE_CPRED_OPCODE Yap_heap_regs->execute_cpred_op #define NOfAtoms Yap_heap_regs->n_of_atoms #define AtomHashTableSize Yap_heap_regs->atom_hash_table_size @@ -156,9 +157,8 @@ - - - +#define GLOBAL_Flags Yap_heap_regs->GLOBAL_Flags_ +#define GLOBAL_flagCount Yap_heap_regs->GLOBAL_flagCount_ #define Yap_ExecutionMode Yap_heap_regs->execution_mode @@ -332,6 +332,9 @@ #define AtomTranslations Yap_heap_regs->atom_translations #define MaxAtomTranslations Yap_heap_regs->max_atom_translations + +#define FunctorTranslations Yap_heap_regs->functor_translations +#define MaxFunctorTranslations Yap_heap_regs->max_functor_translations #define EmptyWakeups Yap_heap_regs->empty_wakeups #define MaxEmptyWakeups Yap_heap_regs->max_empty_wakeups diff --git a/H/dlocals.h b/H/dlocals.h index f4927ebfc..41fec19ba 100644 --- a/H/dlocals.h +++ b/H/dlocals.h @@ -1,6 +1,6 @@ - - /* This file, dlocals.h, was generated automatically by "yap -L misc/buildlocalglobal" - please do not update, update misc/LOCALS instead */ + + /* This file, dlocals.h , was generated automatically by "yap -L misc/buildlocalglobal" + please do not update, update misc/LOCALS instead */ diff --git a/H/eval.h b/H/eval.h index c6472c2b7..a8526ad18 100644 --- a/H/eval.h +++ b/H/eval.h @@ -415,11 +415,16 @@ Yap_FoundArithError__(USES_REGS1) return YAP_NO_ERROR; } -static inline Term takeName(Term t) { - if (IsAtomTerm(t)) return t; - MkAtomTerm(NameOfFunctor(FunctorOfTerm(t))); - if (IsPairTerm(t)) return TermNil; - return t; +static inline Term takeIndicator(Term t) { + Term ts[2]; + if (IsAtomTerm(t)) { ts[0] = t; ts[1] = MkIntTerm(0); } + else if (IsPairTerm(t)) { ts[0] = TermNil; ts[1] = MkIntTerm(2); } + else { + CACHE_REGS + ts[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(t))); + ts[1] = MkIntegerTerm(ArityOfFunctor(FunctorOfTerm(t))); + } + return Yap_MkApplTerm( FunctorSlash, 2, ts ); } Atom Yap_NameOfUnaryOp(int i); diff --git a/H/heapgc.h b/H/heapgc.h index d0d7e9742..8d9944afe 100644 --- a/H/heapgc.h +++ b/H/heapgc.h @@ -145,7 +145,6 @@ RMARKED__(CELL* ptr USES_REGS) return mcell(ptr) & RMARK_BIT; } - /* is the object pointed to by ptr marked as in a relocation chain? */ #if LONG_ADDRESSES @@ -171,4 +170,3 @@ void Yap_mark_external_reference(CELL *); void Yap_inc_mark_variable(void); - diff --git a/H/hglobals.h b/H/hglobals.h index 64e71529c..c57e165d0 100644 --- a/H/hglobals.h +++ b/H/hglobals.h @@ -1,6 +1,6 @@ - - /* This file, hglobals.h, was generated automatically by "yap -L misc/buildlocalglobal" - please do not update, update misc/GLOBALS instead */ + + /* This file, hglobals.h , was generated automatically by "yap -L misc/buildlocalglobal" + please do not update, update misc/GLOBALS instead */ @@ -78,9 +78,6 @@ typedef struct global_data { char** argv_; int argc_; - union flagTerm* Flags_; - UInt flagCount_; - #ifdef COROUTINING ext_op attas_[attvars_ext+1]; diff --git a/H/hlocals.h b/H/hlocals.h index 65b1faacd..9de3ce0d5 100644 --- a/H/hlocals.h +++ b/H/hlocals.h @@ -1,6 +1,6 @@ - - /* This file, hlocals.h, was generated automatically by "yap -L misc/buildlocalglobal" - please do not update, update misc/LOCALS instead */ + + /* This file, hlocals.h , was generated automatically by "yap -L misc/buildlocalglobal" + please do not update, update misc/LOCALS instead */ typedef struct worker_local { diff --git a/H/hstruct.h b/H/hstruct.h index 3208a7155..eca7d727a 100755 --- a/H/hstruct.h +++ b/H/hstruct.h @@ -72,6 +72,7 @@ OPCODE orlast_op; OPCODE undef_op; OPCODE retry_userc_op; + OPCODE execute_cpred_op; UInt n_of_atoms; UInt atom_hash_table_size; @@ -156,9 +157,8 @@ - - - + union flagTerm* GLOBAL_Flags_; + UInt GLOBAL_flagCount_; yap_exec_mode execution_mode; @@ -332,6 +332,9 @@ Int atom_translations; Int max_atom_translations; + + Int functor_translations; + Int max_functor_translations; Atom empty_wakeups[MAX_EMPTY_WAKEUPS]; int max_empty_wakeups; diff --git a/H/iatoms.h b/H/iatoms.h index 8fb007219..422e874ab 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -1,5 +1,5 @@ - - /* This file, iatoms.h , was generated automatically by "yap -L misc/buildatoms" + + /* This file, iatoms.h, was generated automatically by "yap -L misc/buildatoms" please do not update, update misc/ATOMS instead */ Atom3Dots = Yap_LookupAtom("..."); diff --git a/H/iglobals.h b/H/iglobals.h index 31d2064b5..5a2023de6 100644 --- a/H/iglobals.h +++ b/H/iglobals.h @@ -1,6 +1,6 @@ - - /* This file, iglobals.h, was generated automatically by "yap -L misc/buildlocalglobal" - please do not update, update misc/GLOBALS instead */ + + /* This file, iglobals.h , was generated automatically by "yap -L misc/buildlocalglobal" + please do not update, update misc/GLOBALS instead */ @@ -78,9 +78,6 @@ static void InitGlobal(void) { - - - #ifdef COROUTINING diff --git a/H/ihstruct.h b/H/ihstruct.h index dece3ec2d..6bbbfd1f9 100644 --- a/H/ihstruct.h +++ b/H/ihstruct.h @@ -72,6 +72,7 @@ ORLAST_OPCODE = Yap_opcode(_or_last); UNDEF_OPCODE = Yap_opcode(_undef_p); RETRY_USERC_OPCODE = Yap_opcode(_retry_userc); + EXECUTE_CPRED_OPCODE = Yap_opcode(_execute_cpred); @@ -156,8 +157,7 @@ Yap_InitPlIO(); - - + GLOBAL_Flags = 0; Yap_InitFlags(true); Yap_ExecutionMode = INTERPRETED; @@ -332,6 +332,9 @@ + + + InitEmptyWakeups(); MaxEmptyWakeups = 0; diff --git a/H/ilocals.h b/H/ilocals.h index 3c96e4fdc..439fb4825 100755 --- a/H/ilocals.h +++ b/H/ilocals.h @@ -1,6 +1,6 @@ - - /* This file, ilocals.h, was generated automatically by "yap -L misc/buildlocalglobal" - please do not update, update misc/LOCALS instead */ + + /* This file, ilocals.h , was generated automatically by "yap -L misc/buildlocalglobal" + please do not update, update misc/LOCALS instead */ static void InitWorker(int wid) { diff --git a/H/ratoms.h b/H/ratoms.h index 7683c43ec..8e28bc9ff 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -1,5 +1,5 @@ - - /* This file, ratoms.h , was generated automatically by "yap -L misc/buildatoms" + + /* This file, ratoms.h, was generated automatically by "yap -L misc/buildatoms" please do not update, update misc/ATOMS instead */ Atom3Dots = AtomAdjust(Atom3Dots); diff --git a/H/rglobals.h b/H/rglobals.h index f1f613f2b..a6bb90f57 100644 --- a/H/rglobals.h +++ b/H/rglobals.h @@ -1,6 +1,6 @@ - - /* This file, rglobals.h, was generated automatically by "yap -L misc/buildlocalglobal" - please do not update, update misc/GLOBALS instead */ + + /* This file, rglobals.h , was generated automatically by "yap -L misc/buildlocalglobal" + please do not update, update misc/GLOBALS instead */ @@ -78,9 +78,6 @@ static void RestoreGlobal(void) { - - - #ifdef COROUTINING diff --git a/H/rheap.h b/H/rheap.h index 32b9cc5ad..285c780d6 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -724,7 +724,7 @@ RestoreSWIAtoms__( USES_REGS1 ) for (i=0; i < AtomTranslations; i++) { SWI_Atoms[i] = AtomAdjust(SWI_Atoms[i]); } - for (j=0; j < N_SWI_FUNCTORS; j++) { + for (j=0; j < FunctorTranslations; j++) { SWI_Functors[j] = FuncAdjust(SWI_Functors[j]); } RestoreSWIHash(); @@ -1462,6 +1462,13 @@ RestoreEntries(PropEntry *pp, int int_key USES_REGS) PropAdjust(he->NextOfPE); } break; + case MutexProperty: + { + HoldEntry *he = (HoldEntry *)pp; + he->NextOfPE = + PropAdjust(he->NextOfPE); + } + break; case TranslationProperty: { TranslationEntry *he = (TranslationEntry *)pp; @@ -1469,6 +1476,13 @@ RestoreEntries(PropEntry *pp, int int_key USES_REGS) PropAdjust(he->NextOfPE); } break; + case FlagProperty: + { + FlagEntry *he = (FlagEntry *)pp; + he->NextOfPE = + PropAdjust(he->NextOfPE); + } + break; case ArrayProperty: { ArrayEntry *ae = (ArrayEntry *)pp; diff --git a/H/rhstruct.h b/H/rhstruct.h index 0731297ef..e3475b96a 100644 --- a/H/rhstruct.h +++ b/H/rhstruct.h @@ -72,6 +72,7 @@ ORLAST_OPCODE = Yap_opcode(_or_last); UNDEF_OPCODE = Yap_opcode(_undef_p); RETRY_USERC_OPCODE = Yap_opcode(_retry_userc); + EXECUTE_CPRED_OPCODE = Yap_opcode(_execute_cpred); @@ -157,8 +158,7 @@ - - + RestoreFlags(GLOBAL_flagCount); @@ -332,6 +332,9 @@ + + + RestoreEmptyWakeups(); diff --git a/H/rlocals.h b/H/rlocals.h index 87d79f84a..a2de2f841 100644 --- a/H/rlocals.h +++ b/H/rlocals.h @@ -1,6 +1,6 @@ - - /* This file, rlocals.h, was generated automatically by "yap -L misc/buildlocalglobal" - please do not update, update misc/LOCALS instead */ + + /* This file, rlocals.h , was generated automatically by "yap -L misc/buildlocalglobal" + please do not update, update misc/LOCALS instead */ static void RestoreWorker(int wid USES_REGS) { diff --git a/H/sshift.h b/H/sshift.h index efe1712ea..828548bdc 100644 --- a/H/sshift.h +++ b/H/sshift.h @@ -22,101 +22,101 @@ #define CharP(ptr) ((char *) (ptr)) -#define CodeAdjust(P) CodeAdjust__(P PASS_REGS) -#define PtoTRAdjust(P) PtoTRAdjust__(P PASS_REGS) -#define BaseAddrAdjust(P) BaseAddrAdjust__(P PASS_REGS) -#define CutCAdjust(P) CutCAdjust__(P PASS_REGS) -#define ChoicePtrAdjust(P) ChoicePtrAdjust__(P PASS_REGS) -#define FuncAdjust(P) FuncAdjust__(P PASS_REGS) -#define AtomTermAdjust(P) AtomTermAdjust__(P PASS_REGS) -#define TermToGlobalOrAtomAdjust(P) TermToGlobalOrAtomAdjust__(P PASS_REGS) -#define AtomAdjust(P) AtomAdjust__(P PASS_REGS) -#define IsOldCode(P) IsOldCode__(P PASS_REGS) -#define IsOldLocal(P) IsOldLocal__(P PASS_REGS) -#define IsOldLocalPtr(P) IsOldLocalPtr__(P PASS_REGS) -#define IsOldCodeCellPtr(P) IsOldCodeCellPtr__(P PASS_REGS) -#define IsOldDelay(P) IsOldDelay__(P PASS_REGS) -#define IsOldDelayPtr(P) IsOldDelayPtr__(P PASS_REGS) -#define IsOldLocalInTR(P) IsOldLocalInTR__(P PASS_REGS) -#define IsOldLocalInTRPtr(P) IsOldLocalInTRPtr__(P PASS_REGS) -#define IsOldGlobal(P) IsOldGlobal__(P PASS_REGS) -#define IsOldGlobalPtr(P) IsOldGlobalPtr__(P PASS_REGS) -#define IsOldTrail(P) IsOldTrail__(P PASS_REGS) -#define IsOldTrailPtr(P) IsOldTrailPtr__(P PASS_REGS) -#define NoAGCAtomAdjust(P) NoAGCAtomAdjust__(P PASS_REGS) -// #define OrArgAdjust(P) OrArgAdjust__(P PASS_REGS) -// #define TabEntryAdjust(P) TabEntryAdjust__(P PASS_REGS) -// #define IntegerAdjust(D) IntegerAdjust__(P PASS_REGS) -#define AddrAdjust(P) AddrAdjust__(P PASS_REGS) -#define BlockAdjust(P) BlockAdjust__(P PASS_REGS) -#define CodeVarAdjust(P) CodeVarAdjust__(P PASS_REGS) -#define ConstantAdjust(P) ConstantAdjust__(P PASS_REGS) -#define ArityAdjust(P) ArityAdjust__(P PASS_REGS) -// #define DoubleInCodeAdjust(P) DoubleInCodeAdjust__(P PASS_REGS) -// #define IntegerInCodeAdjust(P) IntegerInCodeAdjust__(P PASS_REGS) -#define OpcodeAdjust(P) OpcodeAdjust__(P PASS_REGS) -#define ModuleAdjust(P) ModuleAdjust__(P PASS_REGS) -// #define ExternalFunctionAdjust(P) ExternalFunctionAdjust__(P PASS_REGS) -#define DBRecordAdjust(P) DBRecordAdjust__(P PASS_REGS) -#define PredEntryAdjust(P) PredEntryAdjust__(P PASS_REGS) -#define ModEntryPtrAdjust(P) ModEntryPtrAdjust__(P PASS_REGS) -#define AtomEntryAdjust(P) AtomEntryAdjust__(P PASS_REGS) -#define GlobalEntryAdjust(P) GlobalEntryAdjust__(P PASS_REGS) -#define BlobTermInCodeAdjust(P) BlobTermInCodeAdjust__(P PASS_REGS) -#define CellPtoHeapAdjust(P) CellPtoHeapAdjust__(P PASS_REGS) -#define PtoAtomHashEntryAdjust(P) PtoAtomHashEntryAdjust__(P PASS_REGS) -#define CellPtoHeapCellAdjust(P) CellPtoHeapCellAdjust__(P PASS_REGS) -#define CellPtoTRAdjust(P) CellPtoTRAdjust__(P PASS_REGS) -#define CodeAddrAdjust(P) CodeAddrAdjust__(P PASS_REGS) -#define ConsultObjAdjust(P) ConsultObjAdjust__(P PASS_REGS) -#define DelayAddrAdjust(P) DelayAddrAdjust__(P PASS_REGS) -#define DelayAdjust(P) DelayAdjust__(P PASS_REGS) -#define GlobalAdjust(P) GlobalAdjust__(P PASS_REGS) -#define DBRefAdjust(P,C) DBRefAdjust__(P PASS_REGS) -#define DBRefPAdjust(P) DBRefPAdjust__(P PASS_REGS) -#define DBTermAdjust(P) DBTermAdjust__(P PASS_REGS) -#define LUIndexAdjust(P) LUIndexAdjust__(P PASS_REGS) -#define SIndexAdjust(P) SIndexAdjust__(P PASS_REGS) -#define LocalAddrAdjust(P) LocalAddrAdjust__(P PASS_REGS) -#define GlobalAddrAdjust(P) GlobalAddrAdjust__(P PASS_REGS) -#define OpListAdjust(P) OpListAdjust__(P PASS_REGS) -#define PtoLUCAdjust(P) PtoLUCAdjust__(P PASS_REGS) -#define PtoStCAdjust(P) PtoStCAdjust__(P PASS_REGS) -#define PtoArrayEAdjust(P) PtoArrayEAdjust__(P PASS_REGS) -#define PtoArraySAdjust(P) PtoArraySAdjust__(P PASS_REGS) -#define PtoGlobalEAdjust(P) PtoGlobalEAdjust__(P PASS_REGS) -#define PtoDelayAdjust(P) PtoDelayAdjust__(P PASS_REGS) -#define PtoGloAdjust(P) PtoGloAdjust__(P PASS_REGS) -#define PtoLocAdjust(P) PtoLocAdjust__(P PASS_REGS) -#define PtoHeapCellAdjust(P) PtoHeapCellAdjust__(P PASS_REGS) -#define TermToGlobalAdjust(P) TermToGlobalAdjust__(P PASS_REGS) -#define PtoOpAdjust(P) PtoOpAdjust__(P PASS_REGS) -#define PtoLUClauseAdjust(P) PtoLUClauseAdjust__(P PASS_REGS) -#define PtoLUIndexAdjust(P) PtoLUIndexAdjust__(P PASS_REGS) -#define PtoDBTLAdjust(P) PtoDBTLAdjust__(P PASS_REGS) -#define PtoPredAdjust(P) PtoPredAdjust__(P PASS_REGS) -#define PtoPtoPredAdjust(P) PtoPtoPredAdjust__(P PASS_REGS) -#define OpRTableAdjust(P) OpRTableAdjust__(P PASS_REGS) -#define OpEntryAdjust(P) OpEntryAdjust__(P PASS_REGS) -#define PropAdjust(P) PropAdjust__(P PASS_REGS) -#define BlobTypeAdjust(P) BlobTypeAdjust__(P PASS_REGS) -#define TrailAddrAdjust(P) TrailAddrAdjust__(P PASS_REGS) -#define XAdjust(P) XAdjust__(P PASS_REGS) -#define YAdjust(P) YAdjust__(P PASS_REGS) -#define LocalAdjust(P) LocalAdjust__(P PASS_REGS) -#define TrailAdjust(P) TrailAdjust__(P PASS_REGS) -#define HoldEntryAdjust(P) HoldEntryAdjust__(P PASS_REGS) -#define CodeCharPAdjust(P) CodeCharPAdjust__(P PASS_REGS) -#define CodeConstCharPAdjust(P) CodeConstCharPAdjust__(P PASS_REGS) -#define CodeVoidPAdjust(P) CodeVoidPAdjust__(P PASS_REGS) -#define HaltHookAdjust(P) HaltHookAdjust__(P PASS_REGS) -#define TokEntryAdjust(P) TokEntryAdjust__(P PASS_REGS) -#define VarEntryAdjust(P) VarEntryAdjust__(P PASS_REGS) -#define ConsumerChoicePtrAdjust(P) ConsumerChoicePtrAdjust__(P PASS_REGS) -#define GeneratorChoicePtrAdjust(P) GeneratorChoicePtrAdjust__(P PASS_REGS) -#define IsHeapP(P) IsHeapP__(P PASS_REGS) -#define IsOldVarTableTrailPtr(P) IsOldVarTableTrailPtr__(P PASS_REGS) -#define IsOldTokenTrailPtr(P) IsOldTokenTrailPtr__(P PASS_REGS) +#define CodeAdjust(ptr) CodeAdjust__(ptr PASS_REGS) +#define PtoTRAdjust(ptr) PtoTRAdjust__(ptr PASS_REGS) +#define BaseAddrAdjust(ptr) BaseAddrAdjust__(ptr PASS_REGS) +#define CutCAdjust(ptr) CutCAdjust__(ptr PASS_REGS) +#define ChoicePtrAdjust(ptr) ChoicePtrAdjust__(ptr PASS_REGS) +#define FuncAdjust(ptr) FuncAdjust__(ptr PASS_REGS) +#define AtomTermAdjust(ptr) AtomTermAdjust__(ptr PASS_REGS) +#define TermToGlobalOrAtomAdjust(ptr) TermToGlobalOrAtomAdjust__(ptr PASS_REGS) +#define AtomAdjust(ptr) AtomAdjust__(ptr PASS_REGS) +#define IsOldCode(ptr) IsOldCode__(ptr PASS_REGS) +#define IsOldLocal(ptr) IsOldLocal__(ptr PASS_REGS) +#define IsOldLocalPtr(ptr) IsOldLocalPtr__(ptr PASS_REGS) +#define IsOldCodeCellPtr(ptr) IsOldCodeCellPtr__(ptr PASS_REGS) +#define IsOldDelay(ptr) IsOldDelay__(ptr PASS_REGS) +#define IsOldDelayPtr(ptr) IsOldDelayPtr__(ptr PASS_REGS) +#define IsOldLocalInTR(ptr) IsOldLocalInTR__(ptr PASS_REGS) +#define IsOldLocalInTRPtr(ptr) IsOldLocalInTRPtr__(ptr PASS_REGS) +#define IsOldGlobal(ptr) IsOldGlobal__(ptr PASS_REGS) +#define IsOldGlobalPtr(ptr) IsOldGlobalPtr__(ptr PASS_REGS) +#define IsOldTrail(ptr) IsOldTrail__(ptr PASS_REGS) +#define IsOldTrailPtr(ptr) IsOldTrailPtr__(ptr PASS_REGS) +#define NoAGCAtomAdjust(ptr) NoAGCAtomAdjust__(ptr PASS_REGS) +// #define OrArgAdjust(ptr) OrArgAdjust__(ptr PASS_REGS) +// #define TabEntryAdjust(ptr) TabEntryAdjust__(ptr PASS_REGS) +// #define IntegerAdjust(D) IntegerAdjust__(ptr PASS_REGS) +#define AddrAdjust(ptr) AddrAdjust__(ptr PASS_REGS) +#define BlockAdjust(ptr) BlockAdjust__(ptr PASS_REGS) +#define CodeVarAdjust(ptr) CodeVarAdjust__(ptr PASS_REGS) +#define ConstantAdjust(ptr) ConstantAdjust__(ptr PASS_REGS) +#define ArityAdjust(ptr) ArityAdjust__(ptr PASS_REGS) +// #define DoubleInCodeAdjust(ptr) DoubleInCodeAdjust__(ptr PASS_REGS) +// #define IntegerInCodeAdjust(ptr) IntegerInCodeAdjust__(ptr PASS_REGS) +#define OpcodeAdjust(ptr) OpcodeAdjust__(ptr PASS_REGS) +#define ModuleAdjust(ptr) ModuleAdjust__(ptr PASS_REGS) +// #define ExternalFunctionAdjust(ptr) ExternalFunctionAdjust__(ptr PASS_REGS) +#define DBRecordAdjust(ptr) DBRecordAdjust__(ptr PASS_REGS) +#define PredEntryAdjust(ptr) PredEntryAdjust__(ptr PASS_REGS) +#define ModEntryPtrAdjust(ptr) ModEntryPtrAdjust__(ptr PASS_REGS) +#define AtomEntryAdjust(ptr) AtomEntryAdjust__(ptr PASS_REGS) +#define GlobalEntryAdjust(ptr) GlobalEntryAdjust__(ptr PASS_REGS) +#define BlobTermInCodeAdjust(ptr) BlobTermInCodeAdjust__(ptr PASS_REGS) +#define CellPtoHeapAdjust(ptr) CellPtoHeapAdjust__(ptr PASS_REGS) +#define PtoAtomHashEntryAdjust(ptr) PtoAtomHashEntryAdjust__(ptr PASS_REGS) +#define CellPtoHeapCellAdjust(ptr) CellPtoHeapCellAdjust__(ptr PASS_REGS) +#define CellPtoTRAdjust(ptr) CellPtoTRAdjust__(ptr PASS_REGS) +#define CodeAddrAdjust(ptr) CodeAddrAdjust__(ptr PASS_REGS) +#define ConsultObjAdjust(ptr) ConsultObjAdjust__(ptr PASS_REGS) +#define DelayAddrAdjust(ptr) DelayAddrAdjust__(ptr PASS_REGS) +#define DelayAdjust(ptr) DelayAdjust__(ptr PASS_REGS) +#define GlobalAdjust(ptr) GlobalAdjust__(ptr PASS_REGS) +#define DBRefAdjust(ptr,C) DBRefAdjust__(ptr PASS_REGS) +#define DBRefPAdjust(ptr) DBRefPAdjust__(ptr PASS_REGS) +#define DBTermAdjust(ptr) DBTermAdjust__(ptr PASS_REGS) +#define LUIndexAdjust(ptr) LUIndexAdjust__(ptr PASS_REGS) +#define SIndexAdjust(ptr) SIndexAdjust__(ptr PASS_REGS) +#define LocalAddrAdjust(ptr) LocalAddrAdjust__(ptr PASS_REGS) +#define GlobalAddrAdjust(ptr) GlobalAddrAdjust__(ptr PASS_REGS) +#define OpListAdjust(ptr) OpListAdjust__(ptr PASS_REGS) +#define PtoLUCAdjust(ptr) PtoLUCAdjust__(ptr PASS_REGS) +#define PtoStCAdjust(ptr) PtoStCAdjust__(ptr PASS_REGS) +#define PtoArrayEAdjust(ptr) PtoArrayEAdjust__(ptr PASS_REGS) +#define PtoArraySAdjust(ptr) PtoArraySAdjust__(ptr PASS_REGS) +#define PtoGlobalEAdjust(ptr) PtoGlobalEAdjust__(ptr PASS_REGS) +#define PtoDelayAdjust(ptr) PtoDelayAdjust__(ptr PASS_REGS) +#define PtoGloAdjust(ptr) PtoGloAdjust__(ptr PASS_REGS) +#define PtoLocAdjust(ptr) PtoLocAdjust__(ptr PASS_REGS) +#define PtoHeapCellAdjust(ptr) PtoHeapCellAdjust__(ptr PASS_REGS) +#define TermToGlobalAdjust(ptr) TermToGlobalAdjust__(ptr PASS_REGS) +#define PtoOpAdjust(ptr) PtoOpAdjust__(ptr PASS_REGS) +#define PtoLUClauseAdjust(ptr) PtoLUClauseAdjust__(ptr PASS_REGS) +#define PtoLUIndexAdjust(ptr) PtoLUIndexAdjust__(ptr PASS_REGS) +#define PtoDBTLAdjust(ptr) PtoDBTLAdjust__(ptr PASS_REGS) +#define PtoPredAdjust(ptr) PtoPredAdjust__(ptr PASS_REGS) +#define PtoPtoPredAdjust(ptr) PtoPtoPredAdjust__(ptr PASS_REGS) +#define OpRTableAdjust(ptr) OpRTableAdjust__(ptr PASS_REGS) +#define OpEntryAdjust(ptr) OpEntryAdjust__(ptr PASS_REGS) +#define PropAdjust(ptr) PropAdjust__(ptr PASS_REGS) +#define BlobTypeAdjust(ptr) BlobTypeAdjust__(ptr PASS_REGS) +#define TrailAddrAdjust(ptr) TrailAddrAdjust__(ptr PASS_REGS) +#define XAdjust(ptr) XAdjust__(ptr PASS_REGS) +#define YAdjust(ptr) YAdjust__(ptr PASS_REGS) +#define LocalAdjust(ptr) LocalAdjust__(ptr PASS_REGS) +#define TrailAdjust(ptr) TrailAdjust__(ptr PASS_REGS) +#define HoldEntryAdjust(ptr) HoldEntryAdjust__(ptr PASS_REGS) +#define CodeCharPAdjust(ptr) CodeCharPAdjust__(ptr PASS_REGS) +#define CodeConstCharPAdjust(ptr) CodeConstCharPAdjust__(ptr PASS_REGS) +#define CodeVoidPAdjust(ptr) CodeVoidPAdjust__(ptr PASS_REGS) +#define HaltHookAdjust(ptr) HaltHookAdjust__(ptr PASS_REGS) +#define TokEntryAdjust(ptr) TokEntryAdjust__(ptr PASS_REGS) +#define VarEntryAdjust(ptr) VarEntryAdjust__(ptr PASS_REGS) +#define ConsumerChoicePtrAdjust(ptr) ConsumerChoicePtrAdjust__(ptr PASS_REGS) +#define GeneratorChoicePtrAdjust(ptr) GeneratorChoicePtrAdjust__(ptr PASS_REGS) +#define IsHeapP(ptr) IsHeapP__(ptr PASS_REGS) +#define IsOldVarTableTrailPtr(ptr) IsOldVarTableTrailPtr__(ptr PASS_REGS) +#define IsOldTokenTrailPtr(ptr) IsOldTokenTrailPtr__(ptr PASS_REGS) #include "inline-only.h" INLINE_ONLY inline EXTERN int IsHeapP__ (CELL * CACHE_TYPE); @@ -131,8 +131,8 @@ IsHeapP__ (CELL * ptr USES_REGS) #endif } -#define OrArgAdjust(P) -#define TabEntryAdjust(P) +#define OrArgAdjust(ptr) +#define TabEntryAdjust(ptr) /* Adjusting cells and pointers to cells */ @@ -840,6 +840,8 @@ TermToGlobalOrAtomAdjust__ (Term t USES_REGS) return t; } +#if USE_THREADED_CODE + INLINE_ONLY inline EXTERN op_entry *OpRTableAdjust__ (op_entry * CACHE_TYPE); INLINE_ONLY inline EXTERN op_entry * @@ -848,6 +850,8 @@ OpRTableAdjust__ (op_entry * ptr USES_REGS) return (op_entry *) (((op_entry *) (CharP (ptr) + LOCAL_HDiff))); } +#endif // USE_THREADED_CODE + INLINE_ONLY inline EXTERN OpEntry *OpEntryAdjust__ (OpEntry * CACHE_TYPE); INLINE_ONLY inline EXTERN OpEntry * diff --git a/H/tatoms.h b/H/tatoms.h index a52a6d357..ee5858f48 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -1,5 +1,5 @@ - - /* This file, tatoms.h , was generated automatically by "yap -L misc/buildatoms" + + /* This file, tatoms.h, was generated automatically by "yap -L misc/buildatoms" please do not update, update misc/ATOMS instead */ Atom Atom3Dots_; diff --git a/JIT/CMakeLists.txt b/JIT/CMakeLists.txt index 02ce1d4b6..a2797c26c 100644 --- a/JIT/CMakeLists.txt +++ b/JIT/CMakeLists.txt @@ -4,21 +4,28 @@ set(LIBJIT_PATCH_VERSION 0) set(LIBJIT_FULL_VERSION ${LIBJIT_MAJOR_VERSION}.${LIBJIT_MINOR_VERSION}.${LIBJIT_PATCH_VERSION}) -set(LIBJIT_SOURCES - jit_analysispreds.c - jit_configpreds.c - jit_statisticpreds.c - jit_codegenpreds.c - jit_debugpreds.c - jit_traced.c - jit_transformpreds.c - JIT_Compiler.cpp - JIT_Init.cpp - HPP/JIT.hpp - HPP/JIT_Compiler.hpp - HPP/jit_predicates.hpp + set(LIBJIT_SOURCES + jit_analysispreds.c + jit_configpreds.c + jit_statisticpreds.c + jit_codegenpreds.c + jit_debugpreds.c + jit_traced.c + jit_transformpreds.c + JIT_Compiler.cpp + JIT_Init.cpp ) + set(LIBJIT_HEADERS + HPP/JIT.hpp + HPP/JIT_Compiler.hpp + HPP/jit_predicates.hpp + ../OPTYap/traced_or.insts.h + ../OPTYap/traced_tab.insts.h + ../OPTYap/traced_tab.tries.insts.h + ../C/traced_absmi_insts.h + ) + # The following variables are defined: # LLVM_FOUND - true if LLVM was found # LLVM_CXXFLAGS - C++ compiler flags for files that include LLVM headers. @@ -43,14 +50,20 @@ set(LIBJIT_SOURCES # system default locations such as /usr/local/bin. Executing find_program() # multiples times is the approach recommended in the docs. +macro_optional_find_package (LLVM OFF) +macro_log_feature (LLVM_FOUND "LLVM JIT generator" +"The LLVM Compiler Infrastructure" "http://www.llvm.org") + +set (YAP_JIT ${LLVM_FOUND} SCOPE GLOBAL) -# ugh set (POSITION_INDEPENDENT_CODE TRUE) set(CMAKE_CXX_FLAGS ${CMAKE_CXX_FLAGS} ${LLVM_CXXFLAGS}) add_library (libyapjit SHARED - ${LIBJIT_SOURCES}) + ${LIBJIT_SOURCES} + ${LIBJIT_HEADERS} +) set_target_properties(libyapjit PROPERTIES diff --git a/JIT/JIT_Init.cpp b/JIT/JIT_Init.cpp index 73f36d312..c56d3c370 100644 --- a/JIT/JIT_Init.cpp +++ b/JIT/JIT_Init.cpp @@ -31,6 +31,8 @@ extern "C" void shutdown_llvm() { llvm_shutdown(); } extern "C" Int traced_absmi(); +#define JIT_CODE 1 + static void initJit(void) { diff --git a/JIT/jit_analysispreds.c b/JIT/jit_analysispreds.c index e69d96c5a..b713abf66 100644 --- a/JIT/jit_analysispreds.c +++ b/JIT/jit_analysispreds.c @@ -78,6 +78,8 @@ static Int p_analysis_output_file( USES_REGS1 ); #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wimplicit-function-declaration" +#define JIT_CODE 1 + static Int p_disable_analysis_pass( USES_REGS1 ) { diff --git a/JIT/jit_configpreds.c b/JIT/jit_configpreds.c index f8221c1ff..ef591a76f 100644 --- a/JIT/jit_configpreds.c +++ b/JIT/jit_configpreds.c @@ -15,6 +15,8 @@ * Last rev: 2013-10-18 * *************************************************************************/ +#define JIT_CODE 1 + #include "jit_predicates.hpp" #include diff --git a/JIT/jit_debugpreds.c b/JIT/jit_debugpreds.c index 24bd9c7d7..b72715596 100644 --- a/JIT/jit_debugpreds.c +++ b/JIT/jit_debugpreds.c @@ -15,6 +15,8 @@ * Last rev: 2013-10-18 * *************************************************************************/ +#define JIT_CODE 1 + #include "jit_predicates.hpp" #if YAP_DBG_PREDS diff --git a/JIT/jit_statisticpreds.c b/JIT/jit_statisticpreds.c index f492b15a9..fc937aee1 100644 --- a/JIT/jit_statisticpreds.c +++ b/JIT/jit_statisticpreds.c @@ -15,6 +15,8 @@ * Last rev: 2013-10-18 * *************************************************************************/ +#define JIT_CODE 1 + #include "jit_predicates.hpp" #if YAP_STAT_PREDS diff --git a/JIT/jit_traced.c b/JIT/jit_traced.c index 2ff6929eb..249b208dc 100644 --- a/JIT/jit_traced.c +++ b/JIT/jit_traced.c @@ -10,7 +10,7 @@ * * * File: jit_traced.c * * comments: Portable abstract machine interpreter * -* Last rev: $Date: 2008-08-13 01:16:26 $,$Author: vsc $ * +* Last: $Date: 2008-08-13 01:16:26 $,$Author: vsc $ * * * *************************************************************************/ @@ -33,17 +33,20 @@ boils down to a recursive loop of the form: loop(Env) :- do_something(Env,NewEnv), loop(NewEnv). -~~~~~ +~~~~ */ - - - + #if YAP_JIT -#define YAP_TRACED 1 -#define IN_ABSMI_C 1 +//#define __YAP_TRACED 1 + +#define IN_TRACED_ABSMI_C 1 + +// #ifndef _NATIVE + #define HAS_CACHE_REGS 1 + #include "absmi.h" #include "heapgc.h" @@ -51,9 +54,7 @@ loop(Env) :- Int traced_absmi(void); -#ifdef PUSH_X -#else - +#ifndef PUSH_X /* keep X as a global variable */ Term Yap_XREGS[MaxTemps]; /* 29 */ @@ -130,7 +131,7 @@ traced_absmi(void) static void *OpAddress[] = { -#define OPCODE(OP,TYPE) && OP +#define OPCODE(OP,TYPE) && _##OP #include "YapOpcodes.h" #undef OPCODE }; @@ -159,7 +160,7 @@ NativeArea->area.compilation_time = NULL; NativeArea->area.native_size_bytes = NULL; NativeArea->area.trace_size_bytes = NULL; NativeArea->success = NULL; -NativeArea->runs = NULL; +->runs = NULL; NativeArea->t_runs = NULL; #endif NativeArea->n = 0; @@ -191,21 +192,22 @@ CACHE_A1(); op_numbers opcode = _Ystop; goto critical_lbl; - //nextop_write: + nextop_write: opcode = Yap_op_from_opcode( PREG->y_u.o.opcw ); goto op_switch; - // nextop: + nextop: opcode = Yap_op_from_opcode( PREG->opc ); op_switch: - +#if !USE_THREADED_CODE switch (opcode) { - +#endif + #if !OS_HANDLES_TR_OVERFLOW notrailleft: /* if we are within indexing code, the system may have to @@ -236,12 +238,10 @@ CACHE_A1(); } } goto reset_absmi; - -#endif /* OS_HANDLES_TR_OVERFLOW */ - +#endif + // move instructions to separate file // so that they are easier to analyse. -#if YAP_JIT #include "../C/traced_absmi_insts.h" #if YAPOR #include "../OPTYap/traced_or.insts.h" @@ -250,14 +250,16 @@ CACHE_A1(); #include "../OPTYap/traced_tab.insts.h" #include "../OPTYap/traced_tab.tries.insts.h" #endif -#endif + - default: +#if _NATIVE + default: saveregs(); Yap_Error(SYSTEM_ERROR, MkIntegerTerm(opcode), "trying to execute invalid YAAM instruction %d", opcode); setregs(); FAIL(); } +#endif } return (0); diff --git a/JIT/jit_transformpreds.c b/JIT/jit_transformpreds.c index 75c49e52a..fc2429e3d 100644 --- a/JIT/jit_transformpreds.c +++ b/JIT/jit_transformpreds.c @@ -15,6 +15,8 @@ * Last rev: 2013-10-18 * *************************************************************************/ +#define JIT_CODE 1 + #include "jit_predicates.hpp" #define N_TRANSFORM_PASSES 69 diff --git a/OPTYap/opt.preds.c b/OPTYap/opt.preds.c index 51b534656..c515ae72c 100644 --- a/OPTYap/opt.preds.c +++ b/OPTYap/opt.preds.c @@ -379,9 +379,11 @@ static Int p_table( USES_REGS1 ) { return (TRUE); /* predicate already tabled */ if (pe->cs.p_code.FirstClause) return (FALSE); /* predicate already compiled */ - pe->PredFlags |= TabledPredFlag; - new_table_entry(tab_ent, pe, at, arity, mode_directed); - pe->TableOfPred = tab_ent; + if (!(pe->PredFlags & TabledPredFlag)) { + pe->PredFlags |= TabledPredFlag; + new_table_entry(tab_ent, pe, at, arity, mode_directed); + pe->TableOfPred = tab_ent; + } return (TRUE); } diff --git a/OPTYap/tab.insts.h b/OPTYap/tab.insts.h index 0cd19c54d..9eee28561 100644 --- a/OPTYap/tab.insts.h +++ b/OPTYap/tab.insts.h @@ -472,7 +472,9 @@ check_trail(TR); tab_ent = PREG->y_u.Otapl.te; YENV2MEM; - sg_fr = subgoal_search(PREG, YENV_ADDRESS); + saveregs(); + sg_fr = subgoal_search(PREG, YENV_ADDRESS); + setregs(); MEM2YENV; #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) if (SgFr_state(sg_fr) <= ready) { @@ -640,7 +642,9 @@ check_trail(TR); tab_ent = PREG->y_u.Otapl.te; YENV2MEM; + saveregs(); sg_fr = subgoal_search(PREG, YENV_ADDRESS); + setregs(); MEM2YENV; #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) if (SgFr_state(sg_fr) <= ready) { diff --git a/absmi-threaded.h b/absmi-threaded.h new file mode 100644 index 000000000..51f95acb6 --- /dev/null +++ b/absmi-threaded.h @@ -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 diff --git a/cmake/Sources.cmake b/cmake/Sources.cmake index ea5883683..1f6988524 100644 --- a/cmake/Sources.cmake +++ b/cmake/Sources.cmake @@ -34,7 +34,7 @@ set (ENGINE_SOURCES C/attvar.c C/bignum.c C/bb.c -C/blobs.c + C/blobs.c C/cdmgr.c C/cmppreds.c C/compiler.c @@ -114,6 +114,9 @@ set(C_INTERFACE_SOURCES H/Regs.h H/Yapproto.h H/absmi.h + H/absmi-switch.h + H/absmi-threaded.h + H/absmi-traced.h H/alloc.h H/amidefs.h H/amiops.h diff --git a/config.h.cmake b/config.h.cmake index dcc6bd426..4cc167a35 100644 --- a/config.h.cmake +++ b/config.h.cmake @@ -14,6 +14,36 @@ #cmakedefine AC_APPLE_UNIVERSAL_BUILD "${AC_APPLE_UNIVERSAL_BUILD}" #endif +/* Are we compiling with support for depth limitT? */ +#ifndef DEPTH_LIMIT +#define DEPTH_LIMIT 1 +#endif + +/* Are we compiling with inlined emulator instructionsT? */ +#ifndef USE_THREADED_CODE +#define USE_THREADED_CODE 1 +#endif + +/* Are we compiling with support for TABLINGtT? */ +#ifndef TABLING +#define TABLING 1 +#endif + +/* Are we compiling with support for WAM level tracing? */ +#ifndef LOW_LEVEL_TRACER +#define LOW_LEVEL_TRACER 1 +#endif + +/* Are we compiling with support for threads? */ +#ifndef THREADS +#cmakedefine THREADS "$YAP_THREADS" +#endif + +/* Are we compiling with support for clause just-in-time compilationT? */ +#ifndef YAP_JIT +#cmakedefine YAP_JIT "$YAP_JIT" +#endif + /* longs should be in addresses that are multiple of four. */ #ifndef ALIGN_LONGS #define ALIGN_LONGS 1 @@ -1581,7 +1611,7 @@ signal. */ #endif /* max number of threads, default 1 or 1024 */ -#ifndef MAX_THREADS +#ifndef MAX_THRADS #cmakedefine MAX_THREADS ${MAX_THREADS} #endif @@ -1815,11 +1845,6 @@ signal. */ #cmakedefine USE_SYSTEM_SHM ${USE_SYSTEM_SHM} #endif -/* threaded emulator */ -#ifndef USE_THREADED_CODE -#cmakedefine USE_THREADED_CODE ${USE_THREADED_CODE} -#endif - /* Whether daylight savings time offset is set via the altzone variable */ #ifndef USE_TIME_ALTZONE #cmakedefine USE_TIME_ALTZONE ${USE_TIME_ALTZONE} diff --git a/include/YapError.h b/include/YapError.h index bed48fef9..3759e8e6d 100644 --- a/include/YapError.h +++ b/include/YapError.h @@ -39,6 +39,7 @@ typedef enum DOMAIN_ERROR_OUT_OF_RANGE, DOMAIN_ERROR_OPERATOR_PRIORITY, DOMAIN_ERROR_OPERATOR_SPECIFIER, + DOMAIN_ERROR_PROLOG_FLAG, DOMAIN_ERROR_RADIX, DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, DOMAIN_ERROR_SOURCE_SINK, @@ -137,7 +138,7 @@ typedef enum #define JMP_LOCAL_ERROR(v, LAB) \ if (H + 2*(v) > ASP-1024) { \ LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;\ - LOCAL_Error_Term = t;\ + LOCAL_Error_Term = TermNilnnnnnnnnnnnnnnnnnnnnnnnnnn;\ LOCAL_Error_Size = 2*(v)*sizeof(CELL);\ goto LAB; \ } @@ -145,15 +146,14 @@ typedef enum #define LOCAL_ERROR(v) \ if (HR + (v) > ASP-1024) { \ LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;\ - LOCAL_Error_Term = t;\ + LOCAL_Error_Term = TermNil;\ LOCAL_Error_Size = 2*(v)*sizeof(CELL);\ return NULL; \ } #define LOCAL_TERM_ERROR(v) \ if (HR + (v) > ASP-1024) { \ - LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;\ - LOCAL_Error_Term = t;\ + ;\ LOCAL_Error_Size = 2*(v)*sizeof(CELL);\ return 0L; \ } diff --git a/include/YapInterface.h b/include/YapInterface.h index 58f65bd65..9b9eb6fae 100755 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -2151,6 +2151,10 @@ extern X_API YAP_Int YAP_AtomToInt(YAP_Atom At); extern X_API YAP_Atom YAP_IntToAtom(YAP_Int i); +extern X_API YAP_Int YAP_FunctorToInt(YAP_Functor At); + +extern X_API YAP_Functor YAP_IntToFunctor(YAP_Int i); + #define YAP_InitCPred(N,A,F) YAP_UserCPredicate(N,F,A) __END_DECLS diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index a6e0809d0..833330cd9 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -113,19 +113,6 @@ YAP_PLArityOfSWIFunctor(functor_t f) { return ArityOfFunctor((Functor)f); } -void -Yap_InitSWIHash(void) -{ - int i, j; - for (i=0; i < N_SWI_ATOMS; i++) { - Yap_PutAtomTranslation( SWI_Atoms[i], i ); - } - AtomTranslations = N_SWI_ATOMS; - for (j=0; j < N_SWI_FUNCTORS; j++) { - add_to_hash(j, (ADDR)SWI_Functors[j]); - } -} - static void UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int flags) { @@ -145,6 +132,41 @@ UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int f * */ +static UInt +cvtFlags( unsigned flags ) +{ + UInt inptype = 0; + if (flags & CVT_ATOM) { + inptype |= YAP_STRING_ATOM; + } + if (flags & CVT_STRING) { + inptype |= YAP_STRING_STRING; + } + if (flags & CVT_LIST) { + inptype |= (YAP_STRING_CODES|YAP_STRING_ATOMS); + } + if (flags & CVT_INTEGER) { + inptype |= YAP_STRING_INT|YAP_STRING_BIG; + } + if (flags & CVT_FLOAT) { + inptype |= YAP_STRING_FLOAT; + } + if (flags & CVT_VARIABLE) { + inptype |= YAP_STRING_TERM; + } + if (flags & CVT_WRITE) { + inptype |= YAP_STRING_TERM; + } + if (flags & CVT_WRITEQ) { + inptype |= YAP_STRING_TERM|YAP_STRING_WQ; + } + if (flags & CVT_WRITE_CANONICAL) { + inptype |= YAP_STRING_TERM|YAP_STRING_WC; + } + return inptype; +} + + /* void PL_agc_hook(void) */ /** @brief Atom garbage collection hook * @@ -187,92 +209,33 @@ Text is in ISO Latin-1 encoding and the call fails if text cannot be represented X_API int PL_get_nchars(term_t l, size_t *lengthp, char **s, unsigned flags) { CACHE_REGS - seq_tv_t inp; + seq_tv_t inp, out; size_t leng; encoding_t enc; int minimal; - void *buf; - char b[1024]; - - buf = b; + void *buf = NULL; inp.val.t = Yap_GetFromSlot( l ); - inp.type = 0; - if (flags & CVT_ATOM) { - inp.type |= YAP_STRING_ATOM; - } - if (flags & CVT_ATOM) { - inp.type |= YAP_STRING_STRING; - } - if (flags & CVT_LIST) { - inp.type |= YAP_STRING_CODES; - } - if (flags & CVT_INTEGER) { - inp.type |= YAP_STRING_INT|YAP_STRING_BIG; - } - if (flags & CVT_FLOAT) { - inp.type |= YAP_STRING_FLOAT; - } - if (flags & CVT_VARIABLE) { - inp.type |= YAP_STRING_TERM; - } - if (flags & CVT_WRITE) { - inp.type |= YAP_STRING_TERM; - } - if (flags & CVT_WRITEQ) { - inp.type |= YAP_STRING_TERM|YAP_STRING_WQ; - } - if (flags & CVT_WRITE_CANONICAL) { - inp.type |= YAP_STRING_TERM|YAP_STRING_WC; - } + inp.type = cvtFlags( flags ); if (flags & (BUF_DISCARDABLE|BUF_RING)) { - inp.val.c = LOCAL_FileNameBuf; + buf = LOCAL_FileNameBuf; leng = YAP_FILENAME_MAX-1; + } else { + buf = NULL; } - if (flags & BUF_MALLOC) { - inp.val.c = PL_malloc(1024); - leng = 1023; + out.type = YAP_STRING_CHARS; + if (flags & (REP_UTF8|REP_MB)) { + out.enc = ENC_ISO_UTF8; + } else { + out.enc = ENC_ISO_LATIN1; } - if (!Yap_readText( buf , &inp, & enc, &minimal, & leng PASS_REGS) ) - return false; - - if (enc == ENC_ISO_UTF8) { - if (flags & REP_UTF8) { - *s = buf; - *lengthp = leng; - return true; - } else if (flags & REP_ISO_LATIN_1) { - char *nptr = buf; - const char *optr = buf; - int chr; - while ((optr = _PL__utf8_get_char(optr, &chr))) { - if (chr > 255) { - if (flags & BUF_MALLOC) { - return false; - } - } - *nptr++ = chr; - } - *nptr = '\0'; - *s = buf; - *lengthp = leng; - } else /* wide */ { - size_t sz = utf8_strlen1(buf)+1; - const char *optr = buf; - wchar_t *nptr, *n = buf; - int chr; - if (sz <= 1024) - n = nptr = (wchar_t *)malloc(sz); - while ((optr = _PL__utf8_get_char(optr, &chr))) { - *nptr++ = chr; - } - *nptr = '\0'; - *s = buf; - *lengthp = leng; - - // handle encodings ltaer - } - } - return false; + if (flags & BUF_MALLOC) + out.type |= YAP_STRING_MALLOC; + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return false; + *s = out.val.c; + if (lengthp) + *lengthp = out.sz; + return true; } @@ -284,92 +247,28 @@ PL_get_chars(term_t t, char **s, unsigned flags) int PL_get_wchars(term_t l, size_t *lengthp, wchar_t **s, unsigned flags) { CACHE_REGS - seq_tv_t inp; + seq_tv_t inp, out; size_t leng; encoding_t enc; int minimal; - void *buf; - char b[1024]; - - buf = b; + void *buf = NULL; inp.val.t = Yap_GetFromSlot( l ); - inp.type = 0; - if (flags & CVT_ATOM) { - inp.type |= YAP_STRING_ATOM; - } - if (flags & CVT_ATOM) { - inp.type |= YAP_STRING_STRING; - } - if (flags & CVT_LIST) { - inp.type |= YAP_STRING_CODES; - } - if (flags & CVT_INTEGER) { - inp.type |= YAP_STRING_INT|YAP_STRING_BIG; - } - if (flags & CVT_FLOAT) { - inp.type |= YAP_STRING_FLOAT; - } - if (flags & CVT_VARIABLE) { - inp.type |= YAP_STRING_TERM; - } - if (flags & CVT_WRITE) { - inp.type |= YAP_STRING_TERM; - } - if (flags & CVT_WRITEQ) { - inp.type |= YAP_STRING_TERM|YAP_STRING_WQ; - } - if (flags & CVT_WRITE_CANONICAL) { - inp.type |= YAP_STRING_TERM|YAP_STRING_WC; - } + inp.type = cvtFlags( flags ); if (flags & (BUF_DISCARDABLE|BUF_RING)) { - inp.val.c = LOCAL_FileNameBuf; + buf = LOCAL_FileNameBuf; leng = YAP_FILENAME_MAX-1; + } else { + buf = NULL; } - if (flags & BUF_MALLOC) { - inp.val.w = PL_malloc(1024*SIZEOF_WCHAR_T); - leng = 1023; - } - if (!Yap_readText( buf , &inp, & enc, &minimal, & leng PASS_REGS) ) - return false; - - if (enc == ENC_ISO_UTF8) { - if (flags & REP_UTF8) { - *s = buf; - *lengthp = leng; - return true; - } else if (flags & REP_ISO_LATIN_1) { - char *nptr = buf; - const char *optr = buf; - int chr; - while ((optr = _PL__utf8_get_char(optr, &chr))) { - if (chr > 255) { - if (flags & BUF_MALLOC) { - return false; - } - } - *nptr++ = chr; - } - *nptr = '\0'; - *s = buf; - *lengthp = leng; - } else /* wide */ { - size_t sz = utf8_strlen1(buf)+1; - const char *optr = buf; - wchar_t *nptr, *n = buf; - int chr; - if (sz <= 1024) - n = nptr = (wchar_t *)malloc(sz*SIZEOF_WCHAR_T); - while ((optr = _PL__utf8_get_char(optr, &chr))) { - *nptr++ = chr; - } - *nptr = '\0'; - *s = buf; - *lengthp = leng; - - // handle encodings later - } - } - return false; + out.type = YAP_STRING_WCHARS; + if (flags & BUF_MALLOC) + out.type |= YAP_STRING_MALLOC; + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return false; + *s = out.val.w; + if (lengthp) + *lengthp = out.sz; + return true; } X_API int @@ -378,7 +277,7 @@ PL_unify_chars(term_t l, int flags, size_t length, const char *s) seq_tv_t inp, out; if (flags & REP_UTF8) { - inp.val.c = s; + inp.val.c0 = s; if (length != (size_t)-1) { inp.sz = length; inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS; @@ -399,8 +298,8 @@ PL_unify_chars(term_t l, int flags, size_t length, const char *s) out.max = length; } if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - return out.val.t; + return 0L; + return Yap_unify( Yap_GetFromSlot(l), out.val.t ); } diff --git a/library/dialect/swi/fli/swi.h b/library/dialect/swi/fli/swi.h index 700b85355..c263090cc 100644 --- a/library/dialect/swi/fli/swi.h +++ b/library/dialect/swi/fli/swi.h @@ -57,18 +57,6 @@ add_to_hash(Int i, ADDR key) SWI_ReverseHash[h].pos = i; } -static atom_t -in_hash(ADDR key) -{ - UInt h = addr_hash(key); - while (SWI_ReverseHash[h].key) { - if (SWI_ReverseHash[h].key == key) - return SWI_ReverseHash[h].pos; - h = (h+1)%N_SWI_HASH; - } - return 0; -} - static inline Term SWIModuleToModule(module_t m) @@ -89,7 +77,7 @@ AtomToSWIAtom(Atom at) { TranslationEntry *p; - if ((p = Yap_GetTranslationProp(at)) != NULL) + if ((p = Yap_GetTranslationProp(at,0)) != NULL) return (atom_t)(p->Translation*2+1); return (atom_t)at; } @@ -104,25 +92,25 @@ SWIAtomToAtom(atom_t at) return (Atom)at; } +static inline functor_t +FunctorToSWIFunctor(Functor f) +{ + TranslationEntry *p; + Atom at = NameOfFunctor(f); + arity_t ar = ArityOfFunctor(f); + if ((p = Yap_GetTranslationProp(at,ar)) != NULL) + return (functor_t)(p->Translation*2+1); + return (functor_t)f; +} -/* This is silly, but let's keep it like that for now */ static inline Functor SWIFunctorToFunctor(functor_t f) { - if (((CELL)(f) & 2) && ((CELL)f) < N_SWI_FUNCTORS*4+2) - return SWI_Functors[((CELL)f)/4]; + if ((CELL)f & 1) + return SWI_Functors[f/2]; return (Functor)f; } -static inline functor_t -FunctorToSWIFunctor(Functor at) -{ - atom_t ats; - if ((ats = in_hash((ADDR)at))) - return (functor_t)((CELL)ats*4+2); - return (functor_t)at; -} - #define isDefinedProcedure(pred) TRUE // TBD int Yap_write_blob(AtomEntry *ref, FILE *stream); diff --git a/misc/GLOBALS b/misc/GLOBALS index cfa34e29a..9c7f5a6af 100755 --- a/misc/GLOBALS +++ b/misc/GLOBALS @@ -88,10 +88,6 @@ lockvar StreamDescLock MkLock char** argv void int argc void -// Prolog execution and state flags -union flagTerm* Flags void -UInt flagCount void - // extensions to Terms #ifdef COROUTINING /* array with the ops for your favourite extensions */ diff --git a/misc/HEAPFIELDS b/misc/HEAPFIELDS index 036d32cb0..b2796d7e0 100644 --- a/misc/HEAPFIELDS +++ b/misc/HEAPFIELDS @@ -57,7 +57,7 @@ UInt MaxStack_ MaxStack =0 void UInt MaxTrail_ MaxTrail =0 void /* execution info */ -/* OPCODE TABLE, needed to recover op tables */ +/* OPCODE REVERSE TABLE, needed to recover op tables */ #if USE_THREADED_CODE op_entry *op_rtable OP_RTABLE void OpRTableAdjust #endif @@ -71,6 +71,7 @@ OPCODE lockpred_op LOCKPRED_OPCODE MkOp _lock_pred OPCODE orlast_op ORLAST_OPCODE MkOp _or_last OPCODE undef_op UNDEF_OPCODE MkOp _undef_p OPCODE retry_userc_op RETRY_USERC_OPCODE MkOp _retry_userc +OPCODE execute_cpred_op EXECUTE_CPRED_OPCODE MkOp _execute_cpred /* atom tables */ UInt n_of_atoms NOfAtoms void void @@ -163,9 +164,8 @@ void void void Yap_InitModules() void // don't actually want to define a field void void void Yap_InitPlIO() void -// make sure we have the flags set at this point. -// don't actually want to define a field -void void void Yap_InitFlags(true) void +union flagTerm* GLOBAL_Flags_ GLOBAL_Flags =0 void +UInt GLOBAL_flagCount_ GLOBAL_flagCount Yap_InitFlags(true) RestoreFlags(GLOBAL_flagCount) /* Anderson's JIT */ yap_exec_mode execution_mode Yap_ExecutionMode =INTERPRETED void @@ -370,6 +370,10 @@ struct swi_reverse_hash swi_reverse_hash[N_SWI_HASH] SWI_ReverseHash void void Int atom_translations AtomTranslations void void Int max_atom_translations MaxAtomTranslations void void +/* integer access to functors */ +Int functor_translations FunctorTranslations void void +Int max_functor_translations MaxFunctorTranslations void void + Atom empty_wakeups[MAX_EMPTY_WAKEUPS] EmptyWakeups InitEmptyWakeups() RestoreEmptyWakeups() int max_empty_wakeups MaxEmptyWakeups =0 diff --git a/os/charsio.c b/os/charsio.c index 4b6a08b08..be2f4670e 100644 --- a/os/charsio.c +++ b/os/charsio.c @@ -447,7 +447,7 @@ put_char ( USES_REGS1 ) int ch; int sno; - if (IsVarTerm(t2 = Deref(ARG1))) { + if (IsVarTerm(t2 = Deref(ARG2))) { Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1"); return FALSE; } else if (!IsAtomTerm (t2)) { @@ -480,7 +480,7 @@ tab_1 ( USES_REGS1 ) int sno = LOCAL_c_output_stream; Term t2; Int tabs, i; - if (IsVarTerm(t2 = Deref(ARG1))) { + if (IsVarTerm(t2 = Deref(ARG2))) { Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1"); return FALSE; } else if (!IsIntegerTerm (t2)) { @@ -514,7 +514,7 @@ tab ( USES_REGS1 ) int sno = LOCAL_c_output_stream; Term t2; Int tabs, i; - if (IsVarTerm(t2 = Deref(ARG1))) { + if (IsVarTerm(t2 = Deref(ARG2))) { Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1"); return FALSE; } else if (!IsIntegerTerm (t2)) { @@ -588,7 +588,7 @@ put_byte ( USES_REGS1 ) { /* '$put_byte'(Stream,N) */ Term t2; Int ch; - if (IsVarTerm(t2 = Deref(ARG1))) { + if (IsVarTerm(t2 = Deref(ARG2))) { Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1"); return FALSE; } else if (!IsIntegerTerm (t2)) { @@ -653,7 +653,7 @@ skip_1 ( USES_REGS1 ) int sno; int ch; - if (IsVarTerm(t2 = Deref(ARG1))) { + if (IsVarTerm(t2 = Deref(ARG2))) { Yap_Error(INSTANTIATION_ERROR, t2, "skip/2"); return FALSE; } else if (!IsIntegerTerm (t2)) { @@ -843,7 +843,7 @@ peek_code_1 ( USES_REGS1 ) if ((ch = dopeek( sno )) < 0) return false; UNLOCK(GLOBAL_Stream[sno].streamlock); - return(Yap_unify_constant(ARG2,MkIntTerm(ch))); + return(Yap_unify_constant(ARG1,MkIntTerm(ch))); } diff --git a/os/chartypes.c b/os/chartypes.c index e0faeac5b..c9bc9f371 100644 --- a/os/chartypes.c +++ b/os/chartypes.c @@ -60,7 +60,7 @@ Term int sno; Term t; - sno = Yap_open_buf_read_stream(s, strlen(s)+1, enc, MEM_BUF_USER); + sno = Yap_open_buf_read_stream(s, strlen(s), enc, MEM_BUF_USER); if (sno < 0) return FALSE; GLOBAL_Stream[sno].encoding = enc; @@ -100,7 +100,7 @@ char * Yap_TermToString(Term t, char *s, size_t sz, size_t *length, encoding_t encp, int flags) { CACHE_REGS - int sno = Yap_open_buf_write_stream(&s, &sz); + int sno = Yap_open_buf_write_stream(s, sz, encp, flags); int old_output_stream = LOCAL_c_output_stream; if (sno < 0) @@ -118,28 +118,59 @@ char * return NULL; } -static encoding_t +const char *encvs[] = { "LANG","LC_ALL","LC_CTYPE", NULL }; + +// wher we can fins an encoding +typedef struct enc_map { + const char *s; + encoding_t e; + } enc_map_t; + +static enc_map_t ematches[] = +{ { "UTF-8", ENC_ISO_UTF8 }, + { "UTF-16", ENC_UTF16_LE }, // ok, this is a very bad name + { "UCS-2", ENC_UTF16_LE }, // ok, this is probably gone by now + { "ISO-LATIN1", ENC_ISO_LATIN1 }, + { "ISO-8859-1", ENC_ISO_LATIN1 }, + { "Windows-1252", ENC_ISO_LATIN1 }, // almost, but not quite + { "CP-1252", ENC_ISO_LATIN1 }, + { "C", ENC_ISO_ASCII }, + { NULL, ENC_OCTET } + }; + + static encoding_t DefaultEncoding(void) { - char *s = getenv("LANG"); - size_t sz; - - /* if we don't have a LANG then just use ISO_LATIN1 */ - if (s == NULL) - s = getenv("LC_CTYPE"); - if (s == NULL) - return ENC_ISO_LATIN1; - sz = strlen(s); - if (sz >= 5) { - if (s[sz-5] == 'U' && - s[sz-4] == 'T' && - s[sz-3] == 'F' && - s[sz-2] == '-' && - s[sz-1] == '8') { - return ENC_ISO_UTF8; + CACHE_REGS + int i = 0, j; + char *enc; + while (encvs[i]) { + char *v = getenv(encvs[i]); + if (v) { + enc = strrchr(v, '.'); + /* that's how it is supposed to be, except in OSX */ + if (!enc) enc = v; + // now that we have one name, try to match it + j= 0; + while (ematches[j].s != NULL) { + if (!strcmp(ematches[j].s, enc)) { + return LOCAL_encoding = ematches[j].e; + } else { + j++; + } + } + Yap_Warning("System uses unknown default encoding %s (taken from %s)", enc, v ); + } else { + i++; } } - return ENC_ISO_ANSI; + // by default, return UTF-8 + // except in _WIN32 +#ifdef _WIN32 + return ENC_UTF16_BE; +#else + return ENC_ISO_UTF8; +#endif } encoding_t diff --git a/os/encoding.h b/os/encoding.h index 4f4138bcd..1f0325383 100644 --- a/os/encoding.h +++ b/os/encoding.h @@ -29,8 +29,8 @@ typedef enum { ENC_ISO_ASCII = 2, /// US only ENC_ISO_ANSI = 4, /// Who cares ENC_ISO_UTF8 = 8, /// Most everyone nowadays - ENC_UNICODE_BE = 16, /// People who made a mistake - ENC_UNICODE_LE = 32, /// People who made the same mistake + ENC_UTF16_BE = 16, /// People who made a mistake + ENC_UTF16_LE = 32, /// People who made the same mistake ENC_ISO_UTF32_BE = 64, /// nobody ENC_ISO_UTF32_LE = 128, /// yes, nobody } encoding_t; @@ -49,8 +49,8 @@ static inline const char *enc_name(encoding_t enc) case ENC_ISO_ASCII: return "ascii"; case ENC_ISO_ANSI: return "octet"; case ENC_ISO_UTF8: return "utf8"; - case ENC_UNICODE_BE: return "utf16_be"; - case ENC_UNICODE_LE: return "utf16_le"; + case ENC_UTF16_BE: return "utf16_be"; + case ENC_UTF16_LE: return "utf16_le"; case ENC_ISO_UTF32_BE: return "utf32_be"; case ENC_ISO_UTF32_LE: return "utf32_le"; } @@ -65,8 +65,8 @@ encoding_t enc_id(char *s) if (!strcmp(s, "iso_ascii")) return ENC_ISO_ASCII; if (!strcmp(s, "iso_ansi")) return ENC_ISO_ANSI; if (!strcmp(s, "iso_utf8")) return ENC_ISO_UTF8; - if (!strcmp(s, "utf16_be")) return ENC_UNICODE_BE; - if (!strcmp(s, "utf16_le")) return ENC_UNICODE_LE; + if (!strcmp(s, "utf16_be")) return ENC_UTF16_BE; + if (!strcmp(s, "utf16_le")) return ENC_UTF16_LE; if (!strcmp(s, "utf32_be")) return ENC_ISO_UTF32_BE; if (!strcmp(s, "utf32_le")) return ENC_ISO_UTF32_LE; if (!strcmp(s, "default")) return Yap_DefaultEncoding(); diff --git a/os/files.c b/os/files.c index e86529109..cdb177964 100644 --- a/os/files.c +++ b/os/files.c @@ -565,7 +565,7 @@ same_file( USES_REGS1 ) { int out; struct stat *b1, *b2; while ((char *)HR+sizeof(struct stat)*2 > (char *)(ASP-1024)) { - if (!Yap_gcl(2*sizeof(struct stat), 2, ENV, gc_P(P,CP))) { + if (!Yap_gcl(2*sizeof(struct stat), 2, ENV,Yap_gcP() ) ) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } diff --git a/os/format.c b/os/format.c index 6253cb8a2..038d3ac51 100644 --- a/os/format.c +++ b/os/format.c @@ -223,10 +223,11 @@ format_copy_args(Term args, Term *targs, Int tsz) } static void -format_clean_up( char *fstr, Term *targs) + +format_clean_up( int sno, const char *fstr, Term *targs) { if (fstr) - Yap_FreeAtomSpace(fstr); + Yap_FreeAtomSpace((void *)fstr); if (targs) Yap_FreeAtomSpace((char *)targs); } @@ -268,7 +269,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS) int column_boundary; Term mytargs[8], *targs; Int tnum, targ; - char *fstr = NULL, *fptr; + const char *fstr = NULL, *fptr; Term args; Term tail; int (* f_putc)(int, wchar_t); @@ -317,16 +318,20 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS) int sz = 256; do { format_cp_res fr; + char *fstr0; + - fstr = fptr = Yap_AllocAtomSpace(sz*sizeof(char)); - if ((fr = copy_format_string(tail, fstr, sz)) == fst_ok) + fstr = fptr = fstr0 = Yap_AllocAtomSpace(sz*sizeof(char)); + if ((fr = copy_format_string(tail, fstr0, sz)) == fst_ok) break; if (fr == fst_error) return FALSE; sz += 256; - Yap_FreeCodeSpace(fstr); + Yap_FreeCodeSpace(fstr0); } while (TRUE); } else if (IsAtomTerm(tail)) { fstr = fptr = RepAtom(AtomOfTerm(tail))->StrOfAE; + } else if (IsStringTerm(tail)) { + fstr = fptr = StringOfTerm(tail); } else { Yap_Error(CONSISTENCY_ERROR, tail, "format/2"); return FALSE; @@ -663,11 +668,12 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS) if (IsStringTerm(t)) { if (has_repeats) goto do_consistency_error; - yhandle_t sl = Yap_StartSlots(); - // stream is already locked. - Yap_plwrite (t, GLOBAL_Stream+sno, 0, Handle_vars_f|To_heap_f, 1200); - Yap_CloseSlots(sl); - LOCAL_FormatInfo = &finfo; + const char *pt = StringOfTerm(t); + while(*pt) { + int ch; + pt = utf8_get_char(pt, &ch); + f_putc(sno, ch); + } } else if (!format_print_str (sno, repeats, has_repeats, t, f_putc)) { goto do_default_error; } @@ -739,7 +745,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS) if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler; } - format_clean_up( fstr, targs); + format_clean_up( sno, fstr, targs); Yap_JumpToEnv(ball); return FALSE; } @@ -820,7 +826,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS) finfo.pad_entries[finfo.padders].pad = bufp; bufp = NULL; sz = 0; - nsno = Yap_open_buf_write_stream(&bufp, &sz); + nsno = Yap_open_buf_write_stream(bufp, sz, GLOBAL_Stream[sno].encoding, 0); if (osno) { GLOBAL_Stream[nsno].linepos = GLOBAL_Stream[sno].linepos; GLOBAL_Stream[nsno].linecount = GLOBAL_Stream[sno].linecount; @@ -877,7 +883,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS) if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler; } - format_clean_up( fstr, targs); + format_clean_up( sno, fstr, targs); LOCAL_Error_TYPE = YAP_NO_ERROR; return FALSE; } @@ -895,7 +901,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS) } // fill_pads( sno, 0, &finfo); } - if (IsAtomTerm(tail)) { + if (IsAtomTerm(tail) || IsStringTerm(tail)) { fstr = NULL; } if (tnum <= 8) @@ -903,7 +909,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS) if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler; } - format_clean_up( fstr, targs); + format_clean_up( sno, fstr, targs); return (TRUE); } @@ -950,8 +956,8 @@ if (IsVarTerm(tin)) { Term tat; Term inp = Deref(ARG1); if (out) { - char *s = GLOBAL_Stream[output_stream].u.mem_string.buf; - s[GLOBAL_Stream[output_stream].u.mem_string.pos] = '\0'; + char *s = GLOBAL_Stream[output_stream].nbuf; + s[GLOBAL_Stream[output_stream].nsize] = '\0'; if (f == FunctorAtom) { tat = MkAtomTerm(Yap_LookupAtom(s)); } else if (f == FunctorCodes) { @@ -974,39 +980,45 @@ if (IsVarTerm(tin)) { } static Int -format2(Term tin, Term tf, Term tas USES_REGS) +format(Term tout, Term tf, Term tas USES_REGS) { bool mem_stream = false; int output_stream; Functor f; Int out; - if (IsVarTerm(tin)) { - Yap_Error(INSTANTIATION_ERROR,tin,"format/3"); + if (IsVarTerm(tout)) { + Yap_Error(INSTANTIATION_ERROR,tout,"format/3"); return false; } - if (IsApplTerm(tin) && - (f = FunctorOfTerm(tin)) && - (f == FunctorAtom || f == FunctorString || + if (IsApplTerm(tout) && + (f = FunctorOfTerm(tout)) && + (f == FunctorAtom || f == FunctorString1 || f == FunctorCodes1 || f == FunctorCodes || f == FunctorChars1 || f == FunctorChars) ) { output_stream = Yap_OpenBufWriteStream( PASS_REGS1); mem_stream = true; } else { /* needs to change LOCAL_c_output_stream for write */ - output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "format/3"); + output_stream = Yap_CheckStream (tout, Output_Stream_f, "format/3"); } if (output_stream == -1) { return false; - } - out = doformat(tf,tas,output_stream PASS_REGS); - UNLOCK(GLOBAL_Stream[output_stream].streamlock); + UNLOCK(GLOBAL_Stream[output_stream].streamlock); + } else { + yhandle_t sls = Yap_CurrentSlot(PASS_REGS1); + + out = doformat(tf,tas,output_stream PASS_REGS); + + Yap_CloseSlots( sls ); + UNLOCK(GLOBAL_Stream[output_stream].streamlock); + } if (mem_stream) { Term tat; Term inp = Deref(ARG1); if (out) { - char *s = GLOBAL_Stream[output_stream].u.mem_string.buf; - s[GLOBAL_Stream[output_stream].u.mem_string.pos] = '\0'; + char *s = GLOBAL_Stream[output_stream].nbuf; + s[GLOBAL_Stream[output_stream].nsize] = '\0'; if (f == FunctorAtom) { tat = MkAtomTerm(Yap_LookupAtom(s)); } else if (f == FunctorCodes) { @@ -1031,10 +1043,10 @@ format2(Term tin, Term tf, Term tas USES_REGS) } static Int -format( USES_REGS1 ) +format2( USES_REGS1 ) { /* 'format'(Stream,Control,Args) */ Int res; - res = format2(MkAtomTerm(AtomUserOut), Deref(ARG1),Deref(ARG2) PASS_REGS); + res = format(MkAtomTerm(AtomUserOut), Deref(ARG1),Deref(ARG2) PASS_REGS); return res; } @@ -1042,14 +1054,14 @@ static Int format3( USES_REGS1 ) { /* 'format'(Stream,Control,Args) */ Int res; - res = format2(Deref(ARG1), Deref(ARG2),Deref(ARG3) PASS_REGS); + res = format(Deref(ARG1), Deref(ARG2),Deref(ARG3) PASS_REGS); return res; } void Yap_InitFormat(void) { - Yap_InitCPred ("format", 2, format, SyncPredFlag); + Yap_InitCPred ("format", 2, format2, SyncPredFlag); Yap_InitCPred ("format", 3, format3, SyncPredFlag); Yap_InitCPred ("with_output_to", 2, with_output_to, SyncPredFlag); } diff --git a/os/iopreds.c b/os/iopreds.c index fc3d64173..758d6f7fc 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -219,7 +219,7 @@ InitStdStream (int sno, SMALLUNSGN flags, FILE * file) s->status = flags; s->linepos = 0; s->linecount = 1; - s->charcount = 0; + s->charcount = 0.; s->encoding = LOCAL_encoding; INIT_LOCK(s->streamlock); unix_upd_stream_info(s); @@ -877,14 +877,14 @@ get_wchar(int sno) } } break; - case ENC_UNICODE_BE: + case ENC_UTF16_BE: if (how_many) { return wch+ch; } how_many=1; wch = ch << 8; break; - case ENC_UNICODE_LE: + case ENC_UTF16_LE: if (how_many) { return wch+(ch<<8); } @@ -1012,10 +1012,10 @@ put_wchar(int sno, wchar_t ch) return -1; } break; - case ENC_UNICODE_BE: + case ENC_UTF16_BE: GLOBAL_Stream[sno].stream_putc(sno, (ch>>8)); return GLOBAL_Stream[sno].stream_putc(sno, (ch&0xff)); - case ENC_UNICODE_LE: + case ENC_UTF16_LE: GLOBAL_Stream[sno].stream_putc(sno, (ch&0xff)); return GLOBAL_Stream[sno].stream_putc(sno, (ch>>8)); case ENC_ISO_UTF32_BE: @@ -1128,14 +1128,14 @@ binary_file(char *file_name) return FALSE; st->status |= HAS_BOM_f; return TRUE; - case ENC_UNICODE_BE: + case ENC_UTF16_BE: if (st->stream_putc(sno,0xFE)<0) return FALSE; if (st->stream_putc(sno,0xFF)<0) return FALSE; st->status |= HAS_BOM_f; return TRUE; - case ENC_UNICODE_LE: + case ENC_UTF16_LE: if (st->stream_putc(sno,0xFF)<0) return FALSE; if (st->stream_putc(sno,0xFE)<0) @@ -1223,7 +1223,7 @@ binary_file(char *file_name) return; } else { st->status |= HAS_BOM_f; - st->encoding = ENC_UNICODE_BE; + st->encoding = ENC_UTF16_BE; return; } } @@ -1257,7 +1257,7 @@ binary_file(char *file_name) } } st->status |= HAS_BOM_f; - st->encoding = ENC_UNICODE_LE; + st->encoding = ENC_UTF16_LE; return; } } diff --git a/os/iopreds.h b/os/iopreds.h index ed5c913c2..ce48ca83a 100644 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -211,6 +211,7 @@ typedef struct stream_desc } StreamDesc; + static inline bool IsStreamTerm(Term t) { @@ -255,12 +256,12 @@ Term Yap_MkStream (int n); bool Yap_PrintWarning( Term twarning ); +char *Yap_MemExportStreamPtr( int sno ); Int PlIOError (yap_error_number type, Term culprit, const char *who, ...); void Yap_plwrite(Term, struct stream_desc *, int, int, int); -int Yap_FormatFloat( Float f, const char *s, size_t sz ); void Yap_WriteAtom(struct stream_desc *s, Atom atom); Term Yap_scan_num(struct stream_desc *); diff --git a/os/mem.c b/os/mem.c index eb8aca9f5..1634f601f 100644 --- a/os/mem.c +++ b/os/mem.c @@ -233,50 +233,45 @@ open_mem_read_stream (USES_REGS1) /* $open_mem_read_stream(+List,-Stream) */ } int -Yap_open_buf_write_stream(char **nbufp, size_t *ncharsp) +Yap_open_buf_write_stream(char *buf, size_t nchars, encoding_t enc, memBufSource sr) { int sno; StreamDesc *st; - char *nbuf = NULL; - size_t nchars = 0; - - if (nbufp) - nbuf = *nbufp; - if (ncharsp) - nchars = *ncharsp; - if (!nchars) - nchars = 256; - if (!nbuf) { - if (!nchars) { - nchars = Yap_page_size; + + + sno = GetFreeStreamD(); + if (sno < 0) + return -1; + if (!buf) { + if (!nchars) { + nchars = Yap_page_size; + } + buf = malloc( nchars ); } - nbuf = malloc( nchars ); - if(!nbuf) { + st = GLOBAL_Stream+sno; + st->nbuf = buf; + if(!st->nbuf) { return -1; } - } - sno = GetFreeStreamD(); - if (sno < 0) - return -1; - st = &GLOBAL_Stream[sno]; - /* currently these streams are not seekable */ - st->linepos = 0; - st->charcount = 0; - st->linecount = 1; - Yap_DefaultStreamOps( st ); + st->nsize = nchars; + /* currently these streams are not seekable */ + st->linepos = 0; + st->charcount = 0; + st->linecount = 1; + st->encoding = enc; + Yap_DefaultStreamOps( st ); #if MAY_WRITE - st->file = open_memstream(&st->nbuf, &st->nsize); - st->status = Output_Stream_f | InMemory_Stream_f|Seekable_Stream_f; + st->file = open_memstream(&st->nbuf, &st->nsize); + st->status = Output_Stream_f | InMemory_Stream_f|Seekable_Stream_f; #else - st->u.mem_string.pos = 0; - st->u.mem_string.buf = nbuf; - st->u.mem_string.max_size = nchars; - st->status = Output_Stream_f | InMemory_Stream_f; + st->u.mem_string.pos = 0; + st->u.mem_string.buf = nbuf; + st->u.mem_string.max_size = nchars; + st->status = Output_Stream_f | InMemory_Stream_f; #endif - Yap_MemOps( st ); - UNLOCK(st->streamlock); - *nbufp = nbuf; - return sno; + Yap_MemOps( st ); + UNLOCK(st->streamlock); + return sno; } int @@ -292,7 +287,7 @@ Yap_OpenBufWriteStream( USES_REGS1 ) return -1; } } - return Yap_open_buf_write_stream(&nbuf, &sz); + return Yap_open_buf_write_stream(nbuf, sz, GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0); } static Int @@ -316,14 +311,16 @@ open_mem_write_stream (USES_REGS1) /* $open_mem_write_stream(-Stream) */ * @return temporary buffer, discarded by close and may be moved away * by other writes.. */ -memHandle * -Yap_MemExportStreamPtrs( int sno ) +char * +Yap_MemExportStreamPtr( int sno ) { + char *s; #if MAY_WRITE - if (fflush(GLOBAL_Stream[sno].file) == 0) { - GLOBAL_Stream[sno].nbuf[GLOBAL_Stream[sno].nsize] = '\0'; - return (memHandle *)GLOBAL_Stream[sno].nbuf; - } + if (fflush(GLOBAL_Stream[sno].file) == 0 && + (s = GLOBAL_Stream[sno].nbuf)) { + s[ftell(GLOBAL_Stream[sno].file)] = '\0'; + return s; + } return NULL; #else return &GLOBAL_Stream[sno].u.mem_string; @@ -360,7 +357,7 @@ peek_mem_write_stream ( USES_REGS1 ) if (HR + 1024 >= ASP) { UNLOCK(GLOBAL_Stream[sno].streamlock); HR = HI; - if (!Yap_gcl((ASP-HI)*sizeof(CELL), 3, ENV, gc_P(P,CP))) { + if (!Yap_gcl((ASP-HI)*sizeof(CELL), 3, ENV, Yap_gcP()) ) { UNLOCK(GLOBAL_Stream[sno].streamlock); Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return(FALSE); diff --git a/os/readterm.c b/os/readterm.c index 29a4e783b..516684478 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -739,6 +739,7 @@ parseError(REnv *re, FEnv *fe, int inp_stream) Term ParserErrorStyle = re->sy; if (ParserErrorStyle == TermQuiet) { /* just fail */ + LOCAL_Error_TYPE = YAP_NO_ERROR; return YAP_PARSING_FINISHED; } else { Term terr = Yap_syntax_error(fe->toklast, inp_stream); @@ -748,10 +749,12 @@ parseError(REnv *re, FEnv *fe, int inp_stream) return YAP_PARSING_FINISHED; } else { Yap_PrintWarning(terr); - if (ParserErrorStyle == TermDec10); - return YAP_SCANNING; + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (ParserErrorStyle == TermDec10) + return YAP_SCANNING; } } + LOCAL_Error_TYPE = YAP_NO_ERROR; return YAP_PARSING_FINISHED; } diff --git a/os/readutil.c b/os/readutil.c index eefc3a340..feebcad99 100644 --- a/os/readutil.c +++ b/os/readutil.c @@ -127,7 +127,7 @@ p_stream_to_codes(USES_REGS1) RESET_VARIABLE(h0); ARG4 = AbsPair(HBASE); ARG5 = (CELL)h0; - if (!Yap_gcl((ASP-HBASE)*sizeof(CELL), 5, ENV, gc_P(P,CP))) { + if (!Yap_gcl((ASP-HBASE)*sizeof(CELL), 5, ENV, Yap_gcP())) { Yap_Error(OUT_OF_STACK_ERROR, ARG1, "read_stream_to_codes/3"); return FALSE; } diff --git a/os/streams.c b/os/streams.c index 9f464b4e8..d09bb4e63 100644 --- a/os/streams.c +++ b/os/streams.c @@ -632,8 +632,6 @@ cont_stream_property (USES_REGS1) ++i; if (i == MaxStreams) cut_fail(); - else - EXTRA_CBACK_ARG (2, 1) = MkIntTerm (i+1); } LOCK(GLOBAL_Stream[i].streamlock); UNLOCK(GLOBAL_StreamDescLock); @@ -645,12 +643,16 @@ cont_stream_property (USES_REGS1) if (rc) { if (det) cut_succeed(); - else - return true; + else { + EXTRA_CBACK_ARG (2, 1) = MkIntTerm (i+1); + return true; + } } else if (det) cut_fail(); - else + else { + EXTRA_CBACK_ARG (2, 1) = MkIntTerm (i+1); return false; + } } static Int diff --git a/os/yapio.h b/os/yapio.h index 1e0a59e6f..c1bd81602 100644 --- a/os/yapio.h +++ b/os/yapio.h @@ -141,14 +141,14 @@ typedef enum mem_buf_source { MEM_BUF_USER=4 } memBufSource; -struct mem_desc *Yap_MemExportStreamPtrs( int sno ); +char * Yap_MemStreamBuf( int sno ); extern Term Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio, Term *bindings_p); extern Term Yap_StringToNumberTerm(char *s, encoding_t encp); -int Yap_FormatFloat(Float f, const char *s, size_t sz); +int Yap_FormatFloat(Float f, char **s, size_t sz); int Yap_open_buf_read_stream(const char *nbuf, size_t nchars, encoding_t enc, memBufSource src); +int Yap_open_buf_write_stream( char *nbuf, size_t nchars, encoding_t enc, memBufSource src); Term Yap_ReadFromAtom(Atom a, Term opts); -int Yap_open_buf_write_stream(char **nbufp, size_t * szp); FILE *Yap_GetInputStream(Term t, const char *m); FILE *Yap_GetOutputStream(Term t,const char *m); char * Yap_guessFileName(int f, int sno, char *nameb, size_t max); diff --git a/packages/cuda/CMakeLists.txt b/packages/cuda/CMakeLists.txt index 570b5cd7b..7fe5fd97c 100644 --- a/packages/cuda/CMakeLists.txt +++ b/packages/cuda/CMakeLists.txt @@ -51,7 +51,7 @@ if (CUDA_FOUND) # Only available for CUDA version 3.2+. # Windows only. # - macro_optional_find_package (FindThrust ON) + macro_optional_find_package (Thrust ON) set (CUDA_SOURCES lista.cu @@ -65,9 +65,9 @@ if (CUDA_FOUND) cuda_add_library (libcuda SHARED ${CUDA_SOURCES}) - target_link_libraries(libcuda libYap - ${CUDA_LIBRARIES} ${CUDA_npp_LIBRARY} ${CUDA_nppc_LIBRARY} -stdc++ ) + target_link_libraries(libcuda libYap + ${CUDA_LIBRARIES} ${CUDA_npp_LIBRARY} # ${CUDA_nppc_LIBRARY} + ) if( THRUST_INCLUDE_DIR ) list( REMOVE_DUPLICATES THRUST_INCLUDE_DIR ) diff --git a/packages/python/CMakeLists.txt b/packages/python/CMakeLists.txt index e54f04170..3f8924a1a 100644 --- a/packages/python/CMakeLists.txt +++ b/packages/python/CMakeLists.txt @@ -3,6 +3,12 @@ set (PYTHON_SOURCES python.c) +#try to use Brew first +#set ( PYTHON_LIBRARY /Anaconda/lib/libpython2.7.dylib ) +#set ( PYTHON_INCLUDE_DIR /Anaconda/include/python2.7 ) +set( PYTHON_LIBRARY /usr/local/opt/python/Frameworks/Python.framework/Versions/Current/lib/libpython2.7.dylib) # - path to the python library +set( PYTHON_INCLUDE_DIR /usr/local/opt/python/Frameworks/Python.framework/Versions/Current/include/python2.7 ) # - path to where Python.h is found + macro_optional_find_package(PythonInterp ON) macro_optional_find_package (PythonLibs ON) macro_log_feature (PYTHONLIBS_FOUND "Python" diff --git a/packages/python/python.c b/packages/python/python.c index 0714a7d0c..ffb764cce 100644 --- a/packages/python/python.c +++ b/packages/python/python.c @@ -659,29 +659,40 @@ term_to_python(term_t t) case PL_VARIABLE: return NULL; case PL_ATOM: - case PL_STRING: { - char *s; atom_t at; if (PL_get_atom(t, &at)) { if (at == ATOM_true) return Py_True; if (at == ATOM_false) return Py_False; } - if (!PL_get_chars(t, &s, REP_UTF8|CVT_ATOM|CVT_STRING|BUF_DISCARDABLE) ) { - return NULL; + { + char *s; + if (!PL_get_atom_chars(t, &s)) + return NULL; + /* return __main__,s */ + return PyObject_GetAttrString(py_Main, s); } -#if PY_MAJOR_VERSION < 3 - if (proper_ascii_string(s)) { - return PyString_FromStringAndSize(s, strlen(s) ); - } else -#endif - { - PyObject *pobj = PyUnicode_DecodeUTF8(s, strlen(s), NULL); - //fprintf(stderr, "%s\n", s); - return pobj; - } } + break; + case PL_STRING: + { + char *s; + if (!PL_get_chars(t, &s, REP_UTF8|CVT_ATOM|CVT_STRING|BUF_DISCARDABLE) ) { + return NULL; + } +#if PY_MAJOR_VERSION < 3 + if (proper_ascii_string(s)) { + return PyString_FromStringAndSize(s, strlen(s) ); + } else +#endif + { + PyObject *pobj = PyUnicode_DecodeUTF8(s, strlen(s), NULL); + //fprintf(stderr, "%s\n", s); + return pobj; + } + } + break; case PL_INTEGER: { int64_t j; @@ -1044,6 +1055,35 @@ assign_python(PyObject *root, term_t t, PyObject *e) case PL_VARIABLE: return -1; case PL_ATOM: + { + char *s; + if (!PL_get_atom_chars(t, &s)) { + wchar_t *w; + atom_t at; + size_t len; + PyObject *attr; + + if (!PL_get_atom(t, &at)) { + return -1; + } + if (!(w = PL_atom_wchars(at, &len))) + return -1; + attr = PyUnicode_FromWideChar(w, wcslen(w) ); + if (!attr) + return -1; + return PyObject_SetAttr(py_Main, attr, e); + } + if (proper_ascii_string(s)) { + return PyObject_SetAttrString(py_Main, s, e); + } else { + PyObject *attr= PyUnicode_DecodeLatin1(s, strlen(s), NULL); + if (!attr) + return -1; + return PyObject_SetAttr(py_Main, attr, e); + } + } + break; + case PL_STRING: { char *s; @@ -1067,8 +1107,8 @@ assign_python(PyObject *root, term_t t, PyObject *e) return PyObject_SetAttr(root, wo, e); } } + break; case PL_INTEGER: - case PL_STRING: case PL_FLOAT: return -1; case PL_TERM: @@ -1278,6 +1318,8 @@ python_import(term_t mname, term_t mod) pModule = PyImport_Import(pName); Py_DECREF(pName); if (pModule == NULL) { + if (PyErr_Occurred()) + PyErr_Print(); PyErr_Clear(); return FALSE; } @@ -1387,8 +1429,28 @@ python_apply(term_t tin, term_t targs, term_t keywds, term_t tf) foreign_t out; term_t targ = PL_new_term_ref(); - pF = term_to_python(tin); + pF = term_t + + + + + + + + + + + + + + + + + + + 'o_python(tin); if ( pF == NULL ) { + PYError() return FALSE; } if (PL_is_atom(keywds) ) @@ -1623,10 +1685,10 @@ end_python(void) return TRUE; } -install_t install_python(void); +install_t install_libpython(void); install_t -install_python(void) +install_libpython(void) { // FUNCTOR_dot2 = PL_new_functor(PL_new_atom("."), 2); // FUNCTOR_equal2 = PL_new_functor(PL_new_atom("="), 2); // FUNCTOR_boolop1 = PL_new_functor(PL_new_atom("@"), 1); @@ -1653,7 +1715,7 @@ install_python(void) FUNCTOR_range2 = PL_new_functor(PL_new_atom("range"), 2); FUNCTOR_range3 = PL_new_functor(PL_new_atom("range"), 3); FUNCTOR_sum1 = PL_new_functor(PL_new_atom("sum"), 1); - FUNCTOR_complex2 = PL_new_functor(PL_new_atom("complex"), 2); + FUNCTOR_complex2 = PL_new_functor(PL_new_atom("i"), 2); FUNCTOR_plus2 = PL_new_functor(PL_new_atom("+"), 2); FUNCTOR_sub2 = PL_new_functor(PL_new_atom("-"), 2); FUNCTOR_mul2 = PL_new_functor(PL_new_atom("*"), 2); diff --git a/packages/python/python.pl b/packages/python/python.pl index 82881912f..06e35a2f6 100644 --- a/packages/python/python.pl +++ b/packages/python/python.pl @@ -13,19 +13,29 @@ %%% -:- module(python, [ - init_python/0, - end_python/0, - python_command/1, - python_assign/3, - python_import/1, - python/2, - op(100,fy,$), - op(950,fy,:=), - op(950,yfx,:=), - (:=)/2, - (:=)/1 - ]). +:- module(python, + [ + init_python/0, + end_python/0, + python_command/1, + python_assign/3, + python_import/1, + python/2, + (:=)/2, + (:=)/1, + (<-)/2, + (<-)/1, + op(100,fy,$), + op(950,fy,:=), + op(950,yfx,:=), + op(950,fx,<-), + op(950,yfx,<-), + op(50, yf, []), + op(50, yf, '()'), + op(100, xfy, '.'), + op(100, fy, '.') + ]). + /** python @@ -35,6 +45,22 @@ @version 0:0:5, 2012/10/8 @license Perl Artistic License +This is an interface to allow calling Python from Prolog. Please look +at the SWIG package if you want to embedd Prolog with Python. + +The interface should be activated by consulting the python lybrary. It +immediately boots a Python image. + +To best define the interface, one has to address two opposite goals: + - make it as similar to python as possible + - make all embedded language interfaces (python, R, Java) as +similar as possible. + + Currently, YAP supports the following translation: + + - numbers -> identical + -> + */ @@ -45,12 +71,12 @@ Python interface Data types are - Python Prolog - string atoms - numbers numbers - lists lists - tuples t(...) - generic objs __pointer__(Address) + Python Prolog + string atoms + numbers numbers + lists lists + tuples t(...) + generic objs __pointer__(Address) $var refers to the attribute __main__.var @@ -62,18 +88,26 @@ Data types are :- use_module(library(charsio)). :- dynamic python_mref_cache/2, python_obj_cache/2. +:- multifile user:(<-)/2. + := F :- python(F,_). V := F :- var(V), !, python(F,V). A := F :- python(F, F1), python_assign(A, F1). +user:( V <- F ) :- + V := F. + +user:((<- F)) :- + <- F. + python_import(Module) :- python_do_import(Module, _). python_do_import(Module, MRef) :- python_mref_cache(Module, MRef), !. python_do_import(Module, MRef) :- - python_import(Module, MRef), + python_import(Module, MRef), assert( python_mref_cache(Module, MRef) ). fetch_module(M:E, M1, E1, MRef) :- @@ -89,12 +123,18 @@ module_extend(M0, M:E, MF, EF, _MRef0, MRef) :- atom_concat([M0,'.',M], MM), python_import(MM, MRef1), !, module_extend(MM, E, MF, EF, MRef1, MRef). +module_extend(M0, M.E, MF, EF, _MRef0, MRef) :- + MM = M0.M, + python_import(MM, MRef1), !, + module_extend(MM, E, MF, EF, MRef1, MRef). module_extend(M, E, M, E, MRef, MRef). object_prefix('__obj__'(_)). object_prefix('$'(_)). object_prefix('__obj__'(_):_). object_prefix('$'(_):_). +object_prefix('__obj__'(_)._). +object_prefix('$'(_)._). % from an exp take an object, and its corresponding Prolog representation descend_exp(V, _Obj, _F, _S) :- @@ -108,9 +148,13 @@ descend_exp(Exp, Obj, F, S) :- python_mref_cache(_, MObj), python_field(MObj:Exp, Obj, F, S), !. descend_exp(Mod:Exp, Obj, F, S) :- - atom(Mod), + atom(Mod), python_import(Mod, MObj), - python_field(MObj:Exp, Obj, F, S), !. + python_field(MObj:Exp, Obj, F, S), !. +descend_exp(Mod.Exp, Obj, F, S) :- + atom(Mod), + python_import(Mod, MObj), + python_field(MObj:Exp, Obj, F, S), !. python_class(Obj) :- python_obj_cache(inspect:isclass(_), F), @@ -129,21 +173,22 @@ python_eval_term(Obj, Obj) :- python_eval_term('__obj__'(Obj), '__obj__'(Obj)) :- !. python_eval_term($Name, Obj) :- !, python_is($Name, Obj). -python_eval_term([H|T], [NH|NT]) :- !, - python_eval_term(H, NH), - python_eval_term(T, NT). +python_eval_term([H|T], NL) :- + is_list(T), !, + maplist( python_eval_term, [H|T], NL). python_eval_term(N, N) :- atomic(N), !. +python_eval_term(N, N) :- string(N), !. python_eval_term(Exp, O) :- descend_exp(Exp, Obj, _Old, S), !, - (functor(S, _, 0) -> + (functor(S, _, 0) -> O = Obj - ; + ; python_check_args(S, NS, Dict), python_apply(Obj, NS, Dict, O) - ). + ). python_eval_term(S, O) :- python_check_args(S, NS, {}), - python_is(NS, O). + python_is(NS, O). python_check_args(Exp, t, {}) :- Exp =.. [_,V], var(V), !. @@ -217,14 +262,13 @@ add_cwd_to_python :- atom_concat(['sys.path.append(\"',Dir,'\")'], Command), python_command(Command), python_command("sys.argv = [\"yap\"]"). - % done + % done python_assign(Name, Exp, '$'(Name)) :- python_assign(Name, Exp). -:- initialization( use_foreign_library(foreign(python)), now ). +:- initialization( use_foreign_library(foreign(libpython)), now ). :- initialization(start_python, now). :- initialization(add_cwd_to_python). - diff --git a/packages/swig/CMakeLists.txt b/packages/swig/CMakeLists.txt index fdac889c0..91fb68199 100644 --- a/packages/swig/CMakeLists.txt +++ b/packages/swig/CMakeLists.txt @@ -11,60 +11,15 @@ if (SWIG_FOUND) # SWIG_VERSION - the version number of the swig executable # - # This is a CMake example for Python + # This is a CMake example for Python and Java INCLUDE(${SWIG_USE_FILE}) - FIND_PACKAGE(PythonLibs) - INCLUDE_DIRECTORIES(${PYTHON_INCLUDE_PATH}) + +add_subdirectory(python) - INCLUDE_DIRECTORIES(${CMAKE_CURRENT_SOURCE_DIR}) + +add_subdirectory(java) - INCLUDE_DIRECTORIES(${CMAKE_SOURCE_DIR}/CXX) - - set_source_files_properties( yap.i - PROPERTIES CPLUSPLUS ON) - -SET(CMAKE_SWIG_FLAGS "") - -set (CMAKE_SWIG_OUTDIR ${CMAKE_CURRENT_BINARY_DIR}/java ) - -macro_optional_find_package(Java ON) -find_package(Java COMPONENTS Development) -#find_package(Java COMPONENTS Runtime) -macro_log_feature (Java_Development_FOUND "Java" - "Use Java System" - "http://www.java.org" FALSE) -macro_optional_find_package(JNI ON) - macro_log_feature (JNI_FOUND "JNI" - "Use Java Native Interface" - "http://www.java.org" FALSE) - - -if (Java_Development_FOUND) - - #set (CMAKE_JAVA_CLASS_OUTPUT_PATH java) - - include ( UseJava ) - - SWIG_ADD_MODULE(jSWIG java yap.i ) - - SWIG_LINK_LIBRARIES(jSWIG ${JAVA_LIBRARIES} ${JNI_LIBRARIES} Yap++) - - #include( UseJavaClassFileList) - set_source_files_properties(yap.i PROPERTY CPLUSPLUS ON) - - target_include_directories ( jSWIG - PUBLIC ${JAVA_INCLUDE_DIRS} ${JNI_INCLUDE_DIRS}) - - INCLUDE_DIRECTORIES(${CMAKE_CURRENT_SOURCE_DIR}) - -#set (CMAKE_JAVA_CLASS_OUTPUT_PATH ${CMAKE_CURRENT_DIR}/java ) - -#include (UseJavaClassFilelist) - -add_subdirectory( java ) - -endif() endif (SWIG_FOUND) diff --git a/packages/swig/java/CMakeLists.txt b/packages/swig/java/CMakeLists.txt index 5acf494da..ad0318573 100644 --- a/packages/swig/java/CMakeLists.txt +++ b/packages/swig/java/CMakeLists.txt @@ -1,47 +1,70 @@ -include ( UseJava ) - -set (SOURCES -${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_CELL.java -${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_CPredicate.java -${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_Prop.java -${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_Term.java -${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_YAP_tag_t.java -${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_arity_t.java -${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_encoding_t.java -${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_intptr_t.java -${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_void.java -${CMAKE_CURRENT_BINARY_DIR}/SWIGTYPE_p_wchar_t.java -${CMAKE_CURRENT_BINARY_DIR}/YAPApplTerm.java -${CMAKE_CURRENT_BINARY_DIR}/YAPAtom.java -${CMAKE_CURRENT_BINARY_DIR}/YAPAtomTerm.java -${CMAKE_CURRENT_BINARY_DIR}/YAPCallback.java -${CMAKE_CURRENT_BINARY_DIR}/YAPEngine.java -${CMAKE_CURRENT_BINARY_DIR}/YAPError.java -${CMAKE_CURRENT_BINARY_DIR}/YAPFLIP.java -${CMAKE_CURRENT_BINARY_DIR}/YAPFunctor.java -${CMAKE_CURRENT_BINARY_DIR}/YAPIntegerTerm.java -${CMAKE_CURRENT_BINARY_DIR}/YAPListTerm.java -${CMAKE_CURRENT_BINARY_DIR}/YAPModule.java -${CMAKE_CURRENT_BINARY_DIR}/YAPModuleProp.java -${CMAKE_CURRENT_BINARY_DIR}/YAPNumberTerm.java -${CMAKE_CURRENT_BINARY_DIR}/YAPPairTerm.java -${CMAKE_CURRENT_BINARY_DIR}/YAPPredicate.java -${CMAKE_CURRENT_BINARY_DIR}/YAPPrologPredicate.java -${CMAKE_CURRENT_BINARY_DIR}/YAPProp.java -${CMAKE_CURRENT_BINARY_DIR}/YAPQuery.java -${CMAKE_CURRENT_BINARY_DIR}/YAPStringTerm.java -${CMAKE_CURRENT_BINARY_DIR}/YAPTerm.java -${CMAKE_CURRENT_BINARY_DIR}/YAPVarTerm.java -${CMAKE_CURRENT_BINARY_DIR}/yap.java -${CMAKE_CURRENT_BINARY_DIR}/yapConstants.java -${CMAKE_CURRENT_BINARY_DIR}/yapJNI.java -) - - add_jar(jYAP - ${SOURCES} +macro_optional_find_package(Java ON) + + find_package(Java COMPONENTS Development) + #find_package(Java COMPONENTS Runtime) + +macro_log_feature (Java_Development_FOUND "Java" + "Use Java System" + "http://www.java.org" FALSE) +macro_optional_find_package(JNI ON) + macro_log_feature (JNI_FOUND "JNI" + "Use Java Native Interface" + "http://www.java.org" FALSE) + + +if (Java_Development_FOUND) + + include ( UseJava ) + + + # SET(CMAKE_SWIG_FLAGS -package YAP) + + SET(SWIG_SOURCES + ../yap.i ) - install_jar( jYAP ${libpl}) -# install_jni_symlink(YAPjar .) + set( CMAKE_CXX_FAGS "${CMAKE_CXX_FLAGS} -Wno-missing-declarations") + + include_directories ( +ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ ${CMAKE_CURRENT_SOURCE_DIR} + ${JAVA_INCLUDE_DIRS} + ${JNI_INCLUDE_DIRS} + ) + set (CMAKE_SWIG_OUTDIR ${CMAKE_CURRENT_BINARY_DIR} ) + + #set (CMAKE_JAVA_CLASS_OUTPUT_PATH java) + + SET_SOURCE_FILES_PROPERTIES(${SWIG_SOURCES} PROPERTIES CPLUSPLUS ON) + + # SWIG_ADD_MODULE(jSWIG java ${SWIG_SOURCES} ) + + # SWIG_LINK_LIBRARIES(jSWIG ${JAVA_LIBRARIES} ${JNI_LIBRARIES} Yap++) + + set_source_files_properties(../yap.i PROPERTY CPLUSPLUS ON) + + add_jar(JavaYAP + SOURCES JavaYAP.java + ENTRY_POINT JavaYAP + ) + install_jar(JavaYAP ${libpl}/JavaYAP) + + set(CMAKE_JNI_TARGET TRUE) + ADD_CUSTOM_COMMAND(TARGET JavaYAP + POST_BUILD + COMMAND cmake -E echo "Compiling Java files..." + COMMAND ${Java_JAVAC_EXECUTABLE} *.java + COMMAND cmake -E echo "Creating jar file..." + COMMAND ${Java_JAR_EXECUTABLE} uvf JavaYAP.jar *.class + ) +# install_jni_symlink(shibboleet ${JAVA_LIB_INSTALL_DIR}) + +# SET_TARGET_PROPERTIES(jSWIG PROPERTIES OUTPUT_NAME "JavaYAP") + + +# add_dependencies(jSWIG JavaYAP) + + Endif (Java_Development_FOUND) + + diff --git a/pl/boot.yap b/pl/boot.yap index 6ed339d48..d8f417df3 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -1053,7 +1053,7 @@ number of steps. '$write_output_vars'([]). '$write_output_vars'([V|VL]) :- - format(user_error,' = ~s',[V]), + format(user_error,' = ~a',[V]), '$write_output_vars'(VL). diff --git a/pl/consult.yap b/pl/consult.yap index 598a8d7c3..73553b60a 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -90,7 +90,7 @@ files and to set-up the Prolog environment. We discuss @pred load_files(+ _Files_, + _Options_) -General implementation of the consult/1 family. Execution is controlled by the +Implementation of the consult/1 family. Execution is controlled by the following flags: + consult(+ _Mode_) @@ -873,7 +873,7 @@ db_files(Fs) :- '$init_win_graphics', fail. '$do_startup_reconsult'(X) :- - ( current_prolog_flag(language_mode, yap) -> + ( current_prolog_flag(halt_after_consult, false) -> '$system_catch'(load_files(X, [silent(true)]), Module, Error, '$Error'(Error)) ; set_prolog_flag(verbose, silent), @@ -882,7 +882,7 @@ db_files(Fs) :- true ), !, - ( current_prolog_flag(language_mode, yap) -> true ; halt). + ( current_prolog_flag(halt_after_consult, false) -> true ; halt). '$do_startup_reconsult'(_). '$skip_unix_header'(Stream) :- @@ -1026,10 +1026,13 @@ prolog_load_context(stream, Stream) :- % module can be reexported. '$ensure_file_unchanged'(F, M) :- - % loaded from the same module, but does not define a module. + % loaded from the same module, but does not define a module. recorded('$source_file','$source_file'(F, Age, NM), R), - % make sure: it either defines a new module or it was loaded in the same context + % make sure: it either defines a new module or it was loaded in the same context '$file_is_unchanged'(F, R, Age), + !, +% ( F = '/usr/local/share/Yap/rbtrees.yap' ->start_low_level_trace ; true), + recorded('$module','$module'(F,NM,_ASource,_P,_),_) ( M == NM -> true ; recorded('$module','$module'(F,NM,_Source,_P,_),_) ), !. '$file_is_unchanged'(F, R, Age) :- @@ -1042,18 +1045,19 @@ prolog_load_context(stream, Stream) :- ( F == user_input -> working_directory(Dir,Dir) ; file_directory_name(F, Dir) ), nb_setval('$consulting_file', F ), ( - Reconsult0 \== consult, - Reconsult0 \== not_loaded, - Reconsult \== changed, + % if we are reconsulting, always start from scratch + Reconsult0 \== consult, + Reconsult0 \== not_loaded, + Reconsult0 \== changed, recorded('$source_file','$source_file'(F, _,_),R), erase(R), - fail - ; - var(Reconsult0) - -> - Reconsult = consult - ; - Reconsult = Reconsult0 + fail + ; + var(Reconsult0) + -> + Reconsult = consult + ; + Reconsult = Reconsult0 ), ( Reconsult \== consult, diff --git a/pl/debug.yap b/pl/debug.yap index 2a81e000b..056ae8f1a 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -1043,7 +1043,7 @@ be lost. '$unleashed'(exception(_)) :- get_value('$leash',L), L /\ 2'0001 =:= 0. %' '$debugger_write'(Stream, G) :- - recorded('$print_options','$debugger'(OUT),_), !, + current_prolog_flag( debugger_print_options, OUT ), !, write_term(Stream, G, OUT). '$debugger_write'(Stream, G) :- writeq(Stream, G). diff --git a/pl/os.yap b/pl/os.yap index dc2f3c97e..d2d506333 100644 --- a/pl/os.yap +++ b/pl/os.yap @@ -142,9 +142,8 @@ Execute a new shell. */ unix(V) :- var(V), !, '$do_error'(instantiation_error,unix(V)). -unix(argv(L)) :- '$is_list_of_atoms'(L,L), !, '$argv'(L). -unix(argv(V)) :- - '$do_error'(type_error(atomic,V),unix(argv(V))). +unix(argv(L)) :- + prolog_flag(argv, L). unix(cd) :- cd('~'). unix(cd(A)) :- cd(A). unix(environ(X,Y)) :- '$do_environ'(X,Y). diff --git a/pl/preds.yap b/pl/preds.yap index 0172609bd..e92013e0d 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -638,9 +638,9 @@ predicate_erased_statistics(P0,NCls,Sz,ISz) :- Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_. */ current_predicate(A,T0) :- - strip_module(T0, M, T), + '$yap_strip_module'(T0, M, T), ( - '$current_predicate'(A, M, T0, user) + '$current_predicate'(A, M, T, user) ; '$imported_predicate'(T, M, SourceT, SourceMod), functor(T, A, _), @@ -654,7 +654,7 @@ is the atom _A_. */ system_predicate(A,T1) :- - strip_module( T1, M, T), + '$yap_strip_module'( T1, M, T), ( M \= prolog, '$current_predicate'(A, M, T0, system) @@ -685,16 +685,16 @@ system_predicate(P) :- _Na_ is the name of the predicate, and _Ar_ its arity. */ current_predicate(F0) :- - strip_module(F0, M, AN), + '$yap_strip_module'(F0, M, AN), ( AN = A/N -> current_predicate(A, M:S), - functor( S, A, Ar) + functor( S, A, N) ; AN == A//N -> current_predicate(A, M:S), - Ar2 is Ar+2, + Ar2 is N+2, functor( S, A, Ar2) ).