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
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;

94
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");
last_time.dwLowDateTime = UserTime.dwLowDateTime;
last_time.dwHighDateTime = UserTime.dwHighDateTime;
StartOfTimes.dwLowDateTime = UserTime.dwLowDateTime;
StartOfTimes.dwHighDateTime = UserTime.dwHighDateTime;
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;
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) {