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

indenting; warning; exceptions; small fixes

This commit is contained in:
Vítor Santos Costa 2016-03-29 02:02:43 +01:00
parent 6bc4acec15
commit f3e8b8b3da
51 changed files with 2220 additions and 2221 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
CMakeLists.txt
View File

@ -565,6 +565,8 @@ macro_optional_find_package (MPI OFF)
endif (MPI_C_FOUND) endif (MPI_C_FOUND)
## add_subDIRECTORY(utils)
add_custom_target (main ALL DEPENDS ${YAP_STARTUP} ) # WORKING_DIRECTORY ${CMAKE_BINARY_DIR} ) add_custom_target (main ALL DEPENDS ${YAP_STARTUP} ) # WORKING_DIRECTORY ${CMAKE_BINARY_DIR} )
# #
# include subdirectories configuration # include subdirectories configuration
@ -590,6 +592,7 @@ install (
) )
macro_display_feature_log() macro_display_feature_log()
if(POLICY CMP0058) if(POLICY CMP0058)
cmake_policy(SET CMP0058 NEW) cmake_policy(SET CMP0058 NEW)

6
CXX/yapi.cpp
View File

@ -12,7 +12,7 @@ extern "C" {
void YAP_UserCPredicate(const char *, YAP_UserCPred, YAP_Arity arity); void YAP_UserCPredicate(const char *, YAP_UserCPred, YAP_Arity arity);
void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, YAP_Arity, YAP_Term); void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, YAP_Arity, YAP_Term);
void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, unsigned int); void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, YAP_Arity);
} }
@ -512,9 +512,7 @@ void YAPQuery::close()
CACHE_REGS CACHE_REGS
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
if (EX /* && !(q_flags & (true PL_Q_CATCH_EXCEPTION)) */) { Yap_ResetException(worker_id);
EX = (struct DB_TERM *)NULL;
}
/* need to implement backtracking here */ /* need to implement backtracking here */
if (q_open != 1 || q_state == 0) { if (q_open != 1 || q_state == 0) {
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();

2
CXX/yapi.hh
View File

@ -74,7 +74,7 @@ extern void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, YAP_Arity, Y
/* void UserBackCPredicate(const char *name, int *init(), int *cont(), int /* void UserBackCPredicate(const char *name, int *init(), int *cont(), int
arity, int extra) */ arity, int extra) */
extern void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, unsigned int); extern void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, YAP_Arity);
extern Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio, Term *bindings_p); extern Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio, Term *bindings_p);

2
CXX/yapq.hh
View File

@ -11,7 +11,7 @@
* interface to a YAP Query; * interface to a YAP Query;
* uses an SWI-like status info internally. * uses an SWI-like status info internally.
*/ */
class YAPQuery: public YAPPredicate, open_query_struct { class YAPQuery: public YAPPredicate, public open_query_struct {
YAPListTerm vnames; YAPListTerm vnames;
YAPTerm goal; YAPTerm goal;
Term names; Term names;

2
H/Regs.h
View File

@ -121,7 +121,6 @@ typedef struct regstore_t
CELL *AuxSp_; /* 9 Auxiliary stack pointer */ CELL *AuxSp_; /* 9 Auxiliary stack pointer */
ADDR AuxTop_; /* 10 Auxiliary stack top */ ADDR AuxTop_; /* 10 Auxiliary stack top */
/* visualc*/ /* visualc*/
struct DB_TERM * EX_; /* 18 */
Term CurrentModule_; Term CurrentModule_;
struct myddas_global *MYDDAS_GLOBAL_POINTER; struct myddas_global *MYDDAS_GLOBAL_POINTER;
#if defined(YAPOR_SBA) || defined(TABLING) #if defined(YAPOR_SBA) || defined(TABLING)
@ -641,7 +640,6 @@ INLINE_ONLY EXTERN inline void restore_B(void) {
#define AuxSp Yap_REGS.AuxSp_ #define AuxSp Yap_REGS.AuxSp_
#define AuxTop Yap_REGS.AuxTop_ #define AuxTop Yap_REGS.AuxTop_
#define CurrentTrailTop Yap_REGS.CurrentTrailTop_ #define CurrentTrailTop Yap_REGS.CurrentTrailTop_
#define EX Yap_REGS.EX_
#define DEPTH Yap_REGS.DEPTH_ #define DEPTH Yap_REGS.DEPTH_
#if defined(YAPOR_SBA) || defined(TABLING) #if defined(YAPOR_SBA) || defined(TABLING)
#define H_FZ Yap_REGS.H_FZ_ #define H_FZ Yap_REGS.H_FZ_

459
H/Yap.h
View File

@ -21,20 +21,28 @@
// #error Do not explicitly define YAPOR // #error Do not explicitly define YAPOR
#endif /* YAPOR */ #endif /* YAPOR */
#if (defined(YAPOR_COPY) && (defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS))) || (defined(YAPOR_COW) && (defined(YAPOR_SBA) || defined(YAPOR_THREADS))) || (defined(YAPOR_SBA) && defined(YAPOR_THREADS)) #if (defined(YAPOR_COPY) && \
(defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS))) || \
(defined(YAPOR_COW) && (defined(YAPOR_SBA) || defined(YAPOR_THREADS))) || \
(defined(YAPOR_SBA) && defined(YAPOR_THREADS))
#error Do not define multiple or-parallel models #error Do not define multiple or-parallel models
#endif /* (YAPOR_COPY && (YAPOR_COW || YAPOR_SBA || YAPOR_THREADS)) || (YAPOR_COW && (YAPOR_SBA || YAPOR_THREADS)) || (YAPOR_SBA || YAPOR_THREADS) */ #endif /* (YAPOR_COPY && (YAPOR_COW || YAPOR_SBA || YAPOR_THREADS)) || \
(YAPOR_COW && (YAPOR_SBA || YAPOR_THREADS)) || (YAPOR_SBA || \
YAPOR_THREADS) */
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS) #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \
defined(YAPOR_THREADS)
#define YAPOR 1 #define YAPOR 1
#define FIXED_STACKS 1 #define FIXED_STACKS 1
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
#if defined(TABLING) && (defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS)) #if defined(TABLING) && \
(defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS))
#error TABLING only works with YAPOR_COPY #error TABLING only works with YAPOR_COPY
#endif /* TABLING && (YAPOR_COW || YAPOR_SBA || YAPOR_THREADS) */ #endif /* TABLING && (YAPOR_COW || YAPOR_SBA || YAPOR_THREADS) */
#if defined(THREADS) && (defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_COPY)) #if defined(THREADS) && \
(defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_COPY))
#error THREADS only works with YAPOR_THREADS #error THREADS only works with YAPOR_THREADS
#endif /* THREADS && (YAPOR_COW || YAPOR_SBA || YAPOR_COPY) */ #endif /* THREADS && (YAPOR_COW || YAPOR_SBA || YAPOR_COPY) */
@ -66,7 +74,6 @@
#include <stdint.h> #include <stdint.h>
#endif #endif
/* /*
#define RATIONAL_TREES 1 #define RATIONAL_TREES 1
@ -104,31 +111,31 @@
#endif /* COROUTINING && !TERM_EXTENSIONS */ #endif /* COROUTINING && !TERM_EXTENSIONS */
/** /**
* Stolen from Mozzila, this code should deal with bad implementations of stdc++. * Stolen from Mozzila, this code should deal with bad implementations of
* stdc++.
* *
* Use C++11 nullptr if available; otherwise use a C++ typesafe template; and * Use C++11 nullptr if available; otherwise use a C++ typesafe template; and
* for C, fall back to longs. See bugs 547964 and 626472. * for C, fall back to longs. See bugs 547964 and 626472.
*/ */
#if !defined(nullptr) && !defined(HAVE_NULLPTR) #if !defined(nullptr) && !defined(HAVE_NULLPTR)
#ifndef __cplusplus #ifndef __cplusplus
# define nullptr ((void*)0) #define nullptr NULL
#elif defined(__GNUC__) #elif defined(__GNUC__)
# define nullptr __null #define nullptr __null
#elif defined(_WIN64) #elif defined(_WIN64)
# define nullptr 0LL #define nullptr 0LL
#else #else
# define nullptr 0L #define nullptr 0L
#endif #endif
#endif /* defined(HAVE_NULLPTR) */ #endif /* defined(HAVE_NULLPTR) */
/* Microsoft's Visual C++ Compiler */ /* Microsoft's Visual C++ Compiler */
#ifdef _MSC_VER /* adjust a config.h from mingw32 to work with vc++ */ #ifdef _MSC_VER /* adjust a config.h from mingw32 to work with vc++ */
#ifdef HAVE_GCC #ifdef HAVE_GCC
#undef HAVE_GCC #undef HAVE_GCC
#endif /* HAVE_GCC */ #endif /* HAVE_GCC */
#ifdef USE_THREADED_CODE #ifdef USE_THREADED_CODE
#undef USE_THREADED_CODE #undef USE_THREADED_CODE
#endif /* USE_THREADED_CODE */ #endif /* USE_THREADED_CODE */
#define inline __inline #define inline __inline
#define YAP_VERSION "YAP-6.3.4" #define YAP_VERSION "YAP-6.3.4"
@ -169,8 +176,7 @@
#endif /* HAVE_GCC */ #endif /* HAVE_GCC */
/* funcions that return a generic pointer */ /* funcions that return a generic pointer */
typedef void * (*fptr_t)(void); typedef void *(*fptr_t)(void);
/************************************************************************************************* /*************************************************************************************************
main exports in YapInterface.h main exports in YapInterface.h
@ -183,37 +189,34 @@ typedef void * (*fptr_t)(void);
/* expect controls the direction of branches */ /* expect controls the direction of branches */
#ifdef HAVE___BUILTIN_EXPECT #ifdef HAVE___BUILTIN_EXPECT
#define likely(x) __builtin_expect((x), 1) #define likely(x) __builtin_expect((x), 1)
#define unlikely(x) __builtin_expect((x), 0) #define unlikely(x) __builtin_expect((x), 0)
#else #else
#define likely(x) (x) #define likely(x) (x)
#define unlikely(x) (x) #define unlikely(x) (x)
#endif #endif
#ifdef THREADS #ifdef THREADS
#if USE_PTHREAD_LOCKING #if USE_PTHREAD_LOCKING
#ifndef _XOPEN_SOURCE #ifndef _XOPEN_SOURCE
#define _XOPEN_SOURCE 600 #define _XOPEN_SOURCE 600
#endif /* !_XOPEN_SOURCE */ #endif /* !_XOPEN_SOURCE */
#endif /* USE_PTHREAD_LOCKING */ #endif /* USE_PTHREAD_LOCKING */
#include <pthread.h> #include <pthread.h>
#endif /* THREADS */ #endif /* THREADS */
/* null pointer */ /* null pointer */
#define NIL 0 #define NIL 0
/* Basic types */ /* Basic types */
#if HAVE_SIGPROF && (defined(__linux__) || defined(__APPLE__)) #if HAVE_SIGPROF && (defined(__linux__) || defined(__APPLE__))
#define LOW_PROF 1 #define LOW_PROF 1
#endif #endif
#if !defined(HAVE_STRNLEN) #if !defined(HAVE_STRNLEN)
INLINE_ONLY inline EXTERN size_t INLINE_ONLY inline EXTERN size_t strnlen(const char *s, size_t maxlen);
strnlen(const char *s, size_t maxlen);
INLINE_ONLY inline EXTERN size_t INLINE_ONLY inline EXTERN size_t strnlen(const char *s, size_t maxlen) {
strnlen(const char *s, size_t maxlen)
{
size_t i = 0; size_t i = 0;
while (s[i]) { while (s[i]) {
if (i == maxlen) if (i == maxlen)
@ -232,7 +235,8 @@ strnlen(const char *s, size_t maxlen)
#endif /* FORCE_SECOND_QUADRANT */ #endif /* FORCE_SECOND_QUADRANT */
#if !defined(IN_SECOND_QUADRANT) #if !defined(IN_SECOND_QUADRANT)
#if defined(__linux__) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(mips) || (__DragonFly__) #if defined(__linux__) || defined(__FreeBSD__) || defined(__NetBSD__) || \
defined(mips) || (__DragonFly__)
#if defined(YAPOR) && defined(__alpha) #if defined(YAPOR) && defined(__alpha)
#define MMAP_ADDR 0x40000000 #define MMAP_ADDR 0x40000000
@ -245,35 +249,37 @@ strnlen(const char *s, size_t maxlen)
#endif /* YAPOR && __alpha */ #endif /* YAPOR && __alpha */
#elif __svr4__ || defined(__SVR4) #elif __svr4__ || defined(__SVR4)
#define MMAP_ADDR 0x02000000 #define MMAP_ADDR 0x02000000
#endif /* __linux__ || __FreeBSD__ || __NetBSD__ || mips || __APPLE__ || __DragonFly__ */ #endif /* __linux__ || __FreeBSD__ || __NetBSD__ || mips || __APPLE__ || \
__DragonFly__ */
#endif /* !IN_SECOND_QUADRANT */ #endif /* !IN_SECOND_QUADRANT */
/* #define RANDOMIZE_START_ADDRESS 1 */ /* #define RANDOMIZE_START_ADDRESS 1 */
#ifdef USE_SYSTEM_MALLOC #ifdef USE_SYSTEM_MALLOC
#define HEAP_INIT_BASE 0L #define HEAP_INIT_BASE 0L
#define AtomBase NULL #define AtomBase NULL
#else /* !USE_SYSTEM_MALLOC */ #else /* !USE_SYSTEM_MALLOC */
#if defined(MMAP_ADDR) && (defined(USE_MMAP) || USE_SHMAT) && !defined(__simplescalar__) && !defined(RANDOMIZE_START_ADDRESS) #if defined(MMAP_ADDR) && (defined(USE_MMAP) || USE_SHMAT) && \
#define HEAP_INIT_BASE (MMAP_ADDR) !defined(__simplescalar__) && !defined(RANDOMIZE_START_ADDRESS)
#define AtomBase ((char *)MMAP_ADDR) #define HEAP_INIT_BASE (MMAP_ADDR)
#else /*! (MMAP_ADDR && (USE_MMAP || USE_SHMAT) && !__simplescalar__ && !RANDOMIZE_START_ADDRESS) */ #define AtomBase ((char *)MMAP_ADDR)
#define HEAP_INIT_BASE ((CELL)Yap_HeapBase) #else /*! (MMAP_ADDR && (USE_MMAP || USE_SHMAT) && !__simplescalar__ && \
#define AtomBase (Yap_HeapBase) !RANDOMIZE_START_ADDRESS) */
#endif /* MMAP_ADDR && (USE_MMAP || USE_SHMAT) && !__simplescalar__ && !RANDOMIZE_START_ADDRESS */ #define HEAP_INIT_BASE ((CELL)Yap_HeapBase)
#define AtomBase (Yap_HeapBase)
#endif /* MMAP_ADDR && (USE_MMAP || USE_SHMAT) && !__simplescalar__ && \
!RANDOMIZE_START_ADDRESS */
#endif /* USE_SYSTEM_MALLOC */ #endif /* USE_SYSTEM_MALLOC */
#ifndef ALIGN_LONGS #ifndef ALIGN_LONGS
#define ALIGN_LONGS 1 #define ALIGN_LONGS 1
#endif #endif
#define K1 ((CELL)1024) #define K1 ((CELL)1024)
#define K16 ((CELL)(1024*64)) #define K16 ((CELL)(1024 * 64))
#define K64 ((CELL)(1024*64)) #define K64 ((CELL)(1024 * 64))
#define M1 ((CELL)(1024*1024)) #define M1 ((CELL)(1024 * 1024))
#define M2 ((CELL)(2048*1024)) #define M2 ((CELL)(2048 * 1024))
#if ALIGN_LONGS #if ALIGN_LONGS
typedef CELL SFLAGS; typedef CELL SFLAGS;
@ -285,17 +291,16 @@ typedef char *ADDR;
typedef CELL OFFSET; typedef CELL OFFSET;
typedef unsigned char *CODEADDR; typedef unsigned char *CODEADDR;
#define TermPtr(V) ((Term *)(V))
#define Addr(V) ((ADDR)(V))
#define TermPtr(V) ((Term *) (V)) #define CodePtr(V) ((CODEADDR)(V))
#define Addr(V) ((ADDR) (V)) #define CellPtr(V) ((CELL *)(V))
#define OpCodePtr(V) ((OPCODE *)(V))
#define CodePtr(V) ((CODEADDR)(V)) #define OpRegPtr(V) ((OPREG *)(V))
#define CellPtr(V) ((CELL *)(V)) #define SmallPtr(V) ((SMALLUNSGN *)(V))
#define OpCodePtr(V) ((OPCODE *)(V)) #define WordPtr(V) ((BITS16 *)(V))
#define OpRegPtr(V) ((OPREG *)(V)) #define DisplPtr(V) ((DISPREG *)(V))
#define SmallPtr(V) ((SMALLUNSGN *)(V))
#define WordPtr(V) ((BITS16 *)(V))
#define DisplPtr(V) ((DISPREG *)(V))
#if !defined(YAPOR) && !defined(THREADS) #if !defined(YAPOR) && !defined(THREADS)
#include <nolocks.h> #include <nolocks.h>
@ -305,7 +310,6 @@ typedef unsigned char *CODEADDR;
#define _XOPEN_SOURCE 600 #define _XOPEN_SOURCE 600
#endif #endif
#include <locks_pthread.h> #include <locks_pthread.h>
typedef pthread_mutex_t lockvar; typedef pthread_mutex_t lockvar;
typedef pthread_rwlock_t rwlock_t; typedef pthread_rwlock_t rwlock_t;
@ -335,21 +339,22 @@ typedef volatile int lockvar;
#define FUNC_WRITE_LOCK(X) WRITE_LOCK((X)->FRWLock) #define FUNC_WRITE_LOCK(X) WRITE_LOCK((X)->FRWLock)
#define FUNC_WRITE_UNLOCK(X) WRITE_UNLOCK((X)->FRWLock) #define FUNC_WRITE_UNLOCK(X) WRITE_UNLOCK((X)->FRWLock)
/************************************************************************************************* /*************************************************************************************************
use an auxiliary function for ranges use an auxiliary function for ranges
*************************************************************************************************/ *************************************************************************************************/
#ifdef __GNUC__ #ifdef __GNUC__
#define IN_BETWEEN(MIN,X,MAX) (Unsigned((Int)(X)-(Int)(MIN)) <= \ #define IN_BETWEEN(MIN, X, MAX) \
Unsigned((Int)(MAX)-(Int)(MIN)) ) (Unsigned((Int)(X) - (Int)(MIN)) <= Unsigned((Int)(MAX) - (Int)(MIN)))
#define OUTSIDE(MIN,X,MAX) (Unsigned((Int)(X)-(Int)(MIN)) > \ #define OUTSIDE(MIN, X, MAX) \
Unsigned((Int)(MAX)-(Int)(MIN)) ) (Unsigned((Int)(X) - (Int)(MIN)) > Unsigned((Int)(MAX) - (Int)(MIN)))
#else #else
#define IN_BETWEEN(MIN,X,MAX) ((void *)(X) >= (void *)(MIN) && (void *)(X) <= (void *)(MAX)) #define IN_BETWEEN(MIN, X, MAX) \
((void *)(X) >= (void *)(MIN) && (void *)(X) <= (void *)(MAX))
#define OUTSIDE(MIN,X,MAX) ((void *)(X) < (void *)(MIN) || (void *)(X) > (void *)(MAX)) #define OUTSIDE(MIN, X, MAX) \
((void *)(X) < (void *)(MIN) || (void *)(X) > (void *)(MAX))
#endif #endif
/************************************************************************************************* /*************************************************************************************************
@ -362,7 +367,6 @@ typedef volatile int lockvar;
Coroutining Coroutining
*************************************************************************************************/ *************************************************************************************************/
#ifdef COROUTINING #ifdef COROUTINING
/* Support for co-routining */ /* Support for co-routining */
#include "corout.h" #include "corout.h"
@ -382,10 +386,12 @@ typedef volatile int lockvar;
#if defined(YAPOR) || defined(TABLING) #if defined(YAPOR) || defined(TABLING)
#include "opt.structs.h" #include "opt.structs.h"
#include "opt.proto.h"
#include "opt.macros.h"
#endif /* YAPOR || TABLING */
#include "opt.proto.h"
#include "opt.macros.h"
#endif /* YAPOR || TABLING */
/************************************************************************************************* /*************************************************************************************************
variables concerned with Error Handling variables concerned with Error Handling
@ -404,8 +410,7 @@ typedef volatile int lockvar;
#include "YapError.h" #include "YapError.h"
typedef enum typedef enum {
{
GPROF_NO_EVENT, GPROF_NO_EVENT,
GPROF_NEW_PRED_FUNC, GPROF_NEW_PRED_FUNC,
GPROF_NEW_PRED_THREAD, GPROF_NEW_PRED_THREAD,
@ -432,7 +437,6 @@ typedef enum
#define MAX_EMPTY_WAKEUPS 16 #define MAX_EMPTY_WAKEUPS 16
/************************************************************************************************* /*************************************************************************************************
prototypes prototypes
*************************************************************************************************/ *************************************************************************************************/
@ -441,7 +445,7 @@ typedef enum
#include "YapTags.h" #include "YapTags.h"
#define TermSize sizeof(Term) #define TermSize sizeof(Term)
/************************************************************************************************* /*************************************************************************************************
variables related to memory allocation variables related to memory allocation
@ -463,48 +467,45 @@ extern ADDR Yap_HeapBase;
extern int Yap_output_msg; extern int Yap_output_msg;
#endif #endif
#if __ANDROID__ #if __ANDROID__
#include <jni.h>
#include <android/asset_manager.h> #include <android/asset_manager.h>
#include <android/asset_manager_jni.h> #include <android/asset_manager_jni.h>
#include <android/log.h> #include <android/log.h>
#include <jni.h>
extern AAssetManager * Yap_assetManager; extern AAssetManager *Yap_assetManager;
extern void *Yap_openAssetFile( const char *path ) ; extern void *Yap_openAssetFile(const char *path);
extern bool Yap_isAsset( const char *path ); extern bool Yap_isAsset(const char *path);
extern bool Yap_AccessAsset( const char *name , int mode); extern bool Yap_AccessAsset(const char *name, int mode);
extern bool Yap_AssetIsFile( const char *name ); extern bool Yap_AssetIsFile(const char *name);
extern bool Yap_AssetIsDir( const char *name ); extern bool Yap_AssetIsDir(const char *name);
extern int64_t Yap_AssetSize( const char *name ); extern int64_t Yap_AssetSize(const char *name);
#endif #endif
/************************************************************************************************* /*************************************************************************************************
variables concerned with atoms table variables concerned with atoms table
*************************************************************************************************/ *************************************************************************************************/
#define MaxHash 3333 #define MaxHash 3333
#define MaxWideHash (MaxHash/10+1) #define MaxWideHash (MaxHash / 10 + 1)
#define FAIL_RESTORE 0 #define FAIL_RESTORE 0
#define DO_EVERYTHING 1 #define DO_EVERYTHING 1
#define DO_ONLY_CODE 2 #define DO_ONLY_CODE 2
/************************************************************************************************* /*************************************************************************************************
common instructions codes common instructions codes
*************************************************************************************************/ *************************************************************************************************/
#define MAX_PROMPT 256 #define MAX_PROMPT 256
#if USE_THREADED_CODE #if USE_THREADED_CODE
/************************************************************************************************* /*************************************************************************************************
reverse lookup of instructions reverse lookup of instructions
*************************************************************************************************/ *************************************************************************************************/
typedef struct opcode_tab_entry typedef struct opcode_tab_entry {
{
OPCODE opc; OPCODE opc;
op_numbers opnum; op_numbers opnum;
} op_entry; } op_entry;
@ -515,102 +516,103 @@ typedef struct opcode_tab_entry
Prolog may be in several modes Prolog may be in several modes
*************************************************************************************************/ *************************************************************************************************/
typedef enum typedef enum {
{ BootMode = 0x1, /** if booting or restoring */
BootMode = 0x1, /* if booting or restoring */ UserMode = 0x2, /** Normal mode */
UserMode = 0x2, /* Normal mode */ CritMode = 0x4, /** If we are meddling with the heap */
CritMode = 0x4, /* If we are meddling with the heap */ AbortMode = 0x8, /** expecting to abort */
AbortMode = 0x8, /* expecting to abort */ InterruptMode = 0x10, /*8 under an interrupt */
InterruptMode = 0x10, /* under an interrupt */ InErrorMode = 0x20, /** error handling */
InErrorMode = 0x20, /* under an interrupt */ ConsoleGetcMode = 0x40, /** blocked reading from console */
ConsoleGetcMode = 0x40, /* blocked reading from console */ ExtendStackMode = 0x80, /** trying to extend stack */
ExtendStackMode = 0x80, /* trying to extend stack */ GrowHeapMode = 0x100, /** extending Heap */
GrowHeapMode = 0x100, /* extending Heap */ GrowStackMode = 0x200, /** extending Stack */
GrowStackMode = 0x200, /* extending Stack */ GCMode = 0x400, /** doing Garbage Collecting */
GCMode = 0x400, /* doing Garbage Collecting */ ErrorHandlingMode = 0x800, /** doing error handling */
ErrorHandlingMode = 0x800, /* doing error handling */ CCallMode = 0x1000, /** In c Call */
CCallMode = 0x1000, /* In c Call */ UnifyMode = 0x2000, /** In Unify Code */
UnifyMode = 0x2000, /* In Unify Code */ UserCCallMode = 0x4000, /** In User C-call Code */
UserCCallMode = 0x4000, /* In User C-call Code */ MallocMode = 0x8000, /** Doing malloc, realloc, free */
MallocMode = 0x8000, /* Doing malloc, realloc, free */ SystemMode = 0x10000, /** in system mode */
SystemMode = 0x10000, /* in system mode */ AsyncIntMode = 0x20000, /** YAP has just been interrupted from the outside */
AsyncIntMode = 0x20000, /* YAP has just been interrupted from the outside */ InReadlineMode =
InReadlineMode = 0x40000 /* YAP has just been interrupted from the outside */ 0x40000, /** YAP has just been interrupted from the outside */
TopGoalMode = 0x40000 /** creating a new autonomous goal */
} prolog_exec_mode; } prolog_exec_mode;
/************************************************************************************************* /*************************************************************************************************
number of modules number of modules
*************************************************************************************************/ *************************************************************************************************/
#define DefaultMaxModules 256 #define DefaultMaxModules 256
/************************************************************************************************* /*************************************************************************************************
Critical sections Critical sections
*************************************************************************************************/ *************************************************************************************************/
#ifdef YAPOR #ifdef YAPOR
#define YAPEnterCriticalSection() \ #define YAPEnterCriticalSection() \
{ \ { \
if (worker_id != GLOBAL_locks_who_locked_heap) { \ if (worker_id != GLOBAL_locks_who_locked_heap) { \
LOCK(GLOBAL_locks_heap_access); \ LOCK(GLOBAL_locks_heap_access); \
GLOBAL_locks_who_locked_heap = worker_id; \ GLOBAL_locks_who_locked_heap = worker_id; \
} \ } \
LOCAL_PrologMode |= CritMode; \ LOCAL_PrologMode |= CritMode; \
LOCAL_CritLocks++; \ LOCAL_CritLocks++; \
} }
#define YAPLeaveCriticalSection() \ #define YAPLeaveCriticalSection() \
{ \ { \
LOCAL_CritLocks--; \ LOCAL_CritLocks--; \
if (!LOCAL_CritLocks) { \ if (!LOCAL_CritLocks) { \
LOCAL_PrologMode &= ~CritMode; \ LOCAL_PrologMode &= ~CritMode; \
if (LOCAL_PrologMode & AbortMode) { \ if (LOCAL_PrologMode & AbortMode) { \
LOCAL_PrologMode &= ~AbortMode; \ LOCAL_PrologMode &= ~AbortMode; \
Yap_Error(ABORT_EVENT, 0, ""); \ Yap_Error(ABORT_EVENT, 0, ""); \
} \ } \
GLOBAL_locks_who_locked_heap = MAX_WORKERS; \ GLOBAL_locks_who_locked_heap = MAX_WORKERS; \
UNLOCK(GLOBAL_locks_heap_access); \ UNLOCK(GLOBAL_locks_heap_access); \
} \ } \
} }
#elif defined(THREADS) #elif defined(THREADS)
#define YAPEnterCriticalSection() \ #define YAPEnterCriticalSection() \
{ \ { \
/* LOCK(BGL); */ \ /* LOCK(BGL); */ \
LOCAL_PrologMode |= CritMode; \ LOCAL_PrologMode |= CritMode; \
} }
#define YAPLeaveCriticalSection() \ #define YAPLeaveCriticalSection() \
{ \ { \
LOCAL_PrologMode &= ~CritMode; \ LOCAL_PrologMode &= ~CritMode; \
if (LOCAL_PrologMode & AbortMode) { \ if (LOCAL_PrologMode & AbortMode) { \
LOCAL_PrologMode &= ~AbortMode; \ LOCAL_PrologMode &= ~AbortMode; \
Yap_Error(ABORT_EVENT, 0, ""); \ Yap_Error(ABORT_EVENT, 0, ""); \
Yap_RestartYap( 1 ); \ Yap_RestartYap(1); \
} \ } \
/* UNLOCK(BGL); */ \ /* UNLOCK(BGL); */ \
} }
#else #else
#define YAPEnterCriticalSection() \ #define YAPEnterCriticalSection() \
{ \ { \
LOCAL_PrologMode |= CritMode;/* printf("%d, %s:%d\n",LOCAL_CritLocks+1,__FILE__,__LINE__);*/ \ LOCAL_PrologMode |= \
LOCAL_CritLocks++; \ CritMode; /* printf("%d, \
} %s:%d\n",LOCAL_CritLocks+1,__FILE__,__LINE__);*/ \
#define YAPLeaveCriticalSection() \ LOCAL_CritLocks++; \
{ \ }
LOCAL_CritLocks--; \ #define YAPLeaveCriticalSection() \
/*printf("%d, %s:%d\n",LOCAL_CritLocks,__FILE__,__LINE__);*/ \ { \
if (!LOCAL_CritLocks) { \ LOCAL_CritLocks--; \
LOCAL_PrologMode &= ~CritMode; \ /*printf("%d, %s:%d\n",LOCAL_CritLocks,__FILE__,__LINE__);*/ \
if (LOCAL_PrologMode & AbortMode) { \ if (!LOCAL_CritLocks) { \
LOCAL_PrologMode &= ~AbortMode; \ LOCAL_PrologMode &= ~CritMode; \
Yap_RestartYap( 1 ); \ if (LOCAL_PrologMode & AbortMode) { \
} \ LOCAL_PrologMode &= ~AbortMode; \
} \ Yap_RestartYap(1); \
} } \
} \
}
#endif /* YAPOR */ #endif /* YAPOR */
/* when we are calling the InitStaff procedures */ /* when we are calling the InitStaff procedures */
#define AT_BOOT 0 #define AT_BOOT 0
#define AT_RESTORE 1 #define AT_RESTORE 1
/************************************************************************************************* /*************************************************************************************************
mutable variables mutable variables
@ -618,63 +620,60 @@ typedef enum
/* I assume that the size of this structure is a multiple of the size /* I assume that the size of this structure is a multiple of the size
of CELL!!! */ of CELL!!! */
typedef struct TIMED_MAVAR typedef struct TIMED_MAVAR {
{
CELL value; CELL value;
CELL clock; CELL clock;
} timed_var; } timed_var;
/************************************************************************************************* /*************************************************************************************************
execution mode execution mode
*************************************************************************************************/ *************************************************************************************************/
typedef enum typedef enum {
{ INTERPRETED = 0x1, /* interpreted */
INTERPRETED = 0x1, /* interpreted */ MIXED_MODE_USER = 0x2, /* mixed mode only for user predicates */
MIXED_MODE_USER = 0x2, /* mixed mode only for user predicates */ MIXED_MODE_ALL = 0x4, /* mixed mode for all predicates */
MIXED_MODE_ALL = 0x4, /* mixed mode for all predicates */ COMPILE_USER = 0x8, /* compile all user predicates*/
COMPILE_USER = 0x8, /* compile all user predicates*/ COMPILE_ALL = 0x10 /* compile all predicates */
COMPILE_ALL = 0x10 /* compile all predicates */ } yap_exec_mode;
} yap_exec_mode;
#define MIXED_MODE ( MIXED_MODE_USER | MIXED_MODE_ALL ) #define MIXED_MODE (MIXED_MODE_USER | MIXED_MODE_ALL)
#define COMPILED ( COMPILE_USER | COMPILE_ALL ) #define COMPILED (COMPILE_USER | COMPILE_ALL)
/************************/ /************************/
// queues are an example of collections of DB objects // queues are an example of collections of DB objects
typedef struct queue_entry { typedef struct queue_entry {
struct queue_entry *next; struct queue_entry *next;
struct DB_TERM *DBT; struct DB_TERM *DBT;
} QueueEntry; } QueueEntry;
typedef struct idb_queue typedef struct idb_queue {
{ struct FunctorEntryStruct
struct FunctorEntryStruct *id; /* identify this as being pointed to by a DBRef */ *id; /* identify this as being pointed to by a DBRef */
SMALLUNSGN Flags; /* always required */ SMALLUNSGN Flags; /* always required */
#if PARALLEL_YAP #if PARALLEL_YAP
rwlock_t QRWLock; /* a simple lock to protect this entry */ rwlock_t QRWLock; /* a simple lock to protect this entry */
#endif #endif
QueueEntry *FirstInQueue, *LastInQueue; QueueEntry *FirstInQueue, *LastInQueue;
} db_queue; } db_queue;
void Yap_init_tqueue( db_queue *dbq ); void Yap_init_tqueue(db_queue *dbq);
void Yap_destroy_tqueue( db_queue *dbq USES_REGS); void Yap_destroy_tqueue(db_queue *dbq USES_REGS);
bool Yap_enqueue_tqueue(db_queue *father_key, Term t USES_REGS); bool Yap_enqueue_tqueue(db_queue *father_key, Term t USES_REGS);
bool Yap_dequeue_tqueue(db_queue *father_key, Term t, bool first, bool release USES_REGS); bool Yap_dequeue_tqueue(db_queue *father_key, Term t, bool first,
bool release USES_REGS);
#ifdef THREADS #ifdef THREADS
typedef struct thread_mbox { typedef struct thread_mbox {
Term name; Term name;
pthread_mutex_t mutex; pthread_mutex_t mutex;
pthread_cond_t cond; pthread_cond_t cond;
struct idb_queue msgs; struct idb_queue msgs;
int nmsgs, nclients; // if nclients < 0 mailbox has been closed. int nmsgs, nclients; // if nclients < 0 mailbox has been closed.
bool open; bool open;
struct thread_mbox *next; struct thread_mbox *next;
} mbox_t; } mbox_t;
typedef struct thandle { typedef struct thandle {
@ -685,7 +684,7 @@ typedef struct thandle {
UInt sysize; UInt sysize;
void *stack_address; void *stack_address;
Term tdetach; Term tdetach;
Term cmod, texit_mod; Term cmod, texit_mod;
struct DB_TERM *tgoal, *texit; struct DB_TERM *tgoal, *texit;
int id; int id;
int ret; int ret;
@ -693,7 +692,7 @@ typedef struct thandle {
REGSTORE *current_yaam_regs; REGSTORE *current_yaam_regs;
struct pred_entry *local_preds; struct pred_entry *local_preds;
pthread_t pthread_handle; pthread_t pthread_handle;
mbox_t mbox_handle; mbox_t mbox_handle;
int ref_count; int ref_count;
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
long long int thread_inst_count; long long int thread_inst_count;
@ -730,18 +729,17 @@ typedef struct gc_ma_hash_entry_struct {
tr_fr_ptr loc; tr_fr_ptr loc;
struct gc_ma_hash_entry_struct *more; struct gc_ma_hash_entry_struct *more;
#endif #endif
CELL* addr; CELL *addr;
struct gc_ma_hash_entry_struct *next; struct gc_ma_hash_entry_struct *next;
} gc_ma_hash_entry; } gc_ma_hash_entry;
typedef int (*Agc_hook)(Atom); typedef int (*Agc_hook)(Atom);
typedef struct scratch_block_struct { typedef struct scratch_block_struct {
char *ptr; char *ptr;
UInt sz, msz; UInt sz, msz;
} scratch_block; } scratch_block;
/* scanner types */ /* scanner types */
#include "ScannerTypes.h" #include "ScannerTypes.h"
@ -759,23 +757,22 @@ extern struct global_data Yap_Global;
#if defined(THREADS) #if defined(THREADS)
extern struct worker_local *Yap_local[MAX_THREADS]; extern struct worker_local *Yap_local[MAX_THREADS];
#define REMOTE(wid) (Yap_local[wid]) #define REMOTE(wid) (Yap_local[wid])
#elif defined(YAPOR) #elif defined(YAPOR)
extern struct worker_local *Yap_local; extern struct worker_local *Yap_local;
#define REMOTE(wid) (Yap_local + wid) #define REMOTE(wid) (Yap_local + wid)
#else /* !THREADS && !YAPOR */ #else /* !THREADS && !YAPOR */
extern struct worker_local Yap_local; extern struct worker_local Yap_local;
#define REMOTE(wid) (&Yap_local) #define REMOTE(wid) (&Yap_local)
#endif #endif
#include "encoding.h" #include "encoding.h"
#include <stdio.h> #include <stdio.h>
#define YP_FILE FILE #define YP_FILE FILE
#include <YapHeap.h> #include <YapHeap.h>
/************************************************************************************************* /*************************************************************************************************
unification routines unification routines
*************************************************************************************************/ *************************************************************************************************/
@ -812,37 +809,33 @@ Global variables for JIT
#endif #endif
#if DEBUGX #if DEBUGX
inline static void inline static void LOG0(const char *f, int l, const char *fmt, ...) {
LOG0(const char *f, int l, const char *fmt, ...)
{
va_list ap; va_list ap;
va_start(ap, fmt); va_start(ap, fmt);
#if __ANDROID__ #if __ANDROID__
__android_log_print(ANDROID_LOG_INFO, "YAP ", fmt, ap); __android_log_print(ANDROID_LOG_INFO, "YAP ", fmt, ap);
#else __WINDOWS__ #else __WINDOWS__
FILE * fd; FILE *fd;
fd = fopen("c:\\cygwin\\Log.txt", "a"); fd = fopen("c:\\cygwin\\Log.txt", "a");
vfprintf(fd, fmt, ap); vfprintf(fd, fmt, ap);
fclose(fd); fclose(fd);
#endif #endif
vfprintf(stderr, fmt, ap); vfprintf(stderr, fmt, ap);
va_end(ap); va_end(ap);
} }
#define LOG( ... ) LOG0( __FILE__, __LINE__, __VA_ARGS__ ) #define LOG(...) LOG0(__FILE__, __LINE__, __VA_ARGS__)
#define REGS_LOG( ... ) CACHE_REGS LOG0( __FILE__, __LINE__, __VA_ARGS__ ) #define REGS_LOG(...) CACHE_REGS LOG0(__FILE__, __LINE__, __VA_ARGS__)
#else #else
#define LOG( ... ) #define LOG(...)
#define REGS_LOG( ... ) #define REGS_LOG(...)
#endif #endif
// YAP lexicon // YAP lexicon
#include "GitSHA1.h" #include "GitSHA1.h"
#endif /* YAP_H */ #endif /* YAP_H */

89
H/YapCompoundTerm.h
View File

@ -23,31 +23,32 @@
#include "inline-only.h" #include "inline-only.h"
EXTERN Int Yap_unify(Term a,Term b); EXTERN Int Yap_unify(Term a, Term b);
INLINE_ONLY EXTERN inline Term Deref(Term a); INLINE_ONLY EXTERN inline Term Deref(Term a);
INLINE_ONLY EXTERN inline Term Deref(Term a) INLINE_ONLY EXTERN inline Term Deref(Term a) {
{ while (IsVarTerm(a)) {
while(IsVarTerm(a)) { Term *b = (Term *)a;
Term *b = (Term *) a; a = *b;
a = *b; if (a == ((Term)b))
if(a==((Term) b)) return a; return a;
} }
return(a); return (a);
} }
INLINE_ONLY EXTERN inline CELL *GetTermAdress(Term a);
INLINE_ONLY EXTERN inline Term Derefa(CELL *b); INLINE_ONLY EXTERN inline Term Derefa(CELL *b);
INLINE_ONLY EXTERN inline Term INLINE_ONLY EXTERN inline Term Derefa(CELL *b) {
Derefa(CELL *b)
{
Term a = *b; Term a = *b;
restart: restart:
if (!IsVarTerm(a)) { if (!IsVarTerm(a)) {
return(a); return (a);
} else if (a == (CELL)b) { } else if (a == (CELL)b) {
return(a); return (a);
} else { } else {
b = (CELL *)a; b = (CELL *)a;
a = *b; a = *b;
@ -55,64 +56,42 @@ Derefa(CELL *b)
} }
} }
INLINE_ONLY inline EXTERN Term ArgOfTerm (int i, Term t); INLINE_ONLY inline EXTERN Term ArgOfTerm(int i, Term t);
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term ArgOfTerm(int i, Term t)
ArgOfTerm (int i, Term t)
{ {
return (Term) (Derefa (RepAppl (t) + (i))); return (Term)(Derefa(RepAppl(t) + (i)));
} }
INLINE_ONLY inline EXTERN Term HeadOfTerm(Term);
INLINE_ONLY inline EXTERN Term HeadOfTerm(Term t) {
INLINE_ONLY inline EXTERN Term HeadOfTerm (Term); return (Term)(Derefa(RepPair(t)));
INLINE_ONLY inline EXTERN Term
HeadOfTerm (Term t)
{
return (Term) (Derefa (RepPair (t)));
} }
INLINE_ONLY inline EXTERN Term TailOfTerm(Term);
INLINE_ONLY inline EXTERN Term TailOfTerm(Term t) {
INLINE_ONLY inline EXTERN Term TailOfTerm (Term); return (Term)(Derefa(RepPair(t) + 1));
INLINE_ONLY inline EXTERN Term
TailOfTerm (Term t)
{
return (Term) (Derefa (RepPair (t) + 1));
} }
INLINE_ONLY inline EXTERN Term ArgOfTermCell(int i, Term t);
INLINE_ONLY inline EXTERN Term ArgOfTermCell(int i, Term t) {
return (Term)((CELL)(RepAppl(t) + (i)));
INLINE_ONLY inline EXTERN Term ArgOfTermCell (int i, Term t);
INLINE_ONLY inline EXTERN Term
ArgOfTermCell (int i, Term t)
{
return (Term) ((CELL) (RepAppl (t) + (i)));
} }
INLINE_ONLY inline EXTERN Term HeadOfTermCell(Term);
INLINE_ONLY inline EXTERN Term HeadOfTermCell(Term t) {
INLINE_ONLY inline EXTERN Term HeadOfTermCell (Term); return (Term)((CELL)(RepPair(t)));
INLINE_ONLY inline EXTERN Term
HeadOfTermCell (Term t)
{
return (Term) ((CELL) (RepPair (t)));
} }
INLINE_ONLY inline EXTERN Term TailOfTermCell(Term);
INLINE_ONLY inline EXTERN Term TailOfTermCell(Term t) {
INLINE_ONLY inline EXTERN Term TailOfTermCell (Term); return (Term)((CELL)(RepPair(t) + 1));
INLINE_ONLY inline EXTERN Term
TailOfTermCell (Term t)
{
return (Term) ((CELL) (RepPair (t) + 1));
} }
#endif /* YAPCOMPOUNDTERM_H */ #endif /* YAPCOMPOUNDTERM_H */

13
H/Yapproto.h
View File

@ -195,15 +195,14 @@ void Yap_InitEval(void);
void Yap_fail_all(choiceptr bb USES_REGS); void Yap_fail_all(choiceptr bb USES_REGS);
Term Yap_ExecuteCallMetaCall(Term); Term Yap_ExecuteCallMetaCall(Term);
void Yap_InitExecFs(void); void Yap_InitExecFs(void);
Int Yap_JumpToEnv(Term); bool Yap_JumpToEnv(Term);
Term Yap_RunTopGoal(Term); Term Yap_RunTopGoal(Term, bool);
void Yap_ResetExceptionTerm(int); bool Yap_execute_goal(Term, int, Term, bool);
Int Yap_execute_goal(Term, int, Term, bool); bool Yap_exec_absmi(bool, yap_reset_t);
Int Yap_exec_absmi(bool, yap_reset_t);
void Yap_trust_last(void); void Yap_trust_last(void);
Term Yap_GetException(void);
void Yap_PrepGoal(UInt, CELL *, choiceptr USES_REGS); void Yap_PrepGoal(UInt, CELL *, choiceptr USES_REGS);
int Yap_execute_pred(struct pred_entry *ppe, CELL *pt, bool Yap_execute_pred(struct pred_entry *ppe, CELL *pt,
bool pass_exception USES_REGS); bool pass_exception USES_REGS);
int Yap_dogc(int extra_args, Term *tp USES_REGS); int Yap_dogc(int extra_args, Term *tp USES_REGS);
Term Yap_PredicateIndicator(Term t, Term mod); Term Yap_PredicateIndicator(Term t, Term mod);

90
H/Yatom.h
View File

@ -38,21 +38,7 @@ INLINE_ONLY inline EXTERN AtomEntry *RepAtom(Atom a) {
INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p); INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p);
INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p) { return (Atom)(p); }
INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p) { return (Atom)(p); }
INLINE_ONLY inline EXTERN AtomEntry *RepAtom(Atom a); INLINE_ONLY inline EXTERN AtomEntry *RepAtom(Atom a);
@ -503,9 +489,8 @@ don't forget to also add in qly.h
typedef uint64_t pred_flags_t; typedef uint64_t pred_flags_t;
#define DiscontiguousPredFlag \ #define DiscontiguousPredFlag \
(( \ ((pred_flags_t)0x1000000000) /* predicates whose clauses may be all-over \
pred_flags_t)0x1000000000) /* predicates whose clauses may be all-over \ the place.. */
the place.. */
#define SysExportPredFlag ((pred_flags_t)0x800000000) #define SysExportPredFlag ((pred_flags_t)0x800000000)
/* reuse export list to prolog module. */ /* reuse export list to prolog module. */
#define NoTracePredFlag \ #define NoTracePredFlag \
@ -518,8 +503,9 @@ typedef uint64_t pred_flags_t;
((pred_flags_t)0x80000000) /* predicate is implemented as a mega-clause */ ((pred_flags_t)0x80000000) /* predicate is implemented as a mega-clause */
#define ThreadLocalPredFlag ((pred_flags_t)0x40000000) /* local to a thread */ #define ThreadLocalPredFlag ((pred_flags_t)0x40000000) /* local to a thread */
#define MultiFileFlag ((pred_flags_t)0x20000000) /* is multi-file */ #define MultiFileFlag ((pred_flags_t)0x20000000) /* is multi-file */
#define UserCPredFlag ((pred_flags_t)0x10000000) /* CPred defined by the user \ #define UserCPredFlag \
*/ ((pred_flags_t)0x10000000) /* CPred defined by the user \
*/
#define LogUpdatePredFlag \ #define LogUpdatePredFlag \
((pred_flags_t)0x08000000) /* dynamic predicate with log. upd. sem. */ ((pred_flags_t)0x08000000) /* dynamic predicate with log. upd. sem. */
#define InUsePredFlag ((pred_flags_t)0x04000000) /* count calls to pred */ #define InUsePredFlag ((pred_flags_t)0x04000000) /* count calls to pred */
@ -533,9 +519,10 @@ typedef uint64_t pred_flags_t;
((pred_flags_t)0x00200000) /* predicate subject to a meta declaration */ ((pred_flags_t)0x00200000) /* predicate subject to a meta declaration */
#define SyncPredFlag \ #define SyncPredFlag \
((pred_flags_t)0x00100000) /* has to synch before it can execute */ ((pred_flags_t)0x00100000) /* has to synch before it can execute */
#define NumberDBPredFlag ((pred_flags_t)0x00080000) /* entry for an atom key \ #define NumberDBPredFlag \
*/ ((pred_flags_t)0x00080000) /* entry for an atom key \
#define AtomDBPredFlag ((pred_flags_t)0x00040000) /* entry for a number key */ */
#define AtomDBPredFlag ((pred_flags_t)0x00040000) /* entry for a number key */
// #define GoalExPredFlag ((pred_flags_t)0x00020000) /// predicate that is // #define GoalExPredFlag ((pred_flags_t)0x00020000) /// predicate that is
// called by goal_expand */ // called by goal_expand */
#define TestPredFlag ((pred_flags_t)0x00010000) /* is a test (optim. comit) */ #define TestPredFlag ((pred_flags_t)0x00010000) /* is a test (optim. comit) */
@ -552,9 +539,10 @@ typedef uint64_t pred_flags_t;
#define SequentialPredFlag \ #define SequentialPredFlag \
((pred_flags_t)0x00000020) /* may not create parallel choice points! */ ((pred_flags_t)0x00000020) /* may not create parallel choice points! */
#define ProfiledPredFlag \ #define ProfiledPredFlag \
((pred_flags_t)0x00000010) /* pred is being profiled */ ((pred_flags_t)0x00000010) /* pred is being profiled */
#define BackCPredFlag ((pred_flags_t)0x00000008) /* Myddas Imported pred \ #define BackCPredFlag \
*/ ((pred_flags_t)0x00000008) /* Myddas Imported pred \
*/
#define ModuleTransparentPredFlag \ #define ModuleTransparentPredFlag \
((pred_flags_t)0x00000004) /* ModuleTransparent pred */ ((pred_flags_t)0x00000004) /* ModuleTransparent pred */
#define SWIEnvPredFlag ((pred_flags_t)0x00000002) /* new SWI interface */ #define SWIEnvPredFlag ((pred_flags_t)0x00000002) /* new SWI interface */
@ -563,9 +551,11 @@ typedef uint64_t pred_flags_t;
#define SystemPredFlags \ #define SystemPredFlags \
(AsmPredFlag | StandardPredFlag | CPredFlag | BinaryPredFlag | BackCPredFlag) (AsmPredFlag | StandardPredFlag | CPredFlag | BinaryPredFlag | BackCPredFlag)
#define ForeignPredFlags \ #define ForeignPredFlags \
(AsmPredFlag | SWIEnvPredFlag | CPredFlag | BinaryPredFlag | UDIPredFlag | CArgsPredFlag | UserCPredFlag|SafePredFlag|BackCPredFlag) (AsmPredFlag | SWIEnvPredFlag | CPredFlag | BinaryPredFlag | UDIPredFlag | \
CArgsPredFlag | UserCPredFlag | SafePredFlag | BackCPredFlag)
#define StatePredFlags (InUsePredFlag|CountPredFlag|SpiedPredFlag|IndexedPredFlag ) #define StatePredFlags \
(InUsePredFlag | CountPredFlag | SpiedPredFlag | IndexedPredFlag)
#define is_system(pe) (pe->PredFlags & SystemPredFlags) #define is_system(pe) (pe->PredFlags & SystemPredFlags)
#define is_dynamic(pe) (pe->PredFlags & DynamicPredFlag) #define is_dynamic(pe) (pe->PredFlags & DynamicPredFlag)
#define is_foreign(pe) (pe->PredFlags & ForeignPredFlags) #define is_foreign(pe) (pe->PredFlags & ForeignPredFlags)
@ -696,15 +686,20 @@ typedef enum {
} dbentry_flags; } dbentry_flags;
/* predicate initialization */ /* predicate initialization */
void Yap_InitCPred(const char *name, arity_t arity, CPredicate f, pred_flags_t flags); void Yap_InitCPred(const char *name, arity_t arity, CPredicate f,
void Yap_InitAsmPred(const char *name, arity_t arity, int code, CPredicate asmc, pred_flags_t flags); pred_flags_t flags);
void Yap_InitCmpPred(const char *name, arity_t arity, CmpPredicate cmp, pred_flags_t flags); void Yap_InitAsmPred(const char *name, arity_t arity, int code, CPredicate asmc,
void Yap_InitCPredBack(const char *name, arity_t arity, arity_t extra, CPredicate call, pred_flags_t flags);
CPredicate retry, pred_flags_t flags); void Yap_InitCmpPred(const char *name, arity_t arity, CmpPredicate cmp,
void Yap_InitCPredBackCut(const char *name, arity_t arity, arity_t extra, CPredicate call, pred_flags_t flags);
CPredicate retry, CPredicate cut, pred_flags_t flags); void Yap_InitCPredBack(const char *name, arity_t arity, arity_t extra,
void Yap_InitCPredBack_(const char *name, arity_t arity, arity_t extra, CPredicate call, CPredicate call, CPredicate retry, pred_flags_t flags);
CPredicate retry, CPredicate cut, pred_flags_t flags); void Yap_InitCPredBackCut(const char *name, arity_t arity, arity_t extra,
CPredicate call, CPredicate retry, CPredicate cut,
pred_flags_t flags);
void Yap_InitCPredBack_(const char *name, arity_t arity, arity_t extra,
CPredicate call, CPredicate retry, CPredicate cut,
pred_flags_t flags);
/* *********************** DBrefs **************************************/ /* *********************** DBrefs **************************************/
@ -1615,7 +1610,8 @@ INLINE_ONLY inline EXTERN const char *AtomName(Atom at) {
INLINE_ONLY inline EXTERN const char *AtomTermName(Term t); INLINE_ONLY inline EXTERN const char *AtomTermName(Term t);
/** /**
* AtomTermName(Term t): get a string with the name of a term storing an Atom. Assumes 8 * AtomTermName(Term t): get a string with the name of a term storing an Atom.
*Assumes 8
*bit representation. *bit representation.
* *
* @param t the atom term * @param t the atom term
@ -1628,4 +1624,22 @@ INLINE_ONLY inline EXTERN const char *AtomTermName(Term t) {
return RepAtom(AtomOfTerm(t))->rep.uStrOfAE; return RepAtom(AtomOfTerm(t))->rep.uStrOfAE;
} }
bool Yap_ResetException(int wid);
bool Yap_HasException(void);
Term Yap_GetException(void);
Term Yap_PeekException(void);
bool Yap_PutException(Term t);
INLINE_ONLY inline EXTERN bool Yap_HasException(void) {
return LOCAL_BallTerm != NULL;
}
INLINE_ONLY inline EXTERN DBTerm *Yap_RefToException(void) {
DBTerm *dbt = LOCAL_BallTerm;
LOCAL_BallTerm = NULL;
return dbt;
}
INLINE_ONLY inline EXTERN void Yap_CopyException(DBTerm *dbt) {
LOCAL_BallTerm = dbt;
}
bool Yap_RaiseException(void);
#endif #endif

2127
H/absmi.h
View File

File diff suppressed because it is too large Load Diff

68
H/cut_c.h
View File

@ -10,44 +10,62 @@
#endif #endif
typedef struct cut_c_str *cut_c_str_ptr; typedef struct cut_c_str *cut_c_str_ptr;
struct cut_c_str{ struct cut_c_str {
cut_c_str_ptr before; cut_c_str_ptr before;
void *try_userc_cut_yamop; void *try_userc_cut_yamop;
}; };
#define CUT_C_STR_SIZE ((sizeof(struct cut_c_str))/(sizeof(CELL))) #define CUT_C_STR_SIZE ((sizeof(struct cut_c_str)) / (sizeof(CELL)))
#define EXTRA_CBACK_CUT_ARG(Type,Offset) \ #define EXTRA_CBACK_CUT_ARG(Type, Offset) EXTRA_CBACK_ARG(PP->ArityOfPE, Offset)
EXTRA_CBACK_ARG( PP->ArityOfPE, Offset )
#define CBACK_CUT_ARG(Offset) \ #define CBACK_CUT_ARG(Offset) B->cp_args[(Offset)-1]
B->cp_args[ (Offset) - 1 ]
#define CUT_C_PUSH(YAMOP,S_YREG) \ #define CUT_C_PUSH(YAMOP, S_YREG) \
{ \ { \
if ((YAMOP)->y_u.OtapFs.f){ \ if ((YAMOP)->y_u.OtapFs.f) { \
S_YREG = S_YREG - CUT_C_STR_SIZE; \ S_YREG = S_YREG - CUT_C_STR_SIZE; \
cut_c_str_ptr new_top = (cut_c_str_ptr) S_YREG; \ cut_c_str_ptr new_top = (cut_c_str_ptr)S_YREG; \
new_top->try_userc_cut_yamop = YAMOP; \ new_top->try_userc_cut_yamop = YAMOP; \
cut_c_push(new_top); \ cut_c_push(new_top); \
} \ } \
} }
#define POP_CHOICE_POINT(cp) \
(((CELL *)Yap_REGS.CUT_C_TOP != (CELL *)LOCAL_LocalBase) && \
((CELL *)(cp) > (CELL *)Yap_REGS.CUT_C_TOP))
#define POP_CHOICE_POINT(cp) \ #define POP_EXECUTE() \
(((CELL *)Yap_REGS.CUT_C_TOP != (CELL *)LOCAL_LocalBase) && ((CELL *)(cp) > (CELL *)Yap_REGS.CUT_C_TOP)) cut_c_str_ptr TOP = Yap_REGS.CUT_C_TOP; \
CPredicate func = \
(CPredicate)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.f; \
#define POP_EXECUTE() \ PredEntry *pred = \
cut_c_str_ptr TOP = Yap_REGS.CUT_C_TOP; \ (PredEntry *)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.p; \
CPredicate func = (CPredicate)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.f; \ YAP_ExecuteOnCut(pred, func, TOP); \
PredEntry *pred = (PredEntry *)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.p; \
YAP_ExecuteOnCut(pred, func, TOP); \
cut_c_pop(); cut_c_pop();
#define POP_FAIL(handler) \
if (handler) { yamop *oap = handler->cp_ap; \
handler->cp_ap = NOCODE; \
P = (yamop *)FAILCODE; \
choiceptr olB = B; B = handler; \
HR = handler->cp_h; \
/* DBTerm *ref = Yap_RefToException(); */ \
Yap_exec_absmi(true, false); \
B = olB; handler->cp_ap = oap; }
#define POP_FAIL_EXECUTE(handler) \
POP_FAIL(handler); \
cut_c_str_ptr TOP = Yap_REGS.CUT_C_TOP; \
CPredicate func = \
(CPredicate)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.f; \
PredEntry *pred = \
(PredEntry *)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.p; \
YAP_ExecuteOnCut(pred, func, TOP); \
cut_c_pop();
/*Initializes CUT_C_TOP*/ /*Initializes CUT_C_TOP*/
void cut_c_initialize(int wid ); void cut_c_initialize(int wid);
/*Removes a choice_point from the stack*/ /*Removes a choice_point from the stack*/
void cut_c_pop(void); void cut_c_pop(void);

4
H/generated/dglobals.h
View File

@ -142,3 +142,7 @@
#define GLOBAL_MaxPriority Yap_global->MaxPriority_ #define GLOBAL_MaxPriority Yap_global->MaxPriority_
#define GLOBAL_FileAliases Yap_global->FileAliases_
#define GLOBAL_NOfFileAliases Yap_global->NOfFileAliases_
#define GLOBAL_SzOfFileAliases Yap_global->SzOfFileAliases_

16
H/generated/dlocals.h
View File

@ -5,12 +5,6 @@
#define LOCAL_FileAliases LOCAL->FileAliases_
#define REMOTE_FileAliases(wid) REMOTE(wid)->FileAliases_
#define LOCAL_NOfFileAliases LOCAL->NOfFileAliases_
#define REMOTE_NOfFileAliases(wid) REMOTE(wid)->NOfFileAliases_
#define LOCAL_SzOfFileAliases LOCAL->SzOfFileAliases_
#define REMOTE_SzOfFileAliases(wid) REMOTE(wid)->SzOfFileAliases_
#define LOCAL_c_input_stream LOCAL->c_input_stream_ #define LOCAL_c_input_stream LOCAL->c_input_stream_
#define REMOTE_c_input_stream(wid) REMOTE(wid)->c_input_stream_ #define REMOTE_c_input_stream(wid) REMOTE(wid)->c_input_stream_
#define LOCAL_c_output_stream LOCAL->c_output_stream_ #define LOCAL_c_output_stream LOCAL->c_output_stream_
@ -137,18 +131,24 @@
#define REMOTE_ScannerStack(wid) REMOTE(wid)->ScannerStack_ #define REMOTE_ScannerStack(wid) REMOTE(wid)->ScannerStack_
#define LOCAL_ScannerExtraBlocks LOCAL->ScannerExtraBlocks_ #define LOCAL_ScannerExtraBlocks LOCAL->ScannerExtraBlocks_
#define REMOTE_ScannerExtraBlocks(wid) REMOTE(wid)->ScannerExtraBlocks_ #define REMOTE_ScannerExtraBlocks(wid) REMOTE(wid)->ScannerExtraBlocks_
#define LOCAL_BallTerm LOCAL->BallTerm_ #define LOCAL_BallTerm LOCAL->BallTerm_
#define REMOTE_BallTerm(wid) REMOTE(wid)->BallTerm_ #define REMOTE_BallTerm(wid) REMOTE(wid)->BallTerm_
#define LOCAL_CBorder LOCAL->CBorder_
#define REMOTE_CBorder(wid) REMOTE(wid)->CBorder_
#define LOCAL_MaxActiveSignals LOCAL->MaxActiveSignals_ #define LOCAL_MaxActiveSignals LOCAL->MaxActiveSignals_
#define REMOTE_MaxActiveSignals(wid) REMOTE(wid)->MaxActiveSignals_ #define REMOTE_MaxActiveSignals(wid) REMOTE(wid)->MaxActiveSignals_
#define LOCAL_Signals LOCAL->Signals_ #define LOCAL_Signals LOCAL->Signals_
#define REMOTE_Signals(wid) REMOTE(wid)->Signals_ #define REMOTE_Signals(wid) REMOTE(wid)->Signals_
#define LOCAL_IPredArity LOCAL->IPredArity_ #define LOCAL_IPredArity LOCAL->IPredArity_
#define REMOTE_IPredArity(wid) REMOTE(wid)->IPredArity_ #define REMOTE_IPredArity(wid) REMOTE(wid)->IPredArity_
#define LOCAL_ProfEnd LOCAL->ProfEnd_ #define LOCAL_ProfEnd LOCAL->ProfEnd_
#define REMOTE_ProfEnd(wid) REMOTE(wid)->ProfEnd_ #define REMOTE_ProfEnd(wid) REMOTE(wid)->ProfEnd_
#define LOCAL_UncaughtThrow LOCAL->UncaughtThrow_
#define REMOTE_UncaughtThrow(wid) REMOTE(wid)->UncaughtThrow_
#define LOCAL_DoingUndefp LOCAL->DoingUndefp_ #define LOCAL_DoingUndefp LOCAL->DoingUndefp_
#define REMOTE_DoingUndefp(wid) REMOTE(wid)->DoingUndefp_ #define REMOTE_DoingUndefp(wid) REMOTE(wid)->DoingUndefp_
#define LOCAL_StartCharCount LOCAL->StartCharCount_ #define LOCAL_StartCharCount LOCAL->StartCharCount_

4
H/generated/h0globals.h
View File

@ -141,4 +141,8 @@ EXTERNAL char* GLOBAL_CharConversionTable;
EXTERNAL char* GLOBAL_CharConversionTable2; EXTERNAL char* GLOBAL_CharConversionTable2;
/* max priority */ /* max priority */
EXTERNAL int GLOBAL_MaxPriority; EXTERNAL int GLOBAL_MaxPriority;
/// alias table access
EXTERNAL struct AliasDescS* GLOBAL_FileAliases;
EXTERNAL int GLOBAL_NOfFileAliases;
EXTERNAL int GLOBAL_SzOfFileAliases;

1
H/generated/h0struct.h
View File

@ -87,6 +87,7 @@ EXTERNAL AtomHashEntry *HashChain;
#ifdef EUROTRA #ifdef EUROTRA
EXTERNAL Term TermDollarU; EXTERNAL Term TermDollarU;
#endif #endif
EXTERNAL Term TermAnswer;
//modules //modules
EXTERNAL Term USER_MODULE; EXTERNAL Term USER_MODULE;
EXTERNAL Term IDB_MODULE; EXTERNAL Term IDB_MODULE;

4
H/generated/hglobals.h
View File

@ -141,4 +141,8 @@ const char* RestoreFile_;
char* CharConversionTable2_; char* CharConversionTable2_;
/* max priority */ /* max priority */
int MaxPriority_; int MaxPriority_;
/// alias table access
struct AliasDescS* FileAliases_;
int NOfFileAliases_;
int SzOfFileAliases_;
} w_shared; } w_shared;

11
H/generated/hlocals.h
View File

@ -5,9 +5,6 @@
// Stuff that must be considered local to a thread or worker // Stuff that must be considered local to a thread or worker
typedef struct worker_local { typedef struct worker_local {
// Streams // Streams
struct AliasDescS* FileAliases_;
int NOfFileAliases_;
int SzOfFileAliases_;
int c_input_stream_; int c_input_stream_;
int c_output_stream_; int c_output_stream_;
int c_error_stream_; int c_error_stream_;
@ -77,12 +74,18 @@ typedef struct worker_local {
struct pred_entry* TmpPred_; struct pred_entry* TmpPred_;
char* ScannerStack_; char* ScannerStack_;
struct scanner_extra_alloc* ScannerExtraBlocks_; struct scanner_extra_alloc* ScannerExtraBlocks_;
/// worker control information
/// pointer to an exception term, from throw
struct DB_TERM* BallTerm_; struct DB_TERM* BallTerm_;
/// stack limit after which the stack is managed by C-code.
Int CBorder_;
/// max number of signals (uint64_t)
UInt MaxActiveSignals_; UInt MaxActiveSignals_;
/// actual life signals
uint64_t Signals_; uint64_t Signals_;
/// indexing help data?
UInt IPredArity_; UInt IPredArity_;
yamop* ProfEnd_; yamop* ProfEnd_;
int UncaughtThrow_;
int DoingUndefp_; int DoingUndefp_;
Int StartCharCount_; Int StartCharCount_;
Int StartLineCount_; Int StartLineCount_;

3
H/generated/iatoms.h
View File

@ -314,6 +314,7 @@
AtomResize = Yap_LookupAtom("resize"); TermResize = MkAtomTerm(AtomResize); AtomResize = Yap_LookupAtom("resize"); TermResize = MkAtomTerm(AtomResize);
AtomResourceError = Yap_LookupAtom("resource_error"); TermResourceError = MkAtomTerm(AtomResourceError); AtomResourceError = Yap_LookupAtom("resource_error"); TermResourceError = MkAtomTerm(AtomResourceError);
AtomRestoreRegs = Yap_FullLookupAtom("$restore_regs"); TermRestoreRegs = MkAtomTerm(AtomRestoreRegs); AtomRestoreRegs = Yap_FullLookupAtom("$restore_regs"); TermRestoreRegs = MkAtomTerm(AtomRestoreRegs);
AtomRetry = Yap_LookupAtom("retry"); TermRetry = MkAtomTerm(AtomRetry);
AtomRetryCounter = Yap_LookupAtom("retry_counter"); TermRetryCounter = MkAtomTerm(AtomRetryCounter); AtomRetryCounter = Yap_LookupAtom("retry_counter"); TermRetryCounter = MkAtomTerm(AtomRetryCounter);
AtomRTree = Yap_LookupAtom("rtree"); TermRTree = MkAtomTerm(AtomRTree); AtomRTree = Yap_LookupAtom("rtree"); TermRTree = MkAtomTerm(AtomRTree);
AtomSafe = Yap_FullLookupAtom("$safe"); TermSafe = MkAtomTerm(AtomSafe); AtomSafe = Yap_FullLookupAtom("$safe"); TermSafe = MkAtomTerm(AtomSafe);
@ -520,7 +521,7 @@
FunctorPrintMessage = Yap_MkFunctor(AtomPrintMessage,2); FunctorPrintMessage = Yap_MkFunctor(AtomPrintMessage,2);
FunctorProcedure = Yap_MkFunctor(AtomProcedure,5); FunctorProcedure = Yap_MkFunctor(AtomProcedure,5);
FunctorPrologConstraint = Yap_MkFunctor(AtomProlog,2); FunctorPrologConstraint = Yap_MkFunctor(AtomProlog,2);
FunctorProtectStack = Yap_MkFunctor(AtomProtectStack,1); FunctorProtectStack = Yap_MkFunctor(AtomProtectStack,4);
FunctorQuery = Yap_MkFunctor(AtomQuery,1); FunctorQuery = Yap_MkFunctor(AtomQuery,1);
FunctorRecordedWithKey = Yap_MkFunctor(AtomRecordedWithKey,6); FunctorRecordedWithKey = Yap_MkFunctor(AtomRecordedWithKey,6);
FunctorRDiv = Yap_MkFunctor(AtomRDiv,2); FunctorRDiv = Yap_MkFunctor(AtomRDiv,2);

4
H/generated/iglobals.h
View File

@ -141,4 +141,8 @@ static void InitGlobal(void) {
GLOBAL_CharConversionTable2 = NULL; GLOBAL_CharConversionTable2 = NULL;
GLOBAL_MaxPriority = 1200; GLOBAL_MaxPriority = 1200;
GLOBAL_FileAliases = Yap_InitStandardAliases();
} }

11
H/generated/ilocals.h
View File

@ -5,9 +5,6 @@
static void InitWorker(int wid) { static void InitWorker(int wid) {
REMOTE_FileAliases(wid) = Yap_InitStandardAliases();
REMOTE_c_input_stream(wid) = 0; REMOTE_c_input_stream(wid) = 0;
REMOTE_c_output_stream(wid) = 1; REMOTE_c_output_stream(wid) = 1;
REMOTE_c_error_stream(wid) = 2; REMOTE_c_error_stream(wid) = 2;
@ -77,12 +74,18 @@ static void InitWorker(int wid) {
REMOTE_TmpPred(wid) = NULL; REMOTE_TmpPred(wid) = NULL;
REMOTE_ScannerStack(wid) = NULL; REMOTE_ScannerStack(wid) = NULL;
REMOTE_ScannerExtraBlocks(wid) = NULL; REMOTE_ScannerExtraBlocks(wid) = NULL;
REMOTE_BallTerm(wid) = NULL; REMOTE_BallTerm(wid) = NULL;
REMOTE_CBorder(wid) = 0;
REMOTE_MaxActiveSignals(wid) = 64L; REMOTE_MaxActiveSignals(wid) = 64L;
REMOTE_Signals(wid) = 0L; REMOTE_Signals(wid) = 0L;
REMOTE_IPredArity(wid) = 0L; REMOTE_IPredArity(wid) = 0L;
REMOTE_ProfEnd(wid) = NULL; REMOTE_ProfEnd(wid) = NULL;
REMOTE_UncaughtThrow(wid) = FALSE;
REMOTE_DoingUndefp(wid) = FALSE; REMOTE_DoingUndefp(wid) = FALSE;
REMOTE_StartCharCount(wid) = 0L; REMOTE_StartCharCount(wid) = 0L;
REMOTE_StartLineCount(wid) = 0L; REMOTE_StartLineCount(wid) = 0L;

1
H/generated/ratoms.h
View File

@ -314,6 +314,7 @@
AtomResize = AtomAdjust(AtomResize); TermResize = MkAtomTerm(AtomResize); AtomResize = AtomAdjust(AtomResize); TermResize = MkAtomTerm(AtomResize);
AtomResourceError = AtomAdjust(AtomResourceError); TermResourceError = MkAtomTerm(AtomResourceError); AtomResourceError = AtomAdjust(AtomResourceError); TermResourceError = MkAtomTerm(AtomResourceError);
AtomRestoreRegs = AtomAdjust(AtomRestoreRegs); TermRestoreRegs = MkAtomTerm(AtomRestoreRegs); AtomRestoreRegs = AtomAdjust(AtomRestoreRegs); TermRestoreRegs = MkAtomTerm(AtomRestoreRegs);
AtomRetry = AtomAdjust(AtomRetry); TermRetry = MkAtomTerm(AtomRetry);
AtomRetryCounter = AtomAdjust(AtomRetryCounter); TermRetryCounter = MkAtomTerm(AtomRetryCounter); AtomRetryCounter = AtomAdjust(AtomRetryCounter); TermRetryCounter = MkAtomTerm(AtomRetryCounter);
AtomRTree = AtomAdjust(AtomRTree); TermRTree = MkAtomTerm(AtomRTree); AtomRTree = AtomAdjust(AtomRTree); TermRTree = MkAtomTerm(AtomRTree);
AtomSafe = AtomAdjust(AtomSafe); TermSafe = MkAtomTerm(AtomSafe); AtomSafe = AtomAdjust(AtomSafe); TermSafe = MkAtomTerm(AtomSafe);

9
H/generated/rlocals.h
View File

@ -61,9 +61,6 @@ static void RestoreWorker(int wid USES_REGS) {
@ -77,6 +74,8 @@ static void RestoreWorker(int wid USES_REGS) {
RestoreBallTerm(wid); RestoreBallTerm(wid);
@ -88,6 +87,10 @@ static void RestoreWorker(int wid USES_REGS) {
#ifdef COROUTINING #ifdef COROUTINING
REMOTE_WokenGoals(wid) = TermToGlobalAdjust(REMOTE_WokenGoals(wid)); REMOTE_WokenGoals(wid) = TermToGlobalAdjust(REMOTE_WokenGoals(wid));
REMOTE_AttsMutableList(wid) = TermToGlobalAdjust(REMOTE_AttsMutableList(wid)); REMOTE_AttsMutableList(wid) = TermToGlobalAdjust(REMOTE_AttsMutableList(wid));

1
H/generated/tatoms.h
View File

@ -314,6 +314,7 @@ Atom AtomReset; Term TermReset;
Atom AtomResize; Term TermResize; Atom AtomResize; Term TermResize;
Atom AtomResourceError; Term TermResourceError; Atom AtomResourceError; Term TermResourceError;
Atom AtomRestoreRegs; Term TermRestoreRegs; Atom AtomRestoreRegs; Term TermRestoreRegs;
Atom AtomRetry; Term TermRetry;
Atom AtomRetryCounter; Term TermRetryCounter; Atom AtomRetryCounter; Term TermRetryCounter;
Atom AtomRTree; Term TermRTree; Atom AtomRTree; Term TermRTree;
Atom AtomSafe; Term TermSafe; Atom AtomSafe; Term TermSafe;

982
JIT/HPP/indexing_ext.h
View File

File diff suppressed because it is too large Load Diff

5
include/YapErrors.h
View File

@ -23,7 +23,7 @@ ECLASS(INSTANTIATION_ERROR_CLASS, "instantiation_error", 0)
/// bad access, I/O /// bad access, I/O
ECLASS(PERMISSION_ERROR, "permission_error", 3) ECLASS(PERMISSION_ERROR, "permission_error", 3)
/// something that could not be represented into a type /// something that could not be represented into a type
ECLASS(REPRESENTATION_ERROR, "representation_error", 2) ECLASS(REPRESENTATION_ERROR, "representation_error", 1)
/// not enough .... /// not enough ....
ECLASS(RESOURCE_ERROR, "resource_error", 2) ECLASS(RESOURCE_ERROR, "resource_error", 2)
/// bad text /// bad text
@ -122,6 +122,7 @@ E2(PERMISSION_ERROR_REPOSITION_STREAM, PERMISSION_ERROR, "reposition", "stream")
E(REPRESENTATION_ERROR_CHARACTER, REPRESENTATION_ERROR, "character") E(REPRESENTATION_ERROR_CHARACTER, REPRESENTATION_ERROR, "character")
E(REPRESENTATION_ERROR_CHARACTER_CODE, REPRESENTATION_ERROR, "character_code") E(REPRESENTATION_ERROR_CHARACTER_CODE, REPRESENTATION_ERROR, "character_code")
E(REPRESENTATION_ERROR_IN_CHARACTER_CODE, REPRESENTATION_ERROR, "in_character_code")
E(REPRESENTATION_ERROR_INT, REPRESENTATION_ERROR, "int") E(REPRESENTATION_ERROR_INT, REPRESENTATION_ERROR, "int")
E(REPRESENTATION_ERROR_MAX_ARITY, REPRESENTATION_ERROR, "max_arity") E(REPRESENTATION_ERROR_MAX_ARITY, REPRESENTATION_ERROR, "max_arity")
E(REPRESENTATION_ERROR_VARIABLE, REPRESENTATION_ERROR, "variable") E(REPRESENTATION_ERROR_VARIABLE, REPRESENTATION_ERROR, "variable")
@ -145,6 +146,7 @@ E(SYSTEM_ERROR_OPERATING_SYSTEM, SYSTEM_ERROR_CLASS, "operating_system_error")
E(SYSTEM_ERROR_SAVED_STATE, SYSTEM_ERROR_CLASS, "saved_state_error") E(SYSTEM_ERROR_SAVED_STATE, SYSTEM_ERROR_CLASS, "saved_state_error")
E(ABORT_EVENT, EVENT, "abort") E(ABORT_EVENT, EVENT, "abort")
E(THROW_EVENT, EVENT, "throw")
E(CALL_COUNTER_UNDERFLOW_EVENT, EVENT, "call_counter_underflow") E(CALL_COUNTER_UNDERFLOW_EVENT, EVENT, "call_counter_underflow")
E(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, EVENT, "pred_entry_counter_underflow") E(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, EVENT, "pred_entry_counter_underflow")
E(RETRY_COUNTER_UNDERFLOW_EVENT, EVENT, "retry_counter_underflow") E(RETRY_COUNTER_UNDERFLOW_EVENT, EVENT, "retry_counter_underflow")
@ -164,6 +166,7 @@ E(TYPE_ERROR_DBREF, TYPE_ERROR, "dbref")
E(TYPE_ERROR_DBTERM, TYPE_ERROR, "dbterm") E(TYPE_ERROR_DBTERM, TYPE_ERROR, "dbterm")
E(TYPE_ERROR_EVALUABLE, TYPE_ERROR, "evaluable") E(TYPE_ERROR_EVALUABLE, TYPE_ERROR, "evaluable")
E(TYPE_ERROR_FLOAT, TYPE_ERROR, "float") E(TYPE_ERROR_FLOAT, TYPE_ERROR, "float")
E(TYPE_ERROR_IN_CHARACTER, TYPE_ERROR, "in_character")
E(TYPE_ERROR_INTEGER, TYPE_ERROR, "integer") E(TYPE_ERROR_INTEGER, TYPE_ERROR, "integer")
E(TYPE_ERROR_KEY, TYPE_ERROR, "key") E(TYPE_ERROR_KEY, TYPE_ERROR, "key")
E(TYPE_ERROR_LIST, TYPE_ERROR, "list") E(TYPE_ERROR_LIST, TYPE_ERROR, "list")

4
include/YapInterface.h
View File

@ -1760,7 +1760,7 @@ extern X_API void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, YAP_Ar
/* void UserBackCPredicate(const char *name, int *init(), int *cont(), int /* void UserBackCPredicate(const char *name, int *init(), int *cont(), int
arity, int extra) */ arity, int extra) */
extern X_API void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, unsigned int); extern X_API void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, YAP_Arity);
/* YAP_Int YAP_ListLength(YAP_Term t) */ /* YAP_Int YAP_ListLength(YAP_Term t) */
extern X_API YAP_Int YAP_ListLength(YAP_Term); extern X_API YAP_Int YAP_ListLength(YAP_Term);
@ -1769,7 +1769,7 @@ extern X_API size_t YAP_UTF8_TextLength(YAP_Term t);
/* void UserBackCPredicate(char *name, int *init(), int *cont(), int *cut(), int /* void UserBackCPredicate(char *name, int *init(), int *cont(), int *cut(), int
arity, int extra) */ arity, int extra) */
extern X_API void YAP_UserBackCutCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_UserCPred, YAP_Arity, unsigned int); extern X_API void YAP_UserBackCutCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_UserCPred, YAP_Arity, YAP_Arity);
/* void CallProlog(YAP_Term t) */ /* void CallProlog(YAP_Term t) */
extern X_API YAP_Int YAP_CallProlog(YAP_Term t); extern X_API YAP_Int YAP_CallProlog(YAP_Term t);

1
library/CMakeLists.txt
View File

@ -23,6 +23,7 @@ set (LIBRARY_PL
lineutils.yap lineutils.yap
listing.yap listing.yap
lists.yap lists.yap
log2md.yap
nb.yap nb.yap
ordsets.yap ordsets.yap
mapargs.yap mapargs.yap

9
library/dialect/swi/fli/swi.c
View File

@ -1308,7 +1308,8 @@ X_API int PL_raise_exception(term_t exception)
{ {
CACHE_REGS CACHE_REGS
LOCAL_Error_TYPE=YAP_NO_ERROR; LOCAL_Error_TYPE=YAP_NO_ERROR;
EX = Yap_StoreTermInDB(Yap_GetFromSlot(exception),0); Yap_PutException(Yap_GetFromSlot(exception));
Yap_RaiseException( );
return 0; return 0;
} }
@ -2307,7 +2308,7 @@ X_API void
PL_clear_exception(void) PL_clear_exception(void)
{ {
CACHE_REGS CACHE_REGS
EX = NULL; Yap_ResetException(worker_id);
} }
X_API int X_API int
@ -2623,8 +2624,8 @@ X_API void PL_close_query(qid_t qi)
{ {
CACHE_REGS CACHE_REGS
if (EX && !(qi->q_flags & (PL_Q_CATCH_EXCEPTION))) { if (Yap_HasException() && !(qi->q_flags & (PL_Q_CATCH_EXCEPTION))) {
EX = NULL; Yap_ResetException(worker_id);
} }
/* need to implement backtracking here */ /* need to implement backtracking here */
if (qi->q_open != 1 || qi->q_state == 0) { if (qi->q_open != 1 || qi->q_state == 0) {

2
library/system/sys_config.h
View File

@ -5,7 +5,7 @@
/* Define to 1 if you have the <openssl/ripemd.h> header file. */ /* Define to 1 if you have the <openssl/ripemd.h> header file. */
#ifndef HAVE_APR_1_APR_MD5_H #ifndef HAVE_APR_1_APR_MD5_H
/* #undef HAVE_APR_1_APR_MD5_H */ #define HAVE_APR_1_APR_MD5_H 1
#endif #endif

3
misc/ATOMS
View File

@ -319,6 +319,7 @@ A Reset N "reset"
A Resize N "resize" A Resize N "resize"
A ResourceError N "resource_error" A ResourceError N "resource_error"
A RestoreRegs F "$restore_regs" A RestoreRegs F "$restore_regs"
A Retry N "retry"
A RetryCounter N "retry_counter" A RetryCounter N "retry_counter"
A RTree N "rtree" A RTree N "rtree"
A Safe F "$safe" A Safe F "$safe"
@ -525,7 +526,7 @@ F Portray Portray 1
F PrintMessage PrintMessage 2 F PrintMessage PrintMessage 2
F Procedure Procedure 5 F Procedure Procedure 5
F PrologConstraint Prolog 2 F PrologConstraint Prolog 2
F ProtectStack ProtectStack 1 F ProtectStack ProtectStack 4
F Query Query 1 F Query Query 1
F RecordedWithKey RecordedWithKey 6 F RecordedWithKey RecordedWithKey 6
F RDiv RDiv 2 F RDiv RDiv 2

4
misc/GLOBALS
View File

@ -168,6 +168,10 @@ char* CharConversionTable2 =NULL
/* max priority */ /* max priority */
int MaxPriority =1200 int MaxPriority =1200
/// alias table access
struct AliasDescS* FileAliases =Yap_InitStandardAliases()
int NOfFileAliases void
int SzOfFileAliases void
END_GLOBAL_DATA END_GLOBAL_DATA

23
misc/LOCALS
View File

@ -2,10 +2,6 @@
START_WORKER_LOCAL START_WORKER_LOCAL
// Streams // Streams
struct AliasDescS* FileAliases =Yap_InitStandardAliases()
int NOfFileAliases void
int SzOfFileAliases void
int c_input_stream =0 int c_input_stream =0
int c_output_stream =1 int c_output_stream =1
int c_error_stream =2 int c_error_stream =2
@ -83,16 +79,25 @@ Int ArenaOverflows =0L
Int DepthArenas =0 Int DepthArenas =0
int ArithError =FALSE int ArithError =FALSE
struct pred_entry* LastAssertedPred =NULL struct pred_entry* LastAssertedPred =NULL
struct pred_entry* TmpPred =NULL struct pred_entry* TmpPred =NULL
char* ScannerStack =NULL char* ScannerStack =NULL
struct scanner_extra_alloc* ScannerExtraBlocks =NULL struct scanner_extra_alloc* ScannerExtraBlocks =NULL
/// worker control information
/// pointer to an exception term, from throw
struct DB_TERM* BallTerm =NULL RestoreBallTerm(wid) struct DB_TERM* BallTerm =NULL RestoreBallTerm(wid)
/// stack limit after which the stack is managed by C-code.
Int CBorder =0
/// max number of signals (uint64_t)
UInt MaxActiveSignals =64L UInt MaxActiveSignals =64L
/// actual life signals
uint64_t Signals =0L uint64_t Signals =0L
/// indexing help data?
UInt IPredArity =0L UInt IPredArity =0L
yamop* ProfEnd =NULL yamop* ProfEnd =NULL
int UncaughtThrow =FALSE
int DoingUndefp =FALSE int DoingUndefp =FALSE
Int StartCharCount =0L Int StartCharCount =0L
Int StartLineCount =0L Int StartLineCount =0L

5
packages/CLPBN/clpbn/graphviz.yap
View File

@ -2,9 +2,8 @@
:- module(clpbn_gviz, :- module(clpbn_gviz,
[clpbn2gviz/4]). [clpbn2gviz/4]).
clpbn2gviz(Stream, Name, Network, Output) :- clpbn2gviz(Stream, Name, Network, Node, Edge, Output) :-
format(Stream, 'digraph ~w { format(Stream, 'digraph ~w { ~n graph [ rankdir="LR" ];~n',[Name]),
graph [ rankdir="LR" ];~n',[Name]),
output_vars(Stream, Network), output_vars(Stream, Network),
info_ouput(Stream, Output), info_ouput(Stream, Output),
format(Stream, '}~n',[]). format(Stream, '}~n',[]).

3
packages/CLPBN/clpbn/table.yap
View File

@ -204,7 +204,8 @@ in_table(K, V) :-
store_in_table(K, V) :- store_in_table(K, V) :-
b_getval(clpbn_tables, Tab), b_getval(clpbn_tables, Tab),
b_hash_insert(Tab, K, V). b_hash_insert(Tab, K, V, NewTab),
( Tab == NewTab -> true ; b_setval(clpbn_tables, NewTab)).
clpbn_tabled_clause(M:Head, Body) :- !, clpbn_tabled_clause(M:Head, Body) :- !,
clpbn_tabled_clause(Head, M, Body). clpbn_tabled_clause(Head, M, Body).

2
packages/bdd/cudd_config.h
View File

@ -27,6 +27,6 @@
/* Define to 1 if you have the <util.h> header file. */ /* Define to 1 if you have the <util.h> header file. */
#ifndef HAVE_UTIL_H #ifndef HAVE_UTIL_H
/* #undef HAVE_UTIL_H */ #define HAVE_UTIL_H 1
#endif #endif

BIN
packages/bdd/simplecudd/simplecudd
View File

Binary file not shown.

10
packages/bdd/simplecudd_lfi/problogbdd_lfi.c
View File

@ -807,7 +807,7 @@ void termhandler(int num) { exit(3); }
void myexpand(extmanager MyManager, DdNode *Current) { void myexpand(extmanager MyManager, DdNode *Current) {
DdNode *h, *l; DdNode *h, *l;
hisnode *Found; hisnode *Found;
char *curnode; const char *curnode;
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current); curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
printf("%s\n", curnode); printf("%s\n", curnode);
if ((Current != MyManager.t) && (Current != MyManager.f) && if ((Current != MyManager.t) && (Current != MyManager.f) &&
@ -828,7 +828,7 @@ void myexpand(extmanager MyManager, DdNode *Current) {
double CalcProbability(extmanager MyManager, DdNode *Current) { double CalcProbability(extmanager MyManager, DdNode *Current) {
DdNode *h, *l; DdNode *h, *l;
hisnode *Found = NULL; hisnode *Found = NULL;
char *curnode; //, *dynvalue; const char *curnode; //, *dynvalue;
double lvalue, hvalue, tvalue; double lvalue, hvalue, tvalue;
// density_integral dynvalue_parsed; // density_integral dynvalue_parsed;
@ -1062,7 +1062,7 @@ double CalcExpectedCountsDown(extmanager *MyManager, DdNode *Current,
Queue q = QueueNew(); Queue q = QueueNew();
// fprintf(stderr", =====> queue is: %p \n",q); // fprintf(stderr", =====> queue is: %p \n",q);
int i; int i;
char *curnode, *curh, *curl, *dynvalue; const char *curnode, *curh, *curl, *dynvalue;
DdNode *h, *l, *node; DdNode *h, *l, *node;
ComparisonFunction fun; ComparisonFunction fun;
hisnode *Found = NULL, *lfound, *hfound; hisnode *Found = NULL, *lfound, *hfound;
@ -1230,7 +1230,7 @@ double CalcExpectedCountsUp(extmanager *MyManager, DdNode *Current,
DdNode *h, *l; DdNode *h, *l;
hisnode *Found; hisnode *Found;
char *curnode = NULL; const char *curnode = NULL;
double lvalue, hvalue, tvalue; double lvalue, hvalue, tvalue;
// tvalue=0.0; // tvalue=0.0;
int ivalue; int ivalue;
@ -1293,7 +1293,7 @@ gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar,
char *TargetPattern, int type) { char *TargetPattern, int type) {
DdNode *h, *l; DdNode *h, *l;
hisnode *Found; hisnode *Found;
char *curnode = NULL, *dynvalue; const char *curnode = NULL, *dynvalue;
gradientpair lowvalue, highvalue, tvalue; gradientpair lowvalue, highvalue, tvalue;
double this_probability; double this_probability;
double *gradient; double *gradient;

2
packages/bdd/simplecudd_lfi/problogmath.c
View File

@ -208,7 +208,7 @@ double cumulative_normal_dsigma(double low, double high,double mu,double sigma)
// this function parses two strings "$a;$b" and "???_???l$ch$d" where $a-$d are (real) numbers // this function parses two strings "$a;$b" and "???_???l$ch$d" where $a-$d are (real) numbers
// it is used to parse in the parameters of continues variables from the input file // it is used to parse in the parameters of continues variables from the input file
density_integral parse_density_integral_string(char *input, char *variablename) { density_integral parse_density_integral_string(char *input, const char *variablename) {
density_integral result; density_integral result;
int i; int i;
char garbage[64], s1[64],s2[64],s3[64],s4[64]; char garbage[64], s1[64],s2[64],s3[64],s4[64];

2
packages/bdd/simplecudd_lfi/problogmath.h
View File

@ -166,4 +166,4 @@ double Phi(double x);
double cumulative_normal(double low, double high, double sigma, double mu); double cumulative_normal(double low, double high, double sigma, double mu);
double cumulative_normal_dmu(double low, double high,double mu,double sigma); double cumulative_normal_dmu(double low, double high,double mu,double sigma);
double cumulative_normal_dsigma(double low, double high,double mu,double sigma); double cumulative_normal_dsigma(double low, double high,double mu,double sigma);
density_integral parse_density_integral_string(char *input, char *variablename); density_integral parse_density_integral_string(char *input, const char *variablename);

2
packages/bdd/simplecudd_lfi/simplecudd.h
View File

@ -249,7 +249,7 @@ typedef struct _bddfileheader {
typedef struct _namedvars { typedef struct _namedvars {
int varcnt; int varcnt;
int varstart; int varstart;
const char ** vars; char ** vars;
int *loaded; int *loaded;
double *dvalue; double *dvalue;
int *ivalue; int *ivalue;

BIN
packages/bdd/simplecudd_lfi/simplecudd_lfi
View File

Binary file not shown.

2
packages/jpl/src/c/jpl.c
View File

@ -1831,7 +1831,7 @@ jni_create_jvm_c(
JNIEnv *env; JNIEnv *env;
JPL_DEBUG(1, Sdprintf( "[creating JVM with 'java.class.path=%s']\n", classpath)); JPL_DEBUG(1, Sdprintf( "[creating JVM with 'java.class.path=%s']\n", classpath));
vm_args.version = JNI_VERSION_1_2; /* "Java 1.2 please" */ vm_args.version = JNI_VERSION_1_6; /* "Java 1.2 please" */
if ( classpath ) if ( classpath )
{ {
cpoptp = (char *)malloc(strlen(classpath)+20); cpoptp = (char *)malloc(strlen(classpath)+20);

48
pl/boot.yap
View File

@ -205,7 +205,6 @@ private(_).
'$do_live'/0, '$do_live'/0,
'$'/0, '$'/0,
'$find_goal_definition'/4, '$find_goal_definition'/4,
'$handle_throw'/3,
'$head_and_body'/3, '$head_and_body'/3,
'$inform_as_reconsulted'/2, '$inform_as_reconsulted'/2,
'$init_system'/0, '$init_system'/0,
@ -1417,8 +1416,8 @@ bootstrap(F) :-
!. !.
'$loop'(Stream,Status) :- '$loop'(Stream,Status) :-
% start_low_level_trace, % start_low_level_trace,
'$current_module'( OldModule ),
repeat, repeat,
'$current_module'( OldModule, OldModule ),
'$system_catch'( '$enter_command'(Stream,OldModule,Status), '$system_catch'( '$enter_command'(Stream,OldModule,Status),
OldModule, Error, OldModule, Error,
user:'$LoopError'(Error, Status) user:'$LoopError'(Error, Status)
@ -1554,11 +1553,7 @@ is responsible to capture uncaught exceptions.
*/ */
catch(G, C, A) :- catch(G, C, A) :-
'$catch'(C,A,_), '$catch'(G,_,[C|A]).
'$$save_by'(CP0),
'$execute'(G),
'$$save_by'(CP1),
(CP0 == CP1 -> !; true ).
% makes sure we have an environment. % makes sure we have an environment.
'$true'. '$true'.
@ -1571,11 +1566,24 @@ catch(G, C, A) :-
% %
'$system_catch'(G, M, C, A) :- '$system_catch'(G, M, C, A) :-
% check current trail % check current trail
'$catch'(C,A,_), '$catch'(M:G,_,[C|A]).
'$$save_by'(CP0),
'$execute_nonstop'(G, M), '$catch'(MG,_,_) :-
'$$save_by'(CP0),
'$execute'(MG),
'$$save_by'(CP1), '$$save_by'(CP1),
% remove catch
(CP0 == CP1 -> !; true ). (CP0 == CP1 -> !; true ).
'$catch'(_,C0,[C|A]) :-
nonvar(C0),
C0 = throw(Ball),
( catch_ball( Ball, C)
->
'$execute'(A)
;
throw(Ball)
).
% %
% throw has to be *exactly* after system catch! % throw has to be *exactly* after system catch!
@ -1588,11 +1596,6 @@ stopped, and the exception is sent to the ancestor goals until reaching
a matching catch/3, or until reaching top-level. a matching catch/3, or until reaching top-level.
*/ */
throw(_Ball) :-
% use existing ball
'$get_exception'(Ball),
!,
'$jump_env_and_store_ball'(Ball).
throw(Ball) :- throw(Ball) :-
( var(Ball) -> ( var(Ball) ->
'$do_error'(instantiation_error,throw(Ball)) '$do_error'(instantiation_error,throw(Ball))
@ -1601,21 +1604,6 @@ throw(Ball) :-
'$jump_env_and_store_ball'(Ball) '$jump_env_and_store_ball'(Ball)
). ).
% just create a choice-point
'$catch'(_,_,_).
'$catch'(_,_,_) :- fail.
'$handle_throw'(_, _, _).
'$handle_throw'(C, A, _Ball) :-
'$reset_exception'(Ball),
% reset info
(catch_ball(Ball, C) ->
'$execute'(A)
;
throw(Ball)
).
catch_ball(Abort, _) :- catch_ball(Abort, _) :-
Abort == '$abort', !, fail. Abort == '$abort', !, fail.
% system defined throws should be ignored by user, unless the % system defined throws should be ignored by user, unless the

145
pl/control.yap
View File

@ -263,10 +263,10 @@ This is similar to <tt>call_cleanup/1</tt> with an additional
*/ */
call_cleanup(Goal, Cleanup) :- call_cleanup(Goal, Cleanup) :-
setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup). '$setup_call_catcher_cleanup'(true, Goal, Catcher, Cleanup).
call_cleanup(Goal, Catcher, Cleanup) :- call_cleanup(Goal, Catcher, Cleanup) :-
setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup). '$setup_call_catcher_cleanup'(true, Goal, Catcher, Cleanup).
/** @pred setup_call_cleanup(: _Setup_,: _Goal_, : _CleanUpGoal_) /** @pred setup_call_cleanup(: _Setup_,: _Goal_, : _CleanUpGoal_)
@ -280,145 +280,13 @@ such as the ones received from `call_with_time_limit/2` or thread_signal/2. In
most uses, _Setup_ will perform temporary side-effects required by most uses, _Setup_ will perform temporary side-effects required by
_Goal_ that are finally undone by _Cleanup_. _Goal_ that are finally undone by _Cleanup_.
Success or failure of _Cleanup_ is ignored and choice-points it
created are destroyed (as once/1). If _Cleanup_ throws an exception,
this is executed as normal.
Typically, this predicate is used to cleanup permanent data storage
required to execute _Goal_, close file-descriptors, etc. The example
below provides a non-deterministic search for a term in a file, closing
the stream as needed.
~~~~~{.prolog}
term_in_file(Term, File) :-
setup_call_cleanup(open(File, read, In),
term_in_stream(Term, In),
close(In) ).
term_in_stream(Term, In) :-
repeat,
read(In, T),
( T == end_of_file
-> !, fail
; T = Term
).
~~~~~
Note that it is impossible to implement this predicate in Prolog other than
by reading all terms into a list, close the file and call member/2.
Without setup_call_cleanup/3 there is no way to gain control if the
choice-point left by `repeat` is removed by a cut or an exception.
`setup_call_cleanup/2` can also be used to test determinism of a goal:
~~~~~
?- setup_call_cleanup(true,(X=1;X=2), Det=yes).
X = 1 ;
X = 2,
Det = yes ;
~~~~~
This predicate is under consideration for inclusion into the ISO standard.
For compatibility with other Prolog implementations see `call_cleanup/2`.
*/ */
setup_call_cleanup(Setup, Goal, Cleanup) :-
setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
/** @pred setup_call_catcher_cleanup(: _Setup_,: _Goal_, + _Catcher_,: _CleanUpGoal_) setup_call_cleanup(Setup,Goal, Cleanup) :-
'$setup_call_catcher_cleanup'(Setup, Goal, Catcher, Cleanup).
setup_call_catcher_cleanup(Setup,Goal, Catcher, Cleanup) :-
Similar to `setup_call_cleanup( _Setup_, _Goal_, _Cleanup_)` with '$setup_call_catcher_cleanup'(Setup, Goal, Catcher, Cleanup).
additional information on the reason of calling _Cleanup_. Prior
to calling _Cleanup_, _Catcher_ unifies with the termination
code. If this unification fails, _Cleanup_ is
*not* called.
*/
setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
yap_hacks:disable_interrupts,
'$check_goal_for_setup_call_cleanup'(Setup, setup_call_cleanup(Setup, Goal, Cleanup)),
catch('$do_setup'(Setup),Exception,'$handle_broken_setup'(Exception)),
'$check_goal_for_setup_call_cleanup'(Cleanup, setup_call_cleanup(Setup, Goal, Cleanup)),
'$safe_call_cleanup'(Goal,Cleanup,Catcher,Exception).
% make sure we don't lose interrupts if we get exceptions
% with setup.
'$handle_broken_setup'(Exception) :-
yap_hacks:enable_interrupts,
throw(Exception).
'$check_goal_for_setup_call_cleanup'(Goal, G) :-
strip_module(Goal, _, MG),
(
var(MG)
->
yap_hacks:enable_interrupts,
'$do_error'(instantiation_error,G)
;
true
).
% this is simple, do nothing
'$do_setup'(A:true) :- atom(A), !.
% this is tricky: please don't forget that interrupts are disabled at this point
% and that they will only be enabled after setting up Cleanup
'$do_setup'(Setup) :-
(
'$execute'(Setup),
% we don't need to care about enabling interrupts
!
;
% reenable interrupts if Setup failed
yap_hacks:enable_interrupts,
fail
).
'$cleanup_exception'(Exception, exception(Exception), Cleanup) :- !,
% whatever happens, let exception go through
catch('$clean_call'(_,Cleanup),_,true),
throw(Exception).
'$cleanup_exception'(Exception, _, _) :-
throw(Exception).
'$safe_call_cleanup'(Goal, Cleanup, Catcher, _Exception) :-
'$coroutining':freeze_goal(Catcher, '$clean_call'(_Active, Cleanup)),
(
yap_hacks:trail_suspension_marker(Catcher),
yap_hacks:enable_interrupts,
'$current_choice_point'(CP0),
'$execute'(Goal),
'$current_choice_point'(CPF),
(
CP0 =:= CPF
->
Catcher = exit,
!
;
true
)
;
Catcher = fail,
fail
).
'$holds_true'.
% The first argument is used by JumpEnv to verify if a throw
% is going to be handled by the cleanup catcher. If it is so,
% clean_call will not be called from JumpToEnv.
'$clean_call'(_, Cleanup) :-
'$execute'(Cleanup), !.
'$clean_call'(_, _).
'$cc_check_throw' :-
'$nb_getval'('$catch', Ball, fail),
throw(Ball).
/** @pred call_with_args(+ _Name_,...,? _Ai_,...) /** @pred call_with_args(+ _Name_,...,? _Ai_,...)
@ -781,3 +649,4 @@ prolog_current_frame(Env) :-
/** /**
@} @}
*/ */

13
pl/debug.yap
View File

@ -1043,10 +1043,11 @@ be lost.
). ).
'$debugger_process_meta_arguments'(G, M, G1) :- '$debugger_process_meta_arguments'(G, M, G1) :-
functor(G,F,N), '$yap_strip_module'( M:G, MM, GM ),
'$meta_predicate'(F,M,N,D), !, % we're in an argument functor(GM,F,N),
'$meta_predicate'(F,MM,N,D), !, % we're in an argument
D =.. [F|BMs], D =.. [F|BMs],
G =.. [F|BGs], GM =.. [F|BGs],
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s), '$ldebugger_process_meta_args'(BGs, M, BMs, BG1s),
G1 =.. [F|BG1s]. G1 =.. [F|BG1s].
'$debugger_process_meta_arguments'(G, _M, G). '$debugger_process_meta_arguments'(G, _M, G).
@ -1055,10 +1056,10 @@ be lost.
'$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$spy'([M1|G1])|BG1s]) :- '$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$spy'([M1|G1])|BG1s]) :-
number(N), number(N),
N >= 0, N >= 0,
'$yap_strip_module'( M:G, M1, G1 ),
functor(G1, Na, _),
Na \= '$trace_call',
!, !,
strip_module( M:G, M1, G1 ),
functor(G1, N, _),
N \= '$trace_call',
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s). '$ldebugger_process_meta_args'(BGs, M, BMs, BG1s).
'$ldebugger_process_meta_args'([G|BGs], M, [_|BMs], [G|BG1s]) :- '$ldebugger_process_meta_args'([G|BGs], M, [_|BMs], [G|BG1s]) :-
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s). '$ldebugger_process_meta_args'(BGs, M, BMs, BG1s).

4
pl/init.yap
View File

@ -106,9 +106,7 @@ otherwise.
'$continue_static_clause'(A,B,C,D,E). '$continue_static_clause'(A,B,C,D,E).
'$do_static_clause'(_,_,_,_,_). '$do_static_clause'(_,_,_,_,_).
:- '$handle_throw'(_,_,_), !. \:- '$all_current_modules'(M), yap_flag(M:unknown, error) ; true.
:- '$all_current_modules'(M), yap_flag(M:unknown, error) ; true.
:- bootstrap('arith.yap'). :- bootstrap('arith.yap').

8
pl/messages.yap
View File

@ -209,21 +209,21 @@ compose_message(Term, Level) -->
location(error(syntax_error(syntax_error(_,between(_,LN,_),FileName,_)),_), _ , _) --> location(error(syntax_error(syntax_error(_,between(_,LN,_),FileName,_)),_), _ , _) -->
!, !,
[ '~a:~d:0: ' - [FileName,LN] ] . [ '~a:~d:0 ' - [FileName,LN] ] .
location(error(style_check(style_check(_,LN,FileName,_ ) ),_), _ , _) --> location(error(style_check(style_check(_,LN,FileName,_ ) ),_), _ , _) -->
% { stream_position_data( line_count, LN) }, % { stream_position_data( line_count, LN) },
!, !,
[ '~a:~d:0: ' - [FileName,LN] ] . [ '~a:~d:0 ' - [FileName,LN] ] .
location( error(_,Term), Level, LC ) --> location( error(_,Term), Level, LC ) -->
{ source_location(F0, L), { source_location(F0, L),
stream_property(_Stream, alias(loop_stream)) }, !, stream_property(_Stream, alias(loop_stream)) }, !,
display_consulting( F0, Level, LC ), display_consulting( F0, Level, LC ),
{ lists:memberchk([p|p(M,Na,Ar,_File,_FilePos)], Term ) }, { lists:memberchk([p|p(M,Na,Ar,_File,_FilePos)], Term ) },
[ '~a:~d:0: ~a in ~a:~q/~d:'-[F0, L,Level,M,Na,Ar] ]. [ '~a:~d:0 ~a in ~a:~q/~d:'-[F0, L,Level,M,Na,Ar] ].
location( error(_,Term), Level, LC ) --> location( error(_,Term), Level, LC ) -->
{ lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) }, !, { lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) }, !,
display_consulting( File, Level, LC ), display_consulting( File, Level, LC ),
[ '~a:~d:0: ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ]. [ '~a:~d:0 ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ].
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
main_message(error(Msg,Info), _, _) --> {var(Info)}, !, main_message(error(Msg,Info), _, _) --> {var(Info)}, !,

4
pl/preds.yap
View File

@ -78,7 +78,6 @@ and therefore he should try to avoid them whenever possible.
:- use_system_module( '$_boot', ['$check_head_and_body'/4, :- use_system_module( '$_boot', ['$check_head_and_body'/4,
'$check_if_reconsulted'/2, '$check_if_reconsulted'/2,
'$handle_throw'/3,
'$head_and_body'/3, '$head_and_body'/3,
'$inform_as_reconsulted'/2]). '$inform_as_reconsulted'/2]).
@ -205,9 +204,6 @@ clause(V0,Q,R) :-
'$do_error'(permission_error(access,private_procedure,Name/Arity), '$do_error'(permission_error(access,private_procedure,Name/Arity),
clause(M:P,Q,R)). clause(M:P,Q,R)).
'$init_preds' :-
once('$handle_throw'(_,_,_)),
fail.
'$init_preds' :- '$init_preds' :-
once('$do_static_clause'(_,_,_,_,_)), once('$do_static_clause'(_,_,_,_,_)),
fail. fail.

38
utils/analysis/graphs.yap
View File

@ -45,7 +45,7 @@ build_graph(F, Mod) :-
nb_setval( line, Line ), nb_setval( line, Line ),
nb_getval( current_module, MC0 ), nb_getval( current_module, MC0 ),
( Mod == prolog -> MC = prolog ; MC = MC0 ), ( Mod == prolog -> MC = prolog ; MC = MC0 ),
get_graph( T, F, Pos, MC ), get_graph( T, F, Line, MC ),
fail fail
). ).
@ -57,31 +57,34 @@ get_graph( V , _F, _Pos, _M ) :-
get_graph( T, _F, _Pos, _M0 ) :- get_graph( T, _F, _Pos, _M0 ) :-
var(T), var(T),
!. !.
get_graph( M:T, F, _Pos, _M0 ) :- !, get_graph( M:T, F, Pos, _M0 ) :- !,
get_graph( T, F, _Pos, M ). always_strip_module(M:T, NM, NT),
get_graph( ( M:H :- B), F, _Pos, M0 ) :- get_graph( NT, F, Pos, NM ).
get_graph( ( M:H :- B), F, Pos, M0 ) :-
!, !,
get_graph( (H :- M0:B), F, _Pos, M ). get_graph( (H :- M0:B), F, Pos, M ).
get_graph( ( M:H --> B), F, _Pos, M0 ) :- get_graph( ( M:H --> B), F, Pos, M0 ) :-
!,
get_graph( ( H --> M0:B), F, Pos, M ).
get_graph( ( A, _ --> B), F, Pos, M ) :-
!, !,
get_graph( ( H --> M0:B), F, _Pos, M ).
get_graph( ( A, _ --> B), F, _Pos, M ) :-
get_graph( ( A --> B), F, _Pos, M ). get_graph( ( A --> B), F, _Pos, M ).
get_graph( (H --> B), F, _Pos, M ) :- get_graph( (H --> B), F, Pos, M ) :-
!, !,
functor( H, N, Ar), functor( H, N, Ar),
Ar2 is Ar+2, Ar2 is Ar+2,
add_deps( B, M, M:N/Ar2, F, _Pos, 2 ). add_deps( B, M, M:N/Ar2, F, Pos, 2 ).
get_graph( (H :- B), F, _Pos, M ) :- get_graph( (H :- B), F, Pos, M ) :-
!, !,
functor( H, N, Ar), functor( H, N, Ar),
add_deps( B, M, M:N/Ar, F, _Pos, 0 ). add_deps( B, M, M:N/Ar, F, Pos, 0 ).
%% switches to new file n %% switches to new file n
get_graph( (:-include( Fs ) ), F, _Pos, M ) :- get_graph( (:-include( Fs ) ), F, _Pos, M ) :-
!, !,
source_graphs( M, F, Fs ). source_graphs( M, F, Fs ).
get_graph( (?- _ ), _F, _Pos, _M ) :- !. get_graph( (?- _ ), _F, _Pos, _M ) :- !.
get_graph( (:- _ ), _F, _Pos, _M ) :- !. get_graph( (:- _ ), _F, _Pos, _M ) :- !.
get_graph( _H, _F, _Pos, _M ).
source_graphs( M, F, Fs ) :- source_graphs( M, F, Fs ) :-
maplist( source_graph( M, F ), Fs ), !. maplist( source_graph( M, F ), Fs ), !.
@ -131,13 +134,12 @@ add_deps(A, M, P, F, Pos, L) :-
Ar is Ar0+L, Ar is Ar0+L,
put_dep( ( F-M:P :- F-M:N/Ar ), Pos ). put_dep( ( F-M:P :- F-M:N/Ar ), Pos ).
put_dep( (Target :- F0-M:Goal ), _Pos ) :- put_dep( (Target :- F0-G0 ), _Pos ) :-
ground(F0-M:Goal), !, ground(F0-G0), !,
assert_new_e( ( Target :- F0-M:N/Ar ) ). Target = F-G,
assert_new_e( F, G, F0, G0 ).
put_dep(_,_). put_dep(_,_).
% prolog is visible ( but maybe not same file ). % prolog is visible ( but maybe not same file )
m_exists(P, F) :- private( F, P ), !. m_exists(P, F) :- private( F, P ), !.
m_exists(P, F) :- public( F, P ). m_exists(P, F) :- public( F, P ).

90
utils/analysis/load.yap
View File

@ -24,9 +24,9 @@ scan_dir( Dir -user) :-
pl_interfs(0, Dir-user ), pl_interfs(0, Dir-user ),
%%% phase 2: find C-code predicates %%% phase 2: find C-code predicates
c_preds( Dir-user ). c_preds( Dir-user ).
// the c-builtins do not depend on prolog code. % the c-builtins do not depend on prolog code.
scan_dir( Dir -prolog) :- scan_dir( Dir -prolog) :-
c_preds( Dir-user ). c_preds( Dir-user ),
pl_interfs(0, Dir-user ). pl_interfs(0, Dir-user ).
%%% phase 2: find C-code predicates %%% phase 2: find C-code predicates
@ -54,7 +54,7 @@ rdir( FRoot ) :-
rdir(_). rdir(_).
c_preds(Dir - Mod) :- c_preds(Dir - Mod) :-
format('%~*| C ************* ~a\n', [1,Dir]), % format('%~*| C ************* ~a\n', [1,Dir]),
atom( Dir ), atom( Dir ),
absolute_file_name( Dir, [glob(*), solutions(all), file_errors(fail)], File ), absolute_file_name( Dir, [glob(*), solutions(all), file_errors(fail)], File ),
( ( sub_atom(File,_,_,0,'.c') ( ( sub_atom(File,_,_,0,'.c')
@ -116,7 +116,7 @@ c_line(Line, Mod, F: LineP) :-
break_line( Line, N/A, Fu), break_line( Line, N/A, Fu),
assert( node( Mod, N/A, F-LineP, Fu ) ), assert( node( Mod, N/A, F-LineP, Fu ) ),
handle_pred( Mod, N, A, F ). handle_pred( Mod, N, A, F ).
c_ext( S, Mod, F ) :- c_ext( S, Mod, F ) :-
repeat, repeat,
stream_property( S, position(Pos) ), stream_property( S, position(Pos) ),
@ -130,11 +130,11 @@ c_ext( S, Mod, F ) :-
( sub_string( Codes, _, _, _, `NULL` ) ( sub_string( Codes, _, _, _, `NULL` )
-> ->
! !
; ;
split_string(String, `,; (){}\t\"\'`, [`FRG`, NS,AS,FS|_]), split_string(String, `,; (){}\t\"\'`, [`FRG`, NS,AS,FS|_]),
atom_string(N,NS), atom_string(N,NS),
atom_string(Fu,FS), atom_string(Fu,FS),
catch( number_string(A, AS), Error, handle( String , Error ) ), catch( number_string(A, AS), Error, handle( String , Error ) ),
stream_position_data( line_count, Pos, Line ), stream_position_data( line_count, Pos, Line ),
assert( node( Mod , N/A, F-Line, Fu ) ), assert( node( Mod , N/A, F-Line, Fu ) ),
handle_pred( Mod, N, A, F ) handle_pred( Mod, N, A, F )
@ -274,10 +274,9 @@ clean_up(_,_).
% %
% %
% %
pl_interfs(Lev0, Dir - Mod) :- pl_interfs(Lev0, Dir - Mod) :-
\+ ( fullskip( Dir ) ), \+ ( fullskip( Dir ) ),
format('%~*| ************* ~a\n', [Lev0,Dir]), % format('%~*| ************* ~a\n', [Lev0,Dir]),
Lev is Lev0+1, Lev is Lev0+1,
nb_setval( current_module, Mod ), nb_setval( current_module, Mod ),
atom( Dir ), atom( Dir ),
@ -310,7 +309,7 @@ pl_interfs(_, _).
pl_interface(F, Mod, _Lev) :- pl_interface(F, Mod, _Lev) :-
module_on( F , _Mod, L ), module_on( F , _Mod, L ),
maplist( private(F, Mod), L ), maplist( private(F, Mod), L ),
!. !.
pl_interface(F, Mod, _) :- pl_interface(F, Mod, _) :-
consulted(F, Mod ), consulted(F, Mod ),
!. !.
@ -329,7 +328,7 @@ pl_interface(F, Mod, Lev) :-
catch( open(PF, read, S, [script(true)]) , _, fail ), catch( open(PF, read, S, [script(true)]) , _, fail ),
repeat, repeat,
nb_getval( current_module, MR ), nb_getval( current_module, MR ),
catch( read_clause( S, T, [module( MR ),term_position(Pos)] ), Throw, loop_error( MR:Throw)), catch( read_clause( S, T, [module( MR ),term_position(Pos),comment(Comment)] ), Throw, loop_error( MR:Throw)),
( T == end_of_file ( T == end_of_file
-> ->
@ -351,7 +350,7 @@ pl_interface(F, Mod, Lev) :-
), ),
clean_up( MR, F ), clean_up( MR, F ),
nb_setval( current_module, M0 ) nb_setval( current_module, M0 )
% writeln('***************************<<<<<<<<<<<'-M0), % writeln('***************************<<<<<<<<<<<'-M0),
% (current_op(X,Y,O), write(M0:O), fail;nl) % (current_op(X,Y,O), write(M0:O), fail;nl)
; ;
@ -361,7 +360,7 @@ pl_interface(F, Mod, Lev) :-
( Mod == prolog -> MC = prolog ; MC = MC0 ), ( Mod == prolog -> MC = prolog ; MC = MC0 ),
Lev1 is Lev+1, Lev1 is Lev+1,
get_interface( T, F, MC, Lev1 ), get_interface( T, F, MC, Lev1 ),
get_graph( T, F, Pos, MC ), get_graph( T, F, Pos, MC ),
fail fail
). ).
@ -403,7 +402,7 @@ get_directive( V , _F, _M , _Lev) :-
get_directive( module( NM0, Is ), F, _M , _Lev) :- get_directive( module( NM0, Is ), F, _M , _Lev) :-
!, !,
( (
(NM0 = system(_) -> NM = prolog ; NM = NM0 ), (NM0 = system(NM) -> true ; NM0 = system(NM,_) -> true ; NM = NM0 ),
assert(module_file( F, NM ) ), assert(module_file( F, NM ) ),
nb_setval( current_module, NM ), nb_setval( current_module, NM ),
assert( module_on( F , NM, Is) ), assert( module_on( F , NM, Is) ),
@ -415,28 +414,25 @@ get_directive( module( NM0, Is ), F, _M , _Lev) :-
writeln(oops:module( NM0, Is )), writeln(oops:module( NM0, Is )),
fail fail
). ).
get_directive( reexport( Loc, Is ), F, M , Lev) :- get_directive( reexport( Loc, Is ), F, M , Lev) :-
!, !,
( % find the file search_file( Loc, F, prolog, F1),
search_file(Loc, F, prolog, F1), pl_interface(F1, M, Lev),
pl_interface(F1, M, Lev), module_on( F1 , NM, Is0),
module_on( F1 , NM, Is0), (var(Is) ->
(var(Is) -> Is = Is0
Is = Is0 ;
; true
true ),
), % extend the interface.rg
% extend the interface.rg retract( module_on( F , M, IsOld) ),
retract( module_on( F , M, IsOld) ), append( Is, IsOld, NIs ),
append( Is, IsOld, NIs ), assert( module_on( F , M, NIs) ),
assert( module_on( F , M, NIs) ), maplist( exported(F, M, F1, NM), NIs ).
maplist( exported(F, M, F1, NM), NIs ) get_directive( use_module( Loc, Is ), F, M , Lev) :-
fail
).
get_directive( use_module( Loc, Is ), F, M , Lev) :- !,
!, !,
include_files( F, M, Is, Lev, Loc ). include_files( F, M, Is, Lev, Loc ).
get_directive( use_module( Loc ), F, M , Lev) :- !, get_directive( use_module( Loc ), F, M , Lev) :-
!, !,
include_files0( F, M, Lev, Loc ). include_files0( F, M, Lev, Loc ).
% nb_getval(current_module,MM), writeln(NM:MM:M). % nb_getval(current_module,MM), writeln(NM:MM:M).
@ -517,7 +513,7 @@ get_directive( thread_local( T ), F, M , _Lev) :-
declare_functors( T, F, M ). declare_functors( T, F, M ).
get_directive( op( X, Y, Z), _F, M , _Lev) :- get_directive( op( X, Y, Z), _F, M , _Lev) :-
!, !,
new_op(M,X,Y,Z). new_op(M,M,X,Y,Z).
get_directive( record( Records ), F, M , _Lev) :- get_directive( record( Records ), F, M , _Lev) :-
!, !,
handle_record( Records, F, M). handle_record( Records, F, M).
@ -590,27 +586,23 @@ handle_pred( M, N, A, F ) :-
) )
). ).
exported( _NF, _F, _NM, M, op(X,Y,Z)) :- exported( _NF, _F, NM, M, op(X,Y,Z)) :-
!, !,
new_op(M,X,Y,Z). new_op(M, NM, X,Y,Z).
exported( NF, F, NM, M, N/A) :- !, exported( NF, F, NM, M, N/A) :- !,
% sink no more % sink no more
retractall( exported(( _ :- F-M:N/A) ) ), assert_new_e( F,M:N/A , NF, NM:N/A ).
assert_new_e( ( (F-M:N/A :- NF-NM:N/A )) ).
exported( NF, F, NM, M, N/A as NN) :- !, exported( NF, F, NM, M, N/A as NN) :- !,
% sink no more % sink no more
retractall( exported(( _ :- F-M:N/A) ) ), assert_new_e( F,M:NN/A , NF,NM:N/A ).
assert_new_e( ( ( F-M:NN/A :- NF-NM:N/A ) ) ).
exported( NF, F, NM, M, N//A) :- !, exported( NF, F, NM, M, N//A) :- !,
A2 is A+2, A2 is A+2,
% sink no more % sink no more
retractall( exported(( _ :- F-M:N/A2) ) ), assert_new_e( F,M:N/A2 , NF, NM:N/A2 ).
assert_new_e( ( (F-M:N/A2 :- NF-NM:N/A2) ) ).
exported( NF, F, NM, M, N//A as NN) :- !, exported( NF, F, NM, M, N//A as NN) :- !,
A2 is A+2, A2 is A+2,
% sink no more % sink no more
retractall( exported(( _ :- F-M:N/A2) ) ), assert_new_e( F, M:NN/A2 , NF, NM:N/A2 ).
assert_new_e( ( ( F-M:NN/A2 :- NF-NM:N/A2 )) ).
@ -632,13 +624,12 @@ include_file( F, M, Is, Lev, Loc ) :-
is_list( Loc ), !, is_list( Loc ), !,
maplist( include_file( F, M, Is, Lev), Loc ). maplist( include_file( F, M, Is, Lev), Loc ).
include_file( F, M, Is0, Lev, Loc ) :- include_file( F, M, Is0, Lev, Loc ) :-
% depth visit % depth visit\
( (
nb_getval( private, Private ), % find the file nb_getval( private, Private ), % find the file
once( search_file( Loc, F, prolog, NF ) ), once( search_file( Loc, F, prolog, NF ) ),
pl_interface(NF, M, Lev), pl_interface(NF, M, Lev),
% should verify Is in _Is % should verify Is in _Is
% link b
%trace, %trace,
( module_on(NF, NM, Is) ( module_on(NF, NM, Is)
-> ->
@ -652,7 +643,7 @@ include_file( F, M, Is0, Lev, Loc ) :-
true true
; ;
writeln(bad_include_file( F, M, Is0, Lev, Loc )), writeln(bad_include_file( F, M, Is0, Lev, Loc )),
fail fail
). ).
source_files( F, M, Lev, Files ) :- source_files( F, M, Lev, Files ) :-
@ -727,7 +718,6 @@ declare_term(F, M, S) :-
functor(S, N, A), functor(S, N, A),
handle_pred( M, N, A, F ). handle_pred( M, N, A, F ).
handle(Line, Error ) :- handle(Line, Error ) :-
format('~s caused Error ~w~n~n', [Line, Error]), format('~s caused Error ~w~n~n', [Line, Error]),
fail. fail.

100
utils/sysgraph
View File

@ -26,7 +26,7 @@
:- dynamic :- dynamic
node/4, node/4,
edge/1, edge/1,
public/2, (public)/2,
private/2, private/2,
module_on/3, module_on/3,
exported/1, exported/1,
@ -79,7 +79,6 @@ main :-
main :- main :-
%%% phase 4: construct graph %%% phase 4: construct graph
retractall( consulted(_,_) ), retractall( consulted(_,_) ),
trace,
find_undefs, find_undefs,
doubles, doubles,
% pl_exported(pl). % pl_exported(pl).
@ -146,50 +145,6 @@ doubles :-
fail. fail.
doubles. doubles.
find_undefs :-
format('UNDEFINED procedure calls:~n',[]),
pmodule(M),
format(' module ~a:~n',[M]),
predicate_in_module(M, P),
\+ edge((_-M:P :- _)),
format(' ~w:~n',[P]),
fail.
find_undefs.
pmodule(M) :-
findall(M, node(M, _,_,_), Ms),
sort(Ms, SMs),
member(M, SMs).
predicate_in_module(M, P) :-
findall(P, node(M, P,_,_), Ps),
sort(Ps, SPs),
member(P, SPs).
/*
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.
*/
out_list([]) :- out_list([]) :-
format('[]', []). format('[]', []).
@ -338,23 +293,24 @@ library('..').
:- dynamic user:prolog_file_type/2. :- dynamic user:prolog_file_type/2.
prolog_file_type(c, '.c'). %prolog_file_type(chr, prolog).
prolog_file_type(c, '.h'). prolog_file_type(c, c).
prolog_file_type(c, '.h.cmake'). prolog_file_type(h, c).
prolog_file_type(c, '.i'). prolog_file_type('h.cmake', c).
prolog_file_type('i', c).
% %
% handle some special cases. % handle some special cases.
% %
search_file( S , LocF, Type, FN ) :- search_file( S , LocF, Type, FN ) :-
functor(S, _, N), functor(S, _, N),
N> 0, N> 0,
!, !,
arg(N, S, A), arg(N, S, A),
search_file( A , LocF, Type, FN ). search_file( A , LocF, Type, FN ).
%try to use your base %try to use your base
search_file( F0, LocF, Type, FO ) :- search_file( F0, LocF, Type, FO ) :-
file_directory_name(LocF, D), file_directory_name(LocF, D),
file_base_name(F0, B), file_base_name(F0, B),
findall(F, fsuffix(Type, B, F), Fs), findall(F, fsuffix(Type, B, F), Fs),
Fs = [_|_], Fs = [_|_],
@ -369,11 +325,11 @@ search_file( F0, LocF, Type, FO ) :-
search_file( Loc , F, Type, _FN ) :- search_file( Loc , F, Type, _FN ) :-
format('~n~n~n###############~n~n FAILED TO FIND ~w.~a when at ~a~n~n###############~n~n~n', [Loc, Type, F ]), format('~n~n~n###############~n~n FAILED TO FIND ~w.~a when at ~a~n~n###############~n~n~n', [Loc, Type, F ]),
fail. fail.
fsuffix(Type,F0, F) :- fsuffix(Type,F0, F) :-
( user:prolog_file_type(Suffix, Type), ( user:prolog_file_type(Suffix, Type),
(atom_concat('.', _, Suffix) (atom_concat('.', _, Suffix)
-> ->
Suffix = DSuffix Suffix = DSuffix
; ;
atom_concat('.', Suffix, DSuffix) atom_concat('.', Suffix, DSuffix)
@ -385,8 +341,8 @@ fsuffix(Type,F0, F) :-
file_base_name(F1, B), file_base_name(F1, B),
file(F, B), file(F, B),
atom_concat(_, F1, F). atom_concat(_, F1, F).
quantf(F, F1, I-F1) :- quantf(F, F1, I-F1) :-
atom_length(F1,M), atom_length(F1,M),
between(0,M,I), between(0,M,I),
@ -397,10 +353,17 @@ quantf(F, F1, I-F1) :-
% if it is .yap... % if it is .yap...
new_op( prolog, _X,_Y,_Z ) :- !. new_op( M, M, X, Y, Z ) :- !,
new_op( M, X,Y,Z ) :- myop( X, Y, M:Z).
op( X, Y, M:Z). new_op( M1, M2, X,Y,Z ) :-
myop( X, Y, M1:Z),
myop( X, Y, M2:Z).
myop(_X, _Y, _M:P) :-
system_op(P),
!.
myop(X, Y, M:P) :-
op(X, Y, M:P).
error(_F, Error) :- error(_F, Error) :-
print_message( error, Error ), print_message( error, Error ),
@ -416,7 +379,7 @@ preprocess_file(F,F).
%%%%%%% %%%%%%%
%% declare a concept exportable %% declare a concept exportable
public( _F, M, op(X,Y,Z) ) :- !, public( _F, M, op(X,Y,Z) ) :- !,
new_op(M,X,Y,Z). new_op(M,M,X,Y,Z).
public( F, M, M:N/Ar ) :- public( F, M, M:N/Ar ) :-
retract( private( F, M:N/Ar ) ), retract( private( F, M:N/Ar ) ),
fail. fail.
@ -445,7 +408,7 @@ public( _F, _M, _//_Ar ).
private( _F, M, op(X,Y,Z) ) :- private( _F, M, op(X,Y,Z) ) :-
!, !,
new_op( M,X, Y, Z ). new_op(M,M,X, Y, Z ).
private( F, M, N/Ar ) :- private( F, M, N/Ar ) :-
assert_new( private( F, M:N/Ar ) ), assert_new( private( F, M:N/Ar ) ),
\+ node( M, N/Ar, F-_, _ ), \+ node( M, N/Ar, F-_, _ ),
@ -468,10 +431,10 @@ is_private( F, M, OP ) :-
assert_new_e((A-MG :- B-MG1 )) :- assert_new_e( A , MG , B, MG1 ) :-
yap_strip_module(MG, M, P), always_strip_module(MG, M, P),
yap_strip_module(MG1, M1, P1), always_strip_module(MG1, M1, P1),
assert(edge((A-M:P :- B-M1:P1 ) )). assert_new(edge((A-M:P :- B-M1:P1 ) )).
assert_new( G ) :- G, !. assert_new( G ) :- G, !.
@ -662,7 +625,7 @@ add_comments :-
member(Line-Comment-Type-Dup, Lines), member(Line-Comment-Type-Dup, Lines),
check_comment( Comment, CN, Line, File ), check_comment( Comment, CN, Line, File ),
Line1 is Line-1, Line1 is Line-1,
format(S, '#~a~ncat << "EOF" > tmp~n~sEOF~nsed -e "~dr tmp" ~a > x~n\ format(S, '#~a~ncat << "EOF" > tmp~n~sEOF~nsed -e "~dr tmp" ~a > x~n\c
mv x ~a~n~n',[Dup,CN, Line1, File, File]) mv x ~a~n~n',[Dup,CN, Line1, File, File])
; ;
close(S) close(S)
@ -800,8 +763,7 @@ user_skip( 'packages/prism/src/prolog').
user_skip( 'packages/prism'). user_skip( 'packages/prism').
user_expand( library(clpfd), 'library/clp/clpfd.pl' ). user_expand( library(clpfd), 'library/clp/clpfd.pl' ).
loop_error(_, Msg) :- loop_error(_, Msg) :-
writeln(Msg), writeln(Msg),
fail. fail.