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

Merge branch 'master' of ssh://git.dcc.fc.up.pt/yap-6.3

Browse Source 
Conflicts:
	C/threads.c
	JIT/HPP/EnvironmentInit.h
	packages/ProbLog/simplecudd_lfi/problogbdd_lfi.c
	pl/preds.yap
This commit is contained in:
Vitor Santos Costa
2014-11-25 16:53:35 +00:00
parent 804504201d 1ca062f558
commit afc6c5d04e
29 changed files with 2005 additions and 1513 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
C/absmi.c
View File

@@ -951,7 +951,7 @@ interrupt_execute( USES_REGS1 )
}
if (PP) UNLOCKPE(1,PP);
PP = P->y_u.pp.p0;
if ((PP->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
if ((PP->PredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
return 2;
}
SET_ASP(YENV, E_CB*sizeof(CELL));
@@ -979,7 +979,7 @@ interrupt_call( USES_REGS1 )
if (PP) UNLOCKPE(1,PP);
PP = P->y_u.Osbpp.p0;
if (Yap_only_has_signal(YAP_CREEP_SIGNAL) &&
(PP->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag)) ) {
(PP->PredFlags & (NoTracePredFlag|HiddenPredFlag)) ) {
return 2;
}
SET_ASP(YENV, P->y_u.Osbpp.s);
@@ -1238,7 +1238,7 @@ interrupt_dexecute( USES_REGS1 )
if (PP) UNLOCKPE(1,PP);
PP = P->y_u.pp.p0;
pe = P->y_u.pp.p;
if ((PP->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
if ((PP->PredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
return 2;
}
/* set S for next instructions */
@@ -7830,8 +7830,7 @@ Yap_absmi(int inp)
BOp(call_cpred, Osbpp);
check_trail(TR);
if (!(PREG->y_u.Osbpp.p->PredFlags & (SafePredFlag)) &&
!(PREG->y_u.Osbpp.p0->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag))) {
if (!(PREG->y_u.Osbpp.p->PredFlags & (SafePredFlag|NoTracePredFlag|HiddenPredFlag))) {
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCCall, HR);
ENDCACHE_Y_AS_ENV();

6
C/adtdefs.c
View File

@@ -848,7 +848,7 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
}
}
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
p->ExtraPredFlags |= NoTracePredFlag;
p->PredFlags |= NoTracePredFlag;
}
p->FunctorOfPred = fe;
if (fe->PropsOfFE) {
@@ -937,7 +937,7 @@ Yap_NewThreadPred(PredEntry *ap USES_REGS)
p->FunctorOfPred = ap->FunctorOfPred;
Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_THREAD);
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
p->ExtraPredFlags |= (NoSpyPredFlag|NoTracePredFlag);
p->PredFlags |= (NoSpyPredFlag|NoTracePredFlag);
}
if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), &(p->cs.p_code.ExpandCode)+1, p, GPROF_NEW_PRED_THREAD);
@@ -1008,7 +1008,7 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
p0 = AbsPredProp(p);
p->FunctorOfPred = (Functor)AbsAtom(ae);
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
p->ExtraPredFlags |= (NoTracePredFlag|NoSpyPredFlag);
p->PredFlags |= (NoTracePredFlag|NoSpyPredFlag);
}
WRITE_UNLOCK(ae->ARWLock);
{

16
C/cdmgr.c
View File

@@ -2136,7 +2136,7 @@ Yap_discontiguous( PredEntry *ap USES_REGS )
{
register consult_obj *fp;
if (ap->ExtraPredFlags & (DiscontiguousPredFlag|MultiFileFlag))
if (ap->PredFlags & (DiscontiguousPredFlag|MultiFileFlag))
return FALSE;
if (!LOCAL_ConsultSp) {
return FALSE;
@@ -2339,7 +2339,7 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
PELOCK(20,p);
pflags = p->PredFlags;
/* we are redefining a prolog module predicate */
if (((p->ExtraPredFlags & SysExportPredFlag) == (UInt)0) &&
if (((p->PredFlags & SysExportPredFlag) == (UInt)0) &&
(
(pflags & (UserCPredFlag|CArgsPredFlag|NumberDBPredFlag|AtomDBPredFlag|TestPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)) ||
(p->ModuleOfPred == PROLOG_MODULE &&
@@ -2847,7 +2847,7 @@ p_sys_export( USES_REGS1 )
return (FALSE);
}
PELOCK(100,pred);
pred->ExtraPredFlags |= SysExportPredFlag;
pred->PredFlags |= SysExportPredFlag;
UNLOCKPE(100,pred);
return TRUE;
}
@@ -2868,7 +2868,7 @@ p_is_no_trace( USES_REGS1 )
if (EndOfPAEntr(pe))
return TRUE;
PELOCK(36,pe);
if (pe->ExtraPredFlags & NoTracePredFlag) {
if (pe->PredFlags & NoTracePredFlag) {
UNLOCKPE(57,pe);
return TRUE;
}
@@ -2886,7 +2886,7 @@ p_set_no_trace( USES_REGS1 )
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(36,pe);
pe->ExtraPredFlags |= NoTracePredFlag;
pe->PredFlags |= NoTracePredFlag;
UNLOCKPE(57,pe);
return TRUE;
}
@@ -2904,7 +2904,7 @@ Yap_SetNoTrace(char *name, UInt arity, Term tmod)
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(36,pe);
pe->ExtraPredFlags |= NoTracePredFlag;
pe->PredFlags |= NoTracePredFlag;
UNLOCKPE(57,pe);
return TRUE;
}
@@ -3164,7 +3164,7 @@ p_new_discontiguous( USES_REGS1 )
else
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, arity),mod));
PELOCK(26,pe);
pe->ExtraPredFlags |= DiscontiguousPredFlag;
pe->PredFlags |= DiscontiguousPredFlag;
/* mutifile-predicates are weird, they do not seat really on the default module */
if (pe->ModuleOfPred == PROLOG_MODULE)
pe->ModuleOfPred = TermProlog;
@@ -3183,7 +3183,7 @@ p_is_discontiguous( USES_REGS1 )
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27,pe);
out = (pe->ExtraPredFlags & DiscontiguousPredFlag);
out = (pe->PredFlags & DiscontiguousPredFlag);
UNLOCKPE(44,pe);
return(out);
}

4
C/exec.c
View File

@@ -1991,8 +1991,8 @@ Yap_InitExecFs(void)
#ifdef DEPTH_LIMIT
Yap_InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0);
#endif
Yap_InitCPred("$execute0", 2, p_execute0, 0);
Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop, 0);
Yap_InitCPred("$execute0", 2, p_execute0, NoTracePredFlag);
Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop,NoTracePredFlag );
Yap_InitCPred("$execute_clause", 4, p_execute_clause, 0);
Yap_InitCPred("$current_choice_point", 1, p_save_cp, 0);
Yap_InitCPred("$current_choicepoint", 1, p_save_cp, 0);

268
C/modules.c
View File

@@ -15,7 +15,7 @@
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
static char SccsId[] = "%W% %G%";
#endif
#include "Yap.h"
@@ -23,12 +23,12 @@ static char SccsId[] = "%W% %G%";
#include "YapHeap.h"
#include "pl-shared.h"
static Int p_current_module( USES_REGS1 );
static Int p_current_module1( USES_REGS1 );
static Int p_current_module(USES_REGS1);
static Int p_current_module1(USES_REGS1);
static ModEntry *LookupModule(Term a);
static Term Yap_YapStripModule(Term t, Term *modp);
inline static ModEntry *
FetchModuleEntry(Atom at)
inline static ModEntry *FetchModuleEntry(Atom at)
/* get predicate entry for ap/arity; create it if neccessary. */
{
Prop p0;
@@ -38,8 +38,7 @@ FetchModuleEntry(Atom at)
p0 = ae->PropsOfAE;
while (p0) {
ModEntry *me = RepModProp(p0);
if ( me->KindOfPE == ModProperty
) {
if (me->KindOfPE == ModProperty) {
READ_UNLOCK(ae->ARWLock);
return me;
}
@@ -49,27 +48,24 @@ FetchModuleEntry(Atom at)
return NULL;
}
inline static ModEntry *
GetModuleEntry(Atom at)
inline static ModEntry *GetModuleEntry(Atom at)
/* get predicate entry for ap/arity; create it if neccessary. */
{
Prop p0;
AtomEntry *ae = RepAtom(at);
ModEntry *new;
p0 = ae->PropsOfAE;
while (p0) {
ModEntry *me = RepModProp(p0);
if ( me->KindOfPE == ModProperty
) {
if (me->KindOfPE == ModProperty) {
return me;
}
p0 = me->NextOfPE;
}
{
CACHE_REGS
new = (ModEntry *) Yap_AllocAtomSpace(sizeof(*new));
new = (ModEntry *)Yap_AllocAtomSpace(sizeof(*new));
INIT_RWLOCK(new->ModRWLock);
new->KindOfPE = ModProperty;
new->PredForME = NULL;
@@ -77,7 +73,7 @@ GetModuleEntry(Atom at)
CurrentModules = new;
new->AtomOfME = ae;
if (at == AtomProlog)
new->flags = UNKNOWN_FAIL|M_SYSTEM|M_CHARESCAPE;
new->flags = UNKNOWN_FAIL | M_SYSTEM | M_CHARESCAPE;
else
new->flags = LookupModule(LOCAL_SourceModule)->flags;
AddPropToAtom(ae, (PropEntry *)new);
@@ -85,20 +81,16 @@ GetModuleEntry(Atom at)
return new;
}
unsigned int
getUnknownModule(ModEntry * m) {
if (m && m->flags & UNKNOWN_MASK)
return m->flags & UNKNOWN_MASK;
else {
return GetModuleEntry(AtomUser)->flags & UNKNOWN_MASK;
}
unsigned int getUnknownModule(ModEntry *m) {
if (m && m->flags & UNKNOWN_MASK)
return m->flags & UNKNOWN_MASK;
else {
return GetModuleEntry(AtomUser)->flags & UNKNOWN_MASK;
}
}
#define ByteAdr(X) ((char *) &(X))
Term
Yap_Module_Name(PredEntry *ap)
{
#define ByteAdr(X) ((char *)&(X))
Term Yap_Module_Name(PredEntry *ap) {
CACHE_REGS
Term mod;
if (!ap->ModuleOfPred)
@@ -109,63 +101,53 @@ Yap_Module_Name(PredEntry *ap)
So I will return the current module in case the system
predicate is a meta-call. Otherwise it will still work.
*/
mod = CurrentModule;
mod = CurrentModule;
else {
mod = ap->ModuleOfPred;
}
if (mod) return mod;
if (mod)
return mod;
return TermProlog;
}
static ModEntry *
LookupModule(Term a )
{
static ModEntry *LookupModule(Term a) {
Atom at;
ModEntry *me;
/* prolog module */
if (a == 0) {
return GetModuleEntry(AtomUser);
return GetModuleEntry(AtomProlog);
}
at = AtomOfTerm(a);
me = GetModuleEntry(at);
return me;
}
Term
Yap_Module(Term tmod)
{
Term Yap_Module(Term tmod) {
LookupModule(tmod);
return tmod;
}
ModEntry *
Yap_GetModuleEntry(Term mod)
{
ModEntry *Yap_GetModuleEntry(Term mod) {
ModEntry *me;
if (!(me = LookupModule(mod)))
return NULL;
return me;
}
Term
Yap_GetModuleFromEntry(ModEntry *me)
{
return MkAtomTerm(me->AtomOfME);;
Term Yap_GetModuleFromEntry(ModEntry *me) {
return MkAtomTerm(me->AtomOfME);
;
}
struct pred_entry *
Yap_ModulePred(Term mod)
{
struct pred_entry *Yap_ModulePred(Term mod) {
ModEntry *me;
if (!(me = LookupModule(mod)))
return NULL;
return me->PredForME;
}
void
Yap_NewModulePred(Term mod, struct pred_entry *ap)
{
void Yap_NewModulePred(Term mod, struct pred_entry *ap) {
ModEntry *me;
if (!(me = LookupModule(mod)))
@@ -176,13 +158,12 @@ Yap_NewModulePred(Term mod, struct pred_entry *ap)
WRITE_UNLOCK(me->ModRWLock);
}
static Int
p_current_module( USES_REGS1 )
{ /* $current_module(Old,New) */
Term t;
static Int
p_current_module(USES_REGS1) { /* $current_module(Old,New) */
Term t;
if (CurrentModule) {
if(!Yap_unify_constant(ARG1, CurrentModule))
if (!Yap_unify_constant(ARG1, CurrentModule))
return FALSE;
} else {
if (!Yap_unify_constant(ARG1, TermProlog))
@@ -201,17 +182,14 @@ p_current_module( USES_REGS1 )
return TRUE;
}
static Int
p_current_module1( USES_REGS1 )
{ /* $current_module(Old) */
static Int p_current_module1(USES_REGS1) { /* $current_module(Old)
*/
if (CurrentModule)
return Yap_unify_constant(ARG1, CurrentModule);
return Yap_unify_constant(ARG1, TermProlog);
}
static Int
p_change_module( USES_REGS1 )
{ /* $change_module(New) */
static Int p_change_module(USES_REGS1) { /* $change_module(New) */
Term mod = Deref(ARG1);
LookupModule(mod);
CurrentModule = mod;
@@ -219,57 +197,94 @@ p_change_module( USES_REGS1 )
return TRUE;
}
static Int
cont_current_module( USES_REGS1 )
{
ModEntry *imod = (ModEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(1,1)), *next;
static Int cont_current_module(USES_REGS1) {
ModEntry *imod = AddressOfTerm(EXTRA_CBACK_ARG(1, 1)), *next;
Term t = MkAtomTerm(imod->AtomOfME);
next = imod->NextME;
/* ARG1 is unbound */
Yap_unify(ARG1,t);
Yap_unify(ARG1, t);
if (!next)
cut_succeed();
EXTRA_CBACK_ARG(1,1) = MkIntegerTerm((Int)next);
EXTRA_CBACK_ARG(1, 1) = MkAddressTerm(next);
return TRUE;
}
static Int
init_current_module( USES_REGS1 )
{ /* current_module(?ModuleName) */
static Int init_current_module(
USES_REGS1) { /* current_module(?ModuleName) */
Term t = Deref(ARG1);
if (!IsVarTerm(t)) {
if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM,t,"module name must be an atom");
Yap_Error(TYPE_ERROR_ATOM, t, "module name must be an atom");
return FALSE;
}
if (FetchModuleEntry(AtomOfTerm(t)) != NULL)
cut_succeed();
cut_fail();
}
EXTRA_CBACK_ARG(1,1) = MkIntegerTerm((Int)CurrentModules);
return cont_current_module( PASS_REGS1 );
EXTRA_CBACK_ARG(1, 1) = MkIntegerTerm((Int)CurrentModules);
return cont_current_module(PASS_REGS1);
}
static Int
p_strip_module( USES_REGS1 )
{
static Int cont_ground_module(USES_REGS1) {
ModEntry *imod = AddressOfTerm(EXTRA_CBACK_ARG(3, 1)), *next;
Term t2 = MkAtomTerm(imod->AtomOfME);
next = imod->NextME;
/* ARG2 is unbound */
if (!next)
cut_succeed();
EXTRA_CBACK_ARG(3, 1) = MkAddressTerm(next);
return Yap_unify(ARG2, t2);
}
static Int init_ground_module(USES_REGS1) {
/* current_module(?ModuleName) */
Term t1 = Deref(ARG1), tmod = CurrentModule, t3;
if (tmod == PROLOG_MODULE) {
tmod = TermProlog;
}
t3 = Yap_YapStripModule(t1, &tmod);
if (!t3) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return FALSE;
}
if (!IsVarTerm(tmod)) {
if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, tmod, "module name must be an atom");
cut_fail();
}
if (FetchModuleEntry(AtomOfTerm(tmod)) != NULL && Yap_unify(tmod, ARG2) &&
Yap_unify(t3, ARG3)) {
cut_succeed();
}
cut_fail();
}
if (!Yap_unify(ARG2, tmod) ||
!Yap_unify(ARG3, t3) ) {
cut_fail();
}
// make sure we keep the binding
B->cp_tr = TR;
B->cp_h = HR;
EXTRA_CBACK_ARG(3, 1) = MkAddressTerm(CurrentModules);
return cont_ground_module(PASS_REGS1);
}
static Int p_strip_module(USES_REGS1) {
Term t1 = Deref(ARG1), tmod = CurrentModule;
if (tmod == PROLOG_MODULE) {
tmod = TermProlog;
}
t1 = Yap_StripModule( t1, &tmod );
t1 = Yap_StripModule(t1, &tmod);
if (!t1) {
Yap_Error(TYPE_ERROR_CALLABLE,t1,"trying to obtain module");
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return FALSE;
}
return Yap_unify(ARG3, t1) &&
Yap_unify(ARG2, tmod);
return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod);
}
static Term
Yap_YapStripModule(Term t, Term *modp)
{
static Term Yap_YapStripModule(Term t, Term *modp) {
CACHE_REGS
Term tmod;
@@ -281,18 +296,18 @@ Yap_YapStripModule(Term t, Term *modp)
tmod = TermProlog;
}
}
restart:
restart:
if (IsVarTerm(t) || !IsApplTerm(t)) {
if (modp)
*modp = tmod;
return t;
} else {
Functor fun = FunctorOfTerm(t);
Functor fun = FunctorOfTerm(t);
if (fun == FunctorModule) {
Term t1 = ArgOfTerm(1, t);
Term t1 = ArgOfTerm(1, t);
tmod = t1;
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod) ) {
return 0L;
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod)) {
return 0L;
}
t = ArgOfTerm(2, t);
goto restart;
@@ -304,50 +319,38 @@ Yap_YapStripModule(Term t, Term *modp)
return 0L;
}
static Int
p_yap_strip_module( USES_REGS1 )
{
static Int p_yap_strip_module(USES_REGS1) {
Term t1 = Deref(ARG1), tmod = CurrentModule;
if (tmod == PROLOG_MODULE) {
tmod = TermProlog;
}
t1 = Yap_YapStripModule( t1, &tmod );
t1 = Yap_YapStripModule(t1, &tmod);
if (!t1) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return FALSE;
}
return Yap_unify(ARG3, t1) &&
Yap_unify(ARG2, tmod);
return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod);
}
static Int
p_context_module( USES_REGS1 )
{
static Int p_context_module(USES_REGS1) {
yamop *parentcp = P;
CELL *yenv;
PredEntry *ap = EnvPreg(parentcp);
if (ap->ModuleOfPred &&
!(ap->PredFlags & MetaPredFlag))
if (ap->ModuleOfPred && !(ap->PredFlags & MetaPredFlag))
return Yap_unify(ARG1, ap->ModuleOfPred);
parentcp = CP;
yenv = ENV;
do {
ap = EnvPreg(parentcp);
if (ap->ModuleOfPred &&
!(ap->PredFlags & MetaPredFlag))
if (ap->ModuleOfPred && !(ap->PredFlags & MetaPredFlag))
return Yap_unify(ARG1, ap->ModuleOfPred);
parentcp = (yamop *)yenv[E_CP];
yenv = (CELL *)yenv[E_E];
} while(yenv);
} while (yenv);
return Yap_unify(ARG1, CurrentModule);
}
Term
Yap_StripModule(Term t, Term *modp)
{
Term Yap_StripModule(Term t, Term *modp) {
CACHE_REGS
Term tmod;
@@ -359,22 +362,22 @@ Yap_StripModule(Term t, Term *modp)
tmod = TermProlog;
}
}
restart:
restart:
if (IsVarTerm(t) || !IsApplTerm(t)) {
if (modp)
*modp = tmod;
return t;
} else {
Functor fun = FunctorOfTerm(t);
Functor fun = FunctorOfTerm(t);
if (fun == FunctorModule) {
Term t1 = ArgOfTerm(1, t);
if (IsVarTerm( t1 ) ) {
*modp = tmod;
return t;
Term t1 = ArgOfTerm(1, t);
if (IsVarTerm(t1)) {
*modp = tmod;
return t;
}
tmod = t1;
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod) ) {
return 0L;
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod)) {
return 0L;
}
t = ArgOfTerm(2, t);
goto restart;
@@ -386,28 +389,29 @@ Yap_StripModule(Term t, Term *modp)
return 0L;
}
void
Yap_InitModulesC(void)
{
Yap_InitCPred("$current_module", 2, p_current_module, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag);
Yap_InitCPred("strip_module", 3, p_strip_module, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$yap_strip_module", 3, p_yap_strip_module, SafePredFlag|SyncPredFlag);
void Yap_InitModulesC(void) {
Yap_InitCPred("$current_module", 2, p_current_module,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$current_module", 1, p_current_module1,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$change_module", 1, p_change_module,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("strip_module", 3, p_strip_module, SafePredFlag | SyncPredFlag);
Yap_InitCPred("$yap_strip_module", 3, p_yap_strip_module,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("context_module", 1, p_context_module, 0);
Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module, cont_current_module,
SafePredFlag|SyncPredFlag);
Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module,
cont_current_module, SafePredFlag | SyncPredFlag);
Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module,
cont_current_module, SafePredFlag | SyncPredFlag);
Yap_InitCPredBack("$ground_module", 3, 1, init_ground_module,
cont_ground_module, SafePredFlag | SyncPredFlag);
}
void
Yap_InitModules(void)
{
void Yap_InitModules(void) {
CACHE_REGS
LookupModule(MkAtomTerm(AtomProlog));
LOCAL_SourceModule = MkAtomTerm(AtomProlog);
LOCAL_SourceModule = MkAtomTerm(AtomProlog);
LookupModule(USER_MODULE);
LookupModule(IDB_MODULE);
LookupModule(ATTRIBUTES_MODULE);

1696
C/stdpreds.c
View File

File diff suppressed because it is too large Load Diff

9
C/sysbits.c
View File

@@ -205,7 +205,7 @@ Yap_dir_separator (int ch)
return dir_separator (ch);
}
#if _MSC_VER || defined(__MINGW32__)
#if __WINDOWS__
#include <psapi.h>
char *libdir = NULL;
@@ -217,9 +217,8 @@ initSysPath(Term tlib, Term tcommons) {
int len;
int dir_done = FALSE;
int commons_done = FALSE;
Int rcl, rcc;
#if _MSC_VER || defined(__MINGW32__) || defined(__MSYS__)
#if __WINDOWS__
{
char *dir;
if ((dir = Yap_RegistryGetString("library")) &&
@@ -236,7 +235,7 @@ initSysPath(Term tlib, Term tcommons) {
}
}
if (dir_done && commons_done)
return rcl && rcc;
return TRUE;
#endif
strncpy(LOCAL_FileNameBuf, YAP_SHAREDIR, YAP_FILENAME_MAX);
strncat(LOCAL_FileNameBuf,"/", YAP_FILENAME_MAX);
@@ -260,7 +259,7 @@ initSysPath(Term tlib, Term tcommons) {
}
}
if (dir_done && commons_done)
return rcl && rcc;
return TRUE;
#if __WINDOWS__
{

405
C/threads.c
View File

@@ -356,6 +356,8 @@ kill_thread_engine (int wid, int always_die)
}
if (REMOTE_ScratchPad(wid).ptr)
free(REMOTE_ScratchPad(wid).ptr);
// if (REMOTE_TmpPred(wid).ptr)
// free(REMOTE_TmpPred(wid).ptr);
REMOTE_PL_local_data_p(wid)->reg_cache =
REMOTE_ThreadHandle(wid).current_yaam_regs = NULL;
if (REMOTE_ThreadHandle(wid).start_of_timesp)
@@ -878,6 +880,18 @@ typedef struct swi_mutex {
pthread_mutex_t m;
} SWIMutex;
static SWIMutex *MutexOfTerm(Term t)
{
Term t1 = Deref(t);
SWIMutex *mut = NULL;
if (IsVarTerm(t1)) {
} else if (IsAtomTerm(t1)) {
} else {
mut = AddressOfTerm(t1);
}
return mut;
}
static Int
p_new_mutex( USES_REGS1 )
{
@@ -1111,7 +1125,245 @@ p_mbox_create( USES_REGS1 )
mboxp = mboxp->next;
if (mboxp) {
UNLOCK(GLOBAL_mboxq_lock);
return FALSE;
=======
return Yap_unify(ARG1, MkAddressTerm(mutp));
}
static Int
p_destroy_mutex( USES_REGS1 )
{
Term t1 = Deref(ARG1);
SWIMutex *mut;
if (IsVarTerm(t1)) {
} else if (IsAtomTerm(t1)) {
} else {
mut = AddressOfTerm(Deref(ARG1));
if (pthread_mutex_destroy(&mut->m) < 0)
return FALSE;
Yap_FreeCodeSpace((void *)mut);
}
return TRUE;
}
static Int
p_lock_mutex( USES_REGS1 )
{
SWIMutex *mut = MutexOfTerm( ARG1 );
#if DEBUG_LOCKS
MUTEX_LOCK(&mut->m);
#else
if (MUTEX_LOCK(&mut->m) < 0)
return FALSE;
#endif
mut->owners++;
mut->tid_own = worker_id;
return TRUE;
}
static Int
p_trylock_mutex( USES_REGS1 )
{
SWIMutex *mut = MutexOfTerm( ARG1 );
if (MUTEX_TRYLOCK(&mut->m) == EBUSY)
return FALSE;
mut->owners++;
mut->tid_own = worker_id;
return TRUE;
}
static Int
p_unlock_mutex( USES_REGS1 )
{
SWIMutex *mut = MutexOfTerm( ARG1 );
#if DEBUG_LOCKS
MUTEX_UNLOCK(&mut->m);
#else
if (MUTEX_UNLOCK(&mut->m) < 0)
return FALSE;
#endif
mut->owners--;
return TRUE;
}
static Int
p_with_mutex( USES_REGS1 )
{
SWIMutex *mut;
Term t1 = Deref(ARG1), excep;
Int rc = FALSE;
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
PredEntry *pe;
Term tm = CurrentModule;
Term tg = Deref(ARG2);
if (IsVarTerm(t1)) {
p_new_mutex( PASS_REGS1 );
t1 = Deref(ARG1);
}
if (IsAtomTerm(t1)) {
} else {
mut = AddressOfTerm(Deref(ARG1));
if (FALSE && !p_lock_mutex( PASS_REGS1 )) {
return FALSE;
}
}
tg = Yap_StripModule(tg, &tm);
if (IsVarTerm(tg)) {
Yap_Error(INSTANTIATION_ERROR, ARG2, "with_mutex/2");
goto end;
} else if (IsApplTerm(tg)) {
register Functor f = FunctorOfTerm(tg);
register CELL *pt;
size_t i, arity;
f = FunctorOfTerm(tg);
if (IsExtensionFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, tg, "with_mutex/2");
goto end;
}
arity = ArityOfFunctor(f);
if (arity > MaxTemps) {
Yap_Error(TYPE_ERROR_CALLABLE, tg, "with_mutex/2");
goto end;
}
pe = RepPredProp(PredPropByFunc(f, tm));
pt = RepAppl(tg)+1;
for (i= 0; i < arity; i++ )
XREGS[i+1] = pt[i];
} else if (IsAtomTerm(tg)) {
pe = RepPredProp(PredPropByAtom(AtomOfTerm(tg), tm));
} else if (IsPairTerm(tg)) {
register CELL *pt;
Functor f;
f = FunctorDot;
pe = RepPredProp(PredPropByFunc(f, tm));
pt = RepPair(tg);
XREGS[1] = pt[0];
XREGS[2] = pt[1];
} else {
Yap_Error(TYPE_ERROR_CALLABLE, tg, "with_mutex/2");
goto end;
}
if (
pe->OpcodeOfPred != FAIL_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS) ) {
rc = TRUE;
}
end:
ARG1 = MkIntegerTerm((Int)mut);
excep = Yap_GetException();
if (FALSE) p_unlock_mutex( PASS_REGS1 );
if (creeping) {
Yap_signal( YAP_CREEP_SIGNAL );
} else if ( excep != 0) {
return Yap_JumpToEnv(excep);
}
return rc;
}
static Int
p_with_with_mutex( USES_REGS1 )
{
if (GLOBAL_WithMutex == NULL) {
p_new_mutex( PASS_REGS1 );
GLOBAL_WithMutex = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
} else {
ARG1 = MkIntegerTerm((Int)GLOBAL_WithMutex);
}
return p_lock_mutex( PASS_REGS1 );
}
static Int
p_unlock_with_mutex( USES_REGS1 )
{
ARG1 = MkIntegerTerm((Int)GLOBAL_WithMutex);
return p_unlock_mutex( PASS_REGS1 );
}
static Int
p_mutex_info( USES_REGS1 )
{
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
return Yap_unify(ARG2, MkIntegerTerm(mut->owners)) &&
Yap_unify(ARG3, MkIntegerTerm(mut->tid_own));
return TRUE;
}
static Int
p_cond_create( USES_REGS1 )
{
pthread_cond_t* condp;
condp = (pthread_cond_t *)Yap_AllocCodeSpace(sizeof(pthread_cond_t));
if (condp == NULL) {
return FALSE;
}
pthread_cond_init(condp, NULL);
return Yap_unify(ARG1, MkIntegerTerm((Int)condp));
}
typedef struct {
UInt indx;
mbox_t mbox;
} counted_mbox;
static Int
p_mbox_create( USES_REGS1 )
{
Term namet = Deref(ARG1);
mbox_t* mboxp = GLOBAL_named_mboxes;
if (IsVarTerm(namet)) {
AtomEntry *ae;
int new;
mbox_t mbox;
ae = Yap_lookupBlob(&mbox, sizeof(mbox), &PL_Message_Queue, &new);
namet = MkAtomTerm(RepAtom(ae));
mboxp = (mbox_t *)(ae->rep.blob[0].data);
Yap_unify(ARG1, namet);
LOCK(GLOBAL_mboxq_lock);
} else if (IsAtomTerm(namet)) {
LOCK(GLOBAL_mboxq_lock);
while( mboxp && mboxp->name != namet)
mboxp = mboxp->next;
if (mboxp) {
UNLOCK(GLOBAL_mboxq_lock);
return FALSE;
}
mboxp = (mbox_t *)Yap_AllocCodeSpace(sizeof(mbox_t));
if (mboxp == NULL) {
UNLOCK(GLOBAL_mboxq_lock);
return FALSE;
}
// global mbox, for now we'll just insert in list
mboxp->next = GLOBAL_named_mboxes;
GLOBAL_named_mboxes = mboxp;
}
bool rc = mboxCreate( namet, mboxp PASS_REGS );
UNLOCK(GLOBAL_mboxq_lock);
return rc;
}
static Int
p_mbox_destroy( USES_REGS1 )
{
Term namet = Deref(ARG1);
mbox_t* mboxp = GLOBAL_named_mboxes, *prevp;
if (IsVarTerm(namet) )
return FALSE;
}
mboxp = (mbox_t *)Yap_AllocCodeSpace(sizeof(mbox_t));
if (mboxp == NULL) {
@@ -1156,7 +1408,156 @@ p_mbox_destroy( USES_REGS1 )
UNLOCK(GLOBAL_mboxq_lock);
mboxDestroy(mboxp PASS_REGS);
Yap_FreeCodeSpace( (char *)mboxp );
return TRUE;
=======
}
LOCK(GLOBAL_mboxq_lock);
prevp = NULL;
while( mboxp && mboxp->name != namet) {
prevp = mboxp;
mboxp = mboxp->next;
}
if (!mboxp) {
UNLOCK(GLOBAL_mboxq_lock);
return FALSE;
}
if (mboxp == GLOBAL_named_mboxes) {
GLOBAL_named_mboxes = mboxp->next;
} else {
prevp->next = mboxp->next;
}
UNLOCK(GLOBAL_mboxq_lock);
mboxDestroy(mboxp PASS_REGS);
Yap_FreeCodeSpace( (char *)mboxp );
return TRUE;
}
static mbox_t*
getMbox(Term t)
{
mbox_t* mboxp;
if (IsAtomTerm(t=Deref(t))) {
Atom at = AtomOfTerm(t);
LOCK(GLOBAL_mboxq_lock);
if (IsBlob(at)) {
mboxp = (mbox_t *)(RepAtom(at)->rep.blob[0].data);
} else {
mboxp = GLOBAL_named_mboxes;
while( mboxp && mboxp->name != t) {
mboxp = mboxp->next;
}
}
if (!mboxp->open)
mboxp = NULL;
if (mboxp) {
pthread_mutex_lock(& mboxp->mutex);
}
UNLOCK(GLOBAL_mboxq_lock);
} else if (IsIntTerm(t)) {
int wid = IntOfTerm(t);
if (REMOTE(wid) &&
(REMOTE_ThreadHandle(wid).in_use || REMOTE_ThreadHandle(wid).zombie))
{
return &REMOTE_ThreadHandle(wid).mbox_handle;
} else {
return NULL;
}
if (!mboxp->open)
mboxp = NULL;
if (mboxp) {
pthread_mutex_lock(& mboxp->mutex);
}
} else {
return NULL;
}
return mboxp;
}
static Int
p_mbox_send( USES_REGS1 )
{
Term namet = Deref(ARG1);
mbox_t* mboxp = getMbox(namet) ;
if (!mboxp)
return FALSE;
return mboxSend(mboxp, Deref(ARG2) PASS_REGS);
}
static Int
p_mbox_size( USES_REGS1 )
{
Term namet = Deref(ARG1);
mbox_t* mboxp = getMbox(namet) ;
if (!mboxp)
return FALSE;
return Yap_unify( ARG2, MkIntTerm(mboxp->nmsgs));
}
static Int
p_mbox_receive( USES_REGS1 )
{
Term namet = Deref(ARG1);
mbox_t* mboxp = getMbox(namet) ;
if (!mboxp)
return FALSE;
return mboxReceive(mboxp, Deref(ARG2) PASS_REGS);
}
static Int
p_mbox_peek( USES_REGS1 )
{
Term namet = Deref(ARG1);
mbox_t* mboxp = getMbox(namet) ;
if (!mboxp)
return FALSE;
return mboxPeek(mboxp, Deref(ARG2) PASS_REGS);
}
static Int
p_cond_destroy( USES_REGS1 )
{
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
if (pthread_cond_destroy(condp) < 0)
return FALSE;
Yap_FreeCodeSpace((void *)condp);
return TRUE;
}
static Int
p_cond_signal( USES_REGS1 )
{
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
if (pthread_cond_signal(condp) < 0)
return FALSE;
return TRUE;
}
static Int
p_cond_broadcast( USES_REGS1 )
{
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
if (pthread_cond_broadcast(condp) < 0)
return FALSE;
return TRUE;
}
static Int
p_cond_wait( USES_REGS1 )
{
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG2));
pthread_cond_wait(condp, &mut->m);
return TRUE;
}
static mbox_t*