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

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

Browse Source
This commit is contained in:
Fabrizio Riguzzi 2014-10-16 10:20:34 +02:00
commit 7227bc62f4
23 changed files with 334 additions and 150 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
C/arith1.c
View File

@ -957,18 +957,29 @@ p_unary_is( USES_REGS1 )
Term t = Deref(ARG2);
Term top;
LOCAL_mathn = 1;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG2, "X is Y");
return FALSE;
}
Yap_ClearExs();
top = Yap_Eval(Deref(ARG3));
if (!Yap_FoundArithError(top, ARG3)) {
return FALSE;
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = top;
return TRUE;
}
if (IsIntTerm(t)) {
Term tout = Yap_FoundArithError(eval1(IntegerOfTerm(t), top PASS_REGS), Deref(ARG3));
if (!tout)
return FALSE;
Term tout;
Int i;
LOCAL_mathop = i = IntegerOfTerm(t);
tout = eval1(i, top PASS_REGS);
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = top;
LOCAL_mathop = i;
LOCAL_mathn = 1;
return TRUE;
}
return Yap_unify_constant(ARG1,tout);
}
if (IsAtomTerm(t)) {
@ -989,8 +1000,14 @@ p_unary_is( USES_REGS1 )
P = FAILCODE;
return(FALSE);
}
if (!(out=Yap_FoundArithError(eval1(p->FOfEE, top PASS_REGS),Deref(ARG3))))
LOCAL_mathop = p->FOfEE;
out= eval1(p->FOfEE, top PASS_REGS);
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = top;
LOCAL_mathop = p->FOfEE;
LOCAL_mathn = 1;
return FALSE;
}
return Yap_unify_constant(ARG1,out);
}
return(FALSE);
@ -1020,6 +1037,12 @@ p_unary_op_as_integer( USES_REGS1 )
return(FALSE);
}
Atom
Yap_NameOfUnaryOp(int i)
{
return Yap_LookupAtom(InitUnTab[i].OpName);
}
void
Yap_InitUnaryExps(void)
{

48
C/arith2.c
View File

@ -1151,18 +1151,27 @@ p_binary_is( USES_REGS1 )
Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
Yap_ClearExs();
t1 = Yap_Eval(Deref(ARG3));
if (!Yap_FoundArithError(t1, ARG3)) {
return FALSE;
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = t1;
return FALSE;
}
LOCAL_mathtt[0] = t1;
t2 = Yap_Eval(Deref(ARG4));
if (!Yap_FoundArithError(t2, ARG4)) {
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = t2;
return FALSE;
}
if (IsIntTerm(t)) {
Term tout = Yap_FoundArithError(eval2(IntOfTerm(t), t1, t2 PASS_REGS), 0L);
if (!tout)
return FALSE;
Term tout = eval2(IntOfTerm(t), t1, t2 PASS_REGS);
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = t1;
LOCAL_mathtt[1] = t2;
LOCAL_mathn = 2;
LOCAL_mathop = IntOfTerm(t);
return FALSE;
}
return Yap_unify_constant(ARG1,tout);
}
if (IsAtomTerm(t)) {
@ -1183,13 +1192,21 @@ p_binary_is( USES_REGS1 )
P = FAILCODE;
return(FALSE);
}
if (!(out=Yap_FoundArithError(eval2(p->FOfEE, t1, t2 PASS_REGS), 0L)))
out= eval2(p->FOfEE, t1, t2 PASS_REGS);
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = t1;
LOCAL_mathtt[1] = t2;
LOCAL_mathn = 2;
LOCAL_mathop = IntOfTerm(t);
return FALSE;
}
return Yap_unify_constant(ARG1,out);
}
return FALSE;
}
static Int
do_arith23(arith2_op op USES_REGS)
{ /* X is Y */
@ -1197,6 +1214,7 @@ do_arith23(arith2_op op USES_REGS)
Int out;
Term t1, t2;
Yap_ClearExs();
if (IsVarTerm(t)) {
Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
@ -1207,8 +1225,14 @@ do_arith23(arith2_op op USES_REGS)
t2 = Yap_Eval(Deref(ARG2));
if (t2 == 0L)
return FALSE;
if (!(out=Yap_FoundArithError(eval2(op, t1, t2 PASS_REGS), 0L)))
return FALSE;
out= eval2(op, t1, t2 PASS_REGS);
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = t1;
LOCAL_mathtt[1] = t2;
LOCAL_mathn = 2;
LOCAL_mathop = op;
return FALSE;
}
return Yap_unify_constant(ARG3,out);
}
@ -1284,6 +1308,12 @@ p_binary_op_as_integer( USES_REGS1 )
return(FALSE);
}
Atom
Yap_NameOfBinaryOp(int i)
{
return Yap_LookupAtom(InitBinTab[i].OpName);
}
void
Yap_InitBinaryExps(void)

60
C/eval.c
View File

@ -171,45 +171,11 @@ Eval(Term t USES_REGS)
}
}
#if HAVE_FENV_H
Term
Yap_InnerEval__(Term t USES_REGS)
{
#pragma STDC FENV_ACCESS ON
int raised;
Term ret;
feclearexcept(FE_ALL_EXCEPT);
ret = Eval(t PASS_REGS);
if ( ret && (raised = fetestexcept( FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW)) ) {
feclearexcept(FE_ALL_EXCEPT);
if (raised & FE_OVERFLOW) {
LOCAL_Error_TYPE = EVALUATION_ERROR_FLOAT_OVERFLOW;
} else if (raised & (FE_INVALID|FE_INEXACT)) {
LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
} else if (raised & FE_DIVBYZERO) {
LOCAL_Error_TYPE = EVALUATION_ERROR_ZERO_DIVISOR;
} else if (raised & FE_UNDERFLOW) {
LOCAL_Error_TYPE = EVALUATION_ERROR_FLOAT_UNDERFLOW;
} else {
LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
}
LOCAL_Error_Term = t;
LOCAL_ErrorMessage="Arithmetic Exception";
return 0L;
}
return ret;
}
#else
Term
Yap_InnerEval__(Term t USES_REGS)
{
CACHE_REGS
return Eval(t PASS_REGS);
}
#endif
#ifdef BEAM
Int BEAM_is(void);
@ -248,18 +214,26 @@ static Int
p_is( USES_REGS1 )
{ /* X is Y */
Term out = 0L;
Yap_ClearExs();
while (!(out = Yap_InnerEval(Deref(ARG2)))) {
if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, CP)) {
Yap_Error(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
return FALSE;
if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, CP)) {
Yap_Error(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
return FALSE;
}
} else {
LOCAL_mathtt[0] = Deref(ARG2);
LOCAL_mathop = 0;
LOCAL_mathn = 0;
return FALSE;
}
} else {
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
Yap_Error(LOCAL_Error_TYPE, LOCAL_mathtt[0], LOCAL_ErrorMessage);
return FALSE;
}
}
if (Yap_FoundArithError()) {
return TRUE;
}
return Yap_unify_constant(ARG1,out);
}

5
C/signals.c
View File

@ -405,6 +405,11 @@ p_first_signal( USES_REGS1 )
case YAP_USR2_SIGNAL:
at = AtomSigUsr2;
break;
#endif
#ifdef SIGFPE
case YAP_FPE_SIGNAL:
at = AtomSigFPE;
break;
#endif
default:
return FALSE;

127
C/sysbits.c
View File

@ -1416,88 +1416,104 @@ HandleSIGSEGV(int sig, void *sipv, void *uap)
}
#endif /* SIGSEGV */
#if HAVE_SIGFPE
static void
HandleMatherr(int sig, void *sipv, void *uapv)
yap_error_number
Yap_MathException__( USES_REGS1 )
{
CACHE_REGS
int raised;
/* reset the registers so that we don't have trash in abstract machine */
#if HAVE_FETESTEXCEPT
int raised = fetestexcept(FE_ALL_EXCEPT);
#pragma STDC FENV_ACCESS ON
if ((raised = fetestexcept( FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW)) ) {
if (raised & FE_OVERFLOW) {
LOCAL_matherror = EVALUATION_ERROR_FLOAT_OVERFLOW;
} else if (raised & (FE_INVALID|FE_INEXACT)) {
LOCAL_matherror = EVALUATION_ERROR_UNDEFINED;
} else if (raised & FE_DIVBYZERO) {
LOCAL_matherror = EVALUATION_ERROR_ZERO_DIVISOR;
} else if (raised & FE_UNDERFLOW) {
LOCAL_matherror = EVALUATION_ERROR_FLOAT_UNDERFLOW;
} else
LOCAL_matherror = EVALUATION_ERROR_UNDEFINED;
if (!feclearexcept(FE_ALL_EXCEPT))
return;
Yap_Error(LOCAL_matherror , TermNil, "Arithmetic Exception");
feclearexcept(FE_ALL_EXCEPT);
if (raised & FE_OVERFLOW) {
LOCAL_matherror = EVALUATION_ERROR_FLOAT_OVERFLOW;
} else if (raised & (FE_INVALID|FE_INEXACT)) {
LOCAL_matherror = EVALUATION_ERROR_UNDEFINED;
} else if (raised & FE_DIVBYZERO) {
LOCAL_matherror = EVALUATION_ERROR_ZERO_DIVISOR;
} else if (raised & FE_UNDERFLOW) {
LOCAL_matherror = EVALUATION_ERROR_FLOAT_UNDERFLOW;
} else {
LOCAL_matherror = EVALUATION_ERROR_UNDEFINED;
}
}
#elif (defined(__svr4__) || defined(__SVR4))
switch(sip->si_code) {
case FPE_INTDIV:
error_no = EVALUATION_ERROR_ZERO_DIVISOR;
LOCAL_matherror = EVALUATION_ERROR_ZERO_DIVISOR;
break;
case FPE_INTOVF:
error_no = EVALUATION_ERROR_INT_OVERFLOW;
LOCAL_matherror = EVALUATION_ERROR_INT_OVERFLOW;
break;
case FPE_FLTDIV:
error_no = EVALUATION_ERROR_ZERO_DIVISOR;
LOCAL_matherror = EVALUATION_ERROR_ZERO_DIVISOR;
break;
case FPE_FLTOVF:
error_no = EVALUATION_ERROR_FLOAT_OVERFLOW;
LOCAL_matherror = EVALUATION_ERROR_FLOAT_OVERFLOW;
break;
case FPE_FLTUND:
error_no = EVALUATION_ERROR_FLOAT_UNDERFLOW;
LOCAL_matherror = EVALUATION_ERROR_FLOAT_UNDERFLOW;
break;
case FPE_FLTRES:
case FPE_FLTINV:
case FPE_FLTSUB:
default:
error_no = EVALUATION_ERROR_UNDEFINED;
LOCAL_matherror = EVALUATION_ERROR_UNDEFINED;
}
set_fpu_exceptions(0);
Yap_Error(error_no, TermNil, "");
#elif __linux__
#if HAVE_FETESTEXCEPT
/* This should work in Linux, but it doesn't seem to. */
int raised = fetestexcept(FE_ALL_EXCEPT);
if (raised & FE_OVERFLOW) {
LOCAL_matherror = EVALUATION_ERROR_FLOAT_OVERFLOW;
} else if (raised & (FE_INVALID|FE_INEXACT)) {
LOCAL_matherror = EVALUATION_ERROR_UNDEFINED;
} else if (raised & FE_DIVBYZERO) {
LOCAL_matherror = EVALUATION_ERROR_ZERO_DIVISOR;
} else if (raised & FE_UNDERFLOW) {
LOCAL_matherror = EVALUATION_ERROR_FLOAT_UNDERFLOW;
} else
#endif
LOCAL_matherror = EVALUATION_ERROR_UNDEFINED;
/* something very bad happened on the way to the forum */
set_fpu_exceptions(FALSE);
Yap_Error(LOCAL_matherror , TermNil, "");
#endif
return LOCAL_matherror;
}
static Int
p_fpe_error( USES_REGS1 )
{
if (LOCAL_mathn == 0) {
Yap_Error(LOCAL_matherror, LOCAL_mathtt[0], "arithmetic");
} else if (LOCAL_mathn == 1) {
Term t;
Functor f;
f = Yap_MkFunctor( Yap_NameOfUnaryOp(LOCAL_mathop), 1);
t = Yap_MkApplTerm(f, 1, LOCAL_mathtt);
Yap_Error(LOCAL_matherror, t, "arithmetic");
} else if (LOCAL_mathn == 2) {
Term t;
Functor f;
f = Yap_MkFunctor( Yap_NameOfBinaryOp(LOCAL_mathop), 2);
t = Yap_MkApplTerm(f, 2, LOCAL_mathtt);
Yap_Error(LOCAL_matherror, t, "arithmetic");
}
LOCAL_matherror = YAP_NO_ERROR;
return FALSE;
}
#if HAVE_SIGFPE
static void
HandleMatherr(int sig, void *sipv, void *uapv)
{
CACHE_REGS
LOCAL_matherror = Yap_MathException( );
/* reset the registers so that we don't have trash in abstract machine */
Yap_external_signal( worker_id, YAP_FPE_SIGNAL );
}
#endif /* SIGFPE */
typedef void (*signal_handler_t)(int, void *, void *);
#if HAVE_SIGACTION
static void
my_signal_info(int sig, void (*handler)(int, void *, void *))
my_signal_info(int sig, void * handler)
{
struct sigaction sigact;
sigact.sa_handler = (void *)handler;
sigact.sa_handler = handler;
sigemptyset(&sigact.sa_mask);
sigact.sa_flags = SA_SIGINFO;
@ -1505,7 +1521,7 @@ my_signal_info(int sig, void (*handler)(int, void *, void *))
}
static void
my_signal(int sig, void (*handler)(int, void *, void *))
my_signal(int sig, void * handler)
{
struct sigaction sigact;
@ -1518,13 +1534,13 @@ my_signal(int sig, void (*handler)(int, void *, void *))
#else
static void
my_signal(int sig, void (*handler)(int, void *, void *))
my_signal(int sig, void *handler)
{
signal(sig, (void *)handler);
signal(sig, void *handler);
}
static void
my_signal_info(int sig, void (*handler)(int, void *, void *))
my_signal_info(int sig, void *handler)
{
if(signal(sig, (void *)handler) == SIG_ERR)
exit(1);
@ -1554,9 +1570,7 @@ ReceiveSignal (int s, void *x, void *y)
#ifndef MPW
#ifdef HAVE_SIGFPE
case SIGFPE:
set_fpu_exceptions(FALSE);
LOCAL_PrologMode &= ~InterruptMode;
Yap_Error (SYSTEM_ERROR, TermNil, "floating point exception ]");
Yap_external_signal( worker_id, YAP_FPE_SIGNAL );
break;
#endif
#endif
@ -3018,6 +3032,7 @@ Yap_InitSysPreds(void)
Yap_InitCPred ("$ld_path", 1, p_ld_path, SafePredFlag);
Yap_InitCPred ("$address_bits", 1, p_address_bits, SafePredFlag);
Yap_InitCPred ("$expand_file_name", 2, p_expand_file_name, SyncPredFlag);
Yap_InitCPred ("$fpe_error", 0, p_fpe_error, 0);
#ifdef _WIN32
Yap_InitCPred ("win_registry_get_value", 3, p_win_registry_get_value,0);
#endif

10
C/threads.c
View File

@ -339,6 +339,12 @@ kill_thread_engine (int wid, int always_die)
}
Yap_KillStacks(wid);
REMOTE_Signals(wid) = 0L;
// must be done before relessing the memory used to store
// thread local time.
if (!always_die) {
/* called by thread itself */
GLOBAL_ThreadsTotalTime += Yap_cputime();
}
if (REMOTE_ScratchPad(wid).ptr)
free(REMOTE_ScratchPad(wid).ptr);
REMOTE_PL_local_data_p(wid)->reg_cache =
@ -355,10 +361,6 @@ kill_thread_engine (int wid, int always_die)
REMOTE_ThreadHandle(wid).default_yaam_regs = NULL;
LOCK(GLOBAL_ThreadHandlesLock);
GLOBAL_NOfThreads--;
if (!always_die) {
/* called by thread itself */
GLOBAL_ThreadsTotalTime += Yap_cputime();
}
MUTEX_LOCK(&(REMOTE_ThreadHandle(wid).tlock));
if (REMOTE_ThreadHandle(wid).tdetach == MkAtomTerm(AtomTrue) ||
always_die) {

3
H/YapSignals.h
View File

@ -44,6 +44,9 @@ typedef enum
#endif
#ifdef SIGVTALRM
YAP_VTALARM_SIGNAL = SIGVTALRM, /* received SIGVTALARM */
#endif
#ifdef SIGFPE
YAP_FPE_SIGNAL = SIGFPE, /* received SIGFPE */
#endif
YAP_WAKEUP_SIGNAL = (NSIG+1), /* goals to wake up */
YAP_ITI_SIGNAL = (NSIG+2), /* received inter thread signal */

6
H/dlocals.h
View File

@ -306,6 +306,12 @@
#define LOCAL_matherror LOCAL->matherror_
#define REMOTE_matherror(wid) REMOTE(wid)->matherror_
#define LOCAL_mathtt LOCAL->mathtt_
#define REMOTE_mathtt(wid) REMOTE(wid)->mathtt_
#define LOCAL_mathn LOCAL->mathn_
#define REMOTE_mathn(wid) REMOTE(wid)->mathn_
#define LOCAL_mathop LOCAL->mathop_
#define REMOTE_mathop(wid) REMOTE(wid)->mathop_
#define LOCAL_CurrentError LOCAL->CurrentError_
#define REMOTE_CurrentError(wid) REMOTE(wid)->CurrentError_

38
H/eval.h
View File

@ -117,6 +117,9 @@ exceptions:
#ifdef HAVE_LIMITS_H
#include <limits.h>
#endif
#ifdef HAVE_FENV_H
#include <fenv.h>
#endif
#ifdef LONG_MAX
#define Int_MAX LONG_MAX
@ -313,6 +316,8 @@ typedef enum {
op_rdiv
} arith2_op;
yap_error_number
Yap_MathException__(USES_REGS1);
Functor EvalArg(Term);
/* Needed to handle numbers:
@ -363,8 +368,11 @@ Int Yap_ArithError(yap_error_number,Term,char *msg, ...);
#include "inline-only.h"
#define Yap_MathException() Yap_MathException__(PASS_REGS1)
#define Yap_InnerEval(x) Yap_InnerEval__(x PASS_REGS)
#define Yap_Eval(x) Yap_Eval__(x PASS_REGS)
#define Yap_FoundArithError() Yap_FoundArithError__(PASS_REGS1)
INLINE_ONLY inline EXTERN Term Yap_Eval__(Term t USES_REGS);
@ -376,19 +384,25 @@ Yap_Eval__(Term t USES_REGS)
return Yap_InnerEval(t);
}
#ifdef P
inline static Term
Yap_FoundArithError(Term t, Term inp)
{
CACHE_REGS
if (LOCAL_Error_TYPE) {
Yap_Error(LOCAL_Error_TYPE, (inp ? inp : LOCAL_Error_Term), LOCAL_ErrorMessage);
P = FAILCODE;
return 0L;
}
return t;
inline static void
Yap_ClearExs(void)
{
feclearexcept(FE_ALL_EXCEPT);
}
#endif
inline static bool
Yap_FoundArithError__(USES_REGS1)
{
if (Yap_MathException() || LOCAL_Error_TYPE) {
Yap_external_signal( worker_id, YAP_FPE_SIGNAL );
regcache->P_ = FAILCODE;
return true;
}
return false;
}
Atom Yap_NameOfUnaryOp(int i);
Atom Yap_NameOfBinaryOp(int i);
#define RINT(v) return(MkIntegerTerm(v))

3
H/hlocals.h
View File

@ -173,6 +173,9 @@ typedef struct worker_local {
struct db_globs* s_dbg_;
yap_error_number matherror_;
Term mathtt_[4];
Int mathn_;
Term mathop_;
yap_error_number CurrentError_;
int heap_overflows_;

1
H/iatoms.h
View File

@ -275,6 +275,7 @@
AtomSigCreep = Yap_LookupAtom("sig_creep");
AtomSigDebug = Yap_LookupAtom("sig_debug");
AtomSigDelayCreep = Yap_LookupAtom("sig_delay_creep");
AtomSigFPE = Yap_LookupAtom("sig_fpe");
AtomSigHup = Yap_LookupAtom("sig_hup");
AtomSigInt = Yap_LookupAtom("sig_int");
AtomSigIti = Yap_LookupAtom("sig_iti");

3
H/ilocals.h
View File

@ -173,6 +173,9 @@ static void InitWorker(int wid) {
REMOTE_matherror(wid) = YAP_NO_ERROR;
REMOTE_mathn(wid) = 0;
REMOTE_mathop(wid) = YAP_NO_ERROR;
REMOTE_CurrentError(wid) = YAP_NO_ERROR;
REMOTE_heap_overflows(wid) = 0;

1
H/ratoms.h
View File

@ -275,6 +275,7 @@
AtomSigCreep = AtomAdjust(AtomSigCreep);
AtomSigDebug = AtomAdjust(AtomSigDebug);
AtomSigDelayCreep = AtomAdjust(AtomSigDelayCreep);
AtomSigFPE = AtomAdjust(AtomSigFPE);
AtomSigHup = AtomAdjust(AtomSigHup);
AtomSigInt = AtomAdjust(AtomSigInt);
AtomSigIti = AtomAdjust(AtomSigIti);

3
H/rlocals.h
View File

@ -186,6 +186,9 @@ static void RestoreWorker(int wid USES_REGS) {
#ifdef LOAD_DYLD
#endif

2
H/tatoms.h
View File

@ -548,6 +548,8 @@
#define AtomSigDebug Yap_heap_regs->AtomSigDebug_
Atom AtomSigDelayCreep_;
#define AtomSigDelayCreep Yap_heap_regs->AtomSigDelayCreep_
Atom AtomSigFPE_;
#define AtomSigFPE Yap_heap_regs->AtomSigFPE_
Atom AtomSigHup_;
#define AtomSigHup Yap_heap_regs->AtomSigHup_
Atom AtomSigInt_;

39
library/tries/base_dbtries.c
View File

@ -208,12 +208,13 @@
/* Local Procedures */
/* -------------------------- */
static TrNode depth_reduction(TrEntry trie, TrNode depth_node, YAP_Int opt_level);
static TrNode breadth_reduction(TrEntry trie, TrNode breadth_node, YAP_Int opt_level);
static void simplification_reduction(TrEntry trie);
static TrNode depth_reduction(TrEntry trie, TrNode depth_node, YAP_Int opt_level);
static TrNode breadth_reduction(TrEntry trie, TrNode breadth_node, YAP_Int opt_level);
static inline int compare_label_nodes(TrData data1, TrData data2);
static inline void move_after(TrData data_source, TrData data_dest);
static inline void move_last_data_after(TrData moveto_data);
static inline void set_depth_breadth_reduction_current_data(TrData data);
static inline void move_after(TrData data_source, TrData data_dest);
static inline void move_last_data_after(TrData moveto_data);
static inline void set_depth_breadth_reduction_current_data(TrData data);
/* -------------------------- */
@ -235,6 +236,9 @@ YAP_Term trie_depth_breadth(TrEntry trie, TrEntry db_trie, YAP_Int opt_level, YA
core_set_trie_db_return_term(YAP_MkAtomTerm(YAP_LookupAtom("false")));
core_initialize_depth_breadth_trie(TrEntry_trie(db_trie), &depth_node, &breadth_node);
set_depth_breadth_reduction_current_data(NULL);
/* We only need to simplify the trie once! */
if (TrNode_child(TrEntry_trie(trie)))
simplification_reduction(trie);
while (TrNode_child(TrEntry_trie(trie))) {
nested_trie = depth_reduction(trie, depth_node, opt_level);
if (nested_trie) {
@ -301,6 +305,27 @@ void set_depth_breadth_reduction_current_data(TrData data) {
}
static
void simplification_reduction(TrEntry trie) {
TrNode node;
TrData stop_data, new_data, data = NULL;
stop_data = TrData_previous(TrEntry_first_data(trie));
data = TrEntry_traverse_data(trie) = TrEntry_last_data(trie);
while ((data != stop_data) && (data != NULL)) {
node = core_simplification_reduction(TRIE_ENGINE, TrData_leaf(data), &trie_data_destruct);
if (node) {
new_trie_data(new_data, trie, node);
PUT_DATA_IN_LEAF_TRIE_NODE(node, new_data);
}
if (data == TrEntry_traverse_data(trie)) {
data = TrData_previous(data);
TrEntry_traverse_data(trie) = data;
} else
data = TrEntry_traverse_data(trie);
}
}
static
TrNode depth_reduction(TrEntry trie, TrNode depth_node, YAP_Int opt_level) {
TrNode node;
@ -309,9 +334,7 @@ TrNode depth_reduction(TrEntry trie, TrNode depth_node, YAP_Int opt_level) {
stop_data = TrData_previous(TrEntry_first_data(trie));
data = TrEntry_traverse_data(trie) = TrEntry_last_data(trie);
while (data != stop_data) {
// printf("hi0\n");
node = core_depth_reduction(TRIE_ENGINE, TrData_leaf(data), depth_node, opt_level, &trie_data_construct, &trie_data_destruct, &trie_data_copy, &trie_data_order_correction);
// printf("bye0\n");
if (node && IS_FUNCTOR_NODE(TrNode_parent(node)) && (strcmp(YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & TrNode_entry(TrNode_parent(node))))), NESTED_TRIE_TERM) == 0)) {
//nested trie stop procedure return nested trie node
return node;
@ -338,9 +361,7 @@ TrNode breadth_reduction(TrEntry trie, TrNode breadth_node, YAP_Int opt_level) {
stop_data = TrData_previous(TrEntry_first_data(trie));
data = TrEntry_traverse_data(trie) = TrEntry_last_data(trie);
while ((data != stop_data) && (data != NULL)) {
// printf("hi\n");
node = core_breadth_reduction(TRIE_ENGINE, TrData_leaf(data), breadth_node, opt_level, &trie_data_construct, &trie_data_destruct, &trie_data_copy, &trie_data_order_correction);
// printf("bye\n");
if (node && IS_FUNCTOR_NODE(TrNode_parent(node)) && (strcmp(YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & TrNode_entry(TrNode_parent(node))))), NESTED_TRIE_TERM) == 0)) {
//nested trie stop procedure return nested trie node
return node;

81
library/tries/core_dbtries.c
View File

@ -206,13 +206,22 @@
/* Local Procedures */
/* -------------------------- */
inline void displaynode(TrNode node);
inline int traverse_get_counter(TrNode node);
inline YAP_Term generate_label(YAP_Int Index);
YAP_Term update_depth_breadth_trie(TrEngine engine, TrNode root, YAP_Int opt_level, void (*construct_function)(TrNode), void (*destruct_function)(TrNode), void (*copy_function)(TrNode, TrNode), void (*correct_order_function)(void));
YAP_Term get_return_node_term(TrNode node);
void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_Term new_term);
TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term);
inline TrNode get_simplification_sibling(TrNode node);
inline TrNode check_parent_first(TrNode node);
inline TrNode TrNode_myparent(TrNode node);
/* -------------------------- */
/* Debug Procedures */
/* -------------------------- */
inline void displaynode(TrNode node);
inline void displayentry(TrNode node);
/* -------------------------- */
@ -274,6 +283,17 @@ void displaynode(TrNode node) {
}
inline
void displayentry(TrNode node) {
printf("Entry Contains Bottom Up:\n");
while (node) {
displaynode(node);
node = TrNode_parent(node);
}
printf("--- End of Entry ---\n");
}
inline
void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_Term new_term) {
TrNode child, temp;
@ -463,6 +483,52 @@ void core_finalize_depth_breadth_trie(TrNode depth_node, TrNode breadth_node) {
}
inline
TrNode get_simplification_sibling(TrNode node) {
TrNode sibling = node;
while (sibling != NULL && TrNode_entry(sibling) != PairEndTag)
sibling = TrNode_next(sibling);
if (sibling != NULL && TrNode_entry(sibling) == PairEndTag) return sibling;
sibling = node;
while (sibling != NULL && TrNode_entry(sibling) != PairEndTag)
sibling = TrNode_previous(sibling);
return sibling;
}
inline
TrNode check_parent_first(TrNode node) {
TrNode simplification;
if (TrNode_entry(TrNode_myparent(node)) != PairInitTag) {
simplification = check_parent_first(TrNode_myparent(node));
if (simplification != NULL && TrNode_entry(simplification) == PairEndTag) return simplification;
}
simplification = get_simplification_sibling(node);
return simplification;
}
inline
TrNode TrNode_myparent(TrNode node) {
TrNode parent = TrNode_parent(node);
while (parent != NULL && IS_FUNCTOR_NODE(parent))
parent = TrNode_parent(parent);
return parent;
}
TrNode core_simplification_reduction(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)) {
/* Try to find the greatest parent that has a sibling that is a PairEndTag: this indicates a deep simplification */
node = check_parent_first(TrNode_myparent(node));
if (node != NULL) {
/* do breadth reduction simplification */
node = TrNode_parent(node);
DATA_DESTRUCT_FUNCTION = destruct_function;
remove_child_nodes(TrNode_child(node));
TrNode_child(node) = NULL;
node = trie_node_check_insert(node, PairEndTag);
INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
}
return node;
}
TrNode core_depth_reduction(TrEngine engine, TrNode node, TrNode depth_node, YAP_Int opt_level, void (*construct_function)(TrNode), void (*destruct_function)(TrNode), void (*copy_function)(TrNode, TrNode), void (*correct_order_function)(void)) {
TrNode leaf = node;
@ -534,14 +600,18 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
YAP_Term t, *stack_top;
int count = -1;
TrNode child;
/* Simplification with breadth reduction (faster dbtrie execution worse BDD)
child = core_simplification_reduction(engine, node, destruct_function);
if (child) return child;
*/
/* collect breadth nodes */
stack_args_base = stack_args = AUXILIARY_TERM_STACK;
stack_top = AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1;
node = TrNode_parent(TrNode_parent(node));
// printf("1\n");
// printf("start node: "); displaynode(node);
if (IS_FUNCTOR_NODE(node)) {
// printf("2\n");
while(IS_FUNCTOR_NODE(node))
node = TrNode_parent(node);
child = TrNode_child(node);
@ -613,6 +683,7 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
do {
if (TrNode_entry(child) == PairEndTag) {
/* do breadth reduction simplification */
printf("I should never arrive here, please contact Theo!\n");
node = TrNode_parent(child);
DATA_DESTRUCT_FUNCTION = destruct_function;
remove_child_nodes(TrNode_child(node));
@ -676,10 +747,7 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
child = TrNode_parent(child);
}
child = TrNode_next(child);
// printf("Siblings: ");displaynode(child);
} while (child);
// printf("pass through\n");
}
if (!count) {
/* termination condition */
@ -699,7 +767,6 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
node = trie_node_check_insert(node, t);
node = trie_node_check_insert(node, PairEndTag);
INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
// printf("end node: "); displaynode(node);
return node;
}

1
library/tries/core_dbtries.h
View File

@ -219,6 +219,7 @@ void core_set_label_counter(YAP_Int value);
YAP_Int core_get_label_counter(void);
void core_initialize_depth_breadth_trie(TrNode node, TrNode *depth_node, TrNode *breadth_node);
void core_finalize_depth_breadth_trie(TrNode depth_node, TrNode breadth_node);
TrNode core_simplification_reduction(TrEngine engine, TrNode node, void (*destruct_function)(TrNode));
TrNode core_depth_reduction(TrEngine engine, TrNode node, TrNode depth_node, YAP_Int opt_level, void (*construct_function)(TrNode), void (*destruct_function)(TrNode), void (*copy_function)(TrNode, TrNode), void (*correct_order_function)(void));
TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node, YAP_Int opt_level, void (*construct_function)(TrNode), void (*destruct_function)(TrNode), void (*copy_function)(TrNode, TrNode), void (*correct_order_function)(void));
YAP_Term core_get_trie_db_return_term(void);

2
library/tries/core_tries.c
View File

@ -519,6 +519,7 @@ TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode,
DATA_LOAD_FUNCTION = load_function;
node = core_trie_open(engine);
traverse_and_load(node, file);
if (n) n = 0; // just added to remove the warning of not used!
return node;
}
@ -1450,6 +1451,7 @@ void traverse_and_load(TrNode parent, FILE *file) {
traverse_and_load(child, file);
} while (fscanf(file, "%lu", &t));
CURRENT_DEPTH--;
if (n) n = 0; // just added to remove the warning of not used!
return;
}

1
misc/ATOMS
View File

@ -280,6 +280,7 @@ A SigBreak N "sig_break"
A SigCreep N "sig_creep"
A SigDebug N "sig_debug"
A SigDelayCreep N "sig_delay_creep"
A SigFPE N "sig_fpe"
A SigHup N "sig_hup"
A SigInt N "sig_int"
A SigIti N "sig_iti"

3
misc/LOCALS
View File

@ -195,6 +195,9 @@ struct db_globs* s_dbg void
//eval.c
yap_error_number matherror =YAP_NO_ERROR
Term mathtt[4] void
Int mathn =0
int mathop =0
yap_error_number CurrentError =YAP_NO_ERROR
//grow.c

8
misc/buildatoms
View File

@ -1,6 +1,6 @@
:- use_module(library(lineutils),
[file_filter_with_init/5,
[file_filter_with_initialization/5,
split/3]).
:- use_module(library(lists),
@ -12,9 +12,9 @@
main :-
warning(Warning),
file_filter_with_init('misc/ATOMS','H/tatoms.h',gen_fields, Warning, ['tatoms.h']),
file_filter_with_init('misc/ATOMS','H/iatoms.h',gen_decl, Warning, ['iatoms.h']),
file_filter_with_init('misc/ATOMS','H/ratoms.h',gen_rcov, Warning, ['ratoms.h']).
file_filter_with_initialization('misc/ATOMS','H/tatoms.h',gen_fields, Warning, ['tatoms.h']),
file_filter_with_initialization('misc/ATOMS','H/iatoms.h',gen_decl, Warning, ['iatoms.h']),
file_filter_with_initialization('misc/ATOMS','H/ratoms.h',gen_rcov, Warning, ['ratoms.h']).
warning('~n /* This file, ~a, was generated automatically by \"yap -L misc/buildatoms\"~n please do not update, update misc/ATOMS instead */~n~n').

4
pl/signals.yap
View File

@ -195,6 +195,8 @@ order of dispatch.
'$continue_signals',
'$hacks':'$stack_dump',
'$execute0'(G,M).
'$do_signal'(sig_fpe, [_M|_G]) :-
'$fpe_error'.
% Unix signals
'$do_signal'(sig_alarm, G) :-
'$signal_handler'(sig_alarm, G).
@ -257,6 +259,7 @@ order of dispatch.
'$signal_def'(sig_usr1, throw(error(signal(usr1,[]),true))).
'$signal_def'(sig_usr2, throw(error(signal(usr2,[]),true))).
'$signal_def'(sig_pipe, throw(error(signal(pipe,[]),true))).
'$signal_def'(sig_fpe, throw(error(signal(fpe,[]),true))).
% ignore sig_alarm by default
'$signal_def'(sig_alarm, true).
@ -267,6 +270,7 @@ order of dispatch.
'$signal'(sig_pipe).
'$signal'(sig_alarm).
'$signal'(sig_vtalarm).
'$signal'(sig_fpe).
on_signal(Signal,OldAction,NewAction) :-
var(Signal), !,