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

small fixes

Browse Source 
indenting
This commit is contained in:
Vítor Santos Costa 2016-03-30 17:35:03 +01:00
parent 78ba5d01f2
commit 145ad73255
18 changed files with 693 additions and 445566 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitignore vendored
View File

@ -16,6 +16,7 @@ tags
TGSautom4te.cache
cscope.*
GPATH
m32
GRTAGS
GTAGS
tmtags*
@ -149,5 +150,7 @@ yap-6.3.workspace
yap-6.3.geany
YAP.project
CBlocks
yPQ
*.tmp
YAP.sublime*
YAP.sublime*
yap32/CMakeCache.txt

12
C/cdmgr.c
View File

@ -4447,18 +4447,18 @@ static bool pred_flag_clause(Functor f, Term mod, const char *name,
s[1] = MkIntegerTerm(val);
#elif USE_GMP
{
char s[64];
char text[64];
MP_INT rop;
#ifdef _WIN32
snprintf(s, 64, "%I64d", (long long int)val);
snprintf(text, 64, "%I64d", (long long int)val);
#elif HAVE_SNPRINTF
snprintf(s, 64, "%lld", (long long int)val);
snprintf(text, 64, "%lld", (long long int)val);
#else
sprintf(s, "%lld", (long long int)val);
sprintf(text, "%lld", (long long int)val);
#endif
mpz_init_set_str(&rop, s, 10);
s[1] = Yap_MkBigNumTerm((void *)&rop);
mpz_init_set_str(&rop, text, 10);
s[1] = Yap_MkBigIntTerm((void *)&rop);
}
#endif
tn = Yap_MkApplTerm(f, 2, s);

57
C/exec.c
View File

@ -978,7 +978,6 @@ static Int setup_call_cleanup(USES_REGS1) {
yamop *oCP = CP, *oP = P;
bool rc;
Yap_DisableInterrupts(worker_id);
rc = Yap_RunTopGoal(Setup, false);
Yap_EnableInterrupts(worker_id);
@ -1451,7 +1450,7 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
if (!Yap_has_a_signal())
CalculateStackGap(PASS_REGS1);
LOCAL_CBorder = OldBorder;
return out;
return out;
}
void Yap_PrepGoal(UInt arity, CELL *pt, choiceptr saved_b USES_REGS) {
@ -1982,53 +1981,53 @@ bool is_cleanup_cp(choiceptr cp_b) {
static Int JumpToEnv() {
choiceptr handler = B, oh = NULL;
/* just keep the thrown object away, we don't need to care about it
/* just keep the throwm object away, we don't need to care about it
*/
/* careful, previous step may have caused a stack shift,
so get pointers here */
/* find the first choicepoint that may be a catch */
//DBTerm *dbt = Yap_RefToException();
while (handler &&
Yap_PredForChoicePt(handler, NULL) != PredDollarCatch) {
while (POP_CHOICE_POINT(handler)) {
// DBTerm *dbt = Yap_RefToException();
while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch) {
while (POP_CHOICE_POINT(handler)) {
POP_FAIL_EXECUTE(handler);
}
/* we are already doing a catch */
/* we are already doing a catch */
/* make sure we prune C-choicepoints */
if (handler->cp_ap == NOCODE && handler >= (choiceptr)(LCL0 - LOCAL_CBorder)) {
break;
}
oh = handler;
handler = handler->cp_b;
if (handler->cp_ap == NOCODE &&
handler >= (choiceptr)(LCL0 - LOCAL_CBorder)) {
break;
}
oh = handler;
handler = handler->cp_b;
}
if (LOCAL_PrologMode & AsyncIntMode) {
Yap_signal(YAP_FAIL_SIGNAL);
}
POP_FAIL(handler);
B = handler;
//Yap_CopyException(ref);
if (Yap_PredForChoicePt(B, NULL) == PredDollarCatch) {
// Yap_CopyException(ref);
if (Yap_PredForChoicePt(B, NULL) == PredDollarCatch) {
/* can recover Heap thanks to copy term :-( */
/* B->cp_h = H; */
/* I could backtrack here, but it is easier to leave the unwinding
to the emulator */
// handler->cp_h = HR;
/* try to recover space */
/* can only do that when we recover space */
/* first, backtrack */
/* so that I recover memory execute op_fail */
// now put the ball in place
//Yap_CopyException(dbt);
Term t = Yap_GetException();
/* B->cp_h = H; */
/* I could backtrack here, but it is easier to leave the unwinding
to the emulator */
// handler->cp_h = HR;
/* try to recover space */
/* can only do that when we recover space */
/* first, backtrack */
/* so that I recover memory execute op_fail */
// now put the ball in place
// Yap_CopyException(dbt);
Term t = Yap_GetException();
if (t == 0) {
return false;
}
t = Yap_MkApplTerm(FunctorThrow, 1, &t);
t = Yap_MkApplTerm(FunctorThrow, 1, &t);
B->cp_h = HR;
HB = HR;
Yap_unify(t, B->cp_a2);
B->cp_tr = TR;
}
}
P = FAILCODE;
return true;
}
@ -2048,7 +2047,7 @@ static Int jump_env(USES_REGS1) {
Term t = Deref(ARG1);
Yap_PutException(t);
bool out = JumpToEnv(PASS_REGS1);
if (P == FAILCODE && B->cp_ap == NOCODE && LCL0-(CELL*)B > LOCAL_CBorder) {
if (P == FAILCODE && B->cp_ap == NOCODE && LCL0 - (CELL *)B > LOCAL_CBorder) {
// we're failing up to the top layer
LOCAL_Error_TYPE = THROW_EVENT;
}

9
CMakeLists.txt
View File

@ -16,12 +16,11 @@ include(disallow)
disallow_intree_builds()
# set(CMAKE_BUILD_TYPE Debug)
set (MACOSX_RPATH ON)
if(POLICY CMP0042)
cmake_policy(SET CMP0042 NEW)
endif(POLICY CMP0042)
if(POLICY CMP0043)
cmake_policy(SET CMP0043 NEW)
@ -118,8 +117,8 @@ add_library(libYap
${WINDLLS}
$<TARGET_OBJECTS:libYAPOs>
$<TARGET_OBJECTS:libOPTYap>
$<TARGET_OBJECTS:myddas>
$<TARGET_OBJECTS:libswi>
$<TARGET_OBJECTS:myddas>
$<TARGET_OBJECTS:libswi>
)
set_property(DIRECTORY PROPERTY CXX_STANDARD 11)
@ -523,7 +522,7 @@ target_link_libraries(libYap
if(WIN32)
if(MSVC)
set(MSVC_RUNTIME "dynamic")
set(MSVC_RUNTIME "dynamic")
ENDIF(MSVC)
target_link_libraries(libYap wsock32 ws2_32 Shlwapi)
endif()

348
H/YapTags.h
View File

@ -24,109 +24,111 @@
#include "inline-only.h"
#ifndef SHORT_ADDRESSES
# define LONG_ADDRESSES 1
#define LONG_ADDRESSES 1
#else
# define LONG_ADDRESSES 0
#define LONG_ADDRESSES 0
#endif
/***********************************************************************/
/*
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
machine we are experimenting with.
*/
#if LONG_ADDRESSES && defined(OLD_TAG_SCHEME)
#include "Tags_32bits.h"
#include "Tags_32bits.h"
#endif /* LONG_ADDRESSES && defined(OLD_TAG_SCHEME) */
/* AIX will by default place mmaped segments at 0x30000000. This is
incompatible with the high tag scheme. Linux-ELF also does not like
if you place things in the lower addresses (power to the libc people).
incompatible with the high tag scheme. Linux-ELF also does not like
if you place things in the lower addresses (power to the libc people).
*/
#if defined(__APPLE__)
/* mmap on __APPLE__ is not the greatest idea. It overwrites memory allocated by malloc */
/* mmap on __APPLE__ is not the greatest idea. It overwrites memory allocated by
* malloc */
#undef USE_DL_MALLOC
#ifndef USE_SYSTEM_MALLOC
#define USE_SYSTEM_MALLOC 1
#endif
#endif
#if (defined(_AIX) || (defined(__APPLE__) && SIZEOF_INT_P==4) || defined(_WIN32) || defined(sparc) || defined(__sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(__POWERPC__) || defined(__linux__) || defined(IN_SECOND_QUADRANT) || defined(__CYGWIN__)) || defined(__NetBSD__) || defined(__DragonFly__)
#if SIZEOF_INT_P == 4
#define USE_LOW32_TAGS 1
#endif
#if LONG_ADDRESSES && SIZEOF_INT_P==4 && !defined(OLD_TAG_SCHEME) && !defined(USE_LOW32_TAGS)
#if SIZEOF_INT_P == 4 && !defined(OLD_TAG_SCHEME) && !defined(USE_LOW32_TAGS)
#include "Tags_32Ops.h"
#include "Tags_32Ops.h"
#elif LONG_ADDRESSES && SIZEOF_INT_P==4 && !defined(OLD_TAG_SCHEME) && defined(USE_LOW32_TAGS)
#elif LONG_ADDRESSES && SIZEOF_INT_P == 4 && !defined(OLD_TAG_SCHEME) && \
defined(USE_LOW32_TAGS)
#include "Tags_32LowTag.h"
#include "Tags_32LowTag.h"
#elif LONG_ADDRESSES && SIZEOF_INT_P==8 && !defined(OLD_TAG_SCHEME)
#elif SIZEOF_INT_P == 8 && !defined(OLD_TAG_SCHEME)
#include "Tags_64bits.h"
#include "Tags_64bits.h"
#elif !LONG_ADDRESSES
// #elif !LONG_ADDRESSES
//
// #include "Tags_24bits.h"
#include "Tags_24bits.h"
#endif
#endif
#ifdef TAG_LOW_BITS_32
#if !GC_NO_TAGS
#define MBIT 0x80000000
#define RBIT 0x40000000
#define MBIT 0x80000000
#define RBIT 0x40000000
#if IN_SECOND_QUADRANT
#define INVERT_RBIT 1 /* RBIT is 1 by default */
#define INVERT_RBIT 1 /* RBIT is 1 by default */
#endif
#endif /* !GC_NO_TAGS */
@ -134,10 +136,10 @@
#if !GC_NO_TAGS
#if defined(YAPOR_SBA) && defined(__linux__)
#define MBIT /* 0x20000000 */ MKTAG(0x1,0) /* mark bit */
#define MBIT /* 0x20000000 */ MKTAG(0x1, 0) /* mark bit */
#else
#define RBIT /* 0x20000000 */ MKTAG(0x1,0) /* relocation chain bit */
#define MBIT /* 0x40000000 */ MKTAG(0x2,0) /* mark bit */
#define RBIT /* 0x20000000 */ MKTAG(0x1, 0) /* relocation chain bit */
#define MBIT /* 0x40000000 */ MKTAG(0x2, 0) /* mark bit */
#endif
#endif /* !GC_NO_TAGS */
@ -147,211 +149,143 @@
???
*************************************************************************************************/
#define MkVarTerm() MkVarTerm__( PASS_REGS1 )
#define MkPairTerm(A,B) MkPairTerm__( A, B PASS_REGS )
#define MkVarTerm() MkVarTerm__(PASS_REGS1)
#define MkPairTerm(A, B) MkPairTerm__(A, B PASS_REGS)
/*************************************************************************************************
applies to unbound variables
*************************************************************************************************/
INLINE_ONLY inline EXTERN Term *VarOfTerm (Term t);
INLINE_ONLY inline EXTERN Term *
VarOfTerm (Term t)
{
return (Term *) (t);
}
INLINE_ONLY inline EXTERN Term *VarOfTerm(Term t);
INLINE_ONLY inline EXTERN Term *VarOfTerm(Term t) { return (Term *)(t); }
#ifdef YAPOR_SBA
#define RESET_VARIABLE(V) (*(CELL *)(V) = 0)
#define RESET_VARIABLE(V) (*(CELL *)(V) = 0)
INLINE_ONLY inline EXTERN Term MkVarTerm__ ( USES_REGS1 );
INLINE_ONLY inline EXTERN Term MkVarTerm__(USES_REGS1);
INLINE_ONLY inline EXTERN Term
MkVarTerm__ ( USES_REGS1 )
{
return (Term) ((*HR = 0, HR++));
INLINE_ONLY inline EXTERN Term MkVarTerm__(USES_REGS1) {
return (Term)((*HR = 0, HR++));
}
INLINE_ONLY inline EXTERN int IsUnboundVar(Term *);
INLINE_ONLY inline EXTERN int IsUnboundVar (Term *);
INLINE_ONLY inline EXTERN int
IsUnboundVar (Term * t)
{
return (int) (*(t) == 0);
}
INLINE_ONLY inline EXTERN int IsUnboundVar(Term *t) { return (int)(*(t) == 0); }
#else
#define RESET_VARIABLE(V) (*(CELL *)(V) = Unsigned(V))
#define RESET_VARIABLE(V) (*(CELL *)(V) = Unsigned(V))
INLINE_ONLY inline EXTERN Term MkVarTerm__ ( USES_REGS1 );
INLINE_ONLY inline EXTERN Term MkVarTerm__(USES_REGS1);
INLINE_ONLY inline EXTERN Term
MkVarTerm__ ( USES_REGS1 )
{
return (Term) ((*HR = (CELL) HR, HR++));
INLINE_ONLY inline EXTERN Term MkVarTerm__(USES_REGS1) {
return (Term)((*HR = (CELL)HR, HR++));
}
INLINE_ONLY inline EXTERN int IsUnboundVar(Term *);
INLINE_ONLY inline EXTERN int IsUnboundVar (Term *);
INLINE_ONLY inline EXTERN int
IsUnboundVar (Term * t)
{
return (int) (*(t) == (Term) (t));
INLINE_ONLY inline EXTERN int IsUnboundVar(Term *t) {
return (int)(*(t) == (Term)(t));
}
#endif
INLINE_ONLY inline EXTERN CELL *PtrOfTerm (Term);
INLINE_ONLY inline EXTERN CELL *PtrOfTerm(Term);
INLINE_ONLY inline EXTERN CELL *
PtrOfTerm (Term t)
{
return (CELL *) (*(CELL *) (t));
INLINE_ONLY inline EXTERN CELL *PtrOfTerm(Term t) {
return (CELL *)(*(CELL *)(t));
}
INLINE_ONLY inline EXTERN Functor FunctorOfTerm(Term);
INLINE_ONLY inline EXTERN Functor FunctorOfTerm (Term);
INLINE_ONLY inline EXTERN Functor
FunctorOfTerm (Term t)
{
return (Functor) (*RepAppl (t));
INLINE_ONLY inline EXTERN Functor FunctorOfTerm(Term t) {
return (Functor)(*RepAppl(t));
}
#if USE_LOW32_TAGS
INLINE_ONLY inline EXTERN Term MkAtomTerm (Atom);
INLINE_ONLY inline EXTERN Term MkAtomTerm(Atom);
INLINE_ONLY inline EXTERN Term
MkAtomTerm (Atom a)
{
return (Term) (AtomTag | (CELL) (a));
INLINE_ONLY inline EXTERN Term MkAtomTerm(Atom a) {
return (Term)(AtomTag | (CELL)(a));
}
INLINE_ONLY inline EXTERN Atom AtomOfTerm(Term t);
INLINE_ONLY inline EXTERN Atom AtomOfTerm (Term t);
INLINE_ONLY inline EXTERN Atom
AtomOfTerm (Term t)
{
return (Atom) ((~AtomTag & (CELL) (t)));
INLINE_ONLY inline EXTERN Atom AtomOfTerm(Term t) {
return (Atom)((~AtomTag & (CELL)(t)));
}
#else
INLINE_ONLY inline EXTERN Term MkAtomTerm (Atom);
INLINE_ONLY inline EXTERN Term MkAtomTerm(Atom);
INLINE_ONLY inline EXTERN Term
MkAtomTerm (Atom at)
{
return (Term) (TAGGEDA ((CELL)AtomTag, (CELL) (at)));
INLINE_ONLY inline EXTERN Term MkAtomTerm(Atom at) {
return (Term)(TAGGEDA((CELL)AtomTag, (CELL)(at)));
}
INLINE_ONLY inline EXTERN Atom AtomOfTerm(Term t);
INLINE_ONLY inline EXTERN Atom AtomOfTerm (Term t);
INLINE_ONLY inline EXTERN Atom
AtomOfTerm (Term t)
{
return (Atom) (NonTagPart (t));
INLINE_ONLY inline EXTERN Atom AtomOfTerm(Term t) {
return (Atom)(NonTagPart(t));
}
#endif
INLINE_ONLY inline EXTERN int IsAtomTerm (Term);
INLINE_ONLY inline EXTERN int IsAtomTerm(Term);
INLINE_ONLY inline EXTERN int
IsAtomTerm (Term t)
{
return (int) (CHKTAG ((t), AtomTag));
INLINE_ONLY inline EXTERN int IsAtomTerm(Term t) {
return (int)(CHKTAG((t), AtomTag));
}
INLINE_ONLY inline EXTERN Term MkIntTerm(Int);
INLINE_ONLY inline EXTERN Term MkIntTerm (Int);
INLINE_ONLY inline EXTERN Term
MkIntTerm (Int n)
{
return (Term) (TAGGED (NumberTag, (n)));
INLINE_ONLY inline EXTERN Term MkIntTerm(Int n) {
return (Term)(TAGGED(NumberTag, (n)));
}
/*
A constant to subtract or add to a well-known term, we assume no
overflow problems are possible
*/
INLINE_ONLY inline EXTERN Term MkIntConstant (Int);
INLINE_ONLY inline EXTERN Term MkIntConstant(Int);
INLINE_ONLY inline EXTERN Term
MkIntConstant (Int n)
{
return (Term) (NONTAGGED (NumberTag, (n)));
INLINE_ONLY inline EXTERN Term MkIntConstant(Int n) {
return (Term)(NONTAGGED(NumberTag, (n)));
}
INLINE_ONLY inline EXTERN int IsIntTerm(Term);
INLINE_ONLY inline EXTERN int IsIntTerm (Term);
INLINE_ONLY inline EXTERN int
IsIntTerm (Term t)
{
return (int) (CHKTAG ((t), NumberTag));
INLINE_ONLY inline EXTERN int IsIntTerm(Term t) {
return (int)(CHKTAG((t), NumberTag));
}
INLINE_ONLY EXTERN inline Term MkPairTerm__(Term head, Term tail USES_REGS);
INLINE_ONLY EXTERN inline Term MkPairTerm__(Term head, Term tail USES_REGS );
INLINE_ONLY EXTERN inline Term
MkPairTerm__ (Term head, Term tail USES_REGS)
{
INLINE_ONLY EXTERN inline Term MkPairTerm__(Term head, Term tail USES_REGS) {
CELL *p = HR;
HR[0] = head;
HR[1] = tail;
HR += 2;
return (AbsPair (p));
return (AbsPair(p));
}
/* Needed to handle numbers:
these two macros are fundamental in the integer/float conversions */
these two macros are fundamental in the integer/float conversions */
#ifdef M_WILLIAMS
#define IntInBnd(X) (TRUE)
#define IntInBnd(X) (TRUE)
#else
#ifdef TAGS_FAST_OPS
#define IntInBnd(X) (Unsigned( ( (Int)(X) >> (32-7) ) + 1) <= 1)
#define IntInBnd(X) (Unsigned(((Int)(X) >> (32 - 7)) + 1) <= 1)
#else
#define IntInBnd(X) ( (X) < MAX_ABS_INT && \
(X) > -MAX_ABS_INT-1L )
#define IntInBnd(X) ((X) < MAX_ABS_INT && (X) > -MAX_ABS_INT - 1L)
#endif
#endif
#ifdef C_PROLOG
#define FlIsInt(X) ( (X) == (Int)(X) && IntInBnd((X)) )
#else
#define FlIsInt(X) ( FALSE )
#endif
/*
There are two types of functors:
@ -363,70 +297,56 @@ MkPairTerm__ (Term head, Term tail USES_REGS)
*/
#include "TermExt.h"
#include "TermExt.h"
#define IsAccessFunc(func) ((func) == FunctorAccess)
#define IsAccessFunc(func) ((func) == FunctorAccess)
#ifdef YAP_H
#define MkIntegerTerm(i) __MkIntegerTerm(i PASS_REGS)
INLINE_ONLY inline EXTERN Term __MkIntegerTerm (Int USES_REGS);
INLINE_ONLY inline EXTERN Term __MkIntegerTerm(Int USES_REGS);
INLINE_ONLY inline EXTERN Term
__MkIntegerTerm (Int n USES_REGS)
{
return (Term) (IntInBnd (n) ? MkIntTerm (n) : MkLongIntTerm (n));
INLINE_ONLY inline EXTERN Term __MkIntegerTerm(Int n USES_REGS) {
return (Term)(IntInBnd(n) ? MkIntTerm(n) : MkLongIntTerm(n));
}
#endif
INLINE_ONLY inline EXTERN int IsIntegerTerm(Term);
INLINE_ONLY inline EXTERN int IsIntegerTerm (Term);
INLINE_ONLY inline EXTERN int
IsIntegerTerm (Term t)
{
return (int) (IsIntTerm (t) || IsLongIntTerm (t));
INLINE_ONLY inline EXTERN int IsIntegerTerm(Term t) {
return (int)(IsIntTerm(t) || IsLongIntTerm(t));
}
INLINE_ONLY inline EXTERN Int IntegerOfTerm (Term);
INLINE_ONLY inline EXTERN Int IntegerOfTerm(Term);
INLINE_ONLY inline EXTERN Int
IntegerOfTerm (Term t)
{
INLINE_ONLY inline EXTERN Int IntegerOfTerm(Term t) {
return (Int) (IsIntTerm (t) ? IntOfTerm (t) : LongIntOfTerm (t));
return (Int)(IsIntTerm(t) ? IntOfTerm(t) : LongIntOfTerm(t));
}
#ifdef YAP_H
#define MkAddressTerm(i) __MkAddressTerm(i PASS_REGS)
INLINE_ONLY inline EXTERN Term __MkAddressTerm (void * USES_REGS);
INLINE_ONLY inline EXTERN Term __MkAddressTerm(void *USES_REGS);
INLINE_ONLY inline EXTERN Term
__MkAddressTerm (void * n USES_REGS)
{
INLINE_ONLY inline EXTERN Term __MkAddressTerm(void *n USES_REGS) {
return __MkIntegerTerm((Int)n PASS_REGS);
}
#endif
INLINE_ONLY inline EXTERN bool IsAddressTerm (Term);
INLINE_ONLY inline EXTERN bool IsAddressTerm(Term);
INLINE_ONLY inline EXTERN bool
IsAddressTerm (Term t)
{
return (bool) IsIntegerTerm (t);
INLINE_ONLY inline EXTERN bool IsAddressTerm(Term t) {
return (bool)IsIntegerTerm(t);
}
INLINE_ONLY inline EXTERN void * AddressOfTerm (Term);
INLINE_ONLY inline EXTERN void *AddressOfTerm(Term);
INLINE_ONLY inline EXTERN void *
AddressOfTerm (Term t)
{
return (void *) (IsIntTerm (t) ? IntOfTerm (t) : LongIntOfTerm (t));
INLINE_ONLY inline EXTERN void *AddressOfTerm(Term t) {
return (void *)(IsIntTerm(t) ? IntOfTerm(t) : LongIntOfTerm(t));
}
#endif

328
H/arith2.h
View File

@ -8,9 +8,9 @@
* *
**************************************************************************
* *
* File: arithi2.c *
* File: arithi2.c *
* Last rev: *
* mods: *
* mods: *
* comments: arithmetical expression evaluation *
* *
*************************************************************************/
@ -19,115 +19,110 @@
*
*/
inline static int
sub_overflow(Int x, Int i, Int j)
{
inline static int sub_overflow(Int x, Int i, Int j) {
return ((i & ~j & ~x) | (~i & j & x)) < 0;
}
inline static Term
sub_int(Int i, Int j USES_REGS)
{
Int x = i-j;
inline static Term sub_int(Int i, Int j USES_REGS) {
Int x = i - j;
#if USE_GMP
Int overflow = ((i & ~j & ~x) | (~i & j & x)) < 0;
/* Integer overflow, we need to use big integers */
if (overflow) {
return(Yap_gmp_sub_ints(i, j));
return (Yap_gmp_sub_ints(i, j));
}
#endif
#ifdef BEAM
RINT(x);
return( MkIntegerTerm (x));
return (MkIntegerTerm(x));
#else
RINT(x);
#endif
}
inline static Int
SLR(Int i, Int shift)
{
return (shift < sizeof(Int)*8-1 ? i >> shift : (i >= 0 ? 0 : -1));
inline static Int SLR(Int i, Int shift) {
return (shift < sizeof(Int) * 8 - 1 ? i >> shift : (i >= 0 ? 0 : -1));
}
#ifdef __GNUC__
#ifdef __i386__
#define DO_MULTI() { Int tmp1; \
__asm__ ("imull %3\n\t movl $0,%1\n\t jno 0f\n\t movl $1,%1\n\t 0:" \
: "=a" (z), \
"=d" (tmp1) \
: "a" (i1), \
"rm" (i2) \
: "cc" ); \
if (tmp1) goto overflow; \
}
#define OPTIMIZE_MULTIPLI 1
#endif
#endif
inline static int
mul_overflow(Int z, Int i1, Int i2)
{
inline static int mul_overflow(Int z, Int i1, Int i2) {
if (i1 == Int_MIN && i2 == -1)
return TRUE;
return (i2 && z/i2 != i1);
return (i2 && z / i2 != i1);
}
#if defined(_MSC_VER) && SIZEOF_DOUBLE == SIZEOF_INT_P
#define DO_MULTI() { \
uint64_t h1 = (11 > 0 ? i1 : -i1) >> 32;\
uint64_t h2 = (12 > 0 ? i2 : -12) >> 32;\
if (h1 != 0 && h2 != 0) goto overflow;\
if ((uint64_t)(i1 & 0xfffffff)*h2 + ((uint64_t)(i2 & 0xfffffff)*h1) > 0x7fffffff) goto overflow;\
z = i1 * i2;\
}
#elif __clang__ && FALSE /* not in OSX yet */
#define DO_MULTI() if (__builtin_smul_overflow( i1, i2, & z ) ) { goto overflow; }
#elif SIZEOF_DOUBLE == 2*SIZEOF_INT_P
#define DO_MULTI() {\
int64_t w = (int64_t)i1*i2; \
if (w >= 0) {\
if ((w | ((int64_t)(2^31)-1)) != ((int64_t)(2^31)-1)) goto overflow; \
} else {\
if ((-w | ((int64_t)(2^31)-1)) != ((int64_t)(2^31)-1)) goto overflow; \
}\
z = w;\
}
#
#if defined(__GNUC__) && defined(__i386__)
#define DO_MULTI() \
{ \
Int tmp1; \
__asm__("imull %3\n\t movl $0,%1\n\t jno 0f\n\t movl $1,%1\n\t 0:" \
: "=a"(z), "=d"(tmp1) \
: "a"(i1), "rm"(i2) \
: "cc"); \
if (tmp1) \
goto overflow; \
}
#define OPTIMIZE_MULTIPLI 1
#elif defined(_MSC_VER) && SIZEOF_DOUBLE == SIZEOF_INT_P
#define DO_MULTI() \
{ \
uint64_t h1 = (11 > 0 ? i1 : -i1) >> 32; \
uint64_t h2 = (12 > 0 ? i2 : -12) >> 32; \
if (h1 != 0 && h2 != 0) \
goto overflow; \
if ((uint64_t)(i1 & 0xfffffff) * h2 + ((uint64_t)(i2 & 0xfffffff) * h1) > \
0x7fffffff) \
goto overflow; \
z = i1 * i2; \
}
#elif __clang__ && FALSE /* not in OSX yet */
#define DO_MULTI() \
if (__builtin_smul_overflow(i1, i2, &z)) { \
goto overflow; \
}
#elif SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
#define DO_MULTI() \
{ \
int64_t w = (int64_t)i1 * i2; \
if (w >= 0) { \
if ((w | ((int64_t)(2 ^ 31) - 1)) != ((int64_t)(2 ^ 31) - 1)) \
goto overflow; \
} else { \
if ((-w | ((int64_t)(2 ^ 31) - 1)) != ((int64_t)(2 ^ 31) - 1)) \
goto overflow; \
} \
z = w; \
}
#else
#define DO_MULTI() {\
__int128_t w = (__int128_t)i1*i2; \
if (w >= 0) {\
if ((w | ((__int128_t)(2^63)-1)) != ((__int128_t)(2^63)-1)) goto overflow; \
} else {\
if ((-w | ((__int128_t)(2^63)-1)) != ((__int128_t)(2^63)-1)) goto overflow; \
}\
z = (Int)w; \
}
#define DO_MULTI() \
{ \
__int128_t w = (__int128_t)i1 * i2; \
if (w >= 0) { \
if ((w | ((__int128_t)(2 ^ 63) - 1)) != ((__int128_t)(2 ^ 63) - 1)) \
goto overflow; \
} else { \
if ((-w | ((__int128_t)(2 ^ 63) - 1)) != ((__int128_t)(2 ^ 63) - 1)) \
goto overflow; \
} \
z = (Int)w; \
}
#endif
inline static Term
times_int(Int i1, Int i2 USES_REGS) {
inline static Term times_int(Int i1, Int i2 USES_REGS) {
#ifdef USE_GMP
Int z;
DO_MULTI();
RINT(z);
overflow:
{
return(Yap_gmp_mul_ints(i1, i2));
}
overflow : { return (Yap_gmp_mul_ints(i1, i2)); }
#else
RINT(i1*i2);
RINT(i1 * i2);
#endif
}
#ifdef USE_GMP
#ifndef __GNUC__X
static int
clrsb(Int i)
{
Int j=0;
static int clrsb(Int i) {
Int j = 0;
if (i < 0) {
if (i == Int_MIN)
@ -135,25 +130,35 @@ clrsb(Int i)
i = -i;
}
#if SIZEOF_INT_P == 8
if (i < (Int)(0x100000000)) { j += 32;}
else i >>= 32;
if (i < (Int)(0x100000000)) {
j += 32;
} else
i >>= 32;
#endif
if (i < (Int)(0x10000)) {j += 16;}
else i >>= 16;
if (i < (Int)(0x100)) {j += 8;}
else i >>= 8;
if (i < (Int)(0x10)) {j += 4;}
else i >>= 4;
if (i < (Int)(0x4)) {j += 2;}
else i >>= 2;
if (i < (Int)(0x2)) j++;
if (i < (Int)(0x10000)) {
j += 16;
} else
i >>= 16;
if (i < (Int)(0x100)) {
j += 8;
} else
i >>= 8;
if (i < (Int)(0x10)) {
j += 4;
} else
i >>= 4;
if (i < (Int)(0x4)) {
j += 2;
} else
i >>= 2;
if (i < (Int)(0x2))
j++;
return j;
}
#endif
#endif
inline static Term
do_sll(Int i, Int j USES_REGS) /* j > 0 */
inline static Term do_sll(Int i, Int j USES_REGS) /* j > 0 */
{
#ifdef USE_GMP
if (
@ -174,22 +179,19 @@ do_sll(Int i, Int j USES_REGS) /* j > 0 */
#endif
}
static Term
p_minus(Term t1, Term t2 USES_REGS) {
static Term p_minus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
return sub_int(IntegerOfTerm(t1), IntegerOfTerm(t2) PASS_REGS);
case double_e:
{
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(fl1-fl2);
}
case double_e: {
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(fl1 - fl2);
}
case big_int_e:
#ifdef USE_GMP
return Yap_gmp_sub_int_big(IntegerOfTerm(t1), t2);
@ -202,14 +204,13 @@ p_minus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* float * integer */
RFLOAT(FloatOfTerm(t1)-IntegerOfTerm(t2));
case double_e:
{
RFLOAT(FloatOfTerm(t1)-FloatOfTerm(t2));
}
RFLOAT(FloatOfTerm(t1) - IntegerOfTerm(t2));
case double_e: {
RFLOAT(FloatOfTerm(t1) - FloatOfTerm(t2));
}
case big_int_e:
#ifdef USE_GMP
return Yap_gmp_sub_float_big(FloatOfTerm(t1),t2);
return Yap_gmp_sub_float_big(FloatOfTerm(t1), t2);
#endif
default:
RERROR();
@ -223,7 +224,7 @@ p_minus(Term t1, Term t2 USES_REGS) {
case big_int_e:
return Yap_gmp_sub_big_big(t1, t2);
case double_e:
return Yap_gmp_sub_big_float(t1,FloatOfTerm(t2));
return Yap_gmp_sub_big_float(t1, FloatOfTerm(t2));
default:
RERROR();
}
@ -234,25 +235,22 @@ p_minus(Term t1, Term t2 USES_REGS) {
RERROR();
}
static Term
p_times(Term t1, Term t2 USES_REGS) {
static Term p_times(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
return(times_int(IntegerOfTerm(t1),IntegerOfTerm(t2) PASS_REGS));
case double_e:
{
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(fl1*fl2);
}
return (times_int(IntegerOfTerm(t1), IntegerOfTerm(t2) PASS_REGS));
case double_e: {
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(fl1 * fl2);
}
case big_int_e:
#ifdef USE_GMP
return(Yap_gmp_mul_int_big(IntegerOfTerm(t1), t2));
return (Yap_gmp_mul_int_big(IntegerOfTerm(t1), t2));
#endif
default:
RERROR();
@ -262,12 +260,12 @@ p_times(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* float * integer */
RFLOAT(FloatOfTerm(t1)*IntegerOfTerm(t2));
RFLOAT(FloatOfTerm(t1) * IntegerOfTerm(t2));
case double_e:
RFLOAT(FloatOfTerm(t1)*FloatOfTerm(t2));
RFLOAT(FloatOfTerm(t1) * FloatOfTerm(t2));
case big_int_e:
#ifdef USE_GMP
return Yap_gmp_mul_float_big(FloatOfTerm(t1),t2);
return Yap_gmp_mul_float_big(FloatOfTerm(t1), t2);
#endif
default:
RERROR();
@ -282,7 +280,7 @@ p_times(Term t1, Term t2 USES_REGS) {
/* two bignums */
return Yap_gmp_mul_big_big(t1, t2);
case double_e:
return Yap_gmp_mul_float_big(FloatOfTerm(t2),t1);
return Yap_gmp_mul_float_big(FloatOfTerm(t2), t1);
default:
RERROR();
}
@ -293,28 +291,27 @@ p_times(Term t1, Term t2 USES_REGS) {
RERROR();
}
static Term
p_div(Term t1, Term t2 USES_REGS) {
static Term p_div(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
{
Int i1 = IntegerOfTerm(t1), i2 = IntegerOfTerm(t2);
if (i2 == 0) {
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
} else if (i1 == Int_MIN && i2 == -1) {
Int i1 = IntegerOfTerm(t1), i2 = IntegerOfTerm(t2);
if (i2 == 0) {
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
} else if (i1 == Int_MIN && i2 == -1) {
#ifdef USE_GMP
return Yap_gmp_add_ints(Int_MAX, 1);
return Yap_gmp_add_ints(Int_MAX, 1);
#else
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
"rem/2 with %d and %d", i1, i2);
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
"rem/2 with %d and %d", i1, i2);
#endif
} else {
RINT(IntegerOfTerm(t1) / i2);
}
} else {
RINT(IntegerOfTerm(t1) / i2);
}
}
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "// /2");
@ -350,8 +347,7 @@ p_div(Term t1, Term t2 USES_REGS) {
RERROR();
}
static Term
p_and(Term t1, Term t2 USES_REGS) {
static Term p_and(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
@ -362,7 +358,7 @@ p_and(Term t1, Term t2 USES_REGS) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "/\\ /2");
case big_int_e:
#ifdef USE_GMP
return Yap_gmp_and_int_big(IntegerOfTerm(t1),t2);
return Yap_gmp_and_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
@ -375,7 +371,7 @@ p_and(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* anding a bignum with an integer is easy */
return Yap_gmp_and_int_big(IntegerOfTerm(t2),t1);
return Yap_gmp_and_int_big(IntegerOfTerm(t2), t1);
case big_int_e:
/* two bignums */
return Yap_gmp_and_big_big(t1, t2);
@ -391,9 +387,8 @@ p_and(Term t1, Term t2 USES_REGS) {
RERROR();
}
static Term
p_or(Term t1, Term t2 USES_REGS) {
switch(ETypeOfTerm(t1)) {
static Term p_or(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
@ -403,7 +398,7 @@ p_or(Term t1, Term t2 USES_REGS) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "\\/ /2");
case big_int_e:
#ifdef USE_GMP
return Yap_gmp_ior_int_big(IntegerOfTerm(t1),t2);
return Yap_gmp_ior_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
@ -416,7 +411,7 @@ p_or(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* anding a bignum with an integer is easy */
return Yap_gmp_ior_int_big(IntegerOfTerm(t2),t1);
return Yap_gmp_ior_int_big(IntegerOfTerm(t2), t1);
case big_int_e:
/* two bignums */
return Yap_gmp_ior_big_big(t1, t2);
@ -432,22 +427,22 @@ p_or(Term t1, Term t2 USES_REGS) {
RERROR();
}
static Term
p_sll(Term t1, Term t2 USES_REGS) {
static Term p_sll(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
{ Int i2 = IntegerOfTerm(t2);
{
Int i2 = IntegerOfTerm(t2);
if (i2 <= 0) {
if (i2 == Int_MIN) {
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
}
RINT(SLR(IntegerOfTerm(t1), -i2));
}
return do_sll(IntegerOfTerm(t1),i2 PASS_REGS);
if (i2 <= 0) {
if (i2 == Int_MIN) {
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
}
RINT(SLR(IntegerOfTerm(t1), -i2));
}
return do_sll(IntegerOfTerm(t1), i2 PASS_REGS);
}
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "<</2");
@ -465,7 +460,7 @@ p_sll(Term t1, Term t2 USES_REGS) {
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return Yap_gmp_sll_big_int(t1, IntegerOfTerm(t2));
return Yap_gmp_sll_big_int(t1, IntegerOfTerm(t2));
case big_int_e:
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
case double_e:
@ -480,22 +475,22 @@ p_sll(Term t1, Term t2 USES_REGS) {
RERROR();
}
static Term
p_slr(Term t1, Term t2 USES_REGS) {
static Term p_slr(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
{ Int i2 = IntegerOfTerm(t2);
{
Int i2 = IntegerOfTerm(t2);
if (i2 < 0) {
if (i2 == Int_MIN) {
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
}
return do_sll(IntegerOfTerm(t1), -i2 PASS_REGS);
}
RINT(SLR(IntegerOfTerm(t1), i2));
if (i2 < 0) {
if (i2 == Int_MIN) {
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
}
return do_sll(IntegerOfTerm(t1), -i2 PASS_REGS);
}
RINT(SLR(IntegerOfTerm(t1), i2));
}
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2");
@ -513,7 +508,7 @@ p_slr(Term t1, Term t2 USES_REGS) {
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return Yap_gmp_sll_big_int(t1, -IntegerOfTerm(t2));
return Yap_gmp_sll_big_int(t1, -IntegerOfTerm(t2));
case big_int_e:
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
case double_e:
@ -527,4 +522,3 @@ p_slr(Term t1, Term t2 USES_REGS) {
}
RERROR();
}

421
H/eval.h
View File

@ -19,7 +19,7 @@
@file eval.h
@defgroup arithmetic Arithmetic in YAP
@defgroup arithmetic Arithmetic in YAP
@ingroup builtins
@ -27,7 +27,8 @@
+ See @ref arithmetic_cmps for the arithmetic comparisons supported in YAP
+ See @ref arithmetic_operators for what arithmetic operations are supported in YAP
+ See @ref arithmetic_operators for what arithmetic operations are supported
in YAP
YAP supports several different numeric types:
<ul>
@ -88,11 +89,14 @@ exceptions:
@exception "type_error(float( V ), Call)" if must be float
@exception "domain_error(out_of_range( V ), Call)" if argument invalid
@exception "domain_error(not_less_than_zero( V ), Call)" if argument must be positive or zero
@exception "domain_error(not_less_than_zero( V ), Call)" if argument must be
positive or zero
@exception "evaluation_error(undefined( V ), Call)" result is not defined
(nan)
@exception "evaluation_error(overflow( V ), Call)" result is arithmetic
overflow
@exception "evaluation_error(undefined( V ), Call)" result is not defined (nan)
@exception "evaluation_error(overflow( V ), Call)" result is arithmetic overflow
@tableofcontents
@secreflist
@ -132,64 +136,68 @@ exceptions:
#include <string.h>
#endif
#ifdef LONG_MAX
#define Int_MAX LONG_MAX
#define Int_MAX LONG_MAX
#else
#define Int_MAX ((Int)((~((CELL)0))>>1))
#define Int_MAX ((Int)((~((CELL)0)) >> 1))
#endif
#ifdef LONG_MIN
#define Int_MIN LONG_MIN
#define Int_MIN LONG_MIN
#else
#define Int_MIN (-Int_MAX-(CELL)1)
#define Int_MIN (-Int_MAX - (CELL)1)
#endif
#define PLMAXTAGGEDINT (MAX_ABS_INT-((CELL)1))
#define PLMINTAGGEDINT (-MAX_ABS_INT)
#define PLMAXTAGGEDINT (MAX_ABS_INT - ((CELL)1))
#define PLMINTAGGEDINT (-MAX_ABS_INT)
#define PLMAXINT Int_MAX
#define PLMININT Int_MIN
#ifndef INFINITY
#define INFINITY (1.0/0.0)
#define INFINITY (1.0 / 0.0)
#endif
#ifndef NAN
#define NAN (0.0/0.0)
#define NAN (0.0 / 0.0)
#endif
/**
* @addtogroup arithmetic_operators
* @enum arith0_op constant operators
* @enum arith0_op constant operators
* @brief specifies the available unary arithmetic operators
*/
typedef enum {
/** pi [ISO]
An approximation to the value of <em>pi</em>, that is, the ratio of a circle's circumference to its diameter.
*
An approximation to the value of <em>pi</em>, that is, the ratio of a
circle's circumference to its diameter.
*
*/
op_pi,
/** e
Euler's number, the base of the natural logarithms (approximately 2.718281828).
*
Euler's number, the base of the natural logarithms (approximately
2.718281828).
*
*/
op_e,
/** epsilon
The difference between the float `1.0` and the next largest floating point number.
*
The difference between the float `1.0` and the next largest floating point
number.
*
*/
op_epsilon,
/** inf
Infinity according to the IEEE Floating-Point standard. Note that evaluating this term will generate a domain error in the `iso` language mode. Also note that
Infinity according to the IEEE Floating-Point standard. Note that
evaluating this term will generate a domain error in the `iso` language mode.
Also note that
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* ?- +inf =:= -inf.
* false.
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*
*
*/
op_inf,
op_nan,
@ -206,35 +214,36 @@ typedef enum {
/**
* @addtogroup arithmetic_operators
* @enum arith1_op unary operators
* @enum arith1_op unary operators
* @brief specifies the available unary arithmetic operators
*/
typedef enum {
/** \+ _X_: the value of _X_ .
*
*
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* X =:= +X.
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*/
op_uplus,
/** \- _X_: the complement of _X_ .
*
*
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* 0-X =:= -X.
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*/
op_uminus,
/** \\ _X_, The bitwise negation of _X_ .
*
*
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* \X /\ X =:= 0.
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*
* Note that the number of bits of an integer is at least the size in bits of a Prolog term cell.
* Note that the number of bits of an integer is at least the size in bits of
* a Prolog term cell.
*/
op_unot,
/** exp( _X_ ), natural exponentiation of _X_ .
*
*
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* X = 0.0, abs(1.0 - exp( _X_ )) < 0.0001
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@ -250,11 +259,12 @@ typedef enum {
*/
op_log,
/** log10( _X_ ) [ISO]
*
*
* Decimal logarithm.
*
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* ?- between(1, 10, I), Delta is log10(I*10) + log10(1/(I*10)), format('0 == ~3g~n',[Delta]), fail.
* ?- between(1, 10, I), Delta is log10(I*10) + log10(1/(I*10)), format('0
* == ~3g~n',[Delta]), fail.
* 0 == 0
* 0 == 0
* 0 == 0
@ -305,7 +315,7 @@ typedef enum {
/**
* @addtogroup arithmetic_operators
* @enum arith2_op binary operators
* @enum arith2_op binary operators
* @brief specifies the available unary arithmetic operators
*/
typedef enum {
@ -336,62 +346,69 @@ typedef enum {
op_rdiv
} arith2_op;
yap_error_number
Yap_MathException__(USES_REGS1);
Functor EvalArg(Term);
yap_error_number Yap_MathException__(USES_REGS1);
Functor EvalArg(Term);
/* Needed to handle numbers:
these two macros are fundamental in the integer/float conversions */
these two macros are fundamental in the integer/float conversions */
#ifdef C_PROLOG
#define FlIsInt(X) ( (X) == (Int)(X) && IntInBnd((X)) )
#define FlIsInt(X) ((X) == (Int)(X) && IntInBnd((X)))
#else
#define FlIsInt(X) ( FALSE )
#define FlIsInt(X) (FALSE)
#endif
#ifdef M_WILLIAMS
#define MkEvalFl(X) MkFloatTerm(X)
#define MkEvalFl(X) MkFloatTerm(X)
#else
#define MkEvalFl(X) ( FlIsInt(X) ? MkIntTerm((Int)(X)) : MkFloatTerm(X) )
#define MkEvalFl(X) (FlIsInt(X) ? MkIntTerm((Int)(X)) : MkFloatTerm(X))
#endif
/* Macros used by some of the eval functions */
#define REvalInt(I) { eval_int = (I); return(FInt); }
#define REvalFl(F) { eval_flt = (F); return(FFloat); }
#define REvalError() { return(FError); }
#define REvalInt(I) \
{ \
eval_int = (I); \
return (FInt); \
}
#define REvalFl(F) \
{ \
eval_flt = (F); \
return (FFloat); \
}
#define REvalError() \
{ return (FError); }
/* this macro, dependent on the particular implementation
is used to interface the arguments into the C libraries */
#ifdef MPW
#define FL(X) ((extended)(X))
is used to interface the arguments into the C libraries */
#ifdef MPW
#define FL(X) ((extended)(X))
#else
#define FL(X) ((double)(X))
#define FL(X) ((double)(X))
#endif
void Yap_InitConstExps(void);
void Yap_InitUnaryExps(void);
void Yap_InitBinaryExps(void);
void Yap_InitConstExps(void);
void Yap_InitUnaryExps(void);
void Yap_InitBinaryExps(void);
int Yap_ReInitConstExps(void);
int Yap_ReInitUnaryExps(void);
int Yap_ReInitBinaryExps(void);
int Yap_ReInitConstExps(void);
int Yap_ReInitUnaryExps(void);
int Yap_ReInitBinaryExps(void);
Term Yap_eval_atom(Int);
Term Yap_eval_unary(Int,Term);
Term Yap_eval_binary(Int,Term,Term);
Term Yap_eval_atom(Int);
Term Yap_eval_unary(Int, Term);
Term Yap_eval_binary(Int, Term, Term);
Term Yap_InnerEval__(Term USES_REGS);
Term Yap_InnerEval__(Term USES_REGS);
#define Yap_EvalError(id, t, ...) \
Yap_EvalError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
yamop *Yap_EvalError__(const char *, const char *, int, yap_error_number, Term,
...);
#define Yap_EvalError( id, t, ...) Yap_EvalError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
yamop *Yap_EvalError__(const char *, const char *, int, yap_error_number,Term, ...);
#define Yap_ArithError( id, t, ...) Yap_ArithError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
Int Yap_ArithError__(const char *, const char *, int, yap_error_number,Term, ...);
#define Yap_ArithError(id, t, ...) \
Yap_ArithError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
Int Yap_ArithError__(const char *, const char *, int, yap_error_number, Term,
...);
#include "inline-only.h"
@ -403,55 +420,49 @@ Int Yap_ArithError__(const char *, const char *, int, yap_error_number,Term, ...
INLINE_ONLY inline EXTERN Term Yap_Eval__(Term t USES_REGS);
INLINE_ONLY inline EXTERN Term
Yap_Eval__(Term t USES_REGS)
{
if (t == 0L || ( !IsVarTerm(t) && IsNumTerm(t) ))
INLINE_ONLY inline EXTERN Term Yap_Eval__(Term t USES_REGS) {
if (t == 0L || (!IsVarTerm(t) && IsNumTerm(t)))
return t;
return Yap_InnerEval(t);
}
inline static void
Yap_ClearExs(void)
{
feclearexcept(FE_ALL_EXCEPT);
}
inline static void Yap_ClearExs(void) { feclearexcept(FE_ALL_EXCEPT); }
inline static yap_error_number
Yap_FoundArithError__(USES_REGS1)
{
inline static yap_error_number Yap_FoundArithError__(USES_REGS1) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR)
return LOCAL_Error_TYPE;
if (trueGlobalPrologFlag( ARITHMETIC_EXCEPTIONS_FLAG ) ) // test support for exception
if (trueGlobalPrologFlag(
ARITHMETIC_EXCEPTIONS_FLAG)) // test support for exception
return Yap_MathException();
return YAP_NO_ERROR;
}
static inline Term takeIndicator(Term t) {
Term ts[2];
if (IsAtomTerm(t)) { ts[0] = t; ts[1] = MkIntTerm(0); }
else if (IsPairTerm(t)) { ts[0] = TermNil; ts[1] = MkIntTerm(2); }
else {
if (IsAtomTerm(t)) {
ts[0] = t;
ts[1] = MkIntTerm(0);
} else if (IsPairTerm(t)) {
ts[0] = TermNil;
ts[1] = MkIntTerm(2);
} else {
CACHE_REGS
ts[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(t)));
ts[1] = MkIntegerTerm(ArityOfFunctor(FunctorOfTerm(t)));
}
return Yap_MkApplTerm( FunctorSlash, 2, ts );
return Yap_MkApplTerm(FunctorSlash, 2, ts);
}
Atom Yap_NameOfUnaryOp(int i);
Atom Yap_NameOfBinaryOp(int i);
#define RINT(v) return (MkIntegerTerm(v))
#define RFLOAT(v) return (MkFloatTerm(v))
#define RBIG(v) return (Yap_MkBigIntTerm(v))
#define RERROR() return (0L)
#define RINT(v) return(MkIntegerTerm(v))
#define RFLOAT(v) return(MkFloatTerm(v))
#define RBIG(v) return(Yap_MkBigIntTerm(v))
#define RERROR() return(0L)
static inline blob_type
ETypeOfTerm(Term t)
{
if (IsIntTerm(t))
static inline blob_type ETypeOfTerm(Term t) {
if (IsIntTerm(t))
return long_int_e;
if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
@ -469,106 +480,105 @@ ETypeOfTerm(Term t)
#if USE_GMP
char *Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base);
Term Yap_gmq_rdiv_int_int(Int, Int);
Term Yap_gmq_rdiv_int_big(Int, Term);
Term Yap_gmq_rdiv_big_int(Term, Int);
Term Yap_gmq_rdiv_big_big(Term, Term);
Term Yap_gmq_rdiv_int_int(Int, Int);
Term Yap_gmq_rdiv_int_big(Int, Term);
Term Yap_gmq_rdiv_big_int(Term, Int);
Term Yap_gmq_rdiv_big_big(Term, Term);
Term Yap_gmp_add_ints(Int, Int);
Term Yap_gmp_sub_ints(Int, Int);
Term Yap_gmp_mul_ints(Int, Int);
Term Yap_gmp_sll_ints(Int, Int);
Term Yap_gmp_add_int_big(Int, Term);
Term Yap_gmp_sub_int_big(Int, Term);
Term Yap_gmp_sub_big_int(Term, Int);
Term Yap_gmp_mul_int_big(Int, Term);
Term Yap_gmp_div_int_big(Int, Term);
Term Yap_gmp_div_big_int(Term, Int);
Term Yap_gmp_div2_big_int(Term, Int);
Term Yap_gmp_fdiv_int_big(Int, Term);
Term Yap_gmp_fdiv_big_int(Term, Int);
Term Yap_gmp_and_int_big(Int, Term);
Term Yap_gmp_ior_int_big(Int, Term);
Term Yap_gmp_xor_int_big(Int, Term);
Term Yap_gmp_sll_big_int(Term, Int);
Term Yap_gmp_add_big_big(Term, Term);
Term Yap_gmp_sub_big_big(Term, Term);
Term Yap_gmp_mul_big_big(Term, Term);
Term Yap_gmp_div_big_big(Term, Term);
Term Yap_gmp_div2_big_big(Term, Term);
Term Yap_gmp_fdiv_big_big(Term, Term);
Term Yap_gmp_and_big_big(Term, Term);
Term Yap_gmp_ior_big_big(Term, Term);
Term Yap_gmp_xor_big_big(Term, Term);
Term Yap_gmp_mod_big_big(Term, Term);
Term Yap_gmp_mod_big_int(Term, Int);
Term Yap_gmp_mod_int_big(Int, Term);
Term Yap_gmp_rem_big_big(Term, Term);
Term Yap_gmp_rem_big_int(Term, Int);
Term Yap_gmp_rem_int_big(Int, Term);
Term Yap_gmp_exp_int_int(Int,Int);
Term Yap_gmp_exp_int_big(Int,Term);
Term Yap_gmp_exp_big_int(Term,Int);
Term Yap_gmp_exp_big_big(Term,Term);
Term Yap_gmp_gcd_int_big(Int,Term);
Term Yap_gmp_gcd_big_big(Term,Term);
Term Yap_gmp_add_ints(Int, Int);
Term Yap_gmp_sub_ints(Int, Int);
Term Yap_gmp_mul_ints(Int, Int);
Term Yap_gmp_sll_ints(Int, Int);
Term Yap_gmp_add_int_big(Int, Term);
Term Yap_gmp_sub_int_big(Int, Term);
Term Yap_gmp_sub_big_int(Term, Int);
Term Yap_gmp_mul_int_big(Int, Term);
Term Yap_gmp_div_int_big(Int, Term);
Term Yap_gmp_div_big_int(Term, Int);
Term Yap_gmp_div2_big_int(Term, Int);
Term Yap_gmp_fdiv_int_big(Int, Term);
Term Yap_gmp_fdiv_big_int(Term, Int);
Term Yap_gmp_and_int_big(Int, Term);
Term Yap_gmp_ior_int_big(Int, Term);
Term Yap_gmp_xor_int_big(Int, Term);
Term Yap_gmp_sll_big_int(Term, Int);
Term Yap_gmp_add_big_big(Term, Term);
Term Yap_gmp_sub_big_big(Term, Term);
Term Yap_gmp_mul_big_big(Term, Term);
Term Yap_gmp_div_big_big(Term, Term);
Term Yap_gmp_div2_big_big(Term, Term);
Term Yap_gmp_fdiv_big_big(Term, Term);
Term Yap_gmp_and_big_big(Term, Term);
Term Yap_gmp_ior_big_big(Term, Term);
Term Yap_gmp_xor_big_big(Term, Term);
Term Yap_gmp_mod_big_big(Term, Term);
Term Yap_gmp_mod_big_int(Term, Int);
Term Yap_gmp_mod_int_big(Int, Term);
Term Yap_gmp_rem_big_big(Term, Term);
Term Yap_gmp_rem_big_int(Term, Int);
Term Yap_gmp_rem_int_big(Int, Term);
Term Yap_gmp_exp_int_int(Int, Int);
Term Yap_gmp_exp_int_big(Int, Term);
Term Yap_gmp_exp_big_int(Term, Int);
Term Yap_gmp_exp_big_big(Term, Term);
Term Yap_gmp_gcd_int_big(Int, Term);
Term Yap_gmp_gcd_big_big(Term, Term);
Term Yap_gmp_big_from_64bits(YAP_LONG_LONG);
Term Yap_gmp_big_from_64bits(YAP_LONG_LONG);
Term Yap_gmp_float_to_big(Float);
Term Yap_gmp_float_to_rational(Float);
Term Yap_gmp_float_rationalize(Float);
Term Yap_gmp_float_to_big(Float);
Term Yap_gmp_float_to_rational(Float);
Term Yap_gmp_float_rationalize(Float);
Float Yap_gmp_to_float(Term);
Term Yap_gmp_add_float_big(Float, Term);
Term Yap_gmp_sub_float_big(Float, Term);
Term Yap_gmp_sub_big_float(Term, Float);
Term Yap_gmp_mul_float_big(Float, Term);
Term Yap_gmp_fdiv_float_big(Float, Term);
Term Yap_gmp_fdiv_big_float(Term, Float);
Term Yap_gmp_add_float_big(Float, Term);
Term Yap_gmp_sub_float_big(Float, Term);
Term Yap_gmp_sub_big_float(Term, Float);
Term Yap_gmp_mul_float_big(Float, Term);
Term Yap_gmp_fdiv_float_big(Float, Term);
Term Yap_gmp_fdiv_big_float(Term, Float);
int Yap_gmp_cmp_big_int(Term, Int);
int Yap_gmp_cmp_big_int(Term, Int);
#define Yap_gmp_cmp_int_big(I, T) (-Yap_gmp_cmp_big_int(T, I))
int Yap_gmp_cmp_big_float(Term, Float);
int Yap_gmp_cmp_big_float(Term, Float);
#define Yap_gmp_cmp_float_big(D, T) (-Yap_gmp_cmp_big_float(T, D))
int Yap_gmp_cmp_big_big(Term, Term);
int Yap_gmp_cmp_big_big(Term, Term);
int Yap_gmp_tcmp_big_int(Term, Int);
int Yap_gmp_tcmp_big_int(Term, Int);
#define Yap_gmp_tcmp_int_big(I, T) (-Yap_gmp_tcmp_big_int(T, I))
int Yap_gmp_tcmp_big_float(Term, Float);
int Yap_gmp_tcmp_big_float(Term, Float);
#define Yap_gmp_tcmp_float_big(D, T) (-Yap_gmp_tcmp_big_float(T, D))
int Yap_gmp_tcmp_big_big(Term, Term);
int Yap_gmp_tcmp_big_big(Term, Term);
Term Yap_gmp_neg_int(Int);
Term Yap_gmp_abs_big(Term);
Term Yap_gmp_neg_big(Term);
Term Yap_gmp_unot_big(Term);
Term Yap_gmp_floor(Term);
Term Yap_gmp_ceiling(Term);
Term Yap_gmp_round(Term);
Term Yap_gmp_trunc(Term);
Term Yap_gmp_float_fractional_part(Term);
Term Yap_gmp_float_integer_part(Term);
Term Yap_gmp_sign(Term);
Term Yap_gmp_lsb(Term);
Term Yap_gmp_msb(Term);
Term Yap_gmp_popcount(Term);
Term Yap_gmp_neg_int(Int);
Term Yap_gmp_abs_big(Term);
Term Yap_gmp_neg_big(Term);
Term Yap_gmp_unot_big(Term);
Term Yap_gmp_floor(Term);
Term Yap_gmp_ceiling(Term);
Term Yap_gmp_round(Term);
Term Yap_gmp_trunc(Term);
Term Yap_gmp_float_fractional_part(Term);
Term Yap_gmp_float_integer_part(Term);
Term Yap_gmp_sign(Term);
Term Yap_gmp_lsb(Term);
Term Yap_gmp_msb(Term);
Term Yap_gmp_popcount(Term);
char * Yap_gmp_to_string(Term, char *, size_t, int);
size_t Yap_gmp_to_size(Term, int);
char *Yap_gmp_to_string(Term, char *, size_t, int);
size_t Yap_gmp_to_size(Term, int);
int Yap_term_to_existing_big(Term, MP_INT *);
int Yap_term_to_existing_rat(Term, MP_RAT *);
int Yap_term_to_existing_big(Term, MP_INT *);
int Yap_term_to_existing_rat(Term, MP_RAT *);
void Yap_gmp_set_bit(Int i, Term t);
void Yap_gmp_set_bit(Int i, Term t);
#endif
#define Yap_Mk64IntegerTerm(i) __Yap_Mk64IntegerTerm((i) PASS_REGS)
#define Yap_Mk64IntegerTerm(i) __Yap_Mk64IntegerTerm((i)PASS_REGS)
INLINE_ONLY inline EXTERN Term __Yap_Mk64IntegerTerm(YAP_LONG_LONG USES_REGS);
INLINE_ONLY inline EXTERN Term
__Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS)
{
__Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS) {
if (i <= Int_MAX && i >= Int_MIN) {
return MkIntegerTerm((Int)i);
} else {
@ -580,52 +590,51 @@ __Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS)
}
}
#if __clang__ && FALSE /* not in OSX yet */
#define DO_ADD() if (__builtin_sadd_overflow( i1, i2, & z ) ) { goto overflow; }
#if __clang__ && FALSE /* not in OSX yet */
#define DO_ADD() \
if (__builtin_sadd_overflow(i1, i2, &z)) { \
goto overflow; \
}
#endif
inline static Term
add_int(Int i, Int j USES_REGS)
{
inline static Term add_int(Int i, Int j USES_REGS) {
#if USE_GMP
UInt w = (UInt)i+(UInt)j;
UInt w = (UInt)i + (UInt)j;
if (i > 0) {
if (j > 0 && (Int)w < 0) goto overflow;
if (j > 0 && (Int)w < 0)
goto overflow;
} else {
if (j < 0 && (Int)w > 0) goto overflow;
if (j < 0 && (Int)w > 0)
goto overflow;
}
RINT( (Int)w);
/* Integer overflow, we need to use big integers */
overflow:
return Yap_gmp_add_ints(i, j);
RINT((Int)w);
/* Integer overflow, we need to use big integers */
overflow:
return Yap_gmp_add_ints(i, j);
#else
RINT(i+j);
RINT(i + j);
#endif
}
/* calculate the most significant bit for an integer */
Int
Yap_msb(Int inp USES_REGS);
Int Yap_msb(Int inp USES_REGS);
static inline Term
p_plus(Term t1, Term t2 USES_REGS) {
static inline Term p_plus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
return add_int(IntegerOfTerm(t1),IntegerOfTerm(t2) PASS_REGS);
case double_e:
{
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(fl1+fl2);
}
return add_int(IntegerOfTerm(t1), IntegerOfTerm(t2) PASS_REGS);
case double_e: {
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(fl1 + fl2);
}
case big_int_e:
#ifdef USE_GMP
return(Yap_gmp_add_int_big(IntegerOfTerm(t1), t2));
return (Yap_gmp_add_int_big(IntegerOfTerm(t1), t2));
#endif
default:
RERROR();
@ -634,12 +643,12 @@ p_plus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* float * integer */
RFLOAT(FloatOfTerm(t1)+IntegerOfTerm(t2));
RFLOAT(FloatOfTerm(t1) + IntegerOfTerm(t2));
case double_e:
RFLOAT(FloatOfTerm(t1)+FloatOfTerm(t2));
RFLOAT(FloatOfTerm(t1) + FloatOfTerm(t2));
case big_int_e:
#ifdef USE_GMP
return Yap_gmp_add_float_big(FloatOfTerm(t1),t2);
return Yap_gmp_add_float_big(FloatOfTerm(t1), t2);
#endif
default:
RERROR();
@ -653,7 +662,7 @@ p_plus(Term t1, Term t2 USES_REGS) {
/* two bignums */
return Yap_gmp_add_big_big(t1, t2);
case double_e:
return Yap_gmp_add_float_big(FloatOfTerm(t2),t1);
return Yap_gmp_add_float_big(FloatOfTerm(t2), t1);
default:
RERROR();
}
@ -677,11 +686,11 @@ p_plus(Term t1, Term t2 USES_REGS) {
#endif
#ifndef INFINITY
#define INFINITY (1.0/0.0)
#define INFINITY (1.0 / 0.0)
#endif
#ifndef NAN
#define NAN (0.0/0.0)
#define NAN (0.0 / 0.0)
#endif
/* copied from SWI-Prolog */

444924
OPTYap/Terminal Saved Output
View File

File diff suppressed because one or more lines are too long

39
cmake/FindCUDD.cmake Normal file
View File

@ -0,0 +1,39 @@
# Try to find CUDD headers and libraries.
#
# Usage of this module as follows:
#
# find_package(CUDD)
#
# Variables used by this module, they can change the default behaviour and need
# to be set before calling find_package:
#
# CUDD_ROOT Set this variable to the root installation of
# libpapi if the module has problems finding the
# proper installation path.
#
# Variables defined by this module:
#
# CUDD_FOUND System has CUDD libraries and headers
# CUDD_LIBRARIES The CUDD library
# CUDD_INCLUDE_DIRS The location of CUDD headers
# Get hint from environment variable (if any)
if(NOT CUDD_ROOT AND DEFINED ENV{CUDD_ROOT})
set(CUDD_ROOT "$ENV{CUDD_ROOT}" CACHE PATH "CUDD base directory location (optional, used for nonstandard installation paths)")
mark_as_advanced(CUDD_ROOT)
endif()
# Search path for nonstandard locations
if(CUDD_ROOT)
set(CUDD_INCLUDE_PATH PATHS "${CUDD_ROOT}/include" NO_DEFAULT_PATH)
set(CUDD_LIBRARY_PATH PATHS "${CUDD_ROOT}/lib" NO_DEFAULT_PATH)
endif()
find_path(CUDD_INCLUDE_DIRS NAMES cudd.h cudd/cudd.h HINTS ${CUDD_INCLUDE_PATH})
find_library(CUDD_LIBRARIES NAMES cudd CUDDVC-2.5.0 HINTS ${CUDD_LIBRARY_PATH})
include(FindPackageHandleStandardArgs)
find_package_handle_standard_args(CUDD DEFAULT_MSG CUDD_LIBRARIES CUDD_INCLUDE_DIRS)
mark_as_advanced(CUDD_ROOT CUDD_LIBRARIES CUDD_INCLUDE_DIRS)

14
cmake/FindGMP.cmake
View File

@ -9,7 +9,7 @@
# GMP_LIBRARIES_DIR - the directory the library we link with is found in.
find_path(GMP_INCLUDE_DIRS NAMES gmp.h
PATHS "$ENV{PROGRAMFILES}/mpir/include"
PATHS "${GMP_DIR}/include" "${GMP_DIR}" "$ENV{PROGRAMFILES}/mpir/include"
DOC "The gmp include directory"
)
@ -30,12 +30,20 @@ if(MVC)
)
else(MVC)
find_library(GMP_LIBRARIES NAMES gmp
PATHS "{CMAKE_INSTALL_PREFIX}/lib"
PATHS "${GMP_DIR}/lib"
DOC "The GMP library"
)
find_library(GMP_LIBRARIES NAMES gmp
PATHS "${GMP_DIR}"
DOC "The GMP library"
)
find_library(GMP_LIBRARIES NAMES gmp
PATHS "${CMAKE_INSTALL_PREFIX}/lib"
DOC "The GMP library"
)
if(WIN32)
find_library(GMP_LIBRARY_DLL NAMES gmp
PATHS "{CMAKE_INSTALL_PREFIX}/bin"
PATHS "${CMAKE_INSTALL_PREFIX}/bin" "${GMP_DIR}/bin" "${GMP_DIR}"
DOC "The GMP library DLL"
)
endif()

2
os/files.c
View File

@ -290,7 +290,7 @@ static Int time_file(USES_REGS1) {
snprintf(s, 64, "%I64d", (long long int)n);
mpz_init_set_str(&rop, s, 10);
rc = Yap_MkBigNumTerm((void *)&rop) PASS_REGS);
rc = Yap_MkBigIntTerm((void *)&rop) PASS_REGS);
#else
rc = MkIntegerTerm(ft.dwHighDateTime);
#endif

2
os/readterm.c
View File

@ -1022,7 +1022,7 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
int inp_stream) {
CACHE_REGS
xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_END);
xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END);
if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION;

24
packages/cplint/CMakeLists.txt
View File

@ -7,6 +7,28 @@ set(SO_MAJOR 1)
set(SO_MINOR 0)
set(SO_PATCH 0)
find_package (CUDD)
macro_log_feature (CUDD_FOUND "CUDD"
"Use CUDD Library"
"http://vlsi.colorado.edu/~fabio/CUDD/" FALSE)
IF (CUDD_FOUND)
# CUDD_FOUND - system has Cudd
# CUDD_LIBRARIES - Link these to use Cudd
# CUDD_INCLUDE_DIR - Include directory for using Cudd
INCLUDE_DIRECTORIES(
${CUDD_INCLUDE_DIR}
${CMAKE_CURRENT_BINARY_DIR}
)
check_include_files( util.h HAVE_UTIL_H )
check_include_files( cudd/util.h HAVE_CUDD_UTIL_H )
check_include_files( cudd.h HAVE_CUDD_H )
check_include_files( "stdio.h;cudd/cudd.h" HAVE_CUDD_CUDD_H )
check_include_files( cuddInt.h HAVE_CUDDINT_H )
check_include_files( "stdio.h;cudd/cudd.h;cudd/cuddInt.h" HAVE_CUDD_CUDDINT_H )
set( CPLINT_SOURCES
cplint.h
cplint_yap.c
@ -128,8 +150,6 @@ examples/win.uni
${CMAKE_CURRENT_BINARY_DIR}/../bdd
)
IF (CUDD_FOUND_EXPORT)
add_library (bddem SHARED
${BDDEM_SOURCES}
)

2
packages/cplint/slipcase/bddem.c
View File

@ -16,7 +16,7 @@ for the relative license.
#include "config.h"
#include "cudd_config.h"
#if HAVE_CUDD_CUDDINT_H
#include "cudd/cuddInt.h"
#include <cudd/cuddInt.h>
#elif HAVE_CUDDINT_H
#include "cuddInt.h"
#endif

11
utf8proc/CMakeLists.txt
View File

@ -1,5 +1,9 @@
cmake_minimum_required (VERSION 2.8)
if(POLICY CMP0042)
cmake_policy(SET CMP0042 NEW)
endif(POLICY CMP0042)
include (utils.cmake)
disallow_intree_builds()
@ -19,6 +23,9 @@ if (NOT MSVC)
set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -O2 -std=c99 -pedantic -Wall")
endif ()
SET( CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} ${my_cxx_flags}" )
SET( CMAKE_C_FLAGS "${CMAKE_C_FLAGS} ${my_cxx_flags}" )
add_library (utf8proc
utf8proc.c
utf8proc.h
@ -32,10 +39,10 @@ set_target_properties (utf8proc PROPERTIES
set( CMAKE_REQUIRED_INCLUDES . ${CMAKE_REQUIRED_INCLUDES} )
set ( YAP_YAPUTF8LIB $<TARGET_FILE_NAME:utf8proc> )
install(TARGETS utf8proc
LIBRARY DESTINATION ${libdir}
ARCHIVE DESTINATION ${libdir})

8
utils/analysis/load.yap
View File

@ -328,7 +328,7 @@ pl_interface(F, Mod, Lev) :-
catch( open(PF, read, S, [script(true)]) , _, fail ),
repeat,
nb_getval( current_module, MR ),
catch( read_clause( S, T, [module( MR ),term_position(Pos),comment(Comment)] ), Throw, loop_error( MR:Throw)),
catch( read_clause( S, T, [module( MR ),term_position(Pos),comments(Comment)] ), Throw, loop_error( S, MR:Throw)),
( T == end_of_file
->
@ -382,7 +382,7 @@ get_interface( T, F, M0 , _Lev) :-
NT = term_expansion( _, _ )
),
!,
catch(directive(NT, F, M), Error, loop_error(Error)).
catch(directive(NT, F, M), Error, loop_error(c_file,Error)).
get_interface( ( M:H :- _B), F, _M , _Lev) :-
!,
functor( H, N, A),
@ -519,7 +519,7 @@ get_directive( record( Records ), F, M , _Lev) :-
handle_record( Records, F, M).
get_directive( set_prolog_flag(dollar_as_lower_case,On), F, M , _Lev) :-
!,
catch(directive(set_prolog_flag(dollar_as_lower_case,M:On), F), Msg, loop_error(585, Msg) ).
catch(directive(set_prolog_flag(dollar_as_lower_case,M:On), F), Msg, loop_error(c_file, Msg) ).
% support SWI package record
handle_record( (Records1, Records2), F, M ) :-
@ -665,7 +665,7 @@ pl_source(F, F0, Mod, Lev) :-
repeat,
nb_getval( current_module, MR ),
%( sub_atom(F,_,_,_,'examples/matrix.yap') -> spy get_interf ; nospyall ),
catch( read_clause( S, T, [module( MR ),term_position(Pos)] ), Throw, loop_error( Throw)),
catch( read_clause( S, T, [module( MR ),term_position(Pos)] ), Throw, loop_error( S, Throw)),
(
T == end_of_file
->

52
utils/analysis/undefs.yap Normal file
View File

@ -0,0 +1,52 @@
find_undefs :-
% check_args(undefs, boolean, true, true),
format('UNDEFINED procedure calls:~n===~n',[]),
pmodule(M),
findall(P, undef_in_m(M,P), Ps),
Ps = [_|_],
format(' * ~w~n', [M]),
member(P, Ps),
format(' + ~w:~n',[P]),
fail.
find_undefs.
pmodule(M) :-
findall(M, node(M, _,_,_), Ms),
sort(Ms, SMs),
member(M, SMs).
called_in_module(M, P) :-
findall(P, edge((_ :- _-M:P)), Ps),
sort(Ps, SPs),
member(P, SPs).
undef_in_m(M,P) :-
called_in_module(M, P),
\+ edge((_-M:P :- _)),
\+ is_private(_, M, P),
\+ is_public(_, M, P).
/*
setof(M, Target^F^Line^NA^undef( ( Target :- F-M:NA ), Line ), Ms ),
member( Mod, Ms ),
format(' module ~a:~n',[Mod]),
setof(NA, Target^F^Line^undef( ( Target :- F-Mod:NA ), Line ), Ns ),
member( NA, Ns ),
\+ node( Mod , NA , _File1, _ ),
\+ node( prolog , NA , _File2, _ ),
format(' predicate ~w:~n',[NA]),
(
setof(F-Line, Target^undef( ( Target :- F-Mod:NA ), Line ), FLs ),
member(F-L, FLs ),
format(' line ~w, file ~a~n',[L,F]),
fail
;
setof(F-M,Type^node( M, NA, F, Type ) , FMs ),
format(' same name at:~n',[]),
member((F-L)-M, FMs ),
format(' module ~a, file ~a, line ~d~n',[M,F,L]),
fail
).
undefs.
*/

1
utils/sysgraph
View File

@ -15,6 +15,7 @@
:- use_module(library(analysis/graphs)).
:- use_module(library(analysis/load)).
:- use_module(library(analysis/undefs)).
:- initialization(main).