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

increase the ignore list

Browse Source
This commit is contained in:
Vítor Santos Costa
2015-06-17 23:49:02 +01:00
parent 4132854fbe
commit c26b5f3175
16 changed files with 5653 additions and 186 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1331
library/dialect/swi/os/#pl-prologflag.c# Executable file
View File

File diff suppressed because it is too large Load Diff

415
library/dialect/swi/os/pl-global.h Executable file
View File

@@ -0,0 +1,415 @@
#ifndef PL_GLOBAL_H
#define PL_GLOBAL_H
#include <setjmp.h>
typedef enum
{ DBG_OFF = 0, /* no debugging */
DBG_ON, /* switch on in current environment */
DBG_ALL /* switch on globally */
} debug_type;
typedef struct debuginfo
{ size_t skiplevel; /* current skip level */
bool tracing; /* are we tracing? */
debug_type debugging; /* are we debugging? */
int leashing; /* ports we are leashing */
int visible; /* ports that are visible */
bool showContext; /* tracer shows context module */
int styleCheck; /* source style checking */
int suspendTrace; /* tracing is suspended now */
//LocalFrame retryFrame; /* Frame to retry */
} pl_debugstatus_t;
typedef struct find_data_tag * FindData; /* pl-trace.c */
typedef enum
{ LDATA_IDLE = 0,
LDATA_SIGNALLED,
LDATA_ANSWERING,
LDATA_ANSWERED
} ldata_status_t;
typedef enum
{ CLN_NORMAL = 0, /* Normal mode */
CLN_ACTIVE, /* Started cleanup */
CLN_FOREIGN, /* Foreign hooks */
CLN_PROLOG, /* Prolog hooks */
CLN_SHARED, /* Unload shared objects */
CLN_DATA /* Remaining data */
} cleanup_status;
#ifdef THREADS
typedef struct free_chunk *FreeChunk; /* left-over chunk */
struct free_chunk
{ FreeChunk next; /* next of chain */
size_t size; /* size of free bit */
};
typedef struct _PL_thread_info_t
{ int pl_tid; /* Prolog thread id */
size_t local_size; /* Stack sizes */
size_t global_size;
size_t trail_size;
size_t stack_size; /* system (C-) stack */
int (*cancel)(int id); /* cancel function */
int open_count; /* for PL_thread_detach_engine() */
bool detached; /* detached thread */
int status; /* PL_THREAD_* */
pthread_t tid; /* Thread identifier */
int has_tid; /* TRUE: tid = valid */
#ifdef __linux__
pid_t pid; /* for identifying */
#endif
#ifdef __WINDOWS__
unsigned long w32id; /* Win32 thread HANDLE */
#endif
struct PL_local_data *thread_data; /* The thread-local data */
module_t module; /* Module for starting goal */
record_t goal; /* Goal to start thread */
record_t return_value; /* Value (term) returned */
atom_t name; /* Name of the thread */
ldata_status_t ldata_status; /* status of forThreadLocalData() */
} PL_thread_info_t;
PL_thread_info_t *SWI_thread_info(int tid, PL_thread_info_t *info);
intptr_t system_thread_id(void);
#endif
typedef struct
{ unsigned long flags; /* Fast access to some boolean Prolog flags */
} pl_features_t;
typedef enum
{ OCCURS_CHECK_FALSE = 0,
OCCURS_CHECK_TRUE,
OCCURS_CHECK_ERROR
} occurs_check_t;
typedef enum
{ ACCESS_LEVEL_USER = 0, /* Default user view */
ACCESS_LEVEL_SYSTEM /* Allow low-level access */
} access_level_t;
typedef struct exception_frame /* PL_throw exception environments */
{ struct exception_frame *parent; /* parent frame */
jmp_buf exception_jmp_env; /* longjmp environment */
} exception_frame;
typedef struct
{ atom_t file; /* current source file */
IOPOS position; /* Line, line pos, char and byte */
} source_location;
typedef struct
{ size_t localSize; /* size of local stack */
size_t globalSize; /* size of global stack */
size_t trailSize; /* size of trail stack */
char * goal; /* initial goal */
char * topLevel; /* toplevel goal */
char * initFile; /* -f initialisation file */
char * systemInitFile; /* -F initialisation file */
// opt_list *scriptFiles;
// opt_list *search_paths; /* -p path */
char * pldoc_server; /* --pldoc=Server */
char * compileOut; /* file to store compiler output */
char * saveclass; /* Type of saved state */
bool silent; /* -q: quiet operation */
#ifdef __WINDOWS__
bool win_app; /* --win_app: be Windows application */
#endif
} pl_options_t;
/* The GD global variable */
typedef struct {
pl_options_t options; /* command-line options */
int io_initialised;
cleanup_status cleaning; /* Inside PL_cleanup() */
pl_defaults_t defaults; /* system default settings */
struct
{ Table table; /* global (read-only) features */
} prolog_flag;
struct
{ Table tmp_files; /* Known temporary files */
CanonicalDir _canonical_dirlist;
char * myhome; /* expansion of ~ */
char * fred; /* last expanded ~user */
char * fredshome; /* home of fred */
OnHalt on_halt_list; /* list of onhalt hooks */
int halting; /* process is shutting down */
int gui_app; /* Win32: Application is a gui app */
IOFUNCTIONS iofunctions; /* initial IO functions */
IOFUNCTIONS org_terminal; /* IO+Prolog terminal functions */
IOFUNCTIONS rl_functions; /* IO+Terminal+Readline functions */
} os;
struct
{ size_t heap; /* heap in use */
size_t atoms; /* No. of atoms defined */
size_t atomspace; /* # bytes used to store atoms */
size_t stack_space; /* # bytes on stacks */
#ifdef O_ATOMGC
size_t atomspacefreed; /* Freed atom-space */
#endif
int functors; /* No. of functors defined */
int predicates; /* No. of predicates defined */
int modules; /* No. of modules in the system */
intptr_t codes; /* No. of byte codes generated */
#ifdef O_PLMT
int threads_created; /* # threads created */
int threads_finished; /* # finished threads */
double thread_cputime; /* Total CPU time of threads */
#endif
double start_time; /* When Prolog was started */
} statistics;
struct
{ atom_t * array; /* index --> atom */
size_t count; /* elements in array */
atom_t *for_code[256]; /* code --> one-char-atom */
} atoms;
struct
{ int os_argc; /* main(int argc, char **argv) */
char ** os_argv;
int appl_argc; /* Application options */
char ** appl_argv;
int notty; /* -tty: donot use ioctl() */
int optimise; /* -O: optimised compilation */
} cmdline;
#if 0
struct
{ //char * CWDdir;
//size_t CWDlen;
//char * executable; /* Running executable */
#ifdef __WINDOWS__
char * module; /* argv[0] module passed */
#endif
} paths;
#endif
struct
{ ExtensionCell _ext_head; /* head of registered extensions */
ExtensionCell _ext_tail; /* tail of this chain */
InitialiseHandle initialise_head; /* PL_initialise_hook() */
InitialiseHandle initialise_tail;
PL_dispatch_hook_t dispatch_events; /* PL_dispatch_hook() */
int _loaded; /* system extensions are loaded */
} foreign;
#ifdef O_PLMT
FreeChunk left_over_pool; /* Left-over from threads */
struct
{ struct _at_exit_goal *exit_goals; /* Global thread_at_exit/1 goals */
int enabled; /* threads are enabled */
Table mutexTable; /* Name --> mutex table */
int mutex_next_id; /* next id for anonymous mutexes */
struct pl_mutex* MUTEX_load; /* The $load mutex */
#ifdef __WINDOWS__
HINSTANCE instance; /* Win32 process instance */
#endif
counting_mutex *mutexes; /* Registered mutexes */
int thread_max; /* Maximum # threads */
PL_thread_info_t *threads[MAX_THREADS]; /* Pointers to thread-info */
} thread;
#endif /*O_PLMT*/
struct /* pl-format.c */
{ Table predicates;
} format;
struct
{/* Procedure dgarbage_collect1; */
/* Procedure catch3; */
/* Procedure true0; */
/* Procedure fail0; */
/* Procedure equals2; /\* =/2 *\/ */
/* Procedure is2; /\* is/2 *\/ */
/* Procedure strict_equal2; /\* ==/2 *\/ */
/* Procedure event_hook1; */
/* Procedure exception_hook4; */
/* Procedure print_message2; */
/* Procedure foreign_registered2; /\* $foreign_registered/2 *\/ */
/* Procedure prolog_trace_interception4; */
predicate_t portray; /* portray/1 */
/* Procedure dcall1; /\* $call/1 *\/ */
/* Procedure setup_call_catcher_cleanup4; /\* setup_call_catcher_cleanup/4 *\/ */
/* Procedure undefinterc4; /\* $undefined_procedure/4 *\/ */
/* Procedure dthread_init0; /\* $thread_init/0 *\/ */
/* Procedure dc_call_prolog0; /\* $c_call_prolog/0 *\/ */
/* #ifdef O_ATTVAR */
/* Procedure dwakeup1; /\* system:$wakeup/1 *\/ */
predicate_t portray_attvar1; /* $attvar:portray_attvar/1 */
/* #endif */
/* #ifdef O_CALL_RESIDUE */
/* Procedure call_residue_vars2; /\* $attvar:call_residue_vars/2 *\/ */
/* #endif */
/* SourceFile reloading; /\* source file we are re-loading *\/ */
/* int active_marked; /\* #prodedures marked active *\/ */
/* int static_dirty; /\* #static dirty procedures *\/ */
/* #ifdef O_CLAUSEGC */
/* DefinitionChain dirty; /\* List of dirty static procedures *\/ */
/* #endif */
} procedures;
#ifdef O_LOCALE
struct
{ Table localeTable; /* Name --> locale table */
PL_locale *default_locale; /* System wide default */
} locale;
#endif
} gds_t;
extern gds_t gds;
#define GD (&gds)
/* The LD macro layer */
typedef struct PL_local_data {
struct /* Local IO stuff */
{ IOSTREAM *streams[6]; /* handles for standard streams */
struct input_context *input_stack; /* maintain input stream info */
struct output_context *output_stack; /* maintain output stream info */
st_check stream_type_check; /* Check bin/text streams? */
} IO;
struct
{ Table table; /* Feature table */
pl_features_t mask; /* Masked access to booleans */
int write_attributes; /* how to write attvars? */
occurs_check_t occurs_check; /* Unify and occurs check */
} feature;
source_location read_source; /* file, line, char of last term */
term_t read_varnames; /* varnames of last term */
struct
{ int active; /* doing pipe I/O */
jmp_buf context; /* context of longjmp() */
} pipe;
struct
{ atom_t current; /* current global prompt */
atom_t first; /* how to prompt first line */
int first_used; /* did we do the first line? */
int next; /* prompt on next read operation */
} prompt;
struct
{ Table table; /* Feature table */
pl_features_t mask; /* Masked access to booleans */
int write_attributes; /* how to write attvars? */
occurs_check_t occurs_check; /* Unify and occurs check */
access_level_t access_level; /* Current access level */
} prolog_flag;
int break_level; /* break */
void * glob_info; /* pl-glob.c */
IOENC encoding; /* default I/O encoding */
struct
{ char * _CWDdir;
size_t _CWDlen;
#ifdef __BEOS__
status_t dl_error; /* dlopen() emulation in pl-beos.c */
#endif
int rand_initialised; /* have we initialised random? */
} os;
struct
{ int64_t pending; /* PL_raise() pending signals */
int current; /* currently processing signal */
int is_sync; /* current signal is synchronous */
record_t exception; /* Pending exception from signal */
#ifdef O_PLMT
simpleMutex sig_lock; /* lock delivery and processing */
#endif
} signal;
int critical; /* heap is being modified */
struct
{ term_t term; /* exception term */
term_t bin; /* temporary handle for exception */
term_t printed; /* already printed exception */
term_t tmp; /* tmp for errors */
term_t pending; /* used by the debugger */
int in_hook; /* inside exception_hook() */
int processing; /* processing an exception */
exception_frame *throw_environment; /* PL_throw() environments */
} exception;
const char *float_format; /* floating point format */
struct
{ FindData find; /* /<ports> <goal> in tracer */
} trace;
pl_debugstatus_t _debugstatus; /* status of the debugger */
#ifdef O_PLMT
struct
{ //intptr_t magic; /* PL_THREAD_MAGIC (checking) */
struct _PL_thread_info_t *info; /* info structure */
//unsigned forall_flags; /* forThreadLocalData() flags */
/* Communication */
//message_queue messages; /* Message queue */
//struct _thread_sig *sig_head; /* Head of signal queue */
//struct _thread_sig *sig_tail; /* Tail of signal queue */
//struct _at_exit_goal *exit_goals; /* thread_at_exit/1 goals */
//DefinitionChain local_definitions; /* P_THREAD_LOCAL predicates */
} thread;
#endif
struct {
buffer _discardable_buffer; /* PL_*() character buffers */
buffer _buffer_ring[BUFFER_RING_SIZE];
int _current_buffer_id;
} fli;
struct
{ fid_t numbervars_frame; /* Numbervars choice-point */
} var_names;
#ifdef O_GMP
struct
{
int persistent; /* do persistent operations */
} gmp;
#endif
int in_print_message;
struct regstore_t *reg_cache; /* pointer to YAP registers */
#ifdef O_LOCALE
struct
{ PL_locale *current; /* Current locale */
} locale;
#endif
} PL_local_data_t;
extern PL_local_data_t lds;
#endif

942
library/dialect/swi/os/pl-incl.h Executable file
View File

@@ -0,0 +1,942 @@
#ifndef PL_INCL_H
#define PL_INCL_H 1
#ifndef __WINDOWS__
#if defined(_MSC_VER) || defined(__MINGW32__) || defined(__MSYS__)
#define __WINDOWS__ 1
#endif
#endif
#ifdef __WINDOWS__
#ifndef __MSYS__
#include <winsock2.h>
#endif
#include <windows.h>
#if HAVE_XOS_H
#include <xos.h> /* Windows POSIX enhancements */
#endif
#include "windows/uxnt.h" /* More Windows POSIX enhancements */
#endif
#include "Yap.h"
#include "YapHeap.h"
/* define that we are in the pl-* code */
#define _PL_EMULATION_LAYER 1
/* include all stuff that is exported to yap */
#include "pl-shared.h"
#define PLVERSION YAP_NUMERIC_VERSION
#define PLNAME "yap"
#define SWIP "swi_"
/* PL internal magic */
typedef word * Word;
/* SWI internal name for a predicate */
typedef struct pred_entry * Procedure; /* predicate */
#ifndef SWI_H
/* try not to pollute the SWI space */
#ifdef P
#undef P
#endif
#ifdef B
#undef B
#endif
#ifdef S
#undef S
#endif
#ifdef H
#undef H
#endif
#endif
/* swi code called from pl-incl.h */
/* should have messages here */
#ifdef DEBUG
#undef DEBUG
#endif
#define DEBUG(LEVEL, COMMAND)
/* vsc: needs defining before getting rid of YAP locks */
static inline int
do_startCritical(void) {
CACHE_REGS
YAPEnterCriticalSection();
return 1;
}
static inline int
do_endCritical(void) {
CACHE_REGS
YAPLeaveCriticalSection();
return 1;
}
#define startCritical do_startCritical()
#define endCritical do_endCritical()
#ifdef LOCK
#undef LOCK
#endif
#ifdef UNLOCK
#undef UNLOCK
#endif
#include <SWI-Stream.h>
#ifdef HAVE_ERRNO_H
#include <errno.h>
#else
extern int errno;
#endif
typedef int Char; /* char that can pass EOF */
#define usedStack(D) 0
#define exception_term (LD->exception.term)
#ifdef Suser_input
#undef Suser_input
#endif
#ifdef Suser_output
#undef Suser_output
#endif
#ifdef Suser_error
#undef Suser_error
#endif
#define Suser_input (LD->IO.streams[0])
#define Suser_output (LD->IO.streams[1])
#define Suser_error (LD->IO.streams[2])
#define Scurin (LD->IO.streams[3])
#define Scurout (LD->IO.streams[4])
#define Sprotocol (LD->IO.streams[5])
#define Sdin Suser_input /* not used for now */
#define Sdout Suser_output
#define source_file_name (LD->read_source.file)
#define source_line_no (LD->read_source.position.lineno)
#define source_line_pos (LD->read_source.position.linepos)
#define source_char_no (LD->read_source.position.charno)
#define source_byte_no (LD->read_source.position.byteno)
#if SIZE_DOUBLE==SIZEOF_INT_P
#define WORDS_PER_DOUBLE 1
#else
#define WORDS_PER_DOUBLE 2
#endif
#define allocForeignState(size) ((void *)Yap_AllocCodeSpace(size))
#define freeForeignState(ptr, size) Yap_FreeCodeSpace((void*)(ptr))
// numbers
typedef enum
{ V_INTEGER, /* integer (64-bit) value */
#ifdef O_GMP
V_MPZ, /* mpz_t */
V_MPQ, /* mpq_t */
#endif
V_FLOAT /* Floating point number (double) */
} numtype;
typedef struct
{ numtype type; /* type of number */
union { double f; /* value as real */
int64_t i; /* value as integer */
word w[WORDS_PER_DOUBLE]; /* for packing/unpacking the double */
#ifdef O_GMP
mpz_t mpz; /* GMP integer */
mpq_t mpq; /* GMP rational */
#endif
} value;
} number, *Number;
#define TOINT_CONVERT_FLOAT 0x1 /* toIntegerNumber() */
#define TOINT_TRUNCATE 0x2
#ifdef O_GMP
#define intNumber(n) ((n)->type <= V_MPZ)
#else
#define intNumber(n) ((n)->type < V_FLOAT)
#endif
#define floatNumber(n) ((n)->type >= V_FLOAT)
typedef enum
{ NUM_ERROR = FALSE, /* Syntax error */
NUM_OK = TRUE, /* Ok */
NUM_FUNDERFLOW = -1, /* Float underflow */
NUM_FOVERFLOW = -2, /* Float overflow */
NUM_IOVERFLOW = -3 /* Integer overflow */
} strnumstat;
#define Arg(N) (PL__t0+((n)-1))
#define A1 (PL__t0)
#define A2 (PL__t0+1)
#define A3 (PL__t0+2)
#define A3 (PL__t0+2)
#define A4 (PL__t0+3)
#define A5 (PL__t0+4)
#define A6 (PL__t0+5)
#define A7 (PL__t0+6)
#define A8 (PL__t0+7)
#define A9 (PL__t0+8)
#define A10 (PL__t0+9)
/* atom_t macro layer */
#define NULL_ATOM ((atom_t)0)
#if __YAP_PROLOG__
#include "dswiatoms.h"
#else
#include "atoms.h"
#endif
#if HAVE_STRING_H
#include <string.h>
#endif
#ifdef HAVE_LOCALE_H
#include <locale.h>
#endif
#ifdef HAVE_LIMITS_H /* get MAXPATHLEN */
#include <limits.h>
#endif
#include <setjmp.h>
#include <assert.h>
#if HAVE_SYS_PARAM_H
#include <sys/param.h> //MAXPATHLEN
#endif
#if __YAP_PROLOG__
#include "pl-yap.h"
#if _WIN32
#define __WINDOWS__ 1
#else
#include <pthread.h>
#endif
#endif
typedef Term PL_atomic_t; /* same size as a word */
typedef struct record * Record;
#define MAXSIGNAL 64
#define LOCAL_OVERFLOW (-1)
#define GLOBAL_OVERFLOW (-2)
#define TRAIL_OVERFLOW (-3)
#define ARGUMENT_OVERFLOW (-4)
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Foreign language interface definitions. Note that these macros MUST be
consistent with the definitions in pl-itf.h, which is included with
users foreign language code.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define NOTRACE PL_FA_NOTRACE
#define METAP PL_FA_TRANSPARENT
#define NDET PL_FA_NONDETERMINISTIC
#define VA PL_FA_VARARGS
#define CREF PL_FA_CREF
#define ISO PL_FA_ISO
/********************************
* THREADS *
*********************************/
#include "pl-thread.h"
#if O_PLMT
/*******************************
* WINDOWS *
*******************************/
#define WM_SIGNALLED (WM_USER+4201) /* how to select a good number!? */
#endif
/********************************
* UTILITIES *
*********************************/
#define ROUND(p, n) ((((p) + (n) - 1) & ~((n) - 1)))
/********************************
* Error *
v *********************************/
#define isDefinedProcedure(pred) TRUE // TBD
#include "pl-error.h"
/********************************
* Files *
*********************************/
#include "pl-files.h"
/*******************************
* OPTION LISTS *
*******************************/
#include "pl-option.h"
/*******************************
* TEXT PROCESSING *
*******************************/
typedef enum
{ CVT_ok = 0, /* Conversion ok */
CVT_wide, /* Conversion needs wide characters */
CVT_partial, /* Input list is partial */
CVT_nolist, /* Input list is not a list */
CVT_nocode, /* List contains a non-code */
CVT_nochar /* List contains a non-char */
} CVT_status;
typedef struct
{ CVT_status status;
word culprit; /* for CVT_nocode/CVT_nochar */
} CVT_result;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Operator types. NOTE: if you change OP_*, check operatorTypeToAtom()!
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define OP_MAXPRIORITY 1200 /* maximum operator priority */
#define OP_PREFIX 0
#define OP_INFIX 1
#define OP_POSTFIX 2
#define OP_MASK 0xf
#define OP_FX (0x10|OP_PREFIX)
#define OP_FY (0x20|OP_PREFIX)
#define OP_XF (0x30|OP_POSTFIX)
#define OP_YF (0x40|OP_POSTFIX)
#define OP_XFX (0x50|OP_INFIX)
#define OP_XFY (0x60|OP_INFIX)
#define OP_YFX (0x70|OP_INFIX)
/*******************************
* COMPARE *
*******************************/
/* Results from comparison operations. Mostly used by compareStandard() */
#define CMP_ERROR -2 /* Error (out of memory) */
#define CMP_LESS -1 /* < */
#define CMP_EQUAL 0 /* == */
#define CMP_GREATER 1 /* > */
#define CMP_NOTEQ 2 /* \== */
/*******************************
* NUMBERVARS *
*******************************/
typedef enum
{ AV_BIND,
AV_SKIP,
AV_ERROR
} av_action;
typedef struct
{ functor_t functor; /* Functor to use ($VAR/1) */
av_action on_attvar; /* How to handle attvars */
int singletons; /* Write singletons as $VAR('_') */
int numbered_check; /* Check for already numbered */
} nv_options;
/*******************************
* GET-PROCEDURE *
*******************************/
#define GP_FIND 0 /* find anywhere */
#define GP_FINDHERE 1 /* find in this module */
#define GP_CREATE 2 /* create (in this module) */
#define GP_DEFINE 4 /* define a procedure */
#define GP_RESOLVE 5 /* find defenition */
#define GP_HOW_MASK 0x0ff
#define GP_NAMEARITY 0x100 /* or'ed mask */
#define GP_HIDESYSTEM 0x200 /* hide system module */
#define GP_TYPE_QUIET 0x400 /* don't throw errors on wrong types */
#define GP_EXISTENCE_ERROR 0x800 /* throw error if proc is not found */
#define GP_QUALIFY 0x1000 /* Always module-qualify */
/* get_functor() */
#define GF_EXISTING 1
#define GF_PROCEDURE 2 /* check for max arity */
/*******************************
* LIST BUILDING *
*******************************/
#include "pl-privitf.h"
// LOCAL variables (heap will get this form LOCAL
#define FT_ATOM 0 /* atom feature */
#define FT_BOOL 1 /* boolean feature (true, false) */
#define FT_INTEGER 2 /* integer feature */
#define FT_FLOAT 3 /* float feature */
#define FT_TERM 4 /* term feature */
#define FT_INT64 5 /* passed as int64_t */
#define FT_FROM_VALUE 0x0f /* Determine type from value */
#define FT_MASK 0x0f /* mask to get type */
#define SYSTEM_MODE (LD->prolog_flag.access_level == ACCESS_LEVEL_SYSTEM)
#define PL_malloc_atomic malloc
#define EXCEPTION_GUARDED(code, cleanup) \
{ exception_frame __throw_env; \
__throw_env.parent = LD->exception.throw_environment; \
if ( setjmp(__throw_env.exception_jmp_env) != 0 ) \
{ LD->exception.throw_environment = __throw_env.parent; \
cleanup; \
} else \
{ LD->exception.throw_environment = &__throw_env; \
code; \
LD->exception.throw_environment = __throw_env.parent; \
} \
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
At times an abort is not allowed because the heap is inconsistent the
programmer should call startCritical to start such a code region and
endCritical to end it.
MT/TBD: how to handle this gracefully in the multi-threading case. Does
it mean anything?
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif
#define succeed return TRUE
#define fail return FALSE
#define TRY(goal) if ((goal) == FALSE) fail
/* Flags on module. Most of these flags are copied to the read context
in pl-read.c.
*/
#define M_SYSTEM (0x0001) /* system module */
#define M_CHARESCAPE (0x0002) /* module */
#define DBLQ_CHARS (0x0004) /* "ab" --> ['a', 'b'] */
#define DBLQ_ATOM (0x0008) /* "ab" --> 'ab' */
#define DBLQ_STRING (0x0010) /* "ab" --> "ab" */
#ifdef DBLQ_MASK
#undef DBLQ_MASK
#endif
#define DBLQ_MASK (DBLQ_CHARS|DBLQ_ATOM|DBLQ_STRING)
#define UNKNOWN_FAIL (0x0020) /* module */
#define UNKNOWN_WARNING (0x0040) /* module */
#define UNKNOWN_ERROR (0x0080) /* module */
#define UNKNOWN_MASK (UNKNOWN_ERROR|UNKNOWN_WARNING|UNKNOWN_FAIL)
extern int fileerrors;
extern int ttymode;
#define CHARESCAPE_FEATURE 0x00001 /* handle \ in atoms */
#define GC_FEATURE 0x00002 /* do GC */
#define TRACE_GC_FEATURE 0x00004 /* verbose gc */
#define TTY_CONTROL_FEATURE 0x00008 /* allow for tty control */
#define READLINE_FEATURE 0x00010 /* readline is loaded */
#define DEBUG_ON_ERROR_FEATURE 0x00020 /* start tracer on error */
#define REPORT_ERROR_FEATURE 0x00040 /* print error message */
#define FILE_CASE_FEATURE 0x00080 /* file names are case sensitive */
#define FILE_CASE_PRESERVING_FEATURE 0x0100 /* case preserving file names */
#define DOS_FILE_NAMES_FEATURE 0x00200 /* dos (8+3) file names */
#define ISO_FEATURE 0x00800 /* Strict ISO compliance */
#define OPTIMISE_FEATURE 0x01000 /* -O: optimised compilation */
#define FILEVARS_FEATURE 0x02000 /* Expand $var and ~ in filename */
#define AUTOLOAD_FEATURE 0x04000 /* do autoloading */
#define CHARCONVERSION_FEATURE 0x08000 /* do character-conversion */
#define LASTCALL_FEATURE 0x10000 /* Last call optimization enabled? */
#define EX_ABORT_FEATURE 0x20000 /* abort with exception */
#define BACKQUOTED_STRING_FEATURE 0x40000 /* `a string` */
#define SIGNALS_FEATURE 0x80000 /* Handle signals */
#define DEBUGINFO_FEATURE 0x100000 /* generate debug info */
int defFeature(const char *c, int f, ...);
int trueFeature(int f);
/*******************************
* WAKEUP *
*******************************/
#define WAKEUP_STATE_WAKEUP 0x1
#define WAKEUP_STATE_EXCEPTION 0x2
#define WAKEUP_STATE_SKIP_EXCEPTION 0x4
typedef struct wakeup_state
{ fid_t fid; /* foreign frame reference */
int flags;
} wakeup_state;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Defining built-in predicates using the new interface
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define ESC ((char) 27)
#define streq(s, q) ((strcmp((s), (q)) == 0))
#define CHAR_MODE 0 /* See PL_unify_char() */
#define CODE_MODE 1
#define BYTE_MODE 2
/* string stuff */
/*******************************
* STRING SUPPORT *
*******************************/
char * store_string(const char *s);
void remove_string(char *s);
/* from foreign interface */
/*******************************
* FILENAME SUPPORT *
*******************************/
#define PL_FILE_ABSOLUTE 0x01 /* return absolute path */
#define PL_FILE_OSPATH 0x02 /* return path in OS notation */
#define PL_FILE_SEARCH 0x04 /* use file_search_path */
#define PL_FILE_EXIST 0x08 /* demand file to exist */
#define PL_FILE_READ 0x10 /* demand read-access */
#define PL_FILE_WRITE 0x20 /* demand write-access */
#define PL_FILE_EXECUTE 0x40 /* demand execute-access */
#define PL_FILE_NOERRORS 0x80 /* do not raise exceptions */
#define PL_FA_ISO (0x20) /* Internal: ISO core predicate */
/********************************
* READ WARNINGS *
*********************************/
#define ReadingSource (source_line_no > 0 && \
source_file_name != NULL_ATOM)
#include <pl-text.h>
typedef double real;
#define forwards static /* forwards function declarations */
/* uxnt package interface */
#if defined(__YAP_PROLOG__) && defined(__MINGW32__)
#ifndef __WINDOWS__
#define __WINDOWS__ 1
#endif
#endif
extern int PL_unify_char(term_t chr, int c, int how);
extern int PL_get_char(term_t chr, int *c, int eof);
extern void PL_cleanup_fork(void);
extern int PL_rethrow(void);
extern void PL_get_number(term_t l, number *n);
extern int PL_unify_atomic(term_t t, PL_atomic_t a);
extern int PL_unify_termv(term_t l, va_list args);
extern int _PL_unify_atomic(term_t t, PL_atomic_t a);
extern int _PL_unify_string(term_t t, word w);
extern IOSTREAM ** /* provide access to Suser_input, */
_PL_streams(void); /* Suser_output and Suser_error */
extern int get_atom_text(atom_t atom, PL_chars_t *text);
COMMON(int) get_string_text(atom_t atom, PL_chars_t *text ARG_LD);
extern char *format_float(double f, char *buf);
/**** stuff from pl-ctype.c ****/
extern IOENC initEncoding(void);
/**** stuff from pl-error.c ****/
extern int PL_get_bool_ex(term_t t, int *i);
extern int PL_get_chars_ex(term_t t, char **s, unsigned int flags);
extern int PL_get_integer_ex(term_t t, int *i);
extern int PL_get_module_ex(term_t t, module_t *m);
extern int PL_get_nchars_ex(term_t t, size_t *len, char **s, unsigned int flags);
extern int PL_get_long_ex(term_t t, long *i);
extern int PL_get_int64_ex(term_t t, int64_t *i);
extern int PL_get_intptr_ex(term_t t, intptr_t *i);
extern int PL_get_float_ex(term_t t, double *f);
extern int PL_get_char_ex(term_t t, int *p, int eof);
extern int PL_unify_list_ex(term_t l, term_t h, term_t t);
extern int PL_unify_nil_ex(term_t l);
extern int PL_get_list_ex(term_t l, term_t h, term_t t);
extern int PL_get_nil_ex(term_t l);
extern int PL_unify_bool_ex(term_t t, int val);
/**** stuff from pl-file.c ****/
extern void initIO(void);
extern void dieIO(void);
extern void protocol(const char *str, size_t n);
extern bool readLine(IOSTREAM *in, IOSTREAM *out, char *buffer);
extern bool tellString(char **s, size_t *size, IOENC enc);
extern bool tellString(char **s, size_t *size, IOENC enc);
extern bool toldString(void);
void closeFiles(int);
atom_t PrologPrompt(void);
word pl_exists_file(term_t name);
char *DirName(const char *f);
void outOfCore(void);
word pl_noprotocol(void);
IOSTREAM *PL_current_input(void);
IOSTREAM *PL_current_output(void);
COMMON(int) stricmp(const char *s1, const char *s2);
COMMON(word) textToString(PL_chars_t *text);
COMMON(int) reportStreamError(IOSTREAM *s);
extern int digitValue(int b, int c);
PL_EXPORT(int) PL_unify_stream(term_t t, IOSTREAM *s);
PL_EXPORT(int) PL_unify_stream_or_alias(term_t t, IOSTREAM *s);
PL_EXPORT(int) PL_get_stream_handle(term_t t, IOSTREAM **s);
PL_EXPORT(void) PL_write_prompt(int);
PL_EXPORT(int) PL_release_stream(IOSTREAM *s);
COMMON(atom_t) fileNameStream(IOSTREAM *s);
COMMON(int) streamStatus(IOSTREAM *s);
#define getOutputStream(t, k, s) getOutputStream__LD(t, k, s PASS_LD)
#define getTextOutputStream(t, s) getTextOutputStream__LD(t, s PASS_LD)
#define getBinaryOutputStream(t, s) getBinaryOutputStream__LD(t, s PASS_LD)
#define getInputStream(t, k, s) getInputStream__LD(t, k, s PASS_LD)
#define getTextInputStream(t, s) getTextInputStream__LD(t, s PASS_LD)
#define getBinaryInputStream(t, s) getBinaryInputStream__LD(t, s PASS_LD)
COMMON(int) getTextOutputStream__LD(term_t t, IOSTREAM **s ARG_LD);
COMMON(int) getBinaryOutputStream__LD(term_t t, IOSTREAM **s ARG_LD);
COMMON(int) getTextInputStream__LD(term_t t, IOSTREAM **s ARG_LD);
COMMON(int) getBinaryInputStream__LD(term_t t, IOSTREAM **s ARG_LD);
COMMON(void) pushOutputContext(void);
COMMON(void) popOutputContext(void);
COMMON(int) getSingleChar(IOSTREAM *s, int signals);
COMMON(void) prompt1(atom_t prompt);
COMMON(atom_t) encoding_to_atom(IOENC enc);
COMMON(int) pl_see(term_t f);
COMMON(int) pl_seen(void);
COMMON(int) unicode_separator(pl_wchar_t c);
COMMON(word) pl_raw_read(term_t term);
COMMON(word) pl_raw_read2(term_t stream, term_t term);
COMMON(access_level_t) setAccessLevel(access_level_t new_level);
/**** stuff from pl-error.c ****/
extern void outOfCore(void);
extern void fatalError(const char *fm, ...);
extern int callProlog(module_t module, term_t goal, int flags, term_t *ex);
extern word notImplemented(char *name, int arity);
/**** stuff from pl-ctype.c ****/
extern void initCharTypes(void);
/**** stuff from pl-fmt.c ****/
COMMON(word) pl_current_format_predicate(term_t chr, term_t descr,
control_t h);
COMMON(intptr_t) lengthList(term_t list, int errors);
COMMON(word) pl_format_predicate(term_t chr, term_t descr);
COMMON(word) pl_format(term_t fmt, term_t args);
COMMON(word) pl_format3(term_t s, term_t fmt, term_t args);
/**** stuff from pl-glob.c ****/
extern void initGlob(void);
/**** stuff from pl-os.c ****/
extern void cleanupOs(void);
extern void PL_clock_wait_ticks(long waited);
extern void setOSFeatures(void);
extern uintptr_t FreeMemory(void);
extern uint64_t _PL_Random(void);
extern void RemoveTemporaryFiles(void);
extern int Pause(real t);
char *findExecutable(const char *av0, char *buffer);
extern void setOSPrologFlags(void);
extern void setRandom(unsigned int *seedp);
extern char *canoniseFileName(char *path);
extern char *canonisePath(char *path);
extern void PL_changed_cwd(void);
extern struct tm *LocalTime(long *t, struct tm *r);
extern size_t getenv3(const char *name, char *buf, size_t len);
extern int Setenv(char *name, char *value);
extern int Unsetenv(char *name);
extern int System(char *cmd);
extern char *expandVars(const char *pattern, char *expanded, int maxlen);
PL_EXPORT(bool) ChDir(const char *X);
#if _WIN32 || defined(__MINGW32__)
PL_EXPORT(char *) BaseName(const char *X);
PL_EXPORT(char *) DirName(const char *f);
#else
#define BaseName basename
#define DirName dirname
#endif
PL_EXPORT(char *) OsPath(const char *X, char *Y);
#define DeleteTemporaryFile(F) RemoveFile(stringAtom(F))
PL_EXPORT(intptr_t) lengthList(term_t list, int errors);
PL_EXPORT(int) promoteToFloatNumber(Number n);
PL_EXPORT(char *) PrologPath(const char *ospath, char *plpath, size_t len);
PL_EXPORT(char *) ExpandOneFile(const char *spec, char *file);
PL_EXPORT(char *) AbsoluteFile(const char *spec, char *path);
PL_EXPORT(int) IsAbsolutePath(const char *p);
PL_EXPORT(char *) OsPath(const char *plpath, char *ospath);
PL_EXPORT(int) IsAbsolutePath(const char *spec);
PL_EXPORT(bool) sysError(const char *fm, ...);
PL_EXPORT(int) setDoubleQuotes(atom_t a, unsigned int *flagp);
PL_EXPORT(int) getAccessLevelMask(atom_t a, access_level_t *val);
/**** SWI stuff (emulated in pl-yap.c) ****/
extern int writeAtomToStream(IOSTREAM *so, atom_t at);
extern int valueExpression(term_t t, Number r ARG_LD);
extern Atom lookupAtom(const char *s, size_t len);
extern Atom lookupUCSAtom(const pl_wchar_t *s, size_t len);
extern int toIntegerNumber(Number n, int flags);
extern int get_atom_ptr_text(Atom a, PL_chars_t *text);
extern int warning(const char *fm, ...);
/**** stuff from pl-files.c ****/
void initFiles(void);
int RemoveFile(const char *path);
int PL_get_file_name(term_t n, char **namep, int flags);
PL_EXPORT(int) PL_get_file_nameW(term_t n, wchar_t **name, int flags);
COMMON(int) unifyTime(term_t t, time_t time);
COMMON(char) digitName(int n, int sm);
/**** stuff from pl-utf8.c ****/
size_t utf8_strlen(const char *s, size_t len);
/**** stuff from pl-version.c ****/
COMMON(void) setGITVersion(void);
/**** stuff from pl-write.c ****/
COMMON(char *) varName(term_t var, char *buf);
COMMON(int) writeUCSAtom(IOSTREAM *fd, atom_t atom, int flags);
COMMON(word) pl_nl1(term_t stream);
COMMON(word) pl_nl(void);
COMMON(int) writeAttributeMask(atom_t name);
COMMON(word) pl_write_term(term_t term, term_t options);
COMMON(word) pl_write_term3(term_t stream,
term_t term, term_t options);
COMMON(word) pl_print(term_t term);
COMMON(word) pl_write2(term_t stream, term_t term);
COMMON(word) pl_writeq2(term_t stream, term_t term);
COMMON(word) pl_print2(term_t stream, term_t term);
COMMON(word) pl_writeln(term_t term);
COMMON(word) pl_write_canonical2(term_t stream, term_t term);
/* empty stub */
extern void setPrologFlag(const char *name, int flags, ...);
extern int PL_set_prolog_flag(const char *name, int flags, ...);
extern install_t PL_install_readline(void);
COMMON(int) saveWakeup(wakeup_state *state, int forceframe ARG_LD);
COMMON(void) restoreWakeup(wakeup_state *state ARG_LD);
COMMON(int) priorityOperator(Module m, atom_t atom);
COMMON(int) currentOperator(Module m, atom_t name, int kind,
int *type, int *priority);
COMMON(int) numberVars(term_t t, nv_options *opts, int n ARG_LD);
COMMON(Buffer) codes_or_chars_to_buffer(term_t l, unsigned int flags,
int wide, CVT_result *status);
COMMON(bool) systemMode(bool accept);
COMMON(void) cleanupPrologFlags(void);
COMMON(void) initPrologFlags(void);
COMMON(int) raiseStackOverflow(int overflow);
COMMON(int) PL_qualify(term_t raw, term_t qualified);
static inline word
setBoolean(bool *flag, term_t old, term_t new)
{ int fl = *flag; if ( !PL_unify_bool_ex(old, fl) ||
!PL_get_bool_ex(new, &fl) )
fail;
*flag = fl;
succeed;
}
#define BEGIN_NUMBERVARS(save) \
{ fid_t _savedf; \
if ( save ) \
{ _savedf = LD->var_names.numbervars_frame; \
LD->var_names.numbervars_frame = PL_open_foreign_frame(); \
}
#define END_NUMBERVARS(save) \
if ( save ) \
{ PL_discard_foreign_frame(LD->var_names.numbervars_frame); \
LD->var_names.numbervars_frame = _savedf; \
} \
}
COMMON(int) f_is_prolog_var_start(wint_t c);
COMMON(int) f_is_prolog_atom_start(wint_t c);
COMMON(int) f_is_prolog_identifier_continue(wint_t c);
COMMON(int) f_is_prolog_symbol(wint_t c);
COMMON(int) _PL_get_arg__LD(int index, term_t t, term_t a ARG_LD);
COMMON(int) PL_get_atom__LD(term_t t1, atom_t *a ARG_LD);
COMMON(int) PL_get_atom_ex__LD(term_t t, atom_t *a ARG_LD);
COMMON(int) PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD);
COMMON(int) PL_is_atom__LD(term_t t ARG_LD);
COMMON(int) PL_is_variable__LD(term_t t ARG_LD);
COMMON(term_t) PL_new_term_ref__LD(ARG1_LD);
COMMON(int) PL_put_atom__LD(term_t t, atom_t a ARG_LD);
COMMON(int) PL_put_term__LD(term_t t1, term_t t2 ARG_LD);
COMMON(int) PL_unify__LD(term_t t1, term_t t2 ARG_LD);
COMMON(int) PL_unify_atom__LD(term_t t, atom_t a ARG_LD);
COMMON(int) PL_unify_int64__LD(term_t t1, int64_t ARG_LD);
COMMON(int) PL_unify_int64_ex__LD(term_t t1, int64_t ARG_LD);
COMMON(int) PL_unify_integer__LD(term_t t1, intptr_t i ARG_LD);
COMMON(word) pl_get_prolog_flag(term_t key, term_t value);
COMMON(word) pl_prolog_flag5(term_t key, term_t value, word scope, word access, word type, control_t h);
COMMON(foreign_t) pl_prolog_flag(term_t name, term_t value, control_t h);
COMMON(struct tm *) PL_localtime_r(const time_t *t, struct tm *r);
COMMON(char *) PL_asctime_r(const struct tm *tm, char *buf);
#define PL_unify(t1, t2) PL_unify__LD(t1, t2 PASS_LD)
#define PL_unify_int64(t, i) PL_unify_int64__LD(t, i PASS_LD)
#define PL_unify_int64_ex(t, i) PL_unify_int64_ex__LD(t, i PASS_LD)
static inline int
PL_unify_time(term_t t, time_t time) {
GET_LD
return PL_unify_int64(t, (int64_t)time);
}
/* inlines that need ARG_LD */
static inline intptr_t
skip_list(Word l, Word *tailp ARG_LD) {
return (intptr_t)YAP_SkipList(l, tailp);
}
static inline word
valHandle__LD(term_t r ARG_LD)
{
return (word)YAP_GetFromSlot((Int)r);
}
static inline void *allocHeap__LD(size_t n ARG_LD)
{
return YAP_AllocSpaceFromYap(n);
}
static inline void *allocHeapOrHalt(size_t n)
{
void *ptr = YAP_AllocSpaceFromYap(n);
if (!ptr) Yap_exit(1);
return ptr;
}
static inline void freeHeap(void *mem, size_t n)
{
YAP_FreeSpaceFromYap(mem);
}
extern void unallocStream(IOSTREAM *s);
extern atom_t accessLevel(void);
int currentBreakLevel(void);
#ifdef __WINDOWS__
int hasConsole(void);
int PL_wait_for_console_input(void *handle);
void PlMessage(const char *fm, ...);
const char *WinError(void);
word pl_win_exec(term_t cmd, term_t how);
foreign_t pl_win_module_file(term_t module, term_t file);
int PL_w32_wrap_ansi_console(void);
#ifdef EMULATE_DLOPEN
/* file is in UTF-8, POSIX path */
void *dlopen(const char *file, int flags);
const char *dlerror(void);
void *dlsym(void *handle, char *symbol);
int dlclose(void *handle);
#endif
int ms_snprintf(char *buffer, size_t count, const char *fmt, ...);
void getDefaultsFromRegistry(void);
DWORD RunSilent(const char* strCommand);
FILE *pt_popen(const char *cmd, const char *mode);
int pt_pclose(FILE *fd);
int PL_w32thread_raise(DWORD id, int sig);
#endif
extern const PL_extension PL_predicates_from_ctype[];
extern const PL_extension PL_predicates_from_file[];
extern const PL_extension PL_predicates_from_files[];
extern const PL_extension PL_predicates_from_glob[];
extern const PL_extension PL_predicates_from_read[];
extern const PL_extension PL_predicates_from_tai[];
extern const PL_extension PL_predicates_from_write[];
extern const PL_extension PL_predicates_from_prologflag[];
extern const PL_extension PL_predicates_from_win[];
extern const PL_extension PL_predicates_from_locale[];
extern const PL_extension PL_predicates_from_system[];
#define enableThreads(val) FALSE
#endif

1331
library/dialect/swi/os/pl-prologflag.c Executable file
View File

File diff suppressed because it is too large Load Diff

358
library/dialect/swi/os/pl-shared.h Executable file
View File

@@ -0,0 +1,358 @@
#ifndef PL_SHARED_H
#define PL_SHARED_H
#include "pl-types.h"
#ifndef __WINDOWS__
#if defined(_MSC_VER) || defined(__MINGW32__) || defined(__MSYS__)
#define __WINDOWS__ 1
#endif
#endif
#if !defined(O_PLMT) && !defined(YAPOR)
#define LOCAL_LD (GLOBAL_LD)
#define LD (GLOBAL_LD)
#define ARG1_LD void
#define ARG_LD
#define GET_LD
#define PRED_LD
#define PASS_LD
#define PASS_LD1
#define IGNORE_LD
#define REGS_FROM_LD
#define LD_FROM_REGS
#else
#define LOCAL_LD (__PL_ld)
#define LD LOCAL_LD
#define GET_LD CACHE_REGS struct PL_local_data *__PL_ld = GLOBAL_LD;
#define ARG1_LD struct PL_local_data *__PL_ld
#define ARG_LD , ARG1_LD
#define PASS_LD1 LD
#define PASS_LD , LD
#define PRED_LD GET_LD
#define IGNORE_LD (void)__PL_ld;
#define REGS_FROM_LD struct regstore_t *regcache = __PL_ld->reg_cache;
#define LD_FROM_REGS struct PL_local_data *__PL_ld = LOCAL_PL_local_data_p;
#endif
Atom YAP_AtomFromSWIAtom(atom_t at);
atom_t YAP_SWIAtomFromAtom(Atom at);
static inline Term
OpenList(int n USES_REGS)
{
Term t;
BACKUP_H();
while (HR+2*n > ASP-1024) {
if (!Yap_dogc( 0, (Term *)NULL PASS_REGS )) {
RECOVER_H();
return FALSE;
}
}
t = AbsPair(HR);
HR += 2*n;
RECOVER_H();
return t;
}
static inline Term
ExtendList(Term t0, Term inp)
{
Term t;
CELL *ptr = RepPair(t0);
BACKUP_H();
ptr[0] = inp;
ptr[1] = AbsPair(ptr+2);
t = AbsPair(ptr+2);
RECOVER_H();
return t;
}
static inline int
CloseList(Term t0, Term tail)
{
CELL *ptr = RepPair(t0);
RESET_VARIABLE(ptr-1);
if (!Yap_unify((Term)(ptr-1), tail))
return FALSE;
return TRUE;
}
#ifndef __YAP_PROLOG__
#include <assert.h>
// SWI stuff that is needed everywhere
#ifndef __unix__
#if defined(_AIX) || defined(__APPLE__) || defined(__unix) || defined(__BEOS__) || defined(__NetBSD__)
#define __unix__ 1
#endif
#endif
#ifndef PL_CONSOLE
#define PL_KERNEL 1
#endif
// SWI Options
#define O_STRING 1
#define O_QUASIQUOTATIONS 1
#if HAVE_LOCALE_H && HAVE_SETLOCALE
//#define O_LOCALE 1
#endif
//#define O_ATOMGC 1
//#define O_CLAUSEGC 1
#ifdef HAVE_GMP_H
#define O_GMP 1
#endif
#ifdef __WINDOWS__
#define NOTTYCONTROL TRUE
#define O_DDE 1
#define O_DLL 1
#define O_HASDRIVES 1
#define O_HASSHARES 1
#define O_XOS 1
#define O_RLC 1
#define EMULATE_DLOPEN 1
#endif
#ifdef THREADS
#define O_PLMT 1
#else
#ifdef _REENTRANT
#undef _REENTRANT
#endif
#endif
//#include <SWI-Stream.h>
#include <SWI-Prolog.h>
#define COMMON(X) extern X
#if defined(__GNUC__) && !defined(MAY_ALIAS)
#define MAY_ALIAS __attribute__ ((__may_alias__))
#else
#define MAY_ALIAS
#endif
#ifndef PL_HAVE_TERM_T
#define PL_HAVE_TERM_T
typedef uintptr_t term_t;
#endif
#if _WIN32
#ifndef THREADS
#ifndef WIN_PTHREADS_H
typedef int pthread_t;
#endif
#endif
#endif
typedef uintptr_t word; /* Anonymous 4 byte object */
#define GLOBAL_LD (LOCAL_PL_local_data_p)
/*******************************
* STREAM I/O *
*******************************/
#define REDIR_MAGIC 0x23a9bef3
typedef struct redir_context
{ int magic; /* REDIR_MAGIC */
struct io_stream *stream; /* temporary output */
int is_stream; /* redirect to stream */
int redirected; /* output is redirected */
term_t term; /* redirect target */
int out_format; /* output type */
int out_arity; /* 2 for difference-list versions */
size_t size; /* size of I/O buffer */
char *data; /* data written */
char buffer[1024]; /* fast temporary buffer */
} redir_context;
#include "pl-file.h"
#define EOS '\0'
/********************************
* HASH TABLES *
*********************************/
#include "pl-table.h"
/********************************
* BUFFERS *
*********************************/
#define BUFFER_RING_SIZE 16 /* foreign buffer ring (pl-fli.c) */
#include "pl-buffer.h"
typedef struct canonical_dir * CanonicalDir; /* pl-os.c */
typedef struct
{ char *state; /* system's boot file */
char *startup; /* default user startup file */
int local; /* default local stack size (K) */
int global; /* default global stack size (K) */
int trail; /* default trail stack size (K) */
char *goal; /* default initialisation goal */
char *toplevel; /* default top level goal */
bool notty; /* use tty? */
char *arch; /* machine/OS we are using */
char *home; /* systems home directory */
} pl_defaults_t;
typedef struct on_halt * OnHalt; /* pl-os.c */
typedef struct extension_cell * ExtensionCell; /* pl-ext.c */
typedef struct tempfile * TempFile; /* pl-os.c */
typedef struct initialise_handle * InitialiseHandle;
/********************************
* Operating System *
*********************************/
#include "pl-os.h"
/********************************
* Table *
*********************************/
#include "pl-table.h"
/********************************
* LOCALE *
*********************************/
#include "pl-locale.h" /* Locale objects */
/********************************
* GLOBALS *
*********************************/
/* vsc: global variables */
#include "pl-global.h"
// THIS HAS TO BE ABSTRACTED
#ifndef YAP_CPP_INTERFACE
#define True(s, a) ((s)->flags & (a))
#define False(s, a) (!True((s), (a)))
#define set(s, a) ((s)->flags |= (a))
#define clear(s, a) ((s)->flags &= ~(a))
#endif
#define P_QUASI_QUOTATION_SYNTAX (0x00000004) /* <![Type[Quasi Quote]]> */
#define PLFLAG_CHARESCAPE 0x000001 /* handle \ in atoms */
#define PLFLAG_GC 0x000002 /* do GC */
#define PLFLAG_TRACE_GC 0x000004 /* verbose gc */
#define PLFLAG_TTY_CONTROL 0x000008 /* allow for tty control */
#define PLFLAG_READLINE 0x000010 /* readline is loaded */
#define PLFLAG_DEBUG_ON_ERROR 0x000020 /* start tracer on error */
#define PLFLAG_REPORT_ERROR 0x000040 /* print error message */
#define PLFLAG_FILE_CASE 0x000080 /* file names are case sensitive */
#define PLFLAG_FILE_CASE_PRESERVING 0x000100 /* case preserving file names */
#define PLFLAG_DOS_FILE_NAMES 0x000200 /* dos (8+3) file names */
#define ALLOW_VARNAME_FUNCTOR 0x000400 /* Read Foo(x) as 'Foo'(x) */
#define PLFLAG_ISO 0x000800 /* Strict ISO compliance */
#define PLFLAG_OPTIMISE 0x001000 /* -O: optimised compilation */
#define PLFLAG_FILEVARS 0x002000 /* Expand $var and ~ in filename */
#define PLFLAG_AUTOLOAD 0x004000 /* do autoloading */
#define PLFLAG_CHARCONVERSION 0x008000 /* do character-conversion */
#define PLFLAG_LASTCALL 0x010000 /* Last call optimization enabled? */
#define PLFLAG_EX_ABORT 0x020000 /* abort with exception */
#define PLFLAG_BACKQUOTED_STRING 0x040000 /* `a string` */
#define PLFLAG_SIGNALS 0x080000 /* Handle signals */
#define PLFLAG_DEBUGINFO 0x100000 /* generate debug info */
#define PLFLAG_FILEERRORS 0x200000 /* Edinburgh file errors */
#define PLFLAG_WARN_OVERRIDE_IMPLICIT_IMPORT 0x200000 /* Warn overriding weak symbols */
#define PLFLAG_QUASI_QUOTES 0x400000 /* Support quasi quotes */
/* Flags on module. Most of these flags are copied to the read context
in pl-read.c.
*/
#ifndef M_SYSTEM
#define M_SYSTEM (0x0001) /* system module */
#define M_CHARESCAPE (0x0002) /* module */
#define DBLQ_CHARS (0x0004) /* "ab" --> ['a', 'b'] */
#define DBLQ_ATOM (0x0008) /* "ab" --> 'ab' */
#define DBLQ_STRING (0x0010) /* "ab" --> "ab" */
#define DBLQ_MASK (DBLQ_CHARS|DBLQ_ATOM|DBLQ_STRING)
#define UNKNOWN_FAIL (0x0020) /* module */
#define UNKNOWN_WARNING (0x0040) /* module */
#define UNKNOWN_ERROR (0x0080) /* module */
#define UNKNOWN_MASK (UNKNOWN_ERROR|UNKNOWN_WARNING|UNKNOWN_FAIL)
#endif
extern unsigned int
getUnknownModule(module_t m);
/* keep in sync with style_name/1 in boot/prims.pl */
#define LONGATOM_CHECK 0x0001 /* read/1: error on intptr_t atoms */
#define SINGLETON_CHECK 0x0002 /* read/1: check singleton vars */
#define MULTITON_CHECK 0x0004 /* read/1: check multiton vars */
#define DISCONTIGUOUS_STYLE 0x0008 /* warn on discontiguous predicates */
#define DYNAMIC_STYLE 0x0010 /* warn on assert/retract active */
#define CHARSET_CHECK 0x0020 /* warn on unquoted characters */
#define SEMSINGLETON_CHECK 0x0040 /* Semantic singleton checking */
#define NOEFFECT_CHECK 0x0080 /* Check for meaningless statements */
#define VARBRANCH_CHECK 0x0100 /* warn on unbalanced variables */
#define MULTIPLE_CHECK 0x0200 /* warn on multiple file definitions for a predicate */
#define MAXNEWLINES 5 /* maximum # of newlines in atom */
#define debugstatus (LD->_debugstatus)
#define truePrologFlag(flag) True(&LD->prolog_flag.mask, flag)
#define setPrologFlagMask(flag) set(&LD->prolog_flag.mask, flag)
#define clearPrologFlagMask(flag) clear(&LD->prolog_flag.mask, flag)
#ifndef YAP_CPP_INTERFACE
COMMON(int) debugmode(debug_type newp, debug_type *old);
COMMON(int) tracemode(debug_type newp, debug_type *old);
#endif
COMMON(void) Yap_setCurrentSourceLocation( void *rd );
#define SIG_PROLOG_OFFSET 32 /* Start of Prolog signals */
#define SIG_EXCEPTION (SIG_PROLOG_OFFSET+0)
#ifdef O_ATOMGC
#define SIG_ATOM_GC (SIG_PROLOG_OFFSET+1)
#endif
#define SIG_GC (SIG_PROLOG_OFFSET+2)
#ifdef O_PLMT
#define SIG_THREAD_SIGNAL (SIG_PROLOG_OFFSET+3)
#endif
#define SIG_FREECLAUSES (SIG_PROLOG_OFFSET+4)
#define SIG_PLABORT (SIG_PROLOG_OFFSET+5)
extern int raiseSignal(PL_local_data_t *ld, int sig);
#endif /* YAP codee */
#endif /* PL_SHARED_INCLUDE */

82
library/dialect/swi/os/pl-utf8.h Normal file
View File

@@ -0,0 +1,82 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker and Anjo Anjewierden
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#ifndef UTF8_H_INCLUDED
#define UTF8_H_INCLUDED
#include <wchar.h>
#define PL_MB_LEN_MAX 16
#define UTF8_MALFORMED_REPLACEMENT 0xfffd
#define ISUTF8_MB(c) ((unsigned)(c) >= 0xc0 && (unsigned)(c) <= 0xfd)
#define ISUTF8_CB(c) (((c)&0xc0) == 0x80) /* Is continuation byte */
#define ISUTF8_FB2(c) (((c)&0xe0) == 0xc0)
#define ISUTF8_FB3(c) (((c)&0xf0) == 0xe0)
#define ISUTF8_FB4(c) (((c)&0xf8) == 0xf0)
#define ISUTF8_FB5(c) (((c)&0xfc) == 0xf8)
#define ISUTF8_FB6(c) (((c)&0xfe) == 0xfc)
#define UTF8_FBN(c) (!(c&0x80) ? 0 : \
ISUTF8_FB2(c) ? 1 : \
ISUTF8_FB3(c) ? 2 : \
ISUTF8_FB4(c) ? 3 : \
ISUTF8_FB5(c) ? 4 : \
ISUTF8_FB6(c) ? 5 : -1)
#define UTF8_FBV(c,n) ( n == 0 ? c : (c & ((0x01<<(6-n))-1)) )
#define utf8_get_char(in, chr) \
(*(in) & 0x80 ? _PL__utf8_get_char(in, chr) \
: (*(chr) = *(in), (char *)(in)+1))
#define utf8_skip_char(in) \
(*(in) & 0x80 ? _PL__utf8_skip_char(in) \
: (char *)(in)+1)
#define utf8_put_char(out, chr) \
((chr) < 0x80 ? out[0]=(char)(chr), out+1 \
: _PL__utf8_put_char(out, (chr)))
extern char *_PL__utf8_get_char(const char *in, int *chr);
extern char *_PL__utf8_put_char(char *out, int chr);
extern char *_PL__utf8_skip_char(const char *out);
extern size_t utf8_strlen(const char *s, size_t len);
extern size_t utf8_strlen1(const char *s);
extern const char * utf8_skip(const char *s, int n);
extern int utf8_strncmp(const char *s1, const char *s2, size_t n);
extern int utf8_strprefix(const char *s1, const char *s2);
/// copy a wide string to an UTF-8 version.
extern char *utf8_wcscpy(char *sf, const wchar_t *s0);
typedef enum {
S_ASCII,
S_LATIN,
S_WIDE
} unicode_type_t;
extern unicode_type_t _PL__utf8_type(const char *in0, size_t len);
#endif /*UTF8_H_INCLUDED*/

239
library/dialect/swi/os/pl-yap.h Normal file
View File

@@ -0,0 +1,239 @@
#ifndef PL_YAP_H
#define PL_YAP_H
#ifdef __YAP_PROLOG__
#include "Yatom.h"
#include <libgen.h>
/* depends on tag schema, but 4 should always do */
#define LMASK_BITS 4 /* total # mask bits */
#if HAVE_CTYPE_H
#include <ctype.h>
#endif
#if HAVE_SYS_STAT_H
#include <sys/stat.h>
#endif
#define SIZE_VOIDP SIZEOF_INT_P
#if SIZEOF_LONG_INT==4
#define INT64_FORMAT "%lld"
#else
#define INT64_FORMAT "%ld"
#endif
#define INTBITSIZE (sizeof(int)*8)
typedef module_t Module;
typedef Term (*Func)(term_t); /* foreign functions */
extern const char *Yap_GetCurrentPredName(void);
extern Int Yap_GetCurrentPredArity(void);
extern term_t Yap_fetch_module_for_format(term_t args, Term *modp);
extern void Yap_setCurrentSourceLocation( void *rd );
extern void *Yap_GetStreamHandle(Atom at);
extern void Yap_WriteAtom(IOSTREAM *s, Atom atom);
extern atom_t codeToAtom(int chrcode);
#define valTermRef(t) ((Word)Yap_AddressFromSlot(t))
#include "pl-codelist.h"
//move this to SWI
#define GP_CREATE 2 /* create (in this module) */
#ifndef HAVE_MBSCOLL
COMMON(int) mbscoll(const char *s1, const char *s2);
#endif
#ifndef HAVE_MBSCASECOLL
COMMON(int) mbscasecoll(const char *s1, const char *s2);
#endif
COMMON(atom_t) TemporaryFile(const char *id, int *fdp);
COMMON(char *) Getenv(const char *, char *buf, size_t buflen);
/*** memory allocation stuff: SWI wraps around malloc */
#define stopItimer()
COMMON(word) pl_print(term_t term);
COMMON(word) pl_write(term_t term);
COMMON(word) pl_write_canonical(term_t term);
COMMON(word) pl_write_term(term_t term, term_t options);
COMMON(word) pl_writeq(term_t term);
static inline int
get_procedure(term_t descr, predicate_t *proc, term_t he, int f) {
CACHE_REGS
Term t = Yap_GetFromSlot(descr );
if (IsVarTerm(t)) return FALSE;
if (IsAtomTerm(t))
*proc = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t),CurrentModule));
else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (IsExtensionFunctor(f)) {
return FALSE;
}
*proc = RepPredProp(Yap_GetPredPropByFunc(f, CurrentModule));
}
return TRUE;
}
/* TBD */
extern word globalString(size_t size, char *s);
extern word globalWString(size_t size, wchar_t *s);
#define allocHeap(n) allocHeap__LD(n PASS_LD)
#define valHandle(r) valHandle__LD(r PASS_LD)
Int YAP_PLArityOfSWIFunctor(functor_t f);
struct PL_blob_t* YAP_find_blob_type(Atom at);
void PL_license(const char *license, const char *module);
#define arityFunctor(f) YAP_PLArityOfSWIFunctor(f)
#define stringAtom(w) (YAP_AtomFromSWIAtom(w)->StrOfAE)
#define isInteger(A) (!IsVarTerm(A) && ( IsIntegerTerm((A)) || YAP_IsBigNumTerm((A)) ))
#define isString(A) (!IsVarTerm(A) && IsStringTerm(A) )
#define isAtom(A) (!IsVarTerm(A) && IsAtomTerm((A)) )
#define isList(A) (!IsVarTerm(A) && IsPairTerm((A)) )
#define isNil(A) ((A) == TermNil)
#define isReal(A) (!IsVarTerm(A) && IsFloatTerm((A)) )
#define isFloat(A) (!IsVarTerm(A) && IsFloatTerm((A)) )
#define isVar(A) IsVarTerm((A))
#define valReal(w) FloatOfTerm((w))
#define valFloat(w) FloatOfTerm((w))
#define atomValue(atom) AtomOfTerm(atom)
#define atomFromTerm(term) YAP_SWIAtomFromAtom(AtomOfTerm(term))
inline static char *
atomName(Atom atom)
{
if (IsWideAtom(atom))
return (char *)(atom->WStrOfAE);
return atom->StrOfAE;
}
#define nameOfAtom(atom) nameOfAtom(atom)
#define atomBlobType(at) YAP_find_blob_type(at)
#define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i))))
#define deRef(t) while (IsVarTerm(*(t)) && !IsUnboundVar(t)) { t = (CELL *)(*(t)); }
#define canBind(t) FALSE // VSC: to implement
#define _PL_predicate(A,B,C,D) PL_predicate(A,B,C)
#define predicateHasClauses(pe) ((pe)->cs.p_code.NOfClauses != 0)
#define lookupModule(A) Yap_GetModuleEntry(MkAtomTerm(YAP_AtomFromSWIAtom(A)))
Procedure resolveProcedure(functor_t f, Module module);
#define charEscapeWriteOption(A) FALSE // VSC: to implement
#define wordToTermRef(A) Yap_InitSlot(*(A))
#define isTaggedInt(A) IsIntegerTerm(A)
#define valInt(A) IntegerOfTerm(A)
#define MODULE_user Yap_GetModuleEntry(MkAtomTerm(Yap_LookupAtom("user")))
#define MODULE_system Yap_GetModuleEntry(MkAtomTerm(Yap_LookupAtom("system")))
#define MODULE_parse Yap_GetModuleEntry(LOCAL_SourceModule)
extern term_t Yap_CvtTerm(term_t ts);
#define clearNumber(n)
wchar_t *nameOfWideAtom(atom_t atom);
int isWideAtom(atom_t atom);
inline static int
charCode(Term w)
{ if ( IsAtomTerm(w) )
{
Atom a = atomValue(w);
if (IsWideAtom(a)) {
if (wcslen(a->WStrOfAE) == 1)
return a->WStrOfAE[0];
return -1;
}
if (strlen(a->StrOfAE) == 1)
return ((unsigned char *)(a->StrOfAE))[0];
return -1;
}
return -1;
}
#define PL_get_atom(t, a) PL_get_atom__LD(t, a PASS_LD)
#define PL_get_atom_ex(t, a) PL_get_atom_ex__LD(t, a PASS_LD)
#define PL_get_text(l, t, f) PL_get_text__LD(l, t, f PASS_LD)
#define PL_is_atom(t) PL_is_atom__LD(t PASS_LD)
#define PL_is_variable(t) PL_is_variable__LD(t PASS_LD)
#define PL_new_term_ref() PL_new_term_ref__LD(PASS_LD1)
#define PL_put_atom(t, a) PL_put_atom__LD(t, a PASS_LD)
#define PL_put_term(t1, t2) PL_put_term__LD(t1, t2 PASS_LD)
#define PL_unify_atom(t, a) PL_unify_atom__LD(t, a PASS_LD)
#define PL_unify_integer(t, i) PL_unify_integer__LD(t, i PASS_LD)
#define _PL_get_arg(i, t, a) _PL_get_arg__LD(i, t, a PASS_LD);
#endif /* __YAP_PROLOG__ */
unsigned int getUnknownModule(module_t m);
#if IN_PL_OS_C
static int
stripostfix(const char *s, const char *e)
{ size_t ls = strlen(s);
size_t le = strlen(e);
if ( ls >= le )
return strcasecmp(&s[ls-le], e) == 0;
return FALSE;
}
#endif
#if HAVE_SIGPROCMASK
#if HAVE_SIGNAL_H
#include <signal.h>
#endif
static inline void
unblockSignal(int sig)
{ sigset_t set;
sigemptyset(&set);
sigaddset(&set, sig);
sigprocmask(SIG_UNBLOCK, &set, NULL);
// DEBUG(1, Sdprintf("Unblocked signal %d\n", sig));
}
#else
static inline void
unblockSignal(int sig)
{
}
#endif
#define suspendTrace(x)
atom_t ATOM_;
#if THREADS
intptr_t system_thread_id(void);
#endif
extern Term Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio,Term *bindingsp);
#endif /* PL_YAP_H */