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

6
C/adtdefs.c
View File

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

4
C/arrays.c
View File

@ -282,7 +282,7 @@ p_access_array(void)
Term t = Deref(ARG1);
Term ti = Deref(ARG2);
Term tf;
UInt indx;
Int indx;
if (IsNonVarTerm(ti)) {
union arith_ret v;
@ -1344,7 +1344,7 @@ p_assign_static(void)
Error(TYPE_ERROR_ARRAY,t1,"update_array");
return(FALSE);
}
if (indx > 0 && (UInt)indx > ArityOfFunctor(f)) {
if (indx > 0 && indx > ArityOfFunctor(f)) {
Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"update_array");
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_ERROR -1
#if defined(_MSC_VER) && defined(YAPDLL_EXPORTS)
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
#define X_API __declspec(dllexport)
#else
#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);
exit(1);
}
if (P == FAILCODE)
if (P == (yamop *)(FAILCODE))
return(P);
/* PURE_ABORT may not have set where correctly */
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
do_execute(Term t, int mod)
do_execute(Term t, SMALLUNSGN mod)
{
if (yap_flags[SPY_CREEP_FLAG]) {
return(EnterCreepMode(mod));
@ -1278,7 +1278,7 @@ JumpToEnv(Term t) {
/* I could backtrack here, but it is easier to leave the unwinding
to the emulator */
B->cp_a3 = t;
P = FAILCODE;
P = (yamop *)FAILCODE;
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 */
/* 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;
@ -202,11 +202,11 @@ partition(CELL *a[], Int p, Int r)
static void
insort(CELL *a[], Int p, Int q)
{
UInt j;
Int j;
for (j = p+1; j <= q; j ++) {
CELL *key;
UInt i;
Int i;
key = a[j];
i = j;
@ -223,7 +223,7 @@ insort(CELL *a[], Int p, Int q)
static void
quicksort(CELL *a[], Int p, Int r)
{
UInt q;
Int q;
if (p < r) {
if (r - p < 100) {
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 % */
if (ASP - H < gc_margin || !gc_on || effectiveness < 20) {
UInt gap = CalculateStackGap();
Int gap = CalculateStackGap();
if (ASP-H > gc_margin)
gc_margin = (ASP-H)+gap;
else

5
C/iopreds.c
View File

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

2
C/modules.c
View File

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

2
C/parser.c
View File

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

2
C/stdpreds.c
View File

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

84
C/sysbits.c
View File

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

8
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* 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 */
@ -52,9 +52,9 @@ Term STD_PROTO(MkSFTerm,(Functor,int,Term *,Term));
CELL STD_PROTO(*ArgsOfSFTerm,(Term));
#endif
int STD_PROTO(LookupModule,(Term));
Prop STD_PROTO(GetPredPropByAtom,(Atom, int));
Prop STD_PROTO(GetPredPropByFunc,(Functor, int));
SMALLUNSGN STD_PROTO(LookupModule,(Term));
Prop STD_PROTO(GetPredPropByAtom,(Atom, SMALLUNSGN));
Prop STD_PROTO(GetPredPropByFunc,(Functor, SMALLUNSGN));
Prop STD_PROTO(GetPredPropHavingLock,(Atom,unsigned int,SMALLUNSGN));
Prop STD_PROTO(GetExpProp,(Atom,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])
extern UInt total_marked;
extern Int total_marked;
void STD_PROTO(mark_variable, (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 */
} socket_domain;
/* info on aliases */
typedef struct AliasDescS {
Atom name;
int alias_stream;
} * AliasDesc;
Term STD_PROTO(InitSocketStream,(int, socket_info, socket_domain));
int STD_PROTO(CheckSocketStream,(Term, char *));
socket_domain STD_PROTO(GetSocketDomain,(int));
@ -246,6 +240,12 @@ Int CloseSocket(int, socket_info, socket_domain);
#endif /* USE_SOCKET */
/* info on aliases */
typedef struct AliasDescS {
Atom name;
int alias_stream;
} * AliasDesc;
/****************** character definition table **************************/
#define NUMBER_OF_CHARS 256
extern char *chtype;

16
VC/include/Atoms.h
View File

@ -46,7 +46,8 @@ typedef struct PropEntryStruct *Prop;
/* I can only define the structure after I define the actual atoms */
/* atom structure */
typedef struct AtomEntryStruct {
typedef struct AtomEntryStruct
{
Atom NextOfAE; /* used to build hash chains */
Prop PropsOfAE; /* property list for this atom */
#if defined(YAPOR) || defined(THREADS)
@ -78,10 +79,12 @@ AtomEntry;
typedef SFLAGS PropFlags;
/* basic property entry structure */
typedef struct PropEntryStruct {
typedef struct PropEntryStruct
{
Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */
} PropEntry;
}
PropEntry;
/* ************************* Functors **********************************/
@ -97,7 +100,8 @@ typedef struct PropEntryStruct {
#define FunctorProperty ((PropFlags)(0xbb00))
/* functor property */
typedef struct FunctorEntryStruct {
typedef struct FunctorEntryStruct
{
Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */
unsigned int ArityOfFE; /* arity of functor */
@ -106,7 +110,7 @@ typedef struct FunctorEntryStruct {
#if defined(YAPOR) || defined(THREADS)
rwlock_t FRWLock;
#endif
} FunctorEntry;
}
FunctorEntry;
typedef FunctorEntry *Functor;

2
VC/include/Tags_24bits.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 *
* mods: *
* 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)

2
VC/include/Tags_32LowTag.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 *
* mods: *
* 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

2
VC/include/Tags_32Ops.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 *
* mods: *
* 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 *
* mods: *
* 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,

2
VC/include/Tags_64bits.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 *
* mods: *
* 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

2
VC/include/TermExt.h
View File

@ -17,7 +17,7 @@
* File: TermExt.h *
* mods: *
* 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

300
VC/include/Yap.h
View File

@ -17,7 +17,7 @@
* File: Yap.h.m4 *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h,v 1.7 2002-01-05 04:04:14 vsc Exp $ *
* version: $Id: Yap.h,v 1.8 2002-02-04 16:12:54 vsc Exp $ *
*************************************************************************/
#include "config.h"
@ -109,9 +109,10 @@
#undef USE_THREADED_CODE
#endif
#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 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
#undef HOST_ALIAS
#endif
@ -392,7 +393,8 @@ extern sigjmp_buf RestartEnv; /* used to restart after an abort */
/************ variables concerned with Error Handling *************/
/* Types of Errors */
typedef enum {
typedef enum
{
NO_ERROR,
FATAL_ERROR,
INTERNAL_ERROR,
@ -467,13 +469,15 @@ typedef enum {
TYPE_ERROR_UBYTE,
TYPE_ERROR_VARIABLE,
UNKNOWN_ERROR
} yap_error_number;
}
yap_error_number;
extern char *ErrorMessage; /* used to pass error messages */
extern Term Error_Term; /* used to pass error terms */
extern yap_error_number Error_TYPE; /* used to pass the error */
typedef enum {
typedef enum
{
YAP_INT_BOUNDED_FLAG = 0,
MAX_ARITY_FLAG = 1,
INTEGER_ROUNDING_FLAG = 2,
@ -489,8 +493,10 @@ typedef enum {
CHARACTER_ESCAPE_FLAG = 12,
WRITE_QUOTED_STRING_FLAG = 13,
ALLOW_ASSERTING_STATIC_FLAG = 14,
HALT_AFTER_CONSULT_FLAG = 15
} yap_flags;
HALT_AFTER_CONSULT_FLAG = 15,
FAST_BOOT_FLAG = 16
}
yap_flags;
#define STRING_AS_CHARS 0
#define STRING_AS_ATOM 2
@ -502,7 +508,7 @@ typedef enum {
#define ISO_CHARACTER_ESCAPES 1
#define SICSTUS_CHARACTER_ESCAPES 2
#define NUMBER_OF_YAP_FLAGS HALT_AFTER_CONSULT_FLAG+1
#define NUMBER_OF_YAP_FLAGS FAST_BOOT_FLAG+1
/************************ prototypes **********************************/
@ -518,46 +524,46 @@ typedef enum {
/***********************************************************************/
/*
absrectype Term = Int + Float + Atom + Pair + Appl + Ref + Var
absrectype Term = Int + Float + Atom + Pair + Appl + Ref + Var
with AbsAppl(t) : *CELL -> Term
and RepAppl(t) : Term -> *CELL
with AbsAppl(t) : *CELL -> Term
and RepAppl(t) : Term -> *CELL
and AbsPair(t) : *CELL -> Term
and RepPair(t) : Term -> *CELL
and AbsPair(t) : *CELL -> Term
and RepPair(t) : Term -> *CELL
and IsIntTerm(t) = ...
and IsAtomTerm(t) = ...
and IsVarTerm(t) = ...
and IsPairTerm(t) = ...
and IsApplTerm(t) = ...
and IsFloatTerm(t) = ...
and IsRefTerm(t) = ...
and IsNonVarTerm(t) = ! IsVar(t)
and IsNumterm(t) = IsIntTerm(t) || IsFloatTerm(t)
and IsAtomicTerm(t) = IsNumTerm(t) || IsAtomTerm(t)
and IsPrimitiveTerm(t) = IsAtomicTerm(t) || IsRefTerm(t)
and IsIntTerm(t) = ...
and IsAtomTerm(t) = ...
and IsVarTerm(t) = ...
and IsPairTerm(t) = ...
and IsApplTerm(t) = ...
and IsFloatTerm(t) = ...
and IsRefTerm(t) = ...
and IsNonVarTerm(t) = ! IsVar(t)
and IsNumterm(t) = IsIntTerm(t) || IsFloatTerm(t)
and IsAtomicTerm(t) = IsNumTerm(t) || IsAtomTerm(t)
and IsPrimitiveTerm(t) = IsAtomicTerm(t) || IsRefTerm(t)
and MkIntTerm(n) = ...
and MkFloatTerm(f) = ...
and MkAtomTerm(a) = ...
and MkVarTerm(r) = ...
and MkApplTerm(f,n,args) = ...
and MkPairTerm(hd,tl) = ...
and MkRefTerm(R) = ...
and MkIntTerm(n) = ...
and MkFloatTerm(f) = ...
and MkAtomTerm(a) = ...
and MkVarTerm(r) = ...
and MkApplTerm(f,n,args) = ...
and MkPairTerm(hd,tl) = ...
and MkRefTerm(R) = ...
and PtrOfTerm(t) : Term -> CELL * = ...
and IntOfTerm(t) : Term -> int = ...
and FloatOfTerm(t) : Term -> flt = ...
and AtomOfTerm(t) : Term -> Atom = ...
and VarOfTerm(t) : Term -> *Term = ....
and HeadOfTerm(t) : Term -> Term = ...
and TailOfTerm(t) : Term -> Term = ...
and FunctorOfTerm(t) : Term -> Functor = ...
and ArgOfTerm(i,t) : Term -> Term= ...
and RefOfTerm(t) : Term -> DBRef = ...
and PtrOfTerm(t) : Term -> CELL * = ...
and IntOfTerm(t) : Term -> int = ...
and FloatOfTerm(t) : Term -> flt = ...
and AtomOfTerm(t) : Term -> Atom = ...
and VarOfTerm(t) : Term -> *Term = ....
and HeadOfTerm(t) : Term -> Term = ...
and TailOfTerm(t) : Term -> Term = ...
and FunctorOfTerm(t) : Term -> Functor = ...
and ArgOfTerm(i,t) : Term -> Term= ...
and RefOfTerm(t) : Term -> DBRef = ...
*/
*/
/*
YAP can use several different tag schemes, according to the kind of
@ -624,9 +630,10 @@ and RefOfTerm(t) : Term -> DBRef = ...
/* applies to unbound variables */
inline EXTERN Term * VarOfTerm(Term t);
inline EXTERN Term *VarOfTerm (Term t);
inline EXTERN Term * VarOfTerm(Term t)
inline EXTERN Term *
VarOfTerm (Term t)
{
return (Term *) (t);
}
@ -634,18 +641,20 @@ inline EXTERN Term * VarOfTerm(Term t)
#if SBA
inline EXTERN Term MkVarTerm(void);
inline EXTERN Term MkVarTerm (void);
inline EXTERN Term MkVarTerm()
inline EXTERN Term
MkVarTerm ()
{
return (Term) ((*H = 0, H++));
}
inline EXTERN int IsUnboundVar(Term);
inline EXTERN int IsUnboundVar (Term);
inline EXTERN int IsUnboundVar(Term t)
inline EXTERN int
IsUnboundVar (Term t)
{
return (int) (t == 0);
}
@ -653,98 +662,108 @@ inline EXTERN int IsUnboundVar(Term t)
#else
inline EXTERN Term MkVarTerm(void);
inline EXTERN Term MkVarTerm (void);
inline EXTERN Term MkVarTerm()
inline EXTERN Term
MkVarTerm ()
{
return (Term) ((*H = (CELL) H, H++));
}
inline EXTERN int IsUnboundVar(Term);
inline EXTERN int IsUnboundVar (Term);
inline EXTERN int IsUnboundVar(Term t)
inline EXTERN int
IsUnboundVar (Term t)
{
return (int) (*VarOfTerm(t) == (t));
return (int) (*VarOfTerm (t) == (t));
}
#endif
inline EXTERN CELL * PtrOfTerm(Term);
inline EXTERN CELL *PtrOfTerm (Term);
inline EXTERN CELL * PtrOfTerm(Term t)
inline EXTERN CELL *
PtrOfTerm (Term t)
{
return (CELL *) (*(CELL *)(t));
return (CELL *) (*(CELL *) (t));
}
inline EXTERN Functor FunctorOfTerm(Term);
inline EXTERN Functor FunctorOfTerm (Term);
inline EXTERN Functor FunctorOfTerm(Term t)
inline EXTERN Functor
FunctorOfTerm (Term t)
{
return (Functor) (*RepAppl(t));
return (Functor) (*RepAppl (t));
}
#if IN_SECOND_QUADRANT
inline EXTERN Term MkAtomTerm(Atom);
inline EXTERN Term MkAtomTerm (Atom);
inline EXTERN Term MkAtomTerm(Atom a)
inline EXTERN Term
MkAtomTerm (Atom a)
{
return (Term) (TAGGEDA(AtomTag, (CELL *)(a)-(CELL *)HEAP_INIT_BASE));
return (Term) (TAGGEDA (AtomTag, (CELL *) (a) - (CELL *) HEAP_INIT_BASE));
}
inline EXTERN Atom AtomOfTerm(Term t);
inline EXTERN Atom AtomOfTerm (Term t);
inline EXTERN Atom AtomOfTerm(Term t)
inline EXTERN Atom
AtomOfTerm (Term t)
{
return (Atom) ((CELL *)HEAP_INIT_BASE+NonTagPart(t));
return (Atom) ((CELL *) HEAP_INIT_BASE + NonTagPart (t));
}
#else
inline EXTERN Term MkAtomTerm(Atom);
inline EXTERN Term MkAtomTerm (Atom);
inline EXTERN Term MkAtomTerm(Atom a)
inline EXTERN Term
MkAtomTerm (Atom a)
{
return (Term) (TAGGEDA(AtomTag, (a)));
return (Term) (TAGGEDA (AtomTag, (a)));
}
inline EXTERN Atom AtomOfTerm(Term t);
inline EXTERN Atom AtomOfTerm (Term t);
inline EXTERN Atom AtomOfTerm(Term t)
inline EXTERN Atom
AtomOfTerm (Term t)
{
return (Atom) (NonTagPart(t));
return (Atom) (NonTagPart (t));
}
#endif
inline EXTERN int IsAtomTerm(Term);
inline EXTERN int IsAtomTerm (Term);
inline EXTERN int IsAtomTerm(Term t)
inline EXTERN int
IsAtomTerm (Term t)
{
return (int) (CHKTAG((t), AtomTag));
return (int) (CHKTAG ((t), AtomTag));
}
inline EXTERN Term MkIntTerm(Int);
inline EXTERN Term MkIntTerm (Int);
inline EXTERN Term MkIntTerm(Int n)
inline EXTERN Term
MkIntTerm (Int n)
{
return (Term) (TAGGED(NumberTag, (n)));
return (Term) (TAGGED (NumberTag, (n)));
}
@ -753,20 +772,22 @@ inline EXTERN Term MkIntTerm(Int n)
overflow problems are possible
*/
inline EXTERN Term MkIntConstant(Int);
inline EXTERN Term MkIntConstant (Int);
inline EXTERN Term MkIntConstant(Int n)
inline EXTERN Term
MkIntConstant (Int n)
{
return (Term) (NONTAGGED(NumberTag, (n)));
return (Term) (NONTAGGED (NumberTag, (n)));
}
inline EXTERN int IsIntTerm(Term);
inline EXTERN int IsIntTerm (Term);
inline EXTERN int IsIntTerm(Term t)
inline EXTERN int
IsIntTerm (Term t)
{
return (int) (CHKTAG((t), NumberTag));
return (int) (CHKTAG ((t), NumberTag));
}
@ -796,8 +817,7 @@ inline EXTERN int IsIntTerm(Term t)
extern ADDR HeapBase,
LocalBase,
GlobalBase,
TrailBase, TrailTop,
ForeignCodeBase, ForeignCodeTop, ForeignCodeMax;
TrailBase, TrailTop, ForeignCodeBase, ForeignCodeTop, ForeignCodeMax;
/*
@ -815,29 +835,32 @@ extern ADDR HeapBase,
#define IsAccessFunc(func) ((func) == FunctorAccess)
inline EXTERN Term MkIntegerTerm(Int);
inline EXTERN Term MkIntegerTerm (Int);
inline EXTERN Term MkIntegerTerm(Int n)
inline EXTERN Term
MkIntegerTerm (Int n)
{
return (Term) (IntInBnd(n) ? MkIntTerm(n) : MkLongIntTerm(n));
return (Term) (IntInBnd (n) ? MkIntTerm (n) : MkLongIntTerm (n));
}
inline EXTERN int IsIntegerTerm(Term);
inline EXTERN int IsIntegerTerm (Term);
inline EXTERN int IsIntegerTerm(Term t)
inline EXTERN int
IsIntegerTerm (Term t)
{
return (int) (IsIntTerm(t) || IsLongIntTerm(t));
return (int) (IsIntTerm (t) || IsLongIntTerm (t));
}
inline EXTERN Int IntegerOfTerm(Term);
inline EXTERN Int IntegerOfTerm (Term);
inline EXTERN Int IntegerOfTerm(Term t)
inline EXTERN Int
IntegerOfTerm (Term t)
{
return (Int) (IsIntTerm(t) ? IntOfTerm(t) : LongIntOfTerm(t));
return (Int) (IsIntTerm (t) ? IntOfTerm (t) : LongIntOfTerm (t));
}
@ -854,57 +877,63 @@ inline EXTERN Int IntegerOfTerm(Term t)
/*************** High level macros to access arguments ******************/
inline EXTERN Term ArgOfTerm(int i, Term t);
inline EXTERN Term ArgOfTerm (int i, Term t);
inline EXTERN Term ArgOfTerm(int i, Term t)
inline EXTERN Term
ArgOfTerm (int i, Term t)
{
return (Term) (Derefa(RepAppl(t) + (i)));
return (Term) (Derefa (RepAppl (t) + (i)));
}
inline EXTERN Term HeadOfTerm(Term);
inline EXTERN Term HeadOfTerm (Term);
inline EXTERN Term HeadOfTerm(Term t)
inline EXTERN Term
HeadOfTerm (Term t)
{
return (Term) (Derefa(RepPair(t)));
return (Term) (Derefa (RepPair (t)));
}
inline EXTERN Term TailOfTerm(Term);
inline EXTERN Term TailOfTerm (Term);
inline EXTERN Term TailOfTerm(Term t)
inline EXTERN Term
TailOfTerm (Term t)
{
return (Term) (Derefa(RepPair(t) + 1));
return (Term) (Derefa (RepPair (t) + 1));
}
inline EXTERN Term ArgOfTermCell(int i, Term t);
inline EXTERN Term ArgOfTermCell (int i, Term t);
inline EXTERN Term ArgOfTermCell(int i, Term t)
inline EXTERN Term
ArgOfTermCell (int i, Term t)
{
return (Term) ((CELL)(RepAppl(t) + (i)));
return (Term) ((CELL) (RepAppl (t) + (i)));
}
inline EXTERN Term HeadOfTermCell(Term);
inline EXTERN Term HeadOfTermCell (Term);
inline EXTERN Term HeadOfTermCell(Term t)
inline EXTERN Term
HeadOfTermCell (Term t)
{
return (Term) ((CELL)(RepPair(t)));
return (Term) ((CELL) (RepPair (t)));
}
inline EXTERN Term TailOfTermCell(Term);
inline EXTERN Term TailOfTermCell (Term);
inline EXTERN Term TailOfTermCell(Term t)
inline EXTERN Term
TailOfTermCell (Term t)
{
return (Term) ((CELL)(RepPair(t) + 1));
return (Term) ((CELL) (RepPair (t) + 1));
}
@ -939,10 +968,12 @@ extern char version_number[];
#if USE_THREADED_CODE
/************ reverse lookup of instructions *****************/
typedef struct opcode_tab_entry {
typedef struct opcode_tab_entry
{
OPCODE opc;
op_numbers opnum;
} opentry;
}
opentry;
#endif
@ -958,44 +989,20 @@ extern int CurFileNo;
/********* Prolog may be in several modes *******************************/
typedef enum {
typedef enum
{
BootMode = 1, /* if booting or restoring */
UserMode = 2, /* Normal mode */
CritMode = 4, /* If we are meddling with the heap */
AbortMode = 8, /* expecting to abort */
InterruptMode = 16, /* under an interrupt */
InErrorMode = 32 /* under an interrupt */
} prolog_exec_mode;
}
prolog_exec_mode;
extern prolog_exec_mode PrologMode;
extern int CritLocks;
#if SIZEOF_INT_P==4
#if defined(YAPOR) || defined(TABLING)
#define MinTrailSpace 192
#define MinStackSpace 1200
#define MinHeapSpace 1200
#else
#define MinTrailSpace 128
#define MinStackSpace 800
#define MinHeapSpace 800
#endif /* YAPOR || TABLING */
#else
#if defined(YAPOR) || defined(TABLING)
#define MinTrailSpace 384
#define MinStackSpace 2400
#define MinHeapSpace 2400
#else
#define MinTrailSpace 256
#define MinStackSpace 1600
#define MinHeapSpace 1600
#endif /* YAPOR || TABLING */
#endif
#define DefTrailSpace MinTrailSpace
#define DefStackSpace MinStackSpace
#define DefHeapSpace MinHeapSpace
/************** Access to yap initial arguments ***************************/
extern char **yap_args;
@ -1063,10 +1070,12 @@ extern int compile_arrays;
/* I assume that the size of this structure is a multiple of the size
of CELL!!! */
typedef struct TIMED_MAVAR{
typedef struct TIMED_MAVAR
{
CELL value;
CELL clock;
} timed_var;
}
timed_var;
/********* while debugging you may need some info ***********************/
@ -1091,4 +1100,3 @@ extern int snoozing;
#if SBA
#include "sbaunify.h"
#endif

609
VC/include/Yatom.h
View File

File diff suppressed because it is too large Load Diff

102
VC/include/config.h
View File

@ -1,16 +1,16 @@
/* config.h. Generated automatically by configure. */
/* are we using gcc */
#define HAVE_GCC 1
/* #define HAVE_GCC 1 */
/* 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 ? */
/* #undef HAVE_LIBREADLINE */
/* Should we use gmp ? */
/* #undef HAVE_LIBGMP */
/* #define HAVE_LIBGMP 1 */
/* does the compiler support inline ? */
/* #undef inline */
@ -19,45 +19,51 @@
#define STDC_HEADERS 1
/* Host Name ? */
#define HOST_ALIAS "i386-pc-cygwin32"
#define HOST_ALIAS ""
/* #undef HAVE_SYS_WAIT_H */
#define NO_UNION_WAIT 1
#define HAVE_ARPA_INET_H 1
/* #undef HAVE_ARPA_INET_H */
#define HAVE_CTYPE_H 1
#define HAVE_DIRECT_H 1
#define HAVE_DIRENT_H 1
#define HAVE_ERRNO_H 1
#define HAVE_FCNTL_H 1
/* #undef HAVE_FENV_H */
/* #undef HAVE_FPU_CONTROL_H */
#define HAVE_IEEEFP_H 1
/* #undef HAVE_GMP_H */
/* #undef HAVE_IEEEFP_H */
#define HAVE_IO_H 1
#define HAVE_LIMITS_H 1
#define HAVE_MEMORY_H 1
#define HAVE_NETDB_H 1
#define HAVE_NETINET_IN_H 1
/* #undef HAVE_NETDB_H */
/* #undef HAVE_NETINET_IN_H */
/* #undef HAVE_READLINE_READLINE_H */
/* #undef HAVE_REGEX_H */
/* #undef HAVE_SIGINFO_H */
#define HAVE_SIGNAL_H 1
#define HAVE_STDARG_H 1
#define HAVE_STRING_H 1
/* #undef HAVE_STROPTS_H */
/* #undef HAVE_SYS_CONF_H */
#define HAVE_SYS_FILE_H 1
#define HAVE_SYS_MMAN_H 1
#define HAVE_SYS_PARAM_H 1
#define HAVE_SYS_RESOURCE_H 1
#define HAVE_SYS_SELECT_H 1
/* #undef HAVE_SYS_MMAN_H */
/* #undef HAVE_SYS_PARAM_H */
/* #undef HAVE_SYS_RESOURCE_H */
/* #undef HAVE_SYS_SELECT_H */
/* #undef HAVE_SYS_SHM_H */
#define HAVE_SYS_SOCKET_H 1
/* #undef HAVE_SYS_SOCKET_H */
#define HAVE_SYS_STAT_H 1
#define HAVE_SYS_TIME_H 1
#define HAVE_SYS_TIMES_H 1
/* #undef HAVE_SYS_TIMES_H */
#define HAVE_SYS_TYPES_H 1
/* #undef HAVE_SYS_UCONTEXT_H */
#define HAVE_SYS_UN_H 1
/* #undef HAVE_SYS_UN_H */
#define HAVE_TIME_H 1
#define HAVE_UNISTD_H 1
#define HAVE_WINSOCK_H 1
#define HAVE_WINSOCK2_H 1
/* #undef HAVE_GMP_H */
/* Do we have restartable syscalls */
/* #undef HAVE_RESTARTABLE_SYSCALLS */
@ -91,61 +97,109 @@
/* Define the standard type of a float argument to a function */
#define FAFloat double /* manual */
/* Set the minimum and default heap, trail and stack size */
#define MinTrailSpace ( 32*SIZEOF_INT_P)
#define MinStackSpace (200*SIZEOF_INT_P)
#define MinHeapSpace (200*SIZEOF_INT_P)
#define UsrTrailSpace (0)
#define UsrStackSpace (0)
#define UsrHeapSpace (0)
#if (UsrTrailSpace > MinTrailSpace)
#define DefTrailSpace UsrTrailSpace
#else
#define DefTrailSpace MinTrailSpace
#endif
#if (UsrStackSpace > MinStackSpace)
#define DefStackSpace UsrStackSpace
#else
#define DefStackSpace MinStackSpace
#endif
#if (UsrHeapSpace > MinHeapSpace)
#define DefHeapSpace UsrHeapSpace
#else
#define DefHeapSpace MinHeapSpace
#endif
/* Define return type for signal */
#define RETSIGTYPE void
/* #undef HAVE_ACOSH */
/* #undef HAVE_ALARM */
/* #undef HAVE_ASINH */
/* #undef HAVE_ACOSH */
/* #undef HAVE_ATANH */
#define HAVE_CHDIR 1
#define HAVE_DUP2 1
/* #undef HAVE_FETESTEXCEPT */
/* #undef HAVE_FINITE */
/* #undef HAVE_GETRUSAGE */
#define HAVE_GETCWD 1
#define HAVE_GETENV 1
/* #undef HAVE_GETHOSTBYNAME */
/* #undef HAVE_GETHOSTID */
/* #undef HAVE_GETHOSTNAME */
/* #undef HAVE_GETHRTIME */
/* #undef HAVE_GETPWNAM */
/* #undef HAVE_GETRUSAGE */
/* #undef HAVE_GETTIMEOFDAY */
/* #undef HAVE_GETWD */
#define HAVE_ISATTY 1
/* #undef HAVE_ISNAN */
/* #undef HAVE_KILL */
#define HAVE_LABS 1
/* #undef HAVE_LINK */
/* #undef HAVE_MMAP */
#define HAVE_LOCALTIME 1
/* #undef HAVE_LSTAT */
#define HAVE_MEMCPY 1
#define HAVE_MEMMOVE 1
/* #undef HAVE_MKSTEMP */
#define HAVE_MKTEMP 1
/* #undef HAVE_MMAP */
#define HAVE_OPENDIR 1
#define HAVE_POPEN 1
#define HAVE_PUTENV 1
#define HAVE_RAND 1
/* #undef HAVE_RANDOM */
#define HAVE_RENAME 1
/* #undef HAVE_RINT */
/* #undef HAVE_RL_SET_PROMPT */
/* #undef HAVE_SBRK */
#define HAVE_STAT 1
/* #undef HAVE_SELECT */
#define HAVE_SETBUF 1
/* #undef HAVE_SETLINEBUF */
/* #undef HAVE_SHMAT */
/* #undef HAVE_SIGACTION */
/* #undef HAVE_SIGGETMASK */
/* #undef HAVE_SIGINTERRUPT */
#define HAVE_SIGNAL 1
/* #undef HAVE_SIGPROCMASK */
#define HAVE_SIGSEGV 1
#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_STRCHR 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 */
#define HAVE_ENVIRON 1
/* #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
@ -177,3 +231,5 @@
#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 functor_query = MkFunctor(YapLookupAtom("?-"),1);
fprintf(stderr,"Entering Yap\n");
/* consult boot.pl */
bootfile = fopen (bootfilename, "r");
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
@cnindex reachable/3
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
?- reachable(1,[1-[3,5],2-[4],3-[],4-[5],5-[]],V).
V = [1,3,5]
@end example

2
include/c_interface.h
View File

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

7
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* 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"
@ -102,9 +102,10 @@
#undef USE_THREADED_CODE
#endif
#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 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
#undef HOST_ALIAS
#endif

2
m4/Yatom.h.m4
View File

@ -204,7 +204,6 @@ typedef struct pred_entry {
Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */
unsigned int ArityOfPE; /* arity of property */
int ModuleOfPred; /* module for this definition */
CELL PredFlags;
CODEADDR CodeOfPred; /* code address */
CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */
@ -218,6 +217,7 @@ typedef struct pred_entry {
#ifdef TABLING
tab_ent_ptr TableOfPred;
#endif /* TABLING */
SMALLUNSGN ModuleOfPred; /* module for this definition */
OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */
profile_data StatisticsForPred; /* enable profiling for 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.
'$set_yap_flags'(12,Y),
'$set_yap_flags'(14,1),
'$set_fpu_exceptions',
unknown(_,error).
'$adjust_language'(sicstus) :-
'$switch_log_upd'(1),
@ -553,6 +554,7 @@ yap_flag(host_type,X) :-
'$set_yap_flags'(5,X1),
'$force_char_conversion',
'$set_yap_flags'(14,0),
'$set_fpu_exceptions',
unknown(_,error).
'$adjust_language'(iso) :-
'$switch_log_upd'(2),
@ -566,6 +568,7 @@ yap_flag(host_type,X) :-
'$set_yap_flags'(5,X1),
'$force_char_conversion',
'$set_yap_flags'(14,0),
'$set_fpu_exceptions',
unknown(_,error).
'$transl_to_character_escape_modes'(0,off) :- !.

3
pl/errors.yap
View File

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