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

VC++ changes

Browse Source 
use clock in WIN98
fix manual
get rid of ISO X/0


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@347 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-02-04 16:12:54 +00:00
parent 5139d1a8dc
commit 293fdf9061
35 changed files with 2756 additions and 3086 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
C/absmi.c
View File

@ -68,12 +68,12 @@ push_live_regs(yamop *pco)
{ {
CELL *lab = (CELL *)(pco->u.l.l); CELL *lab = (CELL *)(pco->u.l.l);
CELL max = lab[0]; CELL max = lab[0];
Int curr = lab[1]; CELL curr = lab[1];
CELL *start = H; CELL *start = H;
Int tot = 0; Int tot = 0;
if (max) { if (max) {
Int i; CELL i;
lab += 2; lab += 2;
H++; H++;
@ -10020,7 +10020,7 @@ absmi(int inp)
FAIL(); FAIL();
} }
if ((Int)d0 <= 0 || if ((Int)d0 <= 0 ||
d0 > ArityOfFunctor((Functor) d1)) { (Int)d0 > ArityOfFunctor((Functor) d1)) {
/* don't complain here for Prolog compatibility /* don't complain here for Prolog compatibility
if ((Int)d0 <= 0) { if ((Int)d0 <= 0) {
saveregs(); saveregs();
@ -10108,7 +10108,7 @@ absmi(int inp)
FAIL(); FAIL();
} }
if ((Int)d0 <= 0 || if ((Int)d0 <= 0 ||
d0 > ArityOfFunctor((Functor) d1)) { (Int)d0 > ArityOfFunctor((Functor) d1)) {
/* don't complain here for Prolog compatibility /* don't complain here for Prolog compatibility
if ((Int)d0 <= 0) { if ((Int)d0 <= 0) {
saveregs(); saveregs();
@ -10200,7 +10200,7 @@ absmi(int inp)
FAIL(); FAIL();
} }
if ((Int)d0 <= 0 || if ((Int)d0 <= 0 ||
d0 > ArityOfFunctor((Functor) d1)) { (Int)d0 > ArityOfFunctor((Functor) d1)) {
/* don't complain here for Prolog compatibility /* don't complain here for Prolog compatibility
if ((Int)d0 <= 0) { if ((Int)d0 <= 0) {
saveregs(); saveregs();
@ -10302,7 +10302,7 @@ absmi(int inp)
FAIL(); FAIL();
} }
if ((Int)d0 <= 0 || if ((Int)d0 <= 0 ||
d0 > ArityOfFunctor((Functor) d1)) { (Int)d0 > ArityOfFunctor((Functor) d1)) {
/* don't complain here for Prolog compatibility /* don't complain here for Prolog compatibility
if ((Int)d0 <= 0) { if ((Int)d0 <= 0) {
saveregs(); saveregs();
@ -11460,7 +11460,7 @@ absmi(int inp)
BOp(p_execute, sla); BOp(p_execute, sla);
{ {
PredEntry *pen; PredEntry *pen;
int mod = IntOfTerm(ARG2); SMALLUNSGN mod = IntOfTerm(ARG2);
CACHE_Y_AS_ENV(Y); CACHE_Y_AS_ENV(Y);
#ifndef NO_CHECKING #ifndef NO_CHECKING
@ -11577,7 +11577,7 @@ absmi(int inp)
BOp(p_execute_within, sla); BOp(p_execute_within, sla);
{ {
PredEntry *pen; PredEntry *pen;
int mod = CurrentModule; SMALLUNSGN mod = CurrentModule;
CACHE_Y_AS_ENV(Y); CACHE_Y_AS_ENV(Y);
@ -11720,7 +11720,7 @@ absmi(int inp)
BOp(p_last_execute_within, sla); BOp(p_last_execute_within, sla);
{ {
PredEntry *pen; PredEntry *pen;
int mod = CurrentModule; SMALLUNSGN mod = CurrentModule;
CACHE_Y_AS_ENV(Y); CACHE_Y_AS_ENV(Y);
#ifndef NO_CHECKING #ifndef NO_CHECKING

6
C/adtdefs.c
View File

@ -263,7 +263,7 @@ GetAProp(Atom a, PropFlags kind)
} }
inline static Prop inline static Prop
GetPredPropByAtomHavingLock(AtomEntry* ae, int cur_mod) GetPredPropByAtomHavingLock(AtomEntry* ae, SMALLUNSGN cur_mod)
/* get predicate entry for ap/arity; create it if neccessary. */ /* get predicate entry for ap/arity; create it if neccessary. */
{ {
Prop p0; Prop p0;
@ -281,7 +281,7 @@ GetPredPropByAtomHavingLock(AtomEntry* ae, int cur_mod)
} }
Prop Prop
GetPredPropByAtom(Atom at, int cur_mod) GetPredPropByAtom(Atom at, SMALLUNSGN cur_mod)
/* get predicate entry for ap/arity; create it if neccessary. */ /* get predicate entry for ap/arity; create it if neccessary. */
{ {
Prop p0; Prop p0;
@ -314,7 +314,7 @@ GetPredPropByFuncHavingLock(Functor f, SMALLUNSGN cur_mod)
} }
Prop Prop
GetPredPropByFunc(Functor f, int cur_mod) GetPredPropByFunc(Functor f, SMALLUNSGN cur_mod)
/* get predicate entry for ap/arity; */ /* get predicate entry for ap/arity; */
{ {
Prop p0; Prop p0;

4
C/arrays.c
View File

@ -282,7 +282,7 @@ p_access_array(void)
Term t = Deref(ARG1); Term t = Deref(ARG1);
Term ti = Deref(ARG2); Term ti = Deref(ARG2);
Term tf; Term tf;
UInt indx; Int indx;
if (IsNonVarTerm(ti)) { if (IsNonVarTerm(ti)) {
union arith_ret v; union arith_ret v;
@ -1344,7 +1344,7 @@ p_assign_static(void)
Error(TYPE_ERROR_ARRAY,t1,"update_array"); Error(TYPE_ERROR_ARRAY,t1,"update_array");
return(FALSE); return(FALSE);
} }
if (indx > 0 && (UInt)indx > ArityOfFunctor(f)) { if (indx > 0 && indx > ArityOfFunctor(f)) {
Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"update_array"); Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"update_array");
return(FALSE); return(FALSE);
} }

2
C/c_interface.c
View File

@ -33,7 +33,7 @@
#define YAP_BOOT_FROM_SAVED_STACKS 2 #define YAP_BOOT_FROM_SAVED_STACKS 2
#define YAP_BOOT_FROM_SAVED_ERROR -1 #define YAP_BOOT_FROM_SAVED_ERROR -1
#if defined(_MSC_VER) && defined(YAPDLL_EXPORTS) #if defined(_MSC_VER) && defined(YAP_EXPORTS)
#define X_API __declspec(dllexport) #define X_API __declspec(dllexport)
#else #else
#define X_API #define X_API

2
C/errors.c
View File

@ -331,7 +331,7 @@ Error (yap_error_number type, Term where, char *format,...)
fprintf(stderr,"[ ERROR WITHIN ERROR: %s ]\n", p); fprintf(stderr,"[ ERROR WITHIN ERROR: %s ]\n", p);
exit(1); exit(1);
} }
if (P == FAILCODE) if (P == (yamop *)(FAILCODE))
return(P); return(P);
/* PURE_ABORT may not have set where correctly */ /* PURE_ABORT may not have set where correctly */
if (type == PURE_ABORT) if (type == PURE_ABORT)

233
C/evalis.c
View File

@ -1,233 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: evalis.c *
* Last rev: *
* mods: *
* comments: is/3 predicate *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif /* SCCS */
/*
* This predicates had to be developed here because of a bug in the MPW
* compiler, which was not able to compile the original eval.c
*/
#include "Yap.h"
#include "Yatom.h"
#include "Heap.h"
#include "eval.h"
int
UnEvalInt(BITS16 op, Int i1)
{
switch(op) {
case e_uminus:
REvalInt(-i1);
case e_abs:
#if SHORT_INTS
#if HAVE_LABS
REvalInt((Int)labs((long int)i1));
#else
REvalInt((i1 >= 0 ? i1 : -i1));
#endif
#else
REvalInt(abs(i1));
#endif
case e_msb:
REvalInt(msb(i1));
case e_uplus:
REvalInt(i1);
case e_not:
REvalInt(~i1);
case e_exp:
REvalFl(exp(FL(i1)));
case e_log:
REvalFl(log(FL(i1)));
case e_log10:
REvalFl(log10(FL(i1)));
case e_sqrt:
REvalFl(sqrt(FL(i1)));
case e_sin:
REvalFl(sin(FL(i1)));
case e_cos:
REvalFl(cos(FL(i1)));
case e_tan:
REvalFl(tan(FL(i1)));
case e_sinh:
REvalFl(sinh(FL(i1)));
case e_cosh:
REvalFl(cosh(FL(i1)));
case e_tanh:
REvalFl(tanh(FL(i1)));
case e_asin:
REvalFl(asin(FL(i1)));
case e_acos:
REvalFl(acos(FL(i1)));
case e_atan:
REvalFl(atan(FL(i1)));
case e_asinh:
REvalFl(asinh(FL(i1)));
case e_acosh:
REvalFl(acosh(FL(i1)));
case e_atanh:
REvalFl(atanh(FL(i1)));
case e_floor:
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
Error(TYPE_ERROR_FLOAT, MkIntegerTerm(i1), "floor/1");
P = (yamop *)FAILCODE;
REvalError();
} else {
REvalFl(FL(i1));
}
case e_round:
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
Error(TYPE_ERROR_FLOAT, MkIntegerTerm(i1), "round/1");
P = (yamop *)FAILCODE;
REvalError();
} else {
REvalFl(FL(i1));
}
case e_ceiling:
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
Error(TYPE_ERROR_FLOAT, MkIntegerTerm(i1), "floor/1");
P = (yamop *)FAILCODE;
REvalError();
} else {
REvalFl(FL(i1));
}
case e_truncate:
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
Error(TYPE_ERROR_FLOAT, MkIntegerTerm(i1), "truncate/1");
P = (yamop *)FAILCODE;
REvalError();
} else {
REvalFl(FL(i1));
}
case e_integer:
REvalInt(i1);
case e_float:
REvalFl(FL(i1));
case e_fmodf:
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
Error(TYPE_ERROR_FLOAT,MkIntegerTerm(i1),"mod/2");
P = (yamop *)FAILCODE;
REvalError();
} else {
REvalFl(FL(0.0));
}
case e_imodf:
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
/* iso does not allow integer arguments to this procedure */
Error(TYPE_ERROR_FLOAT,MkIntegerTerm(i1),"mod/2");
P = (yamop *)FAILCODE;
REvalError();
} else {
REvalFl(FL(i1));
}
case e_sign:
if (i1 < 0) {
REvalInt(-1);
} else if (i1 == 0) {
REvalInt(0);
} else {
REvalInt(1);
}
default:
{
Term t, ti[2];
ti[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(current_eval_term)));
ti[1] = MkIntegerTerm(1);
t = MkApplTerm(MkFunctor(LookupAtom("/"),1), 1, ti);
Error(TYPE_ERROR_EVALUABLE, t,
"arithmetic expression %s/%d",
RepAtom(NameOfFunctor(FunctorOfTerm(current_eval_term)))->StrOfAE,
2
);
P = (yamop *)FAILCODE;
REvalError();
}
}
}
Int
p_unary_is(void)
{
register BITS16 OpNum;
Term t2, t3;
int flag;
current_eval_term = MkIntTerm(1);
t2 = Deref(ARG2);
if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t2, "operation for is/3");
P = (yamop *)FAILCODE;
return(FALSE);
}
if (IsAtomTerm(t2)) {
Atom name;
Prop p;
name = AtomOfTerm(t2);
if ((p = GetExpProp(name, 1)) == NIL) {
Term t, ti[2];
ti[0] = MkAtomTerm(name);
ti[1] = MkIntegerTerm(1);
t = MkApplTerm(MkFunctor(LookupAtom("/"),2), 2, ti);
Error(TYPE_ERROR_EVALUABLE, t,
"arithmetic expression %s/%d",
RepAtom(name)->StrOfAE,
1
);
P = (yamop *)FAILCODE;
return(FALSE);
}
OpNum = RepExpProp(p)->ENoOfEE;
} else if (IsIntTerm(t2))
OpNum = IntOfTerm(t2);
else
return (FALSE);
t3 = Deref(ARG3);
if (IsVarTerm(t3)) {
int op = 0;
while (InitTab[op].eno != OpNum) op++;
Error(INSTANTIATION_ERROR, t3, "arithmetic expression %s/1", InitTab[op].OpName);
P = (yamop *)FAILCODE;
return(FALSE);
}
if (IsIntegerTerm(t3)) {
flag = UnEvalInt(OpNum, IntegerOfTerm(t3));
} else if (IsFloatTerm(t3)) {
flag = UnEvalFl(OpNum, FloatOfTerm(t3));
} else {
int aflag = Eval(t3);
if (aflag == FError) {
return(FALSE);
} else if (aflag == FInt) {
flag = UnEvalInt(OpNum, eval_int);
} else {
flag = UnEvalFl(OpNum, eval_flt);
}
}
if (flag == FError) {
return(FALSE);
} else if (flag == FInt) {
return(unify_constant(ARG1,MkIntegerTerm(eval_int)));
} else {
return(unify_constant(ARG1,MkFloatTerm(eval_flt)));
}
}

301
C/evaltwo.c
View File

@ -1,301 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: evaltwo.c *
* Last rev: *
* mods: *
* comments: is/4 predicate *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
/*
* This predicates had to be developed here because of a bug in the MPW
* compiler, which was not able to compile the original eval.c
*/
#include "Yap.h"
#include "Yatom.h"
#include "Heap.h"
#include "eval.h"
#define IntRes(X) return(unify_constant(ARG1,MkIntegerTerm(X)))
#define FloatRes(X) return(unify_constant(ARG1,MkEvalFl(X)))
int
BinEvalInt(BITS16 op, Int i1, Int i2)
{
switch(op) {
case e_plus:
REvalInt(i1 + i2);
case e_dif:
REvalInt(i1 - i2);
case e_times:
REvalInt(i1 * i2);
case e_div:
#ifdef TRY_TO_CONVERT_FLOATS_TO_INTS
if (i1 % i2 == 0)
REvalInt(i1 / i2);
#endif
REvalFl(FL(i1) / FL(i2));
case e_and:
REvalInt(i1 & i2);
case e_xor:
REvalInt(i1 ^ i2);
case e_or:
REvalInt(i1 | i2);
case e_lshift:
REvalInt(i1 << i2);
case e_rshift:
REvalInt(i1 >> i2);
case e_mod:
REvalInt(i1 % i2);
case e_idiv:
REvalInt(i1 / i2);
case e_gcd:
REvalInt(gcd(abs(i1),abs(i2)));
case e_gcdmult:
{
Int i;
REvalInt(gcdmult(abs(i1),abs(i2), &i));
}
case e_min:
REvalInt((i1 < i2 ? i1 : i2));
case e_max:
REvalInt((i1 > i2 ? i1 : i2));
case e_power:
REvalFl(pow(FL(i1), FL(i2)));
case e_atan2:
REvalFl(atan2(FL(i1), FL(i2)));
default:
{
Term t, ti[2];
ti[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(current_eval_term)));
ti[1] = MkIntegerTerm(2);
t = MkApplTerm(MkFunctor(LookupAtom("/"),2), 2, ti);
Error(TYPE_ERROR_EVALUABLE, t,
"in arithmetic expression %s(%d,%d)",
RepAtom(NameOfFunctor(FunctorOfTerm(current_eval_term)))->StrOfAE,
i1,
i2
);
P = (yamop *)FAILCODE;
REvalError();
}
}
}
int
BinEvalFl(BITS16 op, Float f1, Float f2, int flts)
{
switch(op) {
case e_plus:
REvalFl(f1 + f2);
case e_dif:
REvalFl(f1 - f2);
case e_times:
REvalFl(f1 * f2);
case e_div:
REvalFl(f1 / f2);
case e_power:
REvalFl(pow(f1, f2));
case e_atan2:
REvalFl(atan2(f1, f2));
case e_min:
REvalFl((f1 < f2 ? f1 : f2));
case e_max:
REvalFl((f1 > f2 ? f1 : f2));
case e_lshift:
if (flts & 1)
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "<</2");
else
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "<</2");
P = (yamop *)FAILCODE;
REvalError();
case e_rshift:
if (flts & 1)
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), ">>/2");
else
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), ">>/2");
P = (yamop *)FAILCODE;
REvalError();
case e_and:
if (flts & 1)
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "/\\/2");
else
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "/\\/2");
P = (yamop *)FAILCODE;
REvalError();
case e_xor:
if (flts & 1)
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "#/2");
else
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "#/2");
P = (yamop *)FAILCODE;
REvalError();
case e_or:
if (flts & 1)
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "\\/ /2");
else
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "\\/ /2");
P = (yamop *)FAILCODE;
REvalError();
case e_mod:
if (flts & 1)
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "mod/2");
else
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "mod/2");
P = (yamop *)FAILCODE;
REvalError();
case e_idiv:
if (flts & 1)
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "/ /2");
else
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "/ /2");
P = (yamop *)FAILCODE;
REvalError();
case e_gcd:
if (flts & 1)
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "gcd/2");
else
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "gcd/2");
P = (yamop *)FAILCODE;
REvalError();
case e_gcdmult:
if (flts & 1)
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "gcdmult/2");
else
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "gcdmult/2");
P = (yamop *)FAILCODE;
REvalError();
default:
{
Term t, ti[2];
ti[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(current_eval_term)));
ti[1] = MkIntegerTerm(2);
t = MkApplTerm(MkFunctor(LookupAtom("/"),2), 2, ti);
Error(TYPE_ERROR_EVALUABLE, t,
"in arithmetic expression %s(%d,%d)",
RepAtom(NameOfFunctor(FunctorOfTerm(current_eval_term)))->StrOfAE,
f1,
f2
);
P = (yamop *)FAILCODE;
}
REvalError();
}
}
Int
p_binary_is(void)
{
register BITS16 OpNum;
Term t2,t3,t4;
Int i1;
Float f1;
int flag;
current_eval_term = MkIntTerm(2);
t2 = Deref(ARG2);
if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t2, "operation for is/4");
P = (yamop *)FAILCODE;
return(FALSE);
}
if (IsIntTerm(t2))
OpNum = IntOfTerm(t2);
else if (IsAtomTerm(t2)) {
Atom name = AtomOfTerm(t2);
Prop p;
if ((p = GetExpProp(name, 2)) == NIL) {
Term t, ti[2];
ti[0] = MkIntegerTerm(2);
ti[0] = MkAtomTerm(name);
t = MkApplTerm(MkFunctor(LookupAtom("/"),2), 2, ti);
Error(TYPE_ERROR_EVALUABLE, t,
"arithmetic expression %s/%d",
RepAtom(name)->StrOfAE,
2
);
P = (yamop *)FAILCODE;
return(FALSE);
}
OpNum = RepExpProp(p)->ENoOfEE;
} else
return (FALSE);
t3 = Deref(ARG3);
t4 = Deref(ARG4);
if (IsVarTerm(t3) || IsVarTerm(t4)) {
int op = 0;
while (InitTab[op].eno != OpNum) op++;
Error(INSTANTIATION_ERROR, (IsVarTerm(t3) ? t3 : t4),
"arithmetic expression %s/2", InitTab[op].OpName);
return(FALSE);
}
if (IsIntegerTerm(t3)) {
i1 = IntegerOfTerm(t3);
t3_int:
if (IsIntegerTerm(t4)) {
flag = BinEvalInt(OpNum, i1, IntegerOfTerm(t4));
} else if (IsFloatTerm(t4)) {
flag = BinEvalFl(OpNum, FL(i1), FloatOfTerm(t4), 2);
} else {
int aflag = Eval(t4);
if (aflag == FError) {
return(FALSE);
} else if (aflag == FInt) {
flag = BinEvalInt(OpNum, i1, eval_int);
} else {
flag = BinEvalFl(OpNum, FL(i1), eval_flt, 2);
}
}
} else if (IsFloatTerm(t3)) {
f1 = FloatOfTerm(t3);
t3_flt:
if (IsIntegerTerm(t4)) {
flag = BinEvalFl(OpNum, f1, FL(IntegerOfTerm(t4)), 1);
} else if (IsFloatTerm(t4)) {
flag = BinEvalFl(OpNum, f1, FloatOfTerm(t4), 3);
} else {
int aflag = Eval(t4);
if (aflag == FError) {
return(FALSE);
} else if (aflag == FInt) {
flag = BinEvalFl(OpNum, f1, eval_int, 1);
} else {
flag = BinEvalFl(OpNum, f1, eval_flt, 3);
}
}
} else {
int aflag = Eval(t3);
if (aflag == FError) {
return(FALSE);
} else if (aflag == FInt) {
i1 = eval_int;
goto t3_int;
} else {
f1 = eval_flt;
goto t3_flt;
}
}
if (flag == FError) {
return(FALSE);
} else if (flag == FInt) {
return(unify_constant(ARG1,MkIntegerTerm(eval_int)));
} else {
return(unify_constant(ARG1,MkFloatTerm(eval_flt)));
}
}

4
C/exec.c
View File

@ -200,7 +200,7 @@ EnterCreepMode(SMALLUNSGN mod) {
} }
inline static Int inline static Int
do_execute(Term t, int mod) do_execute(Term t, SMALLUNSGN mod)
{ {
if (yap_flags[SPY_CREEP_FLAG]) { if (yap_flags[SPY_CREEP_FLAG]) {
return(EnterCreepMode(mod)); return(EnterCreepMode(mod));
@ -1278,7 +1278,7 @@ JumpToEnv(Term t) {
/* I could backtrack here, but it is easier to leave the unwinding /* I could backtrack here, but it is easier to leave the unwinding
to the emulator */ to the emulator */
B->cp_a3 = t; B->cp_a3 = t;
P = FAILCODE; P = (yamop *)FAILCODE;
return(FALSE); return(FALSE);
} }

10
C/heapgc.c
View File

@ -40,7 +40,7 @@ static Int tot_gc_time = 0; /* total time spent in GC */
static Int tot_gc_recovered = 0; /* number of heap objects in all garbage collections */ static Int tot_gc_recovered = 0; /* number of heap objects in all garbage collections */
/* in a single gc */ /* in a single gc */
UInt total_marked; /* number of heap objects marked */ Int total_marked; /* number of heap objects marked */
struct gc_ma_h_entry *live_list; struct gc_ma_h_entry *live_list;
@ -202,11 +202,11 @@ partition(CELL *a[], Int p, Int r)
static void static void
insort(CELL *a[], Int p, Int q) insort(CELL *a[], Int p, Int q)
{ {
UInt j; Int j;
for (j = p+1; j <= q; j ++) { for (j = p+1; j <= q; j ++) {
CELL *key; CELL *key;
UInt i; Int i;
key = a[j]; key = a[j];
i = j; i = j;
@ -223,7 +223,7 @@ insort(CELL *a[], Int p, Int q)
static void static void
quicksort(CELL *a[], Int p, Int r) quicksort(CELL *a[], Int p, Int r)
{ {
UInt q; Int q;
if (p < r) { if (p < r) {
if (r - p < 100) { if (r - p < 100) {
insort(a, p, r); insort(a, p, r);
@ -2807,7 +2807,7 @@ gc(Int predarity, CELL *current_env, yamop *nextop)
} }
/* expand the stack if effectiveness is less than 20 % */ /* expand the stack if effectiveness is less than 20 % */
if (ASP - H < gc_margin || !gc_on || effectiveness < 20) { if (ASP - H < gc_margin || !gc_on || effectiveness < 20) {
UInt gap = CalculateStackGap(); Int gap = CalculateStackGap();
if (ASP-H > gc_margin) if (ASP-H > gc_margin)
gc_margin = (ASP-H)+gap; gc_margin = (ASP-H)+gap;
else else

5
C/iopreds.c
View File

@ -68,6 +68,9 @@ static char SccsId[] = "%W% %G%";
#if !HAVE_STRNCPY #if !HAVE_STRNCPY
#define strncpy(X,Y,Z) strcpy(X,Y) #define strncpy(X,Y,Z) strcpy(X,Y)
#endif #endif
#if _MSC_VER
#include <windows.h>
#endif
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
#if USE_SOCKET #if USE_SOCKET
#include <winsock2.h> #include <winsock2.h>
@ -4812,8 +4815,10 @@ StreamToFileNo(Term t)
#else #else
return(Stream[sno].u.pipe.fd); return(Stream[sno].u.pipe.fd);
#endif #endif
#if USE_SOCKET
} else if (Stream[sno].status & Socket_Stream_f) { } else if (Stream[sno].status & Socket_Stream_f) {
return(Stream[sno].u.socket.fd); return(Stream[sno].u.socket.fd);
#endif
} else if (Stream[sno].status & (Null_Stream_f|InMemory_Stream_f)) { } else if (Stream[sno].status & (Null_Stream_f|InMemory_Stream_f)) {
return(-1); return(-1);
} else { } else {

2
C/modules.c
View File

@ -46,7 +46,7 @@ Module_Name(CODEADDR cap)
} }
} }
int SMALLUNSGN
LookupModule(Term a) LookupModule(Term a)
{ {
unsigned int i; unsigned int i;

2
C/parser.c
View File

@ -397,6 +397,7 @@ ParseTerm(int prio)
} }
} else if (tokptr->Tok == Name_tok) { } else if (tokptr->Tok == Name_tok) {
Atom at = (Atom)tokptr->TokInfo; Atom at = (Atom)tokptr->TokInfo;
#ifndef _MSC_VER
if ((Atom)t == AtomPlus) { if ((Atom)t == AtomPlus) {
if (at == AtomInf) { if (at == AtomInf) {
t = MkFloatTerm(INFINITY); t = MkFloatTerm(INFINITY);
@ -418,6 +419,7 @@ ParseTerm(int prio)
break; break;
} }
} }
#endif
} }
if (opprio <= prio) { if (opprio <= prio) {
/* try to parse as a prefix operator */ /* try to parse as a prefix operator */

2
C/stdpreds.c
View File

@ -2009,10 +2009,8 @@ p_set_yap_flags(void)
return(FALSE); return(FALSE);
if (value == 1) { if (value == 1) {
heap_regs->pred_meta_call = RepPredProp(PredPropByFunc(MkFunctor(AtomMetaCall,4),0)); heap_regs->pred_meta_call = RepPredProp(PredPropByFunc(MkFunctor(AtomMetaCall,4),0));
set_fpu_exceptions(TRUE);
} else { } else {
heap_regs->pred_meta_call = RepPredProp(PredPropByFunc(MkFunctor(AtomMetaCall,4),0)); heap_regs->pred_meta_call = RepPredProp(PredPropByFunc(MkFunctor(AtomMetaCall,4),0));
set_fpu_exceptions(FALSE);
} }
yap_flags[LANGUAGE_MODE_FLAG] = value; yap_flags[LANGUAGE_MODE_FLAG] = value;
break; break;

94
C/sysbits.c
View File

@ -294,18 +294,25 @@ void cputime_interval(Int *now,Int *interval)
static FILETIME StartOfTimes, last_time; static FILETIME StartOfTimes, last_time;
static clock_t TimesStartOfTimes, Times_last_time;
/* store user time in this variable */ /* store user time in this variable */
static void static void
InitTime (void) InitTime (void)
{ {
HANDLE hProcess = GetCurrentProcess(); HANDLE hProcess = GetCurrentProcess();
FILETIME CreationTime, ExitTime, KernelTime, UserTime; FILETIME CreationTime, ExitTime, KernelTime, UserTime;
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) {
WinError("could not query cputime"); /* WIN98 */
last_time.dwLowDateTime = UserTime.dwLowDateTime; clock_t t;
last_time.dwHighDateTime = UserTime.dwHighDateTime; t = clock ();
StartOfTimes.dwLowDateTime = UserTime.dwLowDateTime; Times_last_time = TimesStartOfTimes = t;
StartOfTimes.dwHighDateTime = UserTime.dwHighDateTime; } else {
last_time.dwLowDateTime = UserTime.dwLowDateTime;
last_time.dwHighDateTime = UserTime.dwHighDateTime;
StartOfTimes.dwLowDateTime = UserTime.dwLowDateTime;
StartOfTimes.dwHighDateTime = UserTime.dwHighDateTime;
}
} }
Int Int
@ -313,10 +320,12 @@ cputime (void)
{ {
HANDLE hProcess = GetCurrentProcess(); HANDLE hProcess = GetCurrentProcess();
FILETIME CreationTime, ExitTime, KernelTime, UserTime; FILETIME CreationTime, ExitTime, KernelTime, UserTime;
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) {
WinError("could not query cputime"); clock_t t;
t = clock ();
return(((t - TimesStartOfTimes)*1000) / CLOCKS_PER_SEC);
} else {
#ifdef __GNUC__ #ifdef __GNUC__
{
unsigned long long int t = unsigned long long int t =
*(unsigned long long int *)&UserTime - *(unsigned long long int *)&UserTime -
*(unsigned long long int *)&StartOfTimes; *(unsigned long long int *)&StartOfTimes;
@ -324,7 +333,7 @@ cputime (void)
return((Int)t); return((Int)t);
#endif #endif
#ifdef _MSC_VER #ifdef _MSC_VER
LONG_INTEGER t = *(LONG_INTEGER *)&UserTime - *(LONG_INTEGER *)&StartOfTimes; __int64 t = *(__int64 *)&UserTime - *(__int64 *)&StartOfTimes;
return((Int)(t/10000)); return((Int)(t/10000));
#endif #endif
} }
@ -334,9 +343,13 @@ void cputime_interval(Int *now,Int *interval)
{ {
HANDLE hProcess = GetCurrentProcess(); HANDLE hProcess = GetCurrentProcess();
FILETIME CreationTime, ExitTime, KernelTime, UserTime; FILETIME CreationTime, ExitTime, KernelTime, UserTime;
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) {
WinError("could not query cputime"); clock_t t;
{ t = clock ();
*now = ((t - TimesStartOfTimes)*1000) / CLOCKS_PER_SEC;
*interval = (t - Times_last_time) * 1000 / CLOCKS_PER_SEC;
Times_last_time = t;
} else {
#ifdef __GNUC__ #ifdef __GNUC__
unsigned long long int t1 = unsigned long long int t1 =
*(unsigned long long int *)&UserTime - *(unsigned long long int *)&UserTime -
@ -350,8 +363,8 @@ void cputime_interval(Int *now,Int *interval)
*interval = (Int)t2; *interval = (Int)t2;
#endif #endif
#ifdef _MSC_VER #ifdef _MSC_VER
LONG_INTEGER t1 = *(LONG_INTEGER *)&UserTime - *(LONG_INTEGER *)&StartOfTimes; __int64 t1 = *(__int64 *)&UserTime - *(__int64 *)&StartOfTimes;
LONG_INTEGER t2 = *(LONG_INTEGER *)&UserTime - *(LONG_INTEGER *)&last_time; __int64 t2 = *(__int64 *)&UserTime - *(__int64 *)&last_time;
*now = (Int)(t1/10000); *now = (Int)(t1/10000);
*interval = (Int)(t2/10000); *interval = (Int)(t2/10000);
#endif #endif
@ -882,8 +895,8 @@ HandleMatherr(int sig, siginfo_t *sip, ucontext_t *uap)
default: default:
error_no = EVALUATION_ERROR_UNDEFINED; error_no = EVALUATION_ERROR_UNDEFINED;
} }
YAP_matherror = error_no; set_fpu_exceptions(0);
siglongjmp(RestartEnv, 2); Error(error_no, TermNil, "");
} }
@ -950,11 +963,6 @@ STATIC_PROTO (void my_signal, (int, void (*)(int)));
#include <fenv.h> #include <fenv.h>
#endif #endif
#ifdef __linux__
/* fetestexcept does not seem to work in linux :-( :-( */
#undef HAVE_FETESTEXCEPT
#endif
static RETSIGTYPE static RETSIGTYPE
HandleMatherr(int sig) HandleMatherr(int sig)
{ {
@ -964,7 +972,6 @@ HandleMatherr(int sig)
int raised = fetestexcept(FE_ALL_EXCEPT); int raised = fetestexcept(FE_ALL_EXCEPT);
feclearexcept(FE_ALL_EXCEPT);
if (raised & FE_OVERFLOW) { if (raised & FE_OVERFLOW) {
YAP_matherror = EVALUATION_ERROR_FLOAT_OVERFLOW; YAP_matherror = EVALUATION_ERROR_FLOAT_OVERFLOW;
} else if (raised & (FE_INVALID|FE_INEXACT)) { } else if (raised & (FE_INVALID|FE_INEXACT)) {
@ -973,18 +980,12 @@ HandleMatherr(int sig)
YAP_matherror = EVALUATION_ERROR_ZERO_DIVISOR; YAP_matherror = EVALUATION_ERROR_ZERO_DIVISOR;
} else if (raised & FE_UNDERFLOW) { } else if (raised & FE_UNDERFLOW) {
YAP_matherror = EVALUATION_ERROR_FLOAT_UNDERFLOW; YAP_matherror = EVALUATION_ERROR_FLOAT_UNDERFLOW;
} else { } else
YAP_matherror = EVALUATION_ERROR_UNDEFINED;
}
else
#endif #endif
YAP_matherror = EVALUATION_ERROR_UNDEFINED; YAP_matherror = EVALUATION_ERROR_UNDEFINED;
/* something very bad happened on the way to the forum */ /* something very bad happened on the way to the forum */
my_signal (SIGFPE, HandleMatherr); set_fpu_exceptions(FALSE);
/* do a longjmp because Linux is an idiot, and it makes our life Error(YAP_matherror, TermNil, "");
easier anyway, but not an abort!!
*/
siglongjmp(RestartEnv, 2);
} }
static void static void
@ -1064,7 +1065,7 @@ void (*handler)(int);
static int static int
InteractSIGINT(char ch) { InteractSIGINT(int ch) {
switch (ch) { switch (ch) {
case 'a': case 'a':
/* abort computation */ /* abort computation */
@ -1278,7 +1279,7 @@ ReceiveSignal (int s)
{ {
#ifndef MPW #ifndef MPW
case SIGFPE: case SIGFPE:
my_signal (SIGFPE, HandleMatherr); set_fpu_exceptions(FALSE);
Error (SYSTEM_ERROR, TermNil, "floating point exception ]"); Error (SYSTEM_ERROR, TermNil, "floating point exception ]");
break; break;
#endif #endif
@ -1948,7 +1949,8 @@ DoTimerThread(LPVOID targ)
LARGE_INTEGER liDueTime; LARGE_INTEGER liDueTime;
htimer = CreateWaitableTimer(NULL,FALSE,NULL); htimer = CreateWaitableTimer(NULL,FALSE,NULL);
liDueTime.QuadPart = -10000000LL*time; liDueTime.QuadPart = -10000000;
liDueTime.QuadPart *= time;
/* Copy the relative time into a LARGE_INTEGER. */ /* Copy the relative time into a LARGE_INTEGER. */
if (SetWaitableTimer(htimer, &liDueTime,0,NULL,NULL,0) == 0) { if (SetWaitableTimer(htimer, &liDueTime,0,NULL,NULL,0) == 0) {
return(FALSE); return(FALSE);
@ -1959,6 +1961,9 @@ DoTimerThread(LPVOID targ)
/* now, say what is going on */ /* now, say what is going on */
PutValue(AtomAlarm, MkAtomTerm(AtomTrue)); PutValue(AtomAlarm, MkAtomTerm(AtomTrue));
ExitThread(1); ExitThread(1);
#if _MSC_VER
return(0L);
#endif
} }
#endif #endif
@ -2028,7 +2033,7 @@ set_fpu_exceptions(int flag)
#if defined(__hpux) #if defined(__hpux)
fpsetmask(FP_X_INV|FP_X_DZ|FP_X_OFL|FP_X_UFL); fpsetmask(FP_X_INV|FP_X_DZ|FP_X_OFL|FP_X_UFL);
#endif #endif
#if HAVE_FPU_CONTROL_H && i386 && FIX_CONFIGURE #if HAVE_FPU_CONTROL_H && i386
/* I shall ignore denormalization and precision errors */ /* I shall ignore denormalization and precision errors */
int v = _FPU_IEEE & ~(_FPU_MASK_IM|_FPU_MASK_ZM|_FPU_MASK_OM|_FPU_MASK_UM); int v = _FPU_IEEE & ~(_FPU_MASK_IM|_FPU_MASK_ZM|_FPU_MASK_OM|_FPU_MASK_UM);
_FPU_SETCW(v); _FPU_SETCW(v);
@ -2036,19 +2041,31 @@ set_fpu_exceptions(int flag)
#if HAVE_FETESTEXCEPT #if HAVE_FETESTEXCEPT
feclearexcept(FE_ALL_EXCEPT); feclearexcept(FE_ALL_EXCEPT);
#endif #endif
my_signal (SIGFPE, HandleMatherr);
} else { } else {
/* do IEEE arithmetic in the way the big boys do */ /* do IEEE arithmetic in the way the big boys do */
#if defined(__hpux) #if defined(__hpux)
fpsetmask(FP_X_CLEAR); fpsetmask(FP_X_CLEAR);
#endif #endif
#if HAVE_FPU_CONTROL_H && i386 && FIX_CONFIGURE #if HAVE_FPU_CONTROL_H && i386
/* this will probably not work in older releases of Linux */ /* this will probably not work in older releases of Linux */
int v = _FPU_IEEE; int v = _FPU_IEEE;
_FPU_SETCW(v); _FPU_SETCW(v);
#endif #endif
my_signal (SIGFPE, SIG_IGN);
} }
} }
static Int
p_set_fpu_exceptions(void) {
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
set_fpu_exceptions(FALSE); /* can't make it work right */
} else {
set_fpu_exceptions(FALSE);
}
return(TRUE);
}
/* /*
* This is responsable for the initialization of all machine dependant * This is responsable for the initialization of all machine dependant
* predicates * predicates
@ -2096,6 +2113,7 @@ InitSysPreds(void)
InitCPred ("$getenv", 2, p_getenv, SafePredFlag); InitCPred ("$getenv", 2, p_getenv, SafePredFlag);
InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag); InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag);
InitCPred ("$file_age", 2, p_file_age, SafePredFlag|SyncPredFlag); InitCPred ("$file_age", 2, p_file_age, SafePredFlag|SyncPredFlag);
InitCPred ("$set_fpu_exceptions", 0, p_set_fpu_exceptions, SafePredFlag|SyncPredFlag);
} }

2
C/unify.c
View File

@ -1413,7 +1413,7 @@ p_arg(void)
} }
save_hb(); save_hb();
if ((Int)d0 <= 0 || if ((Int)d0 <= 0 ||
d0 > ArityOfFunctor((Functor) d1) || (Int)d0 > ArityOfFunctor((Functor) d1) ||
IUnify((CELL)(pt0+d0), ARG3) == FALSE) { IUnify((CELL)(pt0+d0), ARG3) == FALSE) {
/* don't complain here for Prolog compatibility /* don't complain here for Prolog compatibility
if ((Int)d0 <= 0) { if ((Int)d0 <= 0) {

8
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto * * File: Yap.proto *
* mods: * * mods: *
* comments: Function declarations for YAP * * comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.8 2002-01-29 05:37:31 vsc Exp $ * * version: $Id: Yapproto.h,v 1.9 2002-02-04 16:12:54 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* prototype file for Yap */ /* prototype file for Yap */
@ -52,9 +52,9 @@ Term STD_PROTO(MkSFTerm,(Functor,int,Term *,Term));
CELL STD_PROTO(*ArgsOfSFTerm,(Term)); CELL STD_PROTO(*ArgsOfSFTerm,(Term));
#endif #endif
int STD_PROTO(LookupModule,(Term)); SMALLUNSGN STD_PROTO(LookupModule,(Term));
Prop STD_PROTO(GetPredPropByAtom,(Atom, int)); Prop STD_PROTO(GetPredPropByAtom,(Atom, SMALLUNSGN));
Prop STD_PROTO(GetPredPropByFunc,(Functor, int)); Prop STD_PROTO(GetPredPropByFunc,(Functor, SMALLUNSGN));
Prop STD_PROTO(GetPredPropHavingLock,(Atom,unsigned int,SMALLUNSGN)); Prop STD_PROTO(GetPredPropHavingLock,(Atom,unsigned int,SMALLUNSGN));
Prop STD_PROTO(GetExpProp,(Atom,unsigned int)); Prop STD_PROTO(GetExpProp,(Atom,unsigned int));
Prop STD_PROTO(GetExpPropHavingLock,(AtomEntry *,unsigned int)); Prop STD_PROTO(GetExpPropHavingLock,(AtomEntry *,unsigned int));

2
H/heapgc.h
View File

@ -138,7 +138,7 @@ typedef CELL *CELL_PTR;
#define ENVSIZE(E) EnvSize(((CELL *)E)[E_CP]) #define ENVSIZE(E) EnvSize(((CELL *)E)[E_CP])
extern UInt total_marked; extern Int total_marked;
void STD_PROTO(mark_variable, (CELL *)); void STD_PROTO(mark_variable, (CELL *));
void STD_PROTO(mark_external_reference, (CELL *)); void STD_PROTO(mark_external_reference, (CELL *));

12
H/yapio.h
View File

@ -229,12 +229,6 @@ typedef enum{ /* we accept two domains for the moment, IPV6 may follow */
af_unix /* or AF_FILE */ af_unix /* or AF_FILE */
} socket_domain; } socket_domain;
/* info on aliases */
typedef struct AliasDescS {
Atom name;
int alias_stream;
} * AliasDesc;
Term STD_PROTO(InitSocketStream,(int, socket_info, socket_domain)); Term STD_PROTO(InitSocketStream,(int, socket_info, socket_domain));
int STD_PROTO(CheckSocketStream,(Term, char *)); int STD_PROTO(CheckSocketStream,(Term, char *));
socket_domain STD_PROTO(GetSocketDomain,(int)); socket_domain STD_PROTO(GetSocketDomain,(int));
@ -246,6 +240,12 @@ Int CloseSocket(int, socket_info, socket_domain);
#endif /* USE_SOCKET */ #endif /* USE_SOCKET */
/* info on aliases */
typedef struct AliasDescS {
Atom name;
int alias_stream;
} * AliasDesc;
/****************** character definition table **************************/ /****************** character definition table **************************/
#define NUMBER_OF_CHARS 256 #define NUMBER_OF_CHARS 256
extern char *chtype; extern char *chtype;

228
VC/include/Atoms.h
View File

@ -1,112 +1,116 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog %W% %G% * YAP Prolog %W% %G%
* * * *
* Yap Prolog was developed at NCCUP - Universidade do Porto * * Yap Prolog was developed at NCCUP - Universidade do Porto *
* * * *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* * * *
************************************************************************** **************************************************************************
* * * *
* File: Atoms.h.m4 * * File: Atoms.h.m4 *
* Last rev: 19/2/88 * * Last rev: 19/2/88 *
* mods: * * mods: *
* comments: atom properties header file for YAP * * comments: atom properties header file for YAP *
* * * *
*************************************************************************/ *************************************************************************/
#undef EXTERN #undef EXTERN
#ifndef ADTDEFS_C #ifndef ADTDEFS_C
#define EXTERN static #define EXTERN static
#else #else
#define EXTERN #define EXTERN
#endif #endif
/********* operations for atoms ****************************************/ /********* operations for atoms ****************************************/
/* Atoms are assumed to be uniquely represented by an OFFSET and to have /* Atoms are assumed to be uniquely represented by an OFFSET and to have
associated with them a struct of type AtomEntry associated with them a struct of type AtomEntry
The two functions The two functions
RepAtom : Atom -> *AtomEntry RepAtom : Atom -> *AtomEntry
AbsAtom : *AtomEntry -> Atom AbsAtom : *AtomEntry -> Atom
are used to encapsulate the implementation of atoms are used to encapsulate the implementation of atoms
*/ */
typedef struct AtomEntryStruct *Atom; typedef struct AtomEntryStruct *Atom;
typedef struct PropEntryStruct *Prop; typedef struct PropEntryStruct *Prop;
/* I can only define the structure after I define the actual atoms */ /* I can only define the structure after I define the actual atoms */
/* atom structure */ /* atom structure */
typedef struct AtomEntryStruct { typedef struct AtomEntryStruct
Atom NextOfAE; /* used to build hash chains */ {
Prop PropsOfAE; /* property list for this atom */ Atom NextOfAE; /* used to build hash chains */
#if defined(YAPOR) || defined(THREADS) Prop PropsOfAE; /* property list for this atom */
rwlock_t ARWLock; #if defined(YAPOR) || defined(THREADS)
#endif rwlock_t ARWLock;
#endif
char StrOfAE[MIN_ARRAY]; /* representation of atom as a string */
} char StrOfAE[MIN_ARRAY]; /* representation of atom as a string */
AtomEntry; }
AtomEntry;
/* Props and Atoms are stored in chains, ending with a NIL */
#if USE_OFFSETS /* Props and Atoms are stored in chains, ending with a NIL */
# define EndOfPAEntr(P) ( Addr(P) == AtomBase) #if USE_OFFSETS
#else # define EndOfPAEntr(P) ( Addr(P) == AtomBase)
# define EndOfPAEntr(P) ( Addr(P) == NIL ) #else
#endif # define EndOfPAEntr(P) ( Addr(P) == NIL )
#endif
#define AtomName(at) RepAtom(at)->StrOfAE
#define AtomName(at) RepAtom(at)->StrOfAE
/* ********************** Properties **********************************/
/* ********************** Properties **********************************/
#if USE_OFFSETS
#define USE_OFFSETS_IN_PROPS 1 #if USE_OFFSETS
#else #define USE_OFFSETS_IN_PROPS 1
#define USE_OFFSETS_IN_PROPS 0 #else
#endif #define USE_OFFSETS_IN_PROPS 0
#endif
typedef SFLAGS PropFlags;
typedef SFLAGS PropFlags;
/* basic property entry structure */
typedef struct PropEntryStruct { /* basic property entry structure */
Prop NextOfPE; /* used to chain properties */ typedef struct PropEntryStruct
PropFlags KindOfPE; /* kind of property */ {
} PropEntry; Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */
/* ************************* Functors **********************************/ }
PropEntry;
/* Functor data type
abstype Functor = atom # int /* ************************* Functors **********************************/
with MkFunctor(a,n) = ...
and NameOfFunctor(f) = ... /* Functor data type
and ArityOfFunctor(f) = ... */ abstype Functor = atom # int
with MkFunctor(a,n) = ...
#define MaxArity 255 and NameOfFunctor(f) = ...
and ArityOfFunctor(f) = ... */
#define FunctorProperty ((PropFlags)(0xbb00)) #define MaxArity 255
/* functor property */
typedef struct FunctorEntryStruct { #define FunctorProperty ((PropFlags)(0xbb00))
Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */ /* functor property */
unsigned int ArityOfFE; /* arity of functor */ typedef struct FunctorEntryStruct
Atom NameOfFE; /* back pointer to owner atom */ {
Prop PropsOfFE; /* pointer to list of properties for this functor */ Prop NextOfPE; /* used to chain properties */
#if defined(YAPOR) || defined(THREADS) PropFlags KindOfPE; /* kind of property */
rwlock_t FRWLock; unsigned int ArityOfFE; /* arity of functor */
#endif Atom NameOfFE; /* back pointer to owner atom */
} FunctorEntry; Prop PropsOfFE; /* pointer to list of properties for this functor */
#if defined(YAPOR) || defined(THREADS)
typedef FunctorEntry *Functor; rwlock_t FRWLock;
#endif
}
FunctorEntry;
typedef FunctorEntry *Functor;

2
VC/include/Tags_24bits.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 * * Last rev: December 90 *
* mods: * * mods: *
* comments: Tag Scheme for machines with 24 bits adresses (m68000) * * comments: Tag Scheme for machines with 24 bits adresses (m68000) *
* version: $Id: Tags_24bits.h,v 1.7 2002-01-05 04:04:14 vsc Exp $ * * version: $Id: Tags_24bits.h,v 1.8 2002-02-04 16:12:54 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* Version for 24 bit addresses (68000) /* Version for 24 bit addresses (68000)

2
VC/include/Tags_32LowTag.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 * * Last rev: December 90 *
* mods: * * mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses * * comments: Original Tag Scheme for machines with 32 bits adresses *
* version: $Id: Tags_32LowTag.h,v 1.7 2002-01-05 04:04:14 vsc Exp $ * * version: $Id: Tags_32LowTag.h,v 1.8 2002-02-04 16:12:54 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#define TAG_LOW_BITS_32 1 #define TAG_LOW_BITS_32 1

2
VC/include/Tags_32Ops.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 * * Last rev: December 90 *
* mods: * * mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses * * comments: Original Tag Scheme for machines with 32 bits adresses *
* version: $Id: Tags_32Ops.h,v 1.7 2002-01-05 04:04:14 vsc Exp $ * * version: $Id: Tags_32Ops.h,v 1.8 2002-02-04 16:12:54 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* /*

2
VC/include/Tags_32bits.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 * * Last rev: December 90 *
* mods: * * mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses * * comments: Original Tag Scheme for machines with 32 bits adresses *
* version: $Id: Tags_32bits.h,v 1.7 2002-01-05 04:04:14 vsc Exp $ * * version: $Id: Tags_32bits.h,v 1.8 2002-02-04 16:12:54 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* Original version for 32 bit addresses machines, /* Original version for 32 bit addresses machines,

2
VC/include/Tags_64bits.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 * * Last rev: December 90 *
* mods: * * mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses * * comments: Original Tag Scheme for machines with 32 bits adresses *
* version: $Id: Tags_64bits.h,v 1.7 2002-01-05 04:04:14 vsc Exp $ * * version: $Id: Tags_64bits.h,v 1.8 2002-02-04 16:12:54 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#define TAG_64BITS 1 #define TAG_64BITS 1

2
VC/include/TermExt.h
View File

@ -17,7 +17,7 @@
* File: TermExt.h * * File: TermExt.h *
* mods: * * mods: *
* comments: Extensions to standard terms for YAP * * comments: Extensions to standard terms for YAP *
* version: $Id: TermExt.h,v 1.7 2002-01-05 04:04:14 vsc Exp $ * * version: $Id: TermExt.h,v 1.8 2002-02-04 16:12:54 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#if USE_OFFSETS #if USE_OFFSETS

2196
VC/include/Yap.h
View File

File diff suppressed because it is too large Load Diff

2261
VC/include/Yatom.h
View File

File diff suppressed because it is too large Load Diff

414
VC/include/config.h
View File

@ -1,179 +1,235 @@
/* config.h. Generated automatically by configure. */ /* config.h. Generated automatically by configure. */
/* are we using gcc */ /* are we using gcc */
#define HAVE_GCC 1 /* #define HAVE_GCC 1 */
/* should we use gcc threaded code (i.e. goto *adrs) */ /* should we use gcc threaded code (i.e. goto *adrs) */
#define USE_THREADED_CODE 1 /* #define USE_THREADED_CODE 1*/
/* Should we use lib readline ? */ /* Should we use lib readline ? */
/* #undef HAVE_LIBREADLINE */ /* #undef HAVE_LIBREADLINE */
/* Should we use gmp ? */ /* Should we use gmp ? */
/* #undef HAVE_LIBGMP */ /* #define HAVE_LIBGMP 1 */
/* does the compiler support inline ? */ /* does the compiler support inline ? */
/* #undef inline */ /* #undef inline */
/* Do we have Ansi headers ? */ /* Do we have Ansi headers ? */
#define STDC_HEADERS 1 #define STDC_HEADERS 1
/* Host Name ? */ /* Host Name ? */
#define HOST_ALIAS "i386-pc-cygwin32" #define HOST_ALIAS ""
/* #undef HAVE_SYS_WAIT_H */ /* #undef HAVE_SYS_WAIT_H */
#define NO_UNION_WAIT 1 #define NO_UNION_WAIT 1
#define HAVE_ARPA_INET_H 1 /* #undef HAVE_ARPA_INET_H */
#define HAVE_CTYPE_H 1 #define HAVE_CTYPE_H 1
#define HAVE_DIRECT_H 1 #define HAVE_DIRECT_H 1
#define HAVE_ERRNO_H 1 #define HAVE_DIRENT_H 1
#define HAVE_FCNTL_H 1 #define HAVE_ERRNO_H 1
/* #undef HAVE_FENV_H */ #define HAVE_FCNTL_H 1
/* #undef HAVE_FPU_CONTROL_H */ /* #undef HAVE_FENV_H */
#define HAVE_IEEEFP_H 1 /* #undef HAVE_FPU_CONTROL_H */
#define HAVE_LIMITS_H 1 /* #undef HAVE_GMP_H */
#define HAVE_MEMORY_H 1 /* #undef HAVE_IEEEFP_H */
#define HAVE_NETDB_H 1 #define HAVE_IO_H 1
#define HAVE_NETINET_IN_H 1 #define HAVE_LIMITS_H 1
/* #undef HAVE_REGEX_H */ #define HAVE_MEMORY_H 1
/* #undef HAVE_SIGINFO_H */ /* #undef HAVE_NETDB_H */
#define HAVE_STDARG_H 1 /* #undef HAVE_NETINET_IN_H */
#define HAVE_STRING_H 1 /* #undef HAVE_READLINE_READLINE_H */
#define HAVE_SYS_FILE_H 1 /* #undef HAVE_REGEX_H */
#define HAVE_SYS_MMAN_H 1 /* #undef HAVE_SIGINFO_H */
#define HAVE_SYS_PARAM_H 1 #define HAVE_SIGNAL_H 1
#define HAVE_SYS_RESOURCE_H 1 #define HAVE_STDARG_H 1
#define HAVE_SYS_SELECT_H 1 #define HAVE_STRING_H 1
/* #undef HAVE_SYS_SHM_H */ /* #undef HAVE_STROPTS_H */
#define HAVE_SYS_SOCKET_H 1 /* #undef HAVE_SYS_CONF_H */
#define HAVE_SYS_STAT_H 1 #define HAVE_SYS_FILE_H 1
#define HAVE_SYS_TIME_H 1 /* #undef HAVE_SYS_MMAN_H */
#define HAVE_SYS_TIMES_H 1 /* #undef HAVE_SYS_PARAM_H */
#define HAVE_SYS_TYPES_H 1 /* #undef HAVE_SYS_RESOURCE_H */
/* #undef HAVE_SYS_UCONTEXT_H */ /* #undef HAVE_SYS_SELECT_H */
#define HAVE_SYS_UN_H 1 /* #undef HAVE_SYS_SHM_H */
#define HAVE_TIME_H 1 /* #undef HAVE_SYS_SOCKET_H */
#define HAVE_UNISTD_H 1 #define HAVE_SYS_STAT_H 1
#define HAVE_WINSOCK_H 1 #define HAVE_SYS_TIME_H 1
#define HAVE_WINSOCK2_H 1 /* #undef HAVE_SYS_TIMES_H */
/* #undef HAVE_GMP_H */ #define HAVE_SYS_TYPES_H 1
/* #undef HAVE_SYS_UCONTEXT_H */
/* Do we have restartable syscalls */ /* #undef HAVE_SYS_UN_H */
/* #undef HAVE_RESTARTABLE_SYSCALLS */ #define HAVE_TIME_H 1
#define HAVE_UNISTD_H 1
/* is 'tms' defined in <sys/time.h> ? */ #define HAVE_WINSOCK_H 1
/* #undef TM_IN_SYS_TIME */ #define HAVE_WINSOCK2_H 1
/* define type of prt returned by malloc: char or void */ /* Do we have restartable syscalls */
#define MALLOC_T void * /* #undef HAVE_RESTARTABLE_SYSCALLS */
/* Define byte order */ /* is 'tms' defined in <sys/time.h> ? */
/* #undef WORDS_BIGENDIAN */ /* #undef TM_IN_SYS_TIME */
/* Define sizes of some basic types */ /* define type of prt returned by malloc: char or void */
#define SIZEOF_INT_P 4 #define MALLOC_T void *
#define SIZEOF_INT 4
#define SIZEOF_SHORT_INT 2 /* Define byte order */
#define SIZEOF_LONG_INT 4 /* #undef WORDS_BIGENDIAN */
#define SIZEOF_LONG_LONG_INT 8
#define SIZEOF_FLOAT 4 /* Define sizes of some basic types */
#define SIZEOF_DOUBLE 8 #define SIZEOF_INT_P 4
#define SIZEOF_INT 4
/* Define representation of floats */ #define SIZEOF_SHORT_INT 2
/* only one of the following shoud be set */ #define SIZEOF_LONG_INT 4
/* to add a new representation you must edit FloatOfTerm and MkFloatTerm #define SIZEOF_LONG_LONG_INT 8
in adtdefs.c #define SIZEOF_FLOAT 4
*/ #define SIZEOF_DOUBLE 8
#define FFIEEE 1
/* #undef FFVAX */ /* manual */ /* Define representation of floats */
/* only one of the following shoud be set */
/* Define the standard type of a float argument to a function */ /* to add a new representation you must edit FloatOfTerm and MkFloatTerm
#define FAFloat double /* manual */ in adtdefs.c
*/
/* Define return type for signal */ #define FFIEEE 1
#define RETSIGTYPE void /* #undef FFVAX */ /* manual */
/* #undef HAVE_ALARM */ /* Define the standard type of a float argument to a function */
/* #undef HAVE_ASINH */ #define FAFloat double /* manual */
/* #undef HAVE_ACOSH */
/* #undef HAVE_ATANH */ /* Set the minimum and default heap, trail and stack size */
#define HAVE_CHDIR 1 #define MinTrailSpace ( 32*SIZEOF_INT_P)
#define HAVE_DUP2 1 #define MinStackSpace (200*SIZEOF_INT_P)
/* #undef HAVE_FETESTEXCEPT */ #define MinHeapSpace (200*SIZEOF_INT_P)
/* #undef HAVE_FINITE */
/* #undef HAVE_GETRUSAGE */ #define UsrTrailSpace (0)
#define HAVE_GETCWD 1 #define UsrStackSpace (0)
#define HAVE_GETENV 1 #define UsrHeapSpace (0)
/* #undef HAVE_GETHRTIME */
/* #undef HAVE_GETPWNAM */ #if (UsrTrailSpace > MinTrailSpace)
/* #undef HAVE_GETTIMEOFDAY */ #define DefTrailSpace UsrTrailSpace
/* #undef HAVE_GETWD */ #else
#define HAVE_ISATTY 1 #define DefTrailSpace MinTrailSpace
/* #undef HAVE_ISNAN */ #endif
#define HAVE_LABS 1
/* #undef HAVE_LINK */ #if (UsrStackSpace > MinStackSpace)
/* #undef HAVE_MMAP */ #define DefStackSpace UsrStackSpace
#define HAVE_MEMCPY 1 #else
#define HAVE_MEMMOVE 1 #define DefStackSpace MinStackSpace
/* #undef HAVE_MKSTEMP */ #endif
#define HAVE_PUTENV 1
#define HAVE_RAND 1 #if (UsrHeapSpace > MinHeapSpace)
/* #undef HAVE_RANDOM */ #define DefHeapSpace UsrHeapSpace
/* #undef HAVE_RINT */ #else
/* #undef HAVE_SBRK */ #define DefHeapSpace MinHeapSpace
#define HAVE_STAT 1 #endif
/* #undef HAVE_SELECT */
#define HAVE_SETBUF 1
/* #undef HAVE_SHMAT */
/* #undef HAVE_SIGACTION */ /* Define return type for signal */
/* #undef HAVE_SIGGETMASK */ #define RETSIGTYPE void
#define HAVE_SIGNAL 1
/* #undef HAVE_SIGPROCMASK */ /* #undef HAVE_ACOSH */
#define HAVE_SIGSEGV 1 /* #undef HAVE_ALARM */
#define HAVE_SIGSETJMP 0 /* #undef HAVE_ASINH */
/* #undef HAVE_SNPRINTF */ /* #undef HAVE_ATANH */
/* #undef HAVE_SOCKET */ #define HAVE_CHDIR 1
#define HAVE_STRERROR 1 #define HAVE_DUP2 1
#define HAVE_STRNCAT 1 /* #undef HAVE_FETESTEXCEPT */
#define HAVE_STRNCPY 1 /* #undef HAVE_FINITE */
#define HAVE_STRCHR 1 #define HAVE_GETCWD 1
#define HAVE_STRTOD 1 #define HAVE_GETENV 1
#define HAVE_SYSTEM 1 /* #undef HAVE_GETHOSTBYNAME */
/* #undef HAVE_TIMES */ /* #undef HAVE_GETHOSTID */
#define HAVE_TMPNAM 1 /* #undef HAVE_GETHOSTNAME */
/* #undef HAVE_VSNPRINTF */ /* #undef HAVE_GETHRTIME */
#define HAVE_ENVIRON 1 /* #undef HAVE_GETPWNAM */
#define HAVE_MPZ_XOR 0 /* #undef HAVE_GETRUSAGE */
/* #undef HAVE_GETTIMEOFDAY */
#define SELECT_TYPE_ARG1 /* #undef HAVE_GETWD */
#define SELECT_TYPE_ARG234 #define HAVE_ISATTY 1
#define SELECT_TYPE_ARG5 /* #undef HAVE_ISNAN */
/* #undef HAVE_KILL */
#define TYPE_SELECT_ #define HAVE_LABS 1
#define MYTYPE(X) MYTYPE1#X /* #undef HAVE_LINK */
#define HAVE_LOCALTIME 1
/* define how to pass the address of a function */ /* #undef HAVE_LSTAT */
#define FunAdr(Fn) Fn #define HAVE_MEMCPY 1
#define HAVE_MEMMOVE 1
#define ALIGN_LONGS 1 /* #undef HAVE_MKSTEMP */
#define LOW_ABSMI 0 #define HAVE_MKTEMP 1
/* #undef HAVE_MMAP */
#define MSHIFTOFFS 1 #define HAVE_OPENDIR 1
#define HAVE_POPEN 1
#define USE_MMAP (HAVE_MMAP) #define HAVE_PUTENV 1
#define USE_SHM (HAVE_SHMAT & !HAVE_MMAP) #define HAVE_RAND 1
#define USE_SBRK (HAVE_SBRK & !HAVE_MMAP & !HAVE_SHMAT) /* #undef HAVE_RANDOM */
#define HAVE_RENAME 1
/* for OSes that do not allow user access to the first /* #undef HAVE_RINT */
quadrant of the memory space */ /* #undef HAVE_RL_SET_PROMPT */
/* #undef FORCE_SECOND_QUADRANT */ /* #undef HAVE_SBRK */
/* #undef HAVE_SELECT */
#if (HAVE_SOCKET || defined(__MINGW32__)) && !defined(SIMICS) #define HAVE_SETBUF 1
#define USE_SOCKET 1 /* #undef HAVE_SETLINEBUF */
#endif /* #undef HAVE_SHMAT */
/* #undef HAVE_SIGACTION */
#if HAVE_GMP_H && HAVE_LIBGMP /* #undef HAVE_SIGGETMASK */
#define USE_GMP 1 /* #undef HAVE_SIGINTERRUPT */
#endif #define HAVE_SIGNAL 1
/* #undef HAVE_SIGPROCMASK */
#define HAVE_SIGSETJMP 0
#define HAVE_SLEEP 1
/* #undef HAVE_SNPRINTF */
/* #undef HAVE_SOCKET */
#define HAVE_STAT 1
#define HAVE_STRCHR 1
#define HAVE_STRERROR 1
#define HAVE_STRNCAT 1
#define HAVE_STRNCPY 1
#define HAVE_STRTOD 1
#define HAVE_SYSTEM 1
#define HAVE_TIME 1
/* #undef HAVE_TIMES */
#define HAVE_TMPNAM 1
/* #undef HAVE_USLEEP */
/* #undef HAVE_VSNPRINTF */
/* #undef HAVE_WAITPID */
#define HAVE_MPZ_XOR 0
#define HAVE_SIGSEGV 1
#define HAVE_ENVIRON 1
#define SELECT_TYPE_ARG1
#define SELECT_TYPE_ARG234
#define SELECT_TYPE_ARG5
#define TYPE_SELECT_
#define MYTYPE(X) MYTYPE1#X
/* define how to pass the address of a function */
#define FunAdr(Fn) Fn
#define ALIGN_LONGS 1
#define LOW_ABSMI 0
#define MSHIFTOFFS 1
#define USE_MMAP (HAVE_MMAP)
#define USE_SHM (HAVE_SHMAT & !HAVE_MMAP)
#define USE_SBRK (HAVE_SBRK & !HAVE_MMAP & !HAVE_SHMAT)
/* for OSes that do not allow user access to the first
quadrant of the memory space */
/* #undef FORCE_SECOND_QUADRANT */
#if (HAVE_SOCKET || defined(__MINGW32__)) && !defined(SIMICS)
#define USE_SOCKET 1
#endif
#if HAVE_GMP_H && HAVE_LIBGMP
#define USE_GMP 1
#endif
/* Is fflush(NULL) clobbering input streams? */
#define BROKEN_FFLUSH_NULL 1

2
console/yap.c
View File

@ -132,6 +132,8 @@ do_bootfile (char *bootfilename)
Term term_true = MkAtomTerm(YapLookupAtom("true")); Term term_true = MkAtomTerm(YapLookupAtom("true"));
Term functor_query = MkFunctor(YapLookupAtom("?-"),1); Term functor_query = MkFunctor(YapLookupAtom("?-"),1);
fprintf(stderr,"Entering Yap\n");
/* consult boot.pl */ /* consult boot.pl */
bootfile = fopen (bootfilename, "r"); bootfile = fopen (bootfilename, "r");
if (bootfile == NULL) if (bootfile == NULL)

3
docs/yap.tex
View File

@ -8226,11 +8226,10 @@ L = [1-[2,3,4,5,6],2-[4,5,6],4-[6]]
@syindex reachable/3 @syindex reachable/3
@cnindex reachable/3 @cnindex reachable/3
Unify @var{Vertices} with the set of all vertices in graph Unify @var{Vertices} with the set of all vertices in graph
@var{Graph that are reachable from @var{Node}. In the next example: @var{Graph} that are reachable from @var{Node}. In the next example:
@example @example
?- reachable(1,[1-[3,5],2-[4],3-[],4-[5],5-[]],V). ?- reachable(1,[1-[3,5],2-[4],3-[],4-[5],5-[]],V).
V = [1,3,5] V = [1,3,5]
@end example @end example

2
include/c_interface.h
View File

@ -24,7 +24,7 @@
#include "yap_structs.h" #include "yap_structs.h"
#if defined(_MSC_VER) && defined(YAPDLL_EXPORTS) #if defined(_MSC_VER) && defined(YAP_EXPORTS)
#define X_API __declspec(dllexport) #define X_API __declspec(dllexport)
#else #else
#define X_API #define X_API

7
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 * * File: Yap.h.m4 *
* mods: * * mods: *
* comments: main header file for YAP * * comments: main header file for YAP *
* version: $Id: Yap.h.m4,v 1.19 2002-01-29 05:37:31 vsc Exp $ * * version: $Id: Yap.h.m4,v 1.20 2002-02-04 16:12:54 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#include "config.h" #include "config.h"
@ -102,9 +102,10 @@
#undef USE_THREADED_CODE #undef USE_THREADED_CODE
#endif #endif
#define inline __inline #define inline __inline
#define YAP_VERSION "Yap-4.3.17" #define YAP_VERSION "Yap-4.3.21"
#define BIN_DIR "c:\\Program Files\\Yap\\bin" #define BIN_DIR "c:\\Program Files\\Yap\\bin"
#define LIB_DIR "c:\\Program Files\\Yap\\bin" #define LIB_DIR "c:\\Program Files\\Yap\\lib\\Yap"
#define SHARE_DIR "c:\\Program Files\\Yap\\share\\Yap"
#ifdef HOST_ALIAS #ifdef HOST_ALIAS
#undef HOST_ALIAS #undef HOST_ALIAS
#endif #endif

2
m4/Yatom.h.m4
View File

@ -204,7 +204,6 @@ typedef struct pred_entry {
Prop NextOfPE; /* used to chain properties */ Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */ PropFlags KindOfPE; /* kind of property */
unsigned int ArityOfPE; /* arity of property */ unsigned int ArityOfPE; /* arity of property */
int ModuleOfPred; /* module for this definition */
CELL PredFlags; CELL PredFlags;
CODEADDR CodeOfPred; /* code address */ CODEADDR CodeOfPred; /* code address */
CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */ CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */
@ -218,6 +217,7 @@ typedef struct pred_entry {
#ifdef TABLING #ifdef TABLING
tab_ent_ptr TableOfPred; tab_ent_ptr TableOfPred;
#endif /* TABLING */ #endif /* TABLING */
SMALLUNSGN ModuleOfPred; /* module for this definition */
OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */ OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */
profile_data StatisticsForPred; /* enable profiling for predicate */ profile_data StatisticsForPred; /* enable profiling for predicate */
SMALLUNSGN StateOfPred; /* actual state of predicate */ SMALLUNSGN StateOfPred; /* actual state of predicate */

3
pl/directives.yap
View File

@ -541,6 +541,7 @@ yap_flag(host_type,X) :-
'$transl_to_on_off'(Y,off), % disable character escapes. '$transl_to_on_off'(Y,off), % disable character escapes.
'$set_yap_flags'(12,Y), '$set_yap_flags'(12,Y),
'$set_yap_flags'(14,1), '$set_yap_flags'(14,1),
'$set_fpu_exceptions',
unknown(_,error). unknown(_,error).
'$adjust_language'(sicstus) :- '$adjust_language'(sicstus) :-
'$switch_log_upd'(1), '$switch_log_upd'(1),
@ -553,6 +554,7 @@ yap_flag(host_type,X) :-
'$set_yap_flags'(5,X1), '$set_yap_flags'(5,X1),
'$force_char_conversion', '$force_char_conversion',
'$set_yap_flags'(14,0), '$set_yap_flags'(14,0),
'$set_fpu_exceptions',
unknown(_,error). unknown(_,error).
'$adjust_language'(iso) :- '$adjust_language'(iso) :-
'$switch_log_upd'(2), '$switch_log_upd'(2),
@ -566,6 +568,7 @@ yap_flag(host_type,X) :-
'$set_yap_flags'(5,X1), '$set_yap_flags'(5,X1),
'$force_char_conversion', '$force_char_conversion',
'$set_yap_flags'(14,0), '$set_yap_flags'(14,0),
'$set_fpu_exceptions',
unknown(_,error). unknown(_,error).
'$transl_to_character_escape_modes'(0,off) :- !. '$transl_to_character_escape_modes'(0,off) :- !.

3
pl/errors.yap
View File

@ -34,7 +34,8 @@
write(user_error,'[ Execution Aborted ]'), write(user_error,'[ Execution Aborted ]'),
nl(user_error). nl(user_error).
'$process_error'(error(Msg, Where)) :- !, '$process_error'(error(Msg, Where)) :- !,
print_message(error,error(Msg, Where)). '$set_fpu_exceptions',
'$print_message'(error,error(Msg, Where)).
'$process_error'(Throw) :- '$process_error'(Throw) :-
print_message(error,Throw). print_message(error,Throw).