Merge branch 'master' of github.com:vscosta/yap-6.3

This commit is contained in:
Vitor Santos Costa 2016-02-03 10:17:01 +00:00
commit c8305988ca
173 changed files with 6345 additions and 6576 deletions

5
.gitignore vendored
View File

@ -135,4 +135,7 @@ build
Debug
debug
Release
Build
Build
xcode
Threads
mxe

View File

@ -1062,6 +1062,39 @@ interrupt_pexecute( PredEntry *pen USES_REGS )
return interrupt_handler( pen PASS_REGS );
}
static void
execute_dealloc( USES_REGS1 )
{
/* other instructions do depend on S being set by deallocate
:-( */
CELL *ENV_YREG = YENV;
S = ENV_YREG;
CP = (yamop *) ENV_YREG[E_CP];
ENV = ENV_YREG = (CELL *) ENV_YREG[E_E];
#ifdef DEPTH_LIMIT
DEPTH = ENV_YREG[E_DEPTH];
#endif /* DEPTH_LIMIT */
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA
if (ENV_YREG > (CELL *) top_b || ENV_YREG < HR) ENV_YREG = (CELL *) top_b;
#else
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
#endif /* YAPOR_SBA */
else ENV_YREG = (CELL *)((CELL) ENV_YREG + ENV_Size(CP));
}
#else
if (ENV_YREG > (CELL *) B)
ENV_YREG = (CELL *) B;
else
ENV_YREG = (CELL *) ((CELL) ENV_YREG + ENV_Size(CP));
#endif /* FROZEN_STACKS */
YENV = ENV_YREG;
P = NEXTOP(P,p);
}
/* don't forget I cannot creep at deallocate (where to?) */
/* also, this is unusual in that I have already done deallocate,
so I don't need to redo it.
@ -1085,6 +1118,7 @@ interrupt_deallocate( USES_REGS1 )
/* keep on going if there is something else */
(P->opc != Yap_opcode(_procceed) &&
P->opc != Yap_opcode(_cut_e))) {
execute_dealloc( PASS_REGS1 );
return 1;
} else {
CELL cut_b = LCL0-(CELL *)(S[E_CB]);

View File

@ -1100,7 +1100,7 @@ atom_concat2( USES_REGS1 )
error:
/* Error handling */
if (LOCAL_Error_TYPE) {
if (Yap_HandleError( "string_code/3" )) {
if (Yap_HandleError( "atom_concat/2" )) {
goto restart_aux;
} else {
return FALSE;

View File

@ -35,6 +35,7 @@ char * Yap_blob_to_string(AtomEntry *ref, const char *s0, size_t sz)
char *s = (char *)s0;
blob_type_t *type = RepBlobProp(ref->PropsOfAE)->blob_type;
#if HAVE_FMEMOPEN
if (type->write) {
FILE *f = fmemopen( s, sz, "w");
if (f == NULL){
@ -49,6 +50,7 @@ char * Yap_blob_to_string(AtomEntry *ref, const char *s0, size_t sz)
fclose(f); // return the final result.
return s;
} else {
#endif
#if __APPLE__
size_t sz0 = strlcpy( s, (char *)RepAtom( AtomSWIStream )->StrOfAE, sz);
#else
@ -65,8 +67,10 @@ char * Yap_blob_to_string(AtomEntry *ref, const char *s0, size_t sz)
snprintf(s+strlen(s), sz0, "(0x%p)", ref);
#endif
return s;
}
#if HAVE_FMEMOPEN
}
return NULL;
#endif
}
int Yap_write_blob(AtomEntry *ref, FILE *stream)

View File

@ -1,332 +1,20 @@
/************************************************************************* *
* YAP Prolog *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.Santos Costa and Universidade do Porto 1985-- *
* *
**************************************************************************
* *
* File: c_interface.c *
* comments: c_interface primitives definition *
* *
* Last rev: $Date: 2008-08-07 20:51:21 $,$Author: vsc $
**
* $Log: not supported by cvs2svn $
* Revision 1.122 2008/08/01 21:44:24 vsc
* swi compatibility support
*
* Revision 1.121 2008/07/24 16:02:00 vsc
* improve C-interface and SWI comptaibility a bit.
*
* Revision 1.120 2008/07/11 17:02:07 vsc
* fixes by Bart and Tom: mostly libraries but nasty one in indexing
* compilation.
*
* Revision 1.119 2008/06/17 13:37:48 vsc
* fix c_interface not to crash when people try to recover slots that are
* not there.
* fix try_logical and friends to handle case where predicate has arity 0.
*
* Revision 1.118 2008/06/04 14:47:18 vsc
* make sure we do trim_trail whenever we mess with B!cfc
*
* Revision 1.117 2008/06/04 13:58:36 vsc
* more fixes to C-interface
*
* Revision 1.116 2008/04/28 23:02:32 vsc
* fix bug in current_predicate/2
* fix bug in c_interface.
*
* Revision 1.115 2008/04/11 16:30:27 ricroc
* *** empty log message ***
*
* Revision 1.114 2008/04/04 13:35:41 vsc
* fix duplicate dependency frame at entry
*
* Revision 1.113 2008/04/04 09:10:02 vsc
* restore was restoring twice
*
* Revision 1.112 2008/04/03 13:26:38 vsc
* protect signal handling with locks for threaded version.
* fix close/1 entry in manual (obs from Nicos).
* fix -f option in chr Makefile.
*
* Revision 1.111 2008/04/02 21:44:07 vsc
* threaded version should ignore saved states (for now).
*
* Revision 1.110 2008/04/02 17:37:06 vsc
* handle out of memory error at thread creation (obs from Paulo Moura).
*
* Revision 1.109 2008/04/01 15:31:41 vsc
* more saved state fixes
*
* Revision 1.108 2008/03/22 23:35:00 vsc
* fix bug in all_calls
*
* Revision 1.107 2008/03/13 18:41:50 vsc
* -q flag
*
* Revision 1.106 2008/02/12 17:03:50 vsc
* SWI-portability changes
*
* Revision 1.105 2008/01/28 10:42:19 vsc
* fix BOM trouble
*
* Revision 1.104 2007/12/05 12:17:23 vsc
* improve JT
* fix graph compatibility with SICStus
* re-export declaration.
*
* Revision 1.103 2007/11/16 14:58:40 vsc
* implement sophisticated operations with matrices.
*
* Revision 1.102 2007/11/01 20:50:31 vsc
* fix YAP_LeaveGoal (again)
*
* Revision 1.101 2007/10/29 22:48:54 vsc
* small fixes
*
* Revision 1.100 2007/10/28 00:54:09 vsc
* new version of viterbi implementation
* fix all:atvars reporting bad info
* fix bad S info in x86_64
*
* Revision 1.99 2007/10/16 18:57:17 vsc
* get rid of debug statement.
*
* Revision 1.98 2007/10/15 23:48:46 vsc
* unset var
*
* Revision 1.97 2007/10/05 18:24:30 vsc
* fix garbage collector and fix LeaveGoal
*
* Revision 1.96 2007/09/04 10:34:54 vsc
* Improve SWI interface emulation.
*
* Revision 1.95 2007/06/04 12:28:01 vsc
* interface speedups
* bad error message in X is foo>>2.
*
* Revision 1.94 2007/05/15 11:33:51 vsc
* fix min list
*
* Revision 1.93 2007/05/14 16:44:11 vsc
* improve external interface
*
* Revision 1.92 2007/04/18 23:01:16 vsc
* fix deadlock when trying to create a module with the same name as a
* predicate (for now, just don't lock modules). obs Paulo Moura.
*
* Revision 1.91 2007/03/30 16:47:22 vsc
* fix gmpless blob handling
*
* Revision 1.90 2007/03/22 11:12:20 vsc
* make sure that YAP_Restart does not restart a failed goal.
*
* Revision 1.89 2007/01/28 14:26:36 vsc
* WIN32 support
*
* Revision 1.88 2007/01/08 08:27:19 vsc
* fix restore (Trevor)
* make indexing a bit faster on IDB
*
* Revision 1.87 2006/12/13 16:10:14 vsc
* several debugger and CLP(BN) improvements.
*
* Revision 1.86 2006/11/27 17:42:02 vsc
* support for UNICODE, and other bug fixes.
*
* Revision 1.85 2006/05/16 18:37:30 vsc
* WIN32 fixes
* compiler bug fixes
* extend interface
*
* Revision 1.84 2006/03/09 15:52:04 tiagosoares
* CUT_C and MYDDAS support for 64 bits architectures
*
* Revision 1.83 2006/02/08 17:29:54 tiagosoares
* MYDDAS: Myddas Top Level for MySQL and Datalog
*
* Revision 1.82 2006/01/18 15:34:53 vsc
* avoid sideffects from MkBigInt
*
* Revision 1.81 2006/01/16 02:57:51 vsc
* fix bug with very large integers
* fix bug where indexing code was looking at code after a cut.
*
* Revision 1.80 2006/01/02 03:35:44 vsc
* fix interface and docs
*
* Revision 1.79 2006/01/02 02:25:44 vsc
* cannot release space from external GMPs.
*
* Revision 1.78 2006/01/02 02:16:18 vsc
* support new interface between YAP and GMP, so that we don't rely on our own
* allocation routines.
* Several big fixes.
*
* Revision 1.77 2005/11/18 18:48:51 tiagosoares
* support for executing c code when a cut occurs
*
* Revision 1.76 2005/11/03 18:49:26 vsc
* fix bignum conversion
*
* Revision 1.75 2005/10/28 17:38:49 vsc
* sveral updates
*
* Revision 1.74 2005/10/21 16:07:07 vsc
* fix tabling
*
* Revision 1.73 2005/10/18 17:04:43 vsc
* 5.1:
* - improvements to GC
* 2 generations
* generic speedups
* - new scheme for attvars
* - hProlog like interface also supported
* - SWI compatibility layer
* - extra predicates
* - global variables
* - moved to Prolog module
* - CLP(R) by Leslie De Koninck, Tom Schrijvers, Cristian Holzbaur, Bart
* Demoen and Jan Wielemacker
* - load_files/2
*
* from 5.0.1
*
* - WIN32 missing include files (untested)
* - -L trouble (my thanks to Takeyuchi Shiramoto-san)!
* - debugging of backtrable user-C preds would core dump.
* - redeclaring a C-predicate as Prolog core dumps.
* - badly protected YapInterface.h.
* - break/0 was failing at exit.
* - YAP_cut_fail and YAP_cut_succeed were different from manual.
* - tracing through data-bases could core dump.
* - cut could break on very large computations.
* - first pass at BigNum issues (reported by Roberto).
* - debugger could get go awol after fail port.
* - weird message on wrong debugger option.
*
* Revision 1.72 2005/10/15 02:42:57 vsc
* fix interface
*
* Revision 1.71 2005/08/17 13:35:51 vsc
* YPP would leave exceptions on the system, disabling Yap-4.5.7
* message.
*
* Revision 1.70 2005/08/04 15:45:51 ricroc
* TABLING NEW: support to limit the table space size
*
* Revision 1.69 2005/07/19 17:12:18 rslopes
* fix for older compilers that do not support declaration of vars
* in the middle of the function code.
*
* Revision 1.68 2005/05/31 00:23:47 ricroc
* remove abort_yapor function
*
* Revision 1.67 2005/04/10 04:35:19 vsc
* AllocMemoryFromYap should now handle large requests the right way.
*
* Revision 1.66 2005/04/10 04:01:10 vsc
* bug fixes, I hope!
*
* Revision 1.65 2005/03/15 18:29:23 vsc
* fix GPL
* fix idb: stuff in coroutines.
*
* Revision 1.64 2005/03/13 06:26:10 vsc
* fix excessive pruning in meta-calls
* fix Term->int breakage in compiler
* improve JPL (at least it does something now for amd64).
*
* Revision 1.63 2005/03/04 20:30:10 ricroc
* bug fixes for YapTab support
*
* Revision 1.62 2005/03/02 18:35:44 vsc
* try to make initialization process more robust
* try to make name more robust (in case Lookup new atom fails)
*
* Revision 1.61 2005/03/01 22:25:08 vsc
* fix pruning bug
* make DL_MALLOC less enthusiastic about walking through buckets.
*
* Revision 1.60 2005/02/08 18:04:47 vsc
* library_directory may not be deterministic (usually it isn't).
*
* Revision 1.59 2004/12/08 00:56:35 vsc
* missing ;
*
* Revision 1.58 2004/11/19 22:08:41 vsc
* replace SYSTEM_ERROR_INTERNAL by out OUT_OF_WHATEVER_ERROR whenever
*appropriate.
*
* Revision 1.57 2004/11/18 22:32:31 vsc
* fix situation where we might assume nonextsing double initialization of C
*predicates (use
* Hidden Pred Flag).
* $host_type was double initialized.
*
* Revision 1.56 2004/10/31 02:18:03 vsc
* fix bug in handling Yap heap overflow while adding new clause.
*
* Revision 1.55 2004/10/28 20:12:20 vsc
* Use Doug Lea's malloc as an alternative to YAP's standard malloc
* don't use TR directly in scanner/parser, this avoids trouble with ^C while
* consulting large files.
* pass gcc -mno-cygwin to library compilation in cygwin environment (cygwin
*should
* compile out of the box now).
*
* Revision 1.54 2004/10/06 16:55:46 vsc
* change configure to support big mem configs
* get rid of extra globals
* fix trouble with multifile preds
*
* Revision 1.53 2004/08/11 16:14:51 vsc
* whole lot of fixes:
* - memory leak in indexing
* - memory management in WIN32 now supports holes
* - extend Yap interface, more support for SWI-Interface
* - new predicate mktime in system
* - buffer console I/O in WIN32
*
* Revision 1.52 2004/07/23 03:37:16 vsc
* fix heap overflow in YAP_LookupAtom
*
* Revision 1.51 2004/07/22 21:32:20 vsc
* debugger fixes
* initial support for JPL
* bad calls to garbage collector and gc
* debugger fixes
*
* Revision 1.50 2004/06/29 19:04:41 vsc
* fix multithreaded version
* include new version of Ricardo's profiler
* new predicat atomic_concat
* allow multithreaded-debugging
* small fixes
*
* Revision 1.49 2004/06/09 03:32:02 vsc
* fix bugs
*
* Revision 1.48 2004/06/05 03:36:59 vsc
* coroutining is now a part of attvars.
* some more fixes.
*
* Revision 1.47 2004/05/17 21:42:08 vsc
* misc fixes
*
* Revision 1.46 2004/05/14 17:56:45 vsc
* Yap_WriteBuffer
*
* Revision 1.45 2004/05/14 17:11:30 vsc
* support BigNums in interface
*
* Revision 1.44 2004/05/14 16:33:44 vsc
* add Yap_ReadBuffer
* *
* *
*************************************************************************/
* YAP Prolog *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.Santos Costa and Universidade do Porto 1985-- *
* *
**************************************************************************
* *
* File: c_interface.c *
* comments: c_interface primitives definition *
* *
* Last rev: $Date: 2008-08-07 20:51:21 $,$Author: vsc $
**
* $Log: not supported by cvs2svn $
* *
* *
*************************************************************************/
/**
@file c_interface.c
@ -370,11 +58,11 @@
#include <malloc.h>
#endif
typedef enum {
FRG_FIRST_CALL = 0, /* Initial call */
FRG_CUTTED = 1, /* Context was cutted */
FRG_REDO = 2 /* Normal redo */
} frg_code;
typedef enum {
FRG_FIRST_CALL = 0, /* Initial call */
FRG_CUTTED = 1, /* Context was cutted */
FRG_REDO = 2 /* Normal redo */
} frg_code;
struct foreign_context {
uintptr_t context; /* context value */
@ -391,7 +79,7 @@ X_API int YAP_Reset(yap_reset_t mode);
#define strncat(X, Y, Z) strcat(X, Y)
#endif
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
#if defined(_WIN32)
#define X_API __declspec(dllexport)
#endif
@ -1626,11 +1314,12 @@ X_API void YAP_FreeSpaceFromYap(void *ptr) { Yap_FreeCodeSpace(ptr); }
* @param bufsize bu
*
* @return
*/X_API char *YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) {
*/ X_API char *YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) {
CACHE_REGS
seq_tv_t inp, out;
inp.val.t = t;
inp.type = YAP_STRING_ATOMS_CODES |YAP_STRING_STRING |YAP_STRING_ATOM | YAP_STRING_TRUNC | YAP_STRING_MALLOC;
inp.type = YAP_STRING_ATOMS_CODES | YAP_STRING_STRING | YAP_STRING_ATOM |
YAP_STRING_TRUNC | YAP_STRING_MALLOC;
inp.max = bufsize;
out.type = YAP_STRING_CHARS;
out.val.c = buf;
@ -1723,7 +1412,8 @@ X_API Term YAP_ReadBuffer(const char *s, Term *tp) {
BACKUP_H();
LOCAL_ErrorMessage = NULL;
while (!(t = Yap_StringToTerm(s, strlen(s) + 1, &LOCAL_encoding, GLOBAL_MaxPriority, tp))) {
while (!(t = Yap_StringToTerm(s, strlen(s) + 1, &LOCAL_encoding,
GLOBAL_MaxPriority, tp))) {
if (LOCAL_ErrorMessage) {
if (!strcmp(LOCAL_ErrorMessage, "Stack Overflow")) {
if (!Yap_dogc(0, NULL PASS_REGS)) {
@ -2404,7 +2094,8 @@ X_API int YAP_InitConsult(int mode, const char *filename, int *osnop) {
}
bool consulted = (mode == YAP_CONSULT_MODE);
Yap_init_consult(consulted, filename);
f = fopen(Yap_AbsoluteFile(filename, LOCAL_FileNameBuf, FILENAME_MAX-1), "r");
f = fopen(Yap_AbsoluteFile(filename, LOCAL_FileNameBuf, FILENAME_MAX - 1),
"r");
if (!f)
return -1;
sno = Yap_OpenStream(f, NULL, TermNil, Input_Stream_f);
@ -3590,43 +3281,43 @@ size_t YAP_UTF8_TextLength(Term t) {
utf8proc_uint8_t dst[8];
size_t sz = 0;
if (IsPairTerm( t )) {
if (IsPairTerm(t)) {
while (t != TermNil) {
int c;
Term hd = HeadOfTerm( t );
Term hd = HeadOfTerm(t);
if (IsAtomTerm(hd)) {
Atom at = AtomOfTerm(hd);
if (IsWideAtom(at))
c = RepAtom(at)->WStrOfAE[0];
else
c = RepAtom(at)->StrOfAE[0];
Atom at = AtomOfTerm(hd);
if (IsWideAtom(at))
c = RepAtom(at)->WStrOfAE[0];
else
c = RepAtom(at)->StrOfAE[0];
} else if (IsIntegerTerm(hd)) {
c = IntegerOfTerm( hd );
c = IntegerOfTerm(hd);
} else {
c = '\0';
c = '\0';
}
sz += utf8proc_encode_char(c, dst);
t = TailOfTerm(t);
}
} else if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
if (IsWideAtom(at)) {
const wchar_t *s = RepAtom(at)->WStrOfAE;
int c;
while ((c = *s++)) {
sz += utf8proc_encode_char(c, dst);
}
} else {
const unsigned char *s = (const unsigned char *)RepAtom(at)->StrOfAE;
int c;
} else if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
if (IsWideAtom(at)) {
const wchar_t *s = RepAtom(at)->WStrOfAE;
int c;
while ((c = *s++)) {
sz += utf8proc_encode_char(c, dst);
}
} else {
const unsigned char *s = (const unsigned char *)RepAtom(at)->StrOfAE;
int c;
while ((c = *s++)) {
sz += utf8proc_encode_char(c, dst);
}
}
} else if (IsStringTerm(t)) {
sz = strlen(StringOfTerm( t )) ;
while ((c = *s++)) {
sz += utf8proc_encode_char(c, dst);
}
}
} else if (IsStringTerm(t)) {
sz = strlen(StringOfTerm(t));
}
return sz;
}

View File

@ -1954,8 +1954,9 @@ static Int p_compile(USES_REGS1) { /* '$compile'(+C,+Flags,+C0,-Ref) */
cclause() in case there is a overflow */
t = Deref(ARG1); /* just in case there was an heap overflow */
if (!LOCAL_ErrorMessage) {
YAPEnterCriticalSection();
addclause(t, code_adr, mode, mod, &ARG5);
YAPLeaveCriticalSection();
}
if (LOCAL_ErrorMessage) {
if (!LOCAL_Error_Term)
@ -1964,7 +1965,6 @@ static Int p_compile(USES_REGS1) { /* '$compile'(+C,+Flags,+C0,-Ref) */
YAPLeaveCriticalSection();
return false;
}
YAPLeaveCriticalSection();
return true;
}
@ -2524,6 +2524,10 @@ static Int p_owner_file(USES_REGS1) { /* '$owner_file'(+P,M,F) */
UNLOCKPE(48, pe);
return FALSE;
}
if (is_system(pe) || is_foreign(pe) ) {
UNLOCKPE(48, pe);
return FALSE;
}
owner = pe->src.OwnerFile;
UNLOCKPE(49, pe);
if (owner == AtomNil)

View File

@ -3,49 +3,42 @@
#include "tracer.h"
#ifdef YAPOR
#include "or.macros.h"
#endif /* YAPOR */
#endif /* YAPOR */
#include "clause_list.h"
/* need to fix overflow handling */
static void
mk_blob(int sz USES_REGS)
{
static void mk_blob(int sz USES_REGS) {
MP_INT *dst;
HR[0] = (CELL)FunctorBigInt;
HR[1] = CLAUSE_LIST;
dst = (MP_INT *)(HR+2);
dst = (MP_INT *)(HR + 2);
dst->_mp_size = 0L;
dst->_mp_alloc = sz;
HR += (1+sizeof(MP_INT)/sizeof(CELL));
HR += (1 + sizeof(MP_INT) / sizeof(CELL));
HR[sz] = EndSpecials;
HR += sz+1;
HR += sz + 1;
}
static CELL *
extend_blob(CELL *start, int sz USES_REGS)
{
static CELL *extend_blob(CELL *start, int sz USES_REGS) {
UInt osize;
MP_INT *dst;
if (HR + sz > ASP)
return NULL;
dst = (MP_INT *)(start+2);
dst = (MP_INT *)(start + 2);
osize = dst->_mp_alloc;
start += (1+sizeof(MP_INT)/sizeof(CELL));
start[sz+osize] = EndSpecials;
start += (1 + sizeof(MP_INT) / sizeof(CELL));
start[sz + osize] = EndSpecials;
dst->_mp_alloc += sz;
HR += sz;
return start+osize;
return start + osize;
}
/*init of ClasuseList*/
X_API clause_list_t
Yap_ClauseListInit(clause_list_t in)
{
CACHE_REGS
in->n = 0;
clause_list_t Yap_ClauseListInit(clause_list_t in) {
CACHE_REGS in->n = 0;
in->start = HR;
mk_blob(0 PASS_REGS);
in->end = HR;
@ -54,9 +47,7 @@ Yap_ClauseListInit(clause_list_t in)
/*add clause to ClauseList
returns FALSE on error*/
X_API int
Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred)
{
int Yap_ClauseListExtend(clause_list_t cl, void *clause, void *pred) {
CACHE_REGS
PredEntry *ap = (PredEntry *)pred;
@ -65,15 +56,19 @@ Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred)
return FALSE;
if (cl->n == 0) {
void **ptr;
if (!(ptr = (void **)extend_blob(cl->start,1 PASS_REGS))) return FALSE;
if (!(ptr = (void **)extend_blob(cl->start, 1 PASS_REGS)))
return FALSE;
ptr[0] = clause;
} else if (cl->n == 1) {
} else if (cl->n == 1) {
yamop **ptr;
yamop *code_p, *fclause;
if (!(ptr = (yamop **)extend_blob(cl->start,2*(CELL)NEXTOP((yamop *)NULL,Otapl)/sizeof(CELL)-1 PASS_REGS))) return FALSE;
if (!(ptr = (yamop **)extend_blob(
cl->start, 2 * (CELL)NEXTOP((yamop *)NULL, Otapl) / sizeof(CELL) -
1 PASS_REGS)))
return FALSE;
fclause = ptr[-1];
code_p = (yamop *)(ptr-1);
code_p = (yamop *)(ptr - 1);
code_p->opc = Yap_opcode(_try_clause);
code_p->y_u.Otapl.d = fclause;
code_p->y_u.Otapl.s = ap->ArityOfPE;
@ -84,7 +79,7 @@ Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred)
#ifdef YAPOR
INIT_YAMOP_LTT(code_p, 0);
#endif /* YAPOR */
code_p = NEXTOP(code_p,Otapl);
code_p = NEXTOP(code_p, Otapl);
code_p->opc = Yap_opcode(_trust);
code_p->y_u.Otapl.d = clause;
code_p->y_u.Otapl.s = ap->ArityOfPE;
@ -98,7 +93,10 @@ Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred)
} else {
yamop *code_p;
if (!(code_p = (yamop *)extend_blob(cl->start,((CELL)NEXTOP((yamop *)NULL,Otapl))/sizeof(CELL) PASS_REGS))) return FALSE;
if (!(code_p = (yamop *)extend_blob(cl->start,
((CELL)NEXTOP((yamop *)NULL, Otapl)) /
sizeof(CELL) PASS_REGS)))
return FALSE;
code_p->opc = Yap_opcode(_trust);
code_p->y_u.Otapl.d = clause;
code_p->y_u.Otapl.s = ap->ArityOfPE;
@ -109,7 +107,7 @@ Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred)
#ifdef YAPOR
INIT_YAMOP_LTT(code_p, 0);
#endif /* YAPOR */
code_p = PREVOP(code_p,Otapl);
code_p = PREVOP(code_p, Otapl);
code_p->opc = Yap_opcode(_retry);
}
cl->end = HR;
@ -118,16 +116,11 @@ Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred)
}
/*closes the clause list*/
X_API void
Yap_ClauseListClose(clause_list_t cl)
{
/* no need to do nothing */
void Yap_ClauseListClose(clause_list_t cl) { /* no need to do nothing */
}
/*destroys the clause list freeing memory*/
X_API int
Yap_ClauseListDestroy(clause_list_t cl)
{
int Yap_ClauseListDestroy(clause_list_t cl) {
CACHE_REGS
if (cl->end != HR)
return FALSE;
@ -136,34 +129,25 @@ Yap_ClauseListDestroy(clause_list_t cl)
}
/*destroys clause list and returns only first clause*/
X_API void *
Yap_ClauseListToClause(clause_list_t cl)
{
void *Yap_ClauseListToClause(clause_list_t cl) {
CACHE_REGS
void **ptr;
if (cl->end != HR)
return NULL;
if (cl->n != 1)
return NULL;
if (!(ptr = (void **)extend_blob(cl->start,0 PASS_REGS))) return NULL;
if (!(ptr = (void **)extend_blob(cl->start, 0 PASS_REGS)))
return NULL;
return ptr[-1];
}
/*return pointer to start of try-retry-trust sequence*/
X_API void *
Yap_ClauseListCode(clause_list_t cl)
{
void *Yap_ClauseListCode(clause_list_t cl) {
CELL *ptr;
ptr = (CELL *)cl->start;
ptr += (1+sizeof(MP_INT)/sizeof(CELL));
ptr += (1 + sizeof(MP_INT) / sizeof(CELL));
return (void *)ptr;
}
/* where to fail */
X_API void *
Yap_FAILCODE(void)
{
return (void *)FAILCODE;
}
void *Yap_FAILCODE(void) { return (void *)FAILCODE; }

View File

@ -15,11 +15,13 @@
* comments: comparing two prolog terms *
* *
*************************************************************************/
/// @file cmppreds.c
/** @defgroup Comparing_Terms Comparing Terms
/**
@defgroup Comparing_Terms Comparing Terms
@ingroup builtins
The following predicates are used to compare and order terms, using the
@ -29,8 +31,7 @@ standard ordering:
variables come before numbers, numbers come before atoms which in turn
come before compound terms, i.e.: variables @< numbers @< atoms @<
compound terms.
+
Variables are roughly ordered by "age" (the "oldest" variable is put
+ Variables are roughly ordered by "age" (the "oldest" variable is put
first);
+
Floating point numbers are sorted in increasing order;

View File

@ -115,17 +115,17 @@ bool Yap_Warning(const char *s, ...) {
} else
return false;
va_end(ap);
if (pred->OpcodeOfPred == UNDEF_OPCODE) {
if (pred->OpcodeOfPred == UNDEF_OPCODE||
pred->OpcodeOfPred == FAIL_OPCODE) {
fprintf(stderr, "warning message: %s\n", tmpbuf);
LOCAL_DoingUndefp = false;
LOCAL_within_print_message = false;
return true;
return false;
}
ts[1] = MkAtomTerm(AtomWarning);
ts[0] = MkAtomTerm(Yap_LookupAtom(tmpbuf));
rc = Yap_execute_pred(pred, ts, true PASS_REGS);
LOCAL_within_print_message = false;
return rc;
}
@ -133,6 +133,7 @@ bool Yap_PrintWarning(Term twarning) {
CACHE_REGS
PredEntry *pred = RepPredProp(PredPropByFunc(
FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
Term cmod = CurrentModule;
bool rc;
Term ts[2];
@ -143,13 +144,16 @@ bool Yap_PrintWarning(Term twarning) {
}
LOCAL_DoingUndefp = true;
LOCAL_within_print_message = true;
if (pred->OpcodeOfPred == UNDEF_OPCODE) {
if (pred->OpcodeOfPred == UNDEF_OPCODE ||
pred->OpcodeOfPred == FAIL_OPCODE
) {
fprintf(stderr, "warning message:\n");
Yap_DebugPlWrite(twarning);
fprintf(stderr, "\n");
LOCAL_DoingUndefp = false;
LOCAL_within_print_message = false;
return true;
CurrentModule = cmod;
return false;
}
ts[1] = twarning;
ts[0] = MkAtomTerm(AtomWarning);
@ -159,7 +163,7 @@ bool Yap_PrintWarning(Term twarning) {
return rc;
}
int Yap_HandleError(const char *s, ...) {
bool Yap_HandleError__(const char *file, const char *function, int lineno, const char *s, ...) {
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
const char *serr;
@ -173,28 +177,28 @@ int Yap_HandleError(const char *s, ...) {
switch (err) {
case RESOURCE_ERROR_STACK:
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, ARG1, serr);
return (FALSE);
Yap_Error__(file, function, lineno, RESOURCE_ERROR_STACK, ARG1, serr);
return false;
}
return TRUE;
return true;
case RESOURCE_ERROR_AUXILIARY_STACK:
if (LOCAL_MAX_SIZE < (char *)AuxSp - AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
/* crash in flames */
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, serr);
return FALSE;
Yap_Error__(file, function, lineno, RESOURCE_ERROR_AUXILIARY_STACK, ARG1, serr);
return false;
}
return TRUE;
return true;
case RESOURCE_ERROR_HEAP:
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, ARG2, serr);
return FALSE;
Yap_Error__(file, function, lineno, RESOURCE_ERROR_HEAP, ARG2, serr);
return false;
}
default:
Yap_Error(err, LOCAL_Error_Term, serr);
return (FALSE);
Yap_Error__(file, function, lineno, err, LOCAL_Error_Term, serr);
return false;
}
}
@ -361,7 +365,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
CELL nt[3];
Functor fun;
bool serious;
Term tf, error_t, comment, culprit;
Term tf, error_t, comment, culprit = TermNil;
char *format;
char s[MAXPATHLEN];
@ -527,6 +531,8 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
}
if (type != ABORT_EVENT) {
Term location;
/* This is used by some complex procedures to detect there was an error */
if (IsAtomTerm(nt[0])) {
strncpy(LOCAL_ErrorSay, (char *) RepAtom(AtomOfTerm(nt[0]))->StrOfAE,
@ -538,14 +544,14 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
MAX_ERROR_MSG_SIZE);
LOCAL_ErrorMessage = LOCAL_ErrorSay;
}
nt[1] = TermNil;
switch (type) {
case RESOURCE_ERROR_HEAP:
case RESOURCE_ERROR_STACK:
case RESOURCE_ERROR_TRAIL:
comment = MkAtomTerm(Yap_LookupAtom(tmpbuf));
default:
nt[1] = TermNil;
if (comment != TermNil)
default:
if (comment != TermNil)
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("i")), comment),
nt[1]);
if (file && function) {
@ -557,12 +563,12 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
nt[1] =
MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("c")), t3), nt[1]);
}
if ((culprit = Yap_pc_location(P, B, ENV)) != TermNil) {
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("p")), culprit),
if ((location = Yap_pc_location(P, B, ENV)) != TermNil) {
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("p")), location),
nt[1]);
}
if ((culprit = Yap_env_location(CP, B, ENV, 0)) != TermNil) {
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("e")), culprit),
if ((location = Yap_env_location(CP, B, ENV, 0)) != TermNil) {
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("e")), location),
nt[1]);
}
}

View File

@ -133,7 +133,7 @@
#endif /* TABLING */
case _or_else:
case _or_last:
low_level_trace(retry_or, (PredEntry *)ipc, &(B->cp_a1));
low_level_trace(retry_or, NULL, NULL);
break;
case _retry2:
case _retry3:

View File

@ -29,7 +29,7 @@
static bool ro(Term inp);
static bool nat(Term inp);
static bool isatom(Term inp);
static bool boolean(Term inp);
static bool booleanFlag(Term inp);
// static bool string( Term inp );
// static bool list_atom( Term inp );
static bool list_option(Term inp);
@ -1124,7 +1124,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
flag_term *tarr) {
errno = 0;
if (f == boolean) {
if (f == booleanFlag) {
if (!bootstrap) {
return 0;
}
@ -1266,7 +1266,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
PAR("access", isaccess, PROLOG_FLAG_PROPERTY_ACCESS, "read_write"), \
PAR("type", isground, PROLOG_FLAG_PROPERTY_TYPE, "term"), \
PAR("scope", flagscope, PROLOG_FLAG_PROPERTY_SCOPE, "global"), \
PAR("keep", boolean, PROLOG_FLAG_PROPERTY_KEEP, "false"), \
PAR("keep", booleanFlag, PROLOG_FLAG_PROPERTY_KEEP, "false"), \
PAR(NULL, ok, PROLOG_FLAG_PROPERTY_END, 0)
#define PAR(x, y, z, w) z
@ -1318,7 +1318,7 @@ do_prolog_flag_property(Term tflag,
args[PROLOG_FLAG_PROPERTY_ACCESS].tvalue);
break;
case PROLOG_FLAG_PROPERTY_TYPE:
if (fv->type == boolean)
if (fv->type == booleanFlag)
rc = rc &&
Yap_unify(TermBoolean, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue);
else if (fv->type == isatom)
@ -1480,7 +1480,7 @@ static Int do_create_prolog_flag(USES_REGS1) {
case PROLOG_FLAG_PROPERTY_TYPE: {
Term ttype = args[PROLOG_FLAG_PROPERTY_TYPE].tvalue;
if (ttype == TermBoolean)
fv->type = boolean;
fv->type = booleanFlag;
else if (ttype == TermInteger)
fv->type = isatom;
else if (ttype == TermFloat)

View File

@ -947,8 +947,8 @@ static void InitStdPreds(void) {
Yap_InitCPreds();
Yap_InitBackCPreds();
BACKUP_MACHINE_REGS();
Yap_InitPlIO();
Yap_InitFlags(false);
Yap_InitPlIO();
#if HAVE_MPE
Yap_InitMPE();
#endif
@ -1221,9 +1221,9 @@ void Yap_CloseScratchPad(void) {
LOCAL_ScratchPad.msz = SCRATCH_START_SIZE;
}
#include "heap/iglobals.h"
#include "iglobals.h"
#include "heap/ilocals.h"
#include "ilocals.h"
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
struct global_data *Yap_global;
@ -1247,7 +1247,7 @@ static void InitCodes(void) {
Yap_local[wid] = NULL;
}
#endif
#include "heap/ihstruct.h"
#include "ihstruct.h"
#if THREADS
Yap_InitThread(0);
#endif /* THREADS */

View File

@ -19,7 +19,7 @@
#include "yapio.h"
#include "Foreign.h"
#if LOAD_DLL
#if _WIN32
#include <windows.h>
@ -101,7 +101,7 @@ LoadForeign(StringList ofiles, StringList libs,
other routines */
while (libs) {
HINSTANCE handle;
char * s = AtomName(libs->name);
const char * s = AtomName(libs->name);
if (s[0] == '-') {
strcat(LOCAL_FileNameBuf,s+2);

View File

@ -16,9 +16,13 @@
*************************************************************************/
/** @defgroup Term_Modification Term Modification
/**
@file mavar.c
@defgroup Term_Modification Term Modification
@ingroup builtins
@{
It is sometimes useful to change the value of instantiated
variables. Although, this is against the spirit of logic programming, it
@ -26,14 +30,14 @@ is sometimes useful. As in other Prolog systems, YAP has
several primitives that allow updating Prolog terms. Note that these
primitives are also backtrackable.
The `setarg/3` primitive allows updating any argument of a Prolog
compound terms. The `mutable` family of predicates provides
<em>mutable variables</em>. They should be used instead of `setarg/3`,
The setarg/3 primitive allows updating any argument of a Prolog
compound terms. The _mutable_ family of predicates provides
<em>mutable variables</em>. They should be used instead of setarg/3,
as they allow the encapsulation of accesses to updatable
variables. Their implementation can also be more efficient for long
deterministic computations.
@{
*/
@ -315,7 +319,6 @@ p_update_mutable( USES_REGS1 )
return(TRUE);
}
static Int
/** @pred is_mutable(? _D_)
@ -323,6 +326,7 @@ Holds if _D_ is a mutable term.
*/
static Int
p_is_mutable( USES_REGS1 )
{
Term t = Deref(ARG1);

View File

@ -14,7 +14,7 @@
* comments: module support *
* *
*************************************************************************/
#ifdef SCCS
#ifdef SCCSLookupSystemModule
static char SccsId[] = "%W% %G%";
#endif
@ -26,9 +26,69 @@ static Int current_module(USES_REGS1);
static Int current_module1(USES_REGS1);
static ModEntry *LookupModule(Term a);
static ModEntry *LookupSystemModule(Term a);
static ModEntry *GetModuleEntry(Atom at);
static ModEntry *FetchModuleEntry(Atom at);
/**
* initialize module data-structure
*
* @param to parent module (CurrentModule)
* @param ae module name.
*
* @return a new module structure
*//** */
static ModEntry *
initMod( AtomEntry *toname, AtomEntry *ae) {
CACHE_REGS
ModEntry *n, *parent;
if (toname == NULL)
parent = NULL;
else {
parent = FetchModuleEntry( toname );
}
n = (ModEntry *)Yap_AllocAtomSpace(sizeof(*n));
INIT_RWLOCK(n->ModRWLock);
n->KindOfPE = ModProperty;
n->PredForME = NULL;
n->NextME = CurrentModules;
CurrentModules = n;
n->AtomOfME = ae;
n->OwnerFile = Yap_ConsultingFile( PASS_REGS1);
AddPropToAtom(ae, (PropEntry *)n);
Yap_setModuleFlags(n, parent);
return n;
}
/**
* get predicate entry for ap/arity; create it if neccessary
*
* @param[in] at
*
* @return module descriptorxs
*/
static ModEntry *GetModuleEntry(Atom at)
{
Prop p0;
AtomEntry *ae = RepAtom(at);
READ_LOCK(ae->ARWLock);
p0 = ae->PropsOfAE;
while (p0) {
ModEntry *me = RepModProp(p0);
if (me->KindOfPE == ModProperty) {
READ_UNLOCK(ae->ARWLock);
return me;
}
p0 = me->NextOfPE;
}
READ_UNLOCK(ae->ARWLock);
return initMod( ( CurrentModule == PROLOG_MODULE ? NULL : AtomOfTerm( CurrentModule ) ), at );
}
/** get entry for ap/arity; assumes one is there. */
static ModEntry *FetchModuleEntry(Atom at)
/* get predicate entry for ap/arity; create it if neccessary. */
{
Prop p0;
AtomEntry *ae = RepAtom(at);
@ -47,40 +107,6 @@ static ModEntry *LookupSystemModule(Term a);
return NULL;
}
inline static ModEntry *GetModuleEntry(Atom at)
/* Get predicate entry for ap/arity; create it if necessary. */
{
Prop p0;
AtomEntry *ae = RepAtom(at);
ModEntry *new, *oat;
p0 = ae->PropsOfAE;
while (p0) {
if (p0->KindOfPE == ModProperty) {
return RepModProp(p0);
}
p0 = p0->NextOfPE;
}
{
CACHE_REGS
new = (ModEntry *)Yap_AllocAtomSpace(sizeof(*new));
INIT_RWLOCK(new->ModRWLock);
new->KindOfPE = ModProperty;
new->PredForME = NULL;
new->NextME = CurrentModules;
CurrentModules = new;
new->AtomOfME = ae;
new->OwnerFile = Yap_ConsultingFile( PASS_REGS1);
AddPropToAtom(ae, (PropEntry *)new);
if (CurrentModule == 0L || (oat = GetModuleEntry(AtomOfTerm(CurrentModule))) == new) {
Yap_setModuleFlags(new, NULL);
} else {
Yap_setModuleFlags(new, oat);
}
}
return new;
}
Term Yap_getUnknownModule(ModEntry *m) {
if (m && m->flags & UNKNOWN_ERROR) {
return TermError;
@ -109,21 +135,20 @@ bool Yap_getUnknown ( Term mod) {
Term Yap_Module_Name(PredEntry *ap) {
CACHE_REGS
Term mod;
if (!ap)
return TermUser;
if (!ap->ModuleOfPred)
/* If the system predicate is a metacall I should return the
/* If the system predicate is a meta-call I should return the
module for the metacall, which I will suppose has to be
reachable from the current module anyway.
So I will return the current module in case the system
predicate is a meta-call. Otherwise it will still work.
*/
mod = CurrentModule;
return TermProlog;
else {
mod = ap->ModuleOfPred;
return ap->ModuleOfPred;
}
if (mod)
return mod;
return TermProlog;
}
@ -135,13 +160,16 @@ static ModEntry *LookupSystemModule(Term a) {
/* prolog module */
if (a == 0) {
return GetModuleEntry(AtomProlog);
a = TermProlog;
}
at = AtomOfTerm(a);
me = GetModuleEntry(at);
if (!me)
return NULL;
me->flags |= M_SYSTEM;
me->OwnerFile = Yap_ConsultingFile( PASS_REGS1 );
return me;}
return me;
}
static ModEntry *LookupModule(Term a) {
@ -201,7 +229,7 @@ void Yap_NewModulePred(Term mod, struct pred_entry *ap) {
}
static Int
current_module(USES_REGS1) { /* $current_module(Old,New) */
current_module(USES_REGS1) { /* $current_module(Old,N) */
Term t;
if (CurrentModule) {
@ -225,7 +253,7 @@ static Int
return TRUE;
}
static Int change_module(USES_REGS1) { /* $change_module(New) */
static Int change_module(USES_REGS1) { /* $change_module(N) */
Term mod = Deref(ARG1);
LookupModule(mod);
CurrentModule = mod;
@ -347,8 +375,8 @@ static Int new_system_module( USES_REGS1 )
Yap_Error(TYPE_ERROR_ATOM, t, NULL);
return false;
}
me = LookupSystemModule( t );
me->OwnerFile = Yap_ConsultingFile( PASS_REGS1);
if ((me = LookupSystemModule( t ) ))
me->OwnerFile = Yap_ConsultingFile( PASS_REGS1);
return me != NULL;
}

View File

@ -32,7 +32,7 @@
Op(either, Osblp);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
low_level_trace(try_or, (PredEntry *)PREG, NULL);
low_level_trace(try_or, PREG->y_u.Osblp.p0, NULL);
}
#endif
#ifdef COROUTINING

View File

@ -19,7 +19,8 @@
static char SccsId[] = "@(#)save.c 1.3 3/15/90";
#endif
#include "config.h"
#include "absmi.h"
#include "alloc.h"
#if _MSC_VER || defined(__MINGW32__)
#if HAVE_WINSOCK2_H
#include <winsock2.h>
@ -27,14 +28,12 @@ static char SccsId[] = "@(#)save.c 1.3 3/15/90";
#include <windows.h>
#include <psapi.h>
#endif
#include "absmi.h"
#include "alloc.h"
#if USE_DL_MALLOC
#include "dlmalloc.h"
#endif
#include "yapio.h"
#include "YapText.h"
#include "sshift.h"
#include "yapio.h"
#include "Foreign.h"
#if HAVE_STRING_H
#include <string.h>

View File

@ -151,7 +151,7 @@ double-quoting. The implementation of YAP represents strings as
lists of integers. Since YAP 4.3.0 there is no static limit on string
size.
Escape sequences can be used to include the non-printable characters
Escape sequences can be used anf include the non-printable characters
`a` (alert), `b` (backspace), `r` (carriage return),
`f` (form feed), `t` (horizontal tabulation), `n` (new
line), and `v` (vertical tabulation). Escape sequences also be
@ -563,6 +563,46 @@ typedef struct scanner_extra_alloc {
void *filler;
} ScannerExtraBlock;
static TokEntry *
CodeSpaceError(TokEntry *t, TokEntry *p, TokEntry *l)
{
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
LOCAL_ErrorMessage = "Code Space Overflow";
if (t) {
t->Tok = eot_tok;
t->TokInfo = TermOutOfHeapError;
}
/* serious error now */
return l;
}
static TokEntry *
TrailSpaceError(TokEntry *t, TokEntry *l)
{
LOCAL_ErrorMessage = "Trail Overflow";
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
if (t) {
t->Tok = eot_tok;
t->TokInfo = TermOutOfTrailError;
}
return l;
}
static TokEntry *
AuxSpaceError(TokEntry *p, TokEntry *l, const char *msg)
{
/* huge atom or variable, we are in trouble */
LOCAL_ErrorMessage = (char *)msg;
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
if (p) {
p->Tok = eot_tok;
p->TokInfo = TermOutOfAuxspaceError;
}
/* serious error now */
return l;
}
static void InitScannerMemory(void) {
CACHE_REGS
LOCAL_ErrorMessage = NULL;
@ -1160,7 +1200,8 @@ Term Yap_scan_num(StreamDesc *inp) {
e->TokInfo = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
e->TokPos = GetCurInpPos(inp);
e->TokNext = ef;
ef->Tok = Ord(kind = eot_tok);
ef->Tok = Ord(kind = eot_tok);
ef->TokInfo = TermSyntaxError;
ef->TokPos = GetCurInpPos(inp);
ef->TokNext = NULL;
LOCAL_tokptr = tokptr;
@ -1180,8 +1221,10 @@ Term Yap_scan_num(StreamDesc *inp) {
LOCAL_ErrorMessage = "Stack Overflow"; \
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \
LOCAL_Error_Size = 0L; \
if (p) \
if (p) { \
p->Tok = Ord(kind = eot_tok); \
p->TokInfo = TermOutOfStackError; \
} \
/* serious error now */ \
return l; \
}
@ -1199,8 +1242,6 @@ const char *Yap_tokRep(TokEntry *tokptr) {
case Number_tok:
if ((b = Yap_TermToString(info, buf, sze, &length, &LOCAL_encoding,
flags)) != buf) {
if (b)
free(b);
return NULL;
}
return buf;
@ -1370,12 +1411,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
t = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
t->TokNext = NULL;
if (t == NULL) {
LOCAL_ErrorMessage = "Trail Overflow";
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
if (p)
p->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
return TrailSpaceError(p, l);
}
if (!l)
l = t;
@ -1428,6 +1464,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
} else {
t->Tok = Ord(kind = eot_tok);
mark_eof(inp_stream);
t->TokInfo = TermEof;
}
break;
@ -1445,14 +1482,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
for (; chtype(ch) <= NU; ch = getchr(inp_stream)) {
if (charp == (char *)AuxSp - 1024) {
huge_var_error:
return AuxSpaceError(p, l, "Code Space Overflow due to huge atom");
/* huge atom or variable, we are in trouble */
LOCAL_ErrorMessage = "Code Space Overflow due to huge atom";
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
if (p)
p->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}
add_ch_to_buff(ch);
}
@ -1474,12 +1505,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
ae = Yap_LookupAtom(TokImage);
}
if (ae == NIL) {
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
LOCAL_ErrorMessage = "Code Space Overflow";
if (p)
t->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
return CodeSpaceError(t, p, l);
}
t->TokInfo = Unsigned(ae);
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
@ -1504,18 +1530,15 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
cherr = 0;
if (!(ptr = AllocScannerMemory(4096))) {
LOCAL_ErrorMessage = "Trail Overflow";
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
if (p)
t->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}
return TrailSpaceError(t, l);
}
CHECK_SPACE();
if ((t->TokInfo = get_num(&cha, &cherr, inp_stream, ptr, 4096, 1)) ==
0L) {
if (p)
p->Tok = Ord(kind = eot_tok);
if (p) {
p->Tok = eot_tok;
t->TokInfo = TermError;
}
/* serious error now */
return l;
}
@ -1527,12 +1550,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
t->TokPos = GetCurInpPos(inp_stream);
e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e == NULL) {
LOCAL_ErrorMessage = "Trail Overflow";
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
if (p)
p->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
return TrailSpaceError(p, l);
} else {
e->TokNext = NULL;
}
@ -1556,12 +1575,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
t->TokPos = GetCurInpPos(inp_stream);
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e2 == NULL) {
LOCAL_ErrorMessage = "Trail Overflow";
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
if (p)
p->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
return TrailSpaceError(p, l);
} else {
e2->TokNext = NULL;
}
@ -1587,11 +1601,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
t->TokPos = GetCurInpPos(inp_stream);
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e2 == NULL) {
LOCAL_ErrorMessage = "Trail Overflow";
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
t->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
return TrailSpaceError(p, l);
} else {
e2->TokNext = NULL;
}
@ -1649,6 +1659,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
mark_eof(inp_stream);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermEof;
break;
} else {
add_ch_to_buff(ch);
@ -1657,14 +1668,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
++len;
if (charp > (char *)AuxSp - 1024) {
/* Not enough space to read in the string. */
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
LOCAL_ErrorMessage =
"not enough space to read in string or quoted atom";
/* serious error now */
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
return l;
}
return AuxSpaceError(t, l, "not enough space to read in string or quoted atom");
}
}
if (wcharp) {
*wcharp = '\0';
@ -1682,6 +1687,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
"not enough heap space to read in string or quoted atom";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
return l;
}
if (wcharp) {
@ -1711,13 +1717,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
t->TokInfo = Unsigned(Yap_LookupAtom(TokImage));
}
if (!(t->TokInfo)) {
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
LOCAL_ErrorMessage = "Code Space Overflow";
if (p)
t->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}
return CodeSpaceError(t, p, l);
}
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = Name_tok);
if (ch == '(')
@ -1728,6 +1729,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
case BS:
if (ch == '\0') {
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermEof;
return l;
} else
ch = getchr(inp_stream);
@ -1740,8 +1742,12 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
if (och == '.') {
if (chtype(ch) == BS || chtype(ch) == EF || ch == '%') {
t->Tok = Ord(kind = eot_tok);
if (chtype(ch) == EF)
if (chtype(ch) == EF) {
mark_eof(inp_stream);
t->TokInfo = TermEof;
} else {
t->TokInfo = TermNewLine;
}
return l;
}
}
@ -1768,6 +1774,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
}
if (chtype(ch) == EF) {
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermEof;
break;
} else {
/* leave comments */
@ -1787,8 +1794,12 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
enter_symbol:
if (och == '.' && (chtype(ch) == BS || chtype(ch) == EF || ch == '%')) {
t->Tok = Ord(kind = eot_tok);
if (chtype(ch) == EF)
if (chtype(ch) == EF) {
mark_eof(inp_stream);
t->TokInfo = TermEof;
} else {
t->TokInfo = TermNl;
}
return l;
} else {
Atom ae;
@ -1810,22 +1821,12 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
ae = Yap_LookupAtom(TokImage);
}
if (ae == NIL) {
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
LOCAL_ErrorMessage = "Code Space Overflow";
if (p)
t->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}
return CodeSpaceError(t, p, l);
}
t->TokInfo = Unsigned(ae);
if (t->TokInfo == (CELL)NIL) {
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
LOCAL_ErrorMessage = "Code Space Overflow";
if (p)
t->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}
return CodeSpaceError(t, p, l);
}
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = Name_tok);
if (ch == '(')
@ -1882,12 +1883,14 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
LOCAL_ErrorMessage = "not enough heap space to read in quasi quote";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
return l;
}
if (cur_qq) {
LOCAL_ErrorMessage = "quasi quote in quasi quote";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
free(qq);
return l;
} else {
@ -1925,6 +1928,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
free(cur_qq);
cur_qq = NULL;
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermError;
return l;
}
cur_qq = NULL;
@ -1946,6 +1950,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
"not enough heap space to read in a quasi quoted atom";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermError;
return l;
}
charp = TokImage;
@ -1968,6 +1973,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
mark_eof(inp_stream);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
break;
} else {
charp = (char *)put_utf8((unsigned char *)charp, ch);
@ -1975,13 +1981,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
}
if (charp > (char *)AuxSp - 1024) {
/* Not enough space to read in the string. */
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
LOCAL_ErrorMessage =
"not enough space to read in string or quoted atom";
/* serious error now */
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
return l;
return AuxSpaceError(t, l, "not enough space to read in string or quoted atom");
}
}
len = charp - TokImage;
@ -1990,6 +1990,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
LOCAL_ErrorMessage = "not enough heap space to read in quasi quote";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
return l;
}
strncpy(mp, TokImage, len + 1);
@ -2004,12 +2005,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
qq->end.linepos = inp_stream->linepos - 1;
qq->end.charno = inp_stream->charcount - 1;
if (!(t->TokInfo)) {
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
LOCAL_ErrorMessage = "Code Space Overflow";
if (p)
t->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
return CodeSpaceError(t, p, l);
}
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
solo_flag = FALSE;
@ -2021,13 +2017,19 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
case EF:
mark_eof(inp_stream);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermEof;
return l;
default:
{
char err[1024];
snprintf( err, 1023, "\n++++ token: unrecognised char %c (%d), type %c\n", ch, ch, chtype(ch) );
#if DEBUG
fprintf(stderr, "\n++++ token: wrong char type %c %d\n", ch, chtype(ch));
fprintf(stderr, "%s", err);
#endif
}
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermEof;
}
#if DEBUG
if (GLOBAL_Option[2])
@ -2037,12 +2039,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
/* insert an error token to inform the system of what happened */
TokEntry *e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e == NULL) {
LOCAL_ErrorMessage = "Trail Overflow";
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
p->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}
return TrailSpaceError(p, l);
}
p->TokNext = e;
e->Tok = Error_tok;
e->TokInfo = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));

View File

@ -1924,6 +1924,8 @@ static Term build_bug_location(yamop *codeptr, PredEntry *pe) {
} else
p[4] = MkIntTerm(0);
}
} else {
p[4] = MkIntTerm(0);
}
}
} else if (pe->OpcodeOfPred == UNDEF_OPCODE) {

View File

@ -13,255 +13,7 @@
* comments: General-purpose C implemented system predicates *
* *
* Last rev: $Date: 2008-07-24 16:02:00 $,$Author: vsc $
**
* $Log: not supported by cvs2svn $
* Revision 1.131 2008/06/12 10:55:52 vsc
* fix syntax error messages
*
* Revision 1.130 2008/04/06 11:53:02 vsc
* fix some restore bugs
*
* Revision 1.129 2008/03/15 12:19:33 vsc
* fix flags
*
* Revision 1.128 2008/02/15 12:41:33 vsc
* more fixes to modules
*
* Revision 1.127 2008/02/13 10:15:35 vsc
* fix some bugs from yesterday plus improve support for modules in
* operators.
*
* Revision 1.126 2008/02/07 23:09:13 vsc
* don't break ISO standard in current_predicate/1.
* Include Nicos flag.
*
* Revision 1.125 2008/01/23 17:57:53 vsc
* valgrind it!
* enable atom garbage collection.
*
* Revision 1.124 2007/11/26 23:43:08 vsc
* fixes to support threads and assert correctly, even if inefficiently.
*
* Revision 1.123 2007/11/06 17:02:12 vsc
* compile ground terms away.
*
* Revision 1.122 2007/10/18 08:24:16 vsc
* fix global variables
*
* Revision 1.121 2007/10/10 09:44:24 vsc
* some more fixes to make YAP swi compatible
* fix absolute_file_name (again)
* fix setarg
*
* Revision 1.120 2007/10/08 23:02:15 vsc
* minor fixes
*
* Revision 1.119 2007/04/18 23:01:16 vsc
* fix deadlock when trying to create a module with the same name as a
* predicate (for now, just don't lock modules). obs Paulo Moura.
*
* Revision 1.118 2007/02/26 10:41:40 vsc
* fix prolog_flags for chr.
*
* Revision 1.117 2007/01/28 14:26:37 vsc
* WIN32 support
*
* Revision 1.116 2006/12/13 16:10:23 vsc
* several debugger and CLP(BN) improvements.
*
* Revision 1.115 2006/11/28 13:46:41 vsc
* fix wide_char support for name/2.
*
* Revision 1.114 2006/11/27 17:42:03 vsc
* support for UNICODE, and other bug fixes.
*
* Revision 1.113 2006/11/16 14:26:00 vsc
* fix handling of infinity in name/2 and friends.
*
* Revision 1.112 2006/11/08 01:56:47 vsc
* fix argument order in db statistics.
*
* Revision 1.111 2006/11/06 18:35:04 vsc
* 1estranha
*
* Revision 1.110 2006/10/10 14:08:17 vsc
* small fixes on threaded implementation.
*
* Revision 1.109 2006/09/15 19:32:47 vsc
* ichanges for QSAR
*
* Revision 1.108 2006/09/01 20:14:42 vsc
* more fixes for global data-structures.
* statistics on atom space.
*
* Revision 1.107 2006/08/22 16:12:46 vsc
* global variables
*
* Revision 1.106 2006/08/07 18:51:44 vsc
* fix garbage collector not to try to garbage collect when we ask for large
* chunks of stack in a single go.
*
* Revision 1.105 2006/06/05 19:36:00 vsc
* hacks
*
* Revision 1.104 2006/05/19 14:31:32 vsc
* get rid of IntArrays and FloatArray code.
* include holes when calculating memory usage.
*
* Revision 1.103 2006/05/18 16:33:05 vsc
* fix info reported by memory manager under DL_MALLOC and SYSTEM_MALLOC
*
* Revision 1.102 2006/04/28 17:53:44 vsc
* fix the expand_consult patch
*
* Revision 1.101 2006/04/28 13:23:23 vsc
* fix number of overflow bugs affecting threaded version
* make current_op faster.
*
* Revision 1.100 2006/02/05 02:26:35 tiagosoares
* MYDDAS: Top Level Functionality
*
* Revision 1.99 2006/02/05 02:17:54 tiagosoares
* MYDDAS: Top Level Functionality
*
* Revision 1.98 2005/12/17 03:25:39 vsc
* major changes to support online event-based profiling
* improve error discovery and restart on scanner.
*
* Revision 1.97 2005/11/22 11:25:59 tiagosoares
* support for the MyDDAS interface library
*
* Revision 1.96 2005/10/28 17:38:49 vsc
* sveral updates
*
* Revision 1.95 2005/10/21 16:09:02 vsc
* SWI compatible module only operators
*
* Revision 1.94 2005/09/08 22:06:45 rslopes
* BEAM for YAP update...
*
* Revision 1.93 2005/08/04 15:45:53 ricroc
* TABLING NEW: support to limit the table space size
*
* Revision 1.92 2005/07/20 13:54:27 rslopes
* solved warning: cast from pointer to integer of different size
*
* Revision 1.91 2005/07/06 19:33:54 ricroc
* TABLING: answers for completed calls can now be obtained by loading (new
*option) or executing (default) them from the trie data structure.
*
* Revision 1.90 2005/07/06 15:10:14 vsc
* improvements to compiler: merged instructions and fixes for ->
*
* Revision 1.89 2005/05/26 18:01:11 rslopes
* *** empty log message ***
*
* Revision 1.88 2005/04/27 20:09:25 vsc
* indexing code could get confused with suspension points
* some further improvements on oveflow handling
* fix paths in Java makefile
* changs to support gibbs sampling in CLP(BN)
*
* Revision 1.87 2005/04/07 17:48:55 ricroc
* Adding tabling support for mixed strategy evaluation (batched and local
*scheduling)
* UPDATE: compilation flags -DTABLING_BATCHED_SCHEDULING and
*-DTABLING_LOCAL_SCHEDULING removed. To support tabling use -DTABLING in the
*Makefile or --enable-tabling in configure.
* NEW: yap_flag(tabling_mode,MODE) changes the tabling execution mode of all
*tabled predicates to MODE (batched, local or default).
* NEW: tabling_mode(PRED,MODE) changes the default tabling execution mode of
*predicate PRED to MODE (batched or local).
*
* Revision 1.86 2005/03/13 06:26:11 vsc
* fix excessive pruning in meta-calls
* fix Term->int breakage in compiler
* improve JPL (at least it does something now for amd64).
*
* Revision 1.85 2005/03/02 19:48:02 vsc
* Fix some possible errors in name/2 and friends, and cleanup code a bit
* YAP_Error changed.
*
* Revision 1.84 2005/03/02 18:35:46 vsc
* try to make initialization process more robust
* try to make name more robust (in case Lookup new atom fails)
*
* Revision 1.83 2005/03/01 22:25:09 vsc
* fix pruning bug
* make DL_MALLOC less enthusiastic about walking through buckets.
*
* Revision 1.82 2005/02/21 16:50:04 vsc
* amd64 fixes
* library fixes
*
* Revision 1.81 2005/02/08 04:05:35 vsc
* fix mess with add clause
* improves on sigsegv handling
*
* Revision 1.80 2005/01/05 05:32:37 vsc
* Ricardo's latest version of profiler.
*
* Revision 1.79 2004/12/28 22:20:36 vsc
* some extra bug fixes for trail overflows: some cannot be recovered that
*easily,
* some can.
*
* Revision 1.78 2004/12/08 04:45:03 vsc
* polish changes to undefp
* get rid of a few warnings
*
* Revision 1.77 2004/12/05 05:07:26 vsc
* name/2 should accept [] as a valid list (string)
*
* Revision 1.76 2004/12/05 05:01:25 vsc
* try to reduce overheads when running with goal expansion enabled.
* CLPBN fixes
* Handle overflows when allocating big clauses properly.
*
* Revision 1.75 2004/12/02 06:06:46 vsc
* fix threads so that they at least start
* allow error handling to work with threads
* replace heap_base by Yap_heap_base, according to Yap's convention for globals.
*
* Revision 1.74 2004/11/19 22:08:43 vsc
* replace SYSTEM_ERROR_INTERNAL by out OUT_OF_WHATEVER_ERROR whenever
*appropriate.
*
* Revision 1.73 2004/11/19 17:14:14 vsc
* a few fixes for 64 bit compiling.
*
* Revision 1.72 2004/11/18 22:32:37 vsc
* fix situation where we might assume nonextsing double initialization of C
*predicates (use
* Hidden Pred Flag).
* $host_type was double initialized.
*
* Revision 1.71 2004/07/23 21:08:44 vsc
* windows fixes
*
* Revision 1.70 2004/06/29 19:04:42 vsc
* fix multithreaded version
* include new version of Ricardo's profiler
* new predicat atomic_concat
* allow multithreaded-debugging
* small fixes
*
* Revision 1.69 2004/06/16 14:12:53 vsc
* miscellaneous fixes
*
* Revision 1.68 2004/05/14 17:11:30 vsc
* support BigNums in interface
*
* Revision 1.67 2004/05/14 16:33:45 vsc
* add Yap_ReadBuffer
*
* Revision 1.66 2004/05/13 20:54:58 vsc
* debugger fixes
* make sure we always go back to current module, even during initizlization.
*
* Revision 1.65 2004/04/27 15:14:36 vsc
* fix halt/0 and halt/1
* *
* *
* *
*************************************************************************/
#ifdef SCCS
@ -1008,12 +760,14 @@ static PredEntry *firstModulesPred(PredEntry *npp, ModEntry *m, Term task) {
static Int cont_current_predicate(USES_REGS1) {
UInt Arity;
Term name, task;
Term t1 = ARG1, t2 = ARG2, t3 = ARG3;
Term t1 = ARG1, t2 = Deref(ARG2), t3 = ARG3;
bool rc, will_cut = false;
Functor f;
PredEntry *pp;
t1 = Yap_YapStripModule(t1, &t2);
t3 = Yap_YapStripModule(t3, &t2);
t1 = Deref(t1);
t2 = Deref(t2);
task = Deref(ARG4);
pp = AddressOfTerm(EXTRA_CBACK_ARG(4, 1));
@ -1102,17 +856,34 @@ static Int cont_current_predicate(USES_REGS1) {
if (!pp) {
if (!IsAtomTerm(t2)) {
Yap_Error(TYPE_ERROR_ATOM, t2, "current_predicate/2");
Yap_Error(TYPE_ERROR_ATOM, t2, "module name");
}
ModEntry *m = Yap_GetModuleEntry(t2);
pp = firstModulePred(m->PredForME, task);
if (!pp)
cut_fail();
if (!pp) {
/* try Prolog Module */
if (task != TermUser) {
ModEntry *m = Yap_GetModuleEntry(TermProlog);
pp = firstModulePred(m->PredForME, task);
if (!pp) {
cut_fail();
}
}
}
}
npp = firstModulePred(pp, task);
if (!npp)
will_cut = true;
if (!npp) {
if (pp->ModuleOfPred != PROLOG_MODULE &&
task != TermUser) {
ModEntry *m = Yap_GetModuleEntry(TermProlog);
npp = firstModulePred(m->PredForME, task);
if (!npp)
will_cut = true;
} else {
will_cut = true;
}
}
// just try next one
else {
EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(npp);
@ -1164,11 +935,13 @@ static Int cont_current_predicate(USES_REGS1) {
}
}
if (Arity) {
rc = Yap_unify(t3, Yap_MkNewApplTerm(f, Arity));
rc = Yap_unify(ARG3, Yap_MkNewApplTerm(f, Arity));
} else {
rc = Yap_unify(t3, name);
rc = Yap_unify(ARG3, name);
}
rc = rc && Yap_unify(t2, ModToTerm(pp->ModuleOfPred)) && Yap_unify(t1, name);
rc = rc && (IsAtomTerm(t2) ||
Yap_unify(ARG2, ModToTerm(pp->ModuleOfPred)))
&& Yap_unify(ARG1, name);
if (will_cut) {
if (rc)
cut_succeed();

View File

@ -137,8 +137,8 @@ check_area(void)
}
*/
PredEntry *old_p[10000];
Term old_x1[10000], old_x2[10000], old_x3[10000];
//PredEntry *old_p[10000];
//Term old_x1[10000], old_x2[10000], old_x3[10000];
// static CELL oldv;
@ -329,18 +329,23 @@ void low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) {
UNLOCK(Yap_low_level_trace_lock);
return;
}
if (pred->ModuleOfPred == 0 && !LOCAL_do_trace_primitives) {
UNLOCK(Yap_low_level_trace_lock);
return;
if (pred->ModuleOfPred == PROLOG_MODULE) {
if (!LOCAL_do_trace_primitives) {
UNLOCK(Yap_low_level_trace_lock);
return;
}
mname = "prolog";
} else {
mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
}
switch (port) {
case enter_pred:
mname = (char *)RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
arity = pred->ArityOfPE;
if (arity == 0)
if (arity == 0) {
s = (char *)RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
else
} else {
s = (char *)RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
}
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
return; */
send_tracer_message("CALL: ", s, arity, mname, args);

View File

@ -19,6 +19,7 @@
#include "config.h"
#include "Yap.h"
#include "YapHeap.h"
#include "YapInterface.h"
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
@ -28,8 +29,8 @@
#include <stdlib.h>
#include <stddef.h>
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
#ifdef HAVE_UNISTD_H
#undef HAVE_UNISTD_H
#ifdef HAVE_UNISTD_H
#undef HAVE_UNISTD_H
#endif
#endif
@ -44,78 +45,77 @@
#include <direct.h>
#endif
void YAP_SetOutputMessage(void);
int YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap);
#if (DefTrailSpace < MinTrailSpace)
#undef DefTrailSpace
#define DefTrailSpace MinTrailSpace
#define DefTrailSpace MinTrailSpace
#endif
#if (DefStackSpace < MinStackSpace)
#undef DefStackSpace
#define DefStackSpace MinStackSpace
#define DefStackSpace MinStackSpace
#endif
#if (DefHeapSpace < MinHeapSpace)
#undef DefHeapSpace
#define DefHeapSpace MinHeapSpace
#define DefHeapSpace MinHeapSpace
#endif
#define DEFAULT_NUMBERWORKERS 1
#define DEFAULT_SCHEDULERLOOP 10
#define DEFAULT_DELAYEDRELEASELOAD 3
#define DEFAULT_NUMBERWORKERS 1
#define DEFAULT_SCHEDULERLOOP 10
#define DEFAULT_DELAYEDRELEASELOAD 3
static void
print_usage(void)
{
fprintf(stderr,"\n[ Valid switches for command line arguments: ]\n");
fprintf(stderr," -? Shows this screen\n");
fprintf(stderr," -b Boot file \n");
fprintf(stderr," -dump-runtime-variables\n");
fprintf(stderr," -f initialization file or \"none\"\n");
fprintf(stderr," -g Run Goal Before Top-Level \n");
fprintf(stderr," -z Run Goal Before Top-Level \n");
fprintf(stderr," -q start with informational messages off\n");
fprintf(stderr," -l load Prolog file\n");
fprintf(stderr," -L run Prolog file and exit\n");
fprintf(stderr," -p extra path for file-search-path\n");
fprintf(stderr," -hSize Heap area in Kbytes (default: %d, minimum: %d)\n",
DefHeapSpace, MinHeapSpace);
fprintf(stderr," -sSize Stack area in Kbytes (default: %d, minimum: %d)\n",
DefStackSpace, MinStackSpace);
fprintf(stderr," -tSize Trail area in Kbytes (default: %d, minimum: %d)\n",
DefTrailSpace, MinTrailSpace);
fprintf(stderr," -GSize Max Area for Global Stack\n");
fprintf(stderr," -LSize Max Area for Local Stack (number must follow L)\n");
fprintf(stderr," -TSize Max Area for Trail (number must follow L)\n");
fprintf(stderr," -nosignals disable signal handling from Prolog\n");
fprintf(stderr,"\n[Execution Modes]\n");
fprintf(stderr," -J0 Interpreted mode (default)\n");
fprintf(stderr," -J1 Mixed mode only for user predicates\n");
fprintf(stderr," -J2 Mixed mode for all predicates\n");
fprintf(stderr," -J3 Compile all user predicates\n");
fprintf(stderr," -J4 Compile all predicates\n");
static void print_usage(void) {
fprintf(stderr, "\n[ Valid switches for command line arguments: ]\n");
fprintf(stderr, " -? Shows this screen\n");
fprintf(stderr, " -b Boot file \n");
fprintf(stderr, " -dump-runtime-variables\n");
fprintf(stderr, " -f initialization file or \"none\"\n");
fprintf(stderr, " -g Run Goal Before Top-Level \n");
fprintf(stderr, " -z Run Goal Before Top-Level \n");
fprintf(stderr, " -q start with informational messages off\n");
fprintf(stderr, " -l load Prolog file\n");
fprintf(stderr, " -L run Prolog file and exit\n");
fprintf(stderr, " -p extra path for file-search-path\n");
fprintf(stderr, " -hSize Heap area in Kbytes (default: %d, minimum: %d)\n",
DefHeapSpace, MinHeapSpace);
fprintf(stderr,
" -sSize Stack area in Kbytes (default: %d, minimum: %d)\n",
DefStackSpace, MinStackSpace);
fprintf(stderr,
" -tSize Trail area in Kbytes (default: %d, minimum: %d)\n",
DefTrailSpace, MinTrailSpace);
fprintf(stderr, " -GSize Max Area for Global Stack\n");
fprintf(stderr,
" -LSize Max Area for Local Stack (number must follow L)\n");
fprintf(stderr, " -TSize Max Area for Trail (number must follow L)\n");
fprintf(stderr, " -nosignals disable signal handling from Prolog\n");
fprintf(stderr, "\n[Execution Modes]\n");
fprintf(stderr, " -J0 Interpreted mode (default)\n");
fprintf(stderr, " -J1 Mixed mode only for user predicates\n");
fprintf(stderr, " -J2 Mixed mode for all predicates\n");
fprintf(stderr, " -J3 Compile all user predicates\n");
fprintf(stderr, " -J4 Compile all predicates\n");
#ifdef TABLING
fprintf(stderr," -ts Maximum table space area in Mbytes (default: unlimited)\n");
fprintf(stderr,
" -ts Maximum table space area in Mbytes (default: unlimited)\n");
#endif /* TABLING */
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS)
fprintf(stderr," -w Number of workers (default: %d)\n",
DEFAULT_NUMBERWORKERS);
fprintf(stderr," -sl Loop scheduler executions before look for hiden shared work (default: %d)\n",
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \
defined(YAPOR_THREADS)
fprintf(stderr, " -w Number of workers (default: %d)\n",
DEFAULT_NUMBERWORKERS);
fprintf(stderr, " -sl Loop scheduler executions before look for hiden "
"shared work (default: %d)\n",
DEFAULT_SCHEDULERLOOP);
fprintf(stderr," -d Value of delayed release of load (default: %d)\n",
DEFAULT_DELAYEDRELEASELOAD);
fprintf(stderr, " -d Value of delayed release of load (default: %d)\n",
DEFAULT_DELAYEDRELEASELOAD);
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
/* nf: Preprocessor */
/* nf: Preprocessor */
/* fprintf(stderr," -DVar=Name Persistent definition\n"); */
fprintf(stderr,"\n");
fprintf(stderr, "\n");
}
static int
myisblank(int c)
{
static int myisblank(int c) {
switch (c) {
case ' ':
case '\t':
@ -127,47 +127,34 @@ myisblank(int c)
}
}
static char *
add_end_dot(char arg[])
{
static char *add_end_dot(char arg[]) {
int sz = strlen(arg), i;
i = sz;
while (i && myisblank(arg[--i]));
while (i && myisblank(arg[--i]))
;
if (i && arg[i] != ',') {
char *p = (char *)malloc(sz+2);
char *p = (char *)malloc(sz + 2);
if (!p)
return NULL;
strncpy(p,arg,sz);
strncpy(p, arg, sz);
p[sz] = '.';
p[sz+1] = '\0';
p[sz + 1] = '\0';
return p;
}
return arg;
}
static int
dump_runtime_variables(void)
{
fprintf(stdout,"CC=\"%s\"\n",C_CC);
fprintf(stdout,"YAP_ROOTDIR=\"%s\"\n",YAP_ROOTDIR);
fprintf(stdout,"YAP_LIBS=\"%s\"\n",C_LIBS);
fprintf(stdout,"YAP_SHLIB_SUFFIX=\"%s\"\n",SO_EXT);
fprintf(stdout,"YAP_VERSION=%s\n",YAP_NUMERIC_VERSION);
static int dump_runtime_variables(void) {
fprintf(stdout, "CC=\"%s\"\n", C_CC);
fprintf(stdout, "YAP_ROOTDIR=\"%s\"\n", YAP_ROOTDIR);
fprintf(stdout, "YAP_LIBS=\"%s\"\n", C_LIBS);
fprintf(stdout, "YAP_SHLIB_SUFFIX=\"%s\"\n", SO_EXT);
fprintf(stdout, "YAP_VERSION=%s\n", YAP_NUMERIC_VERSION);
exit(0);
return 1;
}
/*
* proccess command line arguments: valid switches are: -b boot -s
* stack area size (K) -h heap area size -a aux stack size -e
* emacs_mode -m -DVar=Value reserved memory for alloc IF DEBUG -p if you
* want to check out startup IF MAC -mpw if we are using the mpw
* shell
*/
int
YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
{
X_API int YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) {
char *p;
int BootMode = YAP_BOOT_FROM_SAVED_CODE;
unsigned long int *ssize;
@ -204,359 +191,372 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
iap->ErrorCause = NULL;
iap->QuietMode = FALSE;
while (--argc > 0)
{
p = *++argv;
if (*p == '-')
switch (*++p)
{
case 'b':
BootMode = YAP_BOOT_FROM_PROLOG;
iap->YapPrologBootFile = *++argv;
argc--;
break;
case '?':
print_usage();
exit(EXIT_SUCCESS);
case 'q':
iap->QuietMode = TRUE;
break;
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS)
case 'w':
ssize = &(iap->NumberWorkers);
goto GetSize;
case 'd':
if (!strcmp("dump-runtime-variables",p))
return dump_runtime_variables();
ssize = &(iap->DelayedReleaseLoad);
goto GetSize;
while (--argc > 0) {
p = *++argv;
if (*p == '-')
switch (*++p) {
case 'b':
BootMode = YAP_BOOT_FROM_PROLOG;
iap->YapPrologBootFile = *++argv;
argc--;
break;
case '?':
print_usage();
exit(EXIT_SUCCESS);
case 'q':
iap->QuietMode = TRUE;
break;
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \
defined(YAPOR_THREADS)
case 'w':
ssize = &(iap->NumberWorkers);
goto GetSize;
case 'd':
if (!strcmp("dump-runtime-variables", p))
return dump_runtime_variables();
ssize = &(iap->DelayedReleaseLoad);
goto GetSize;
#else
case 'd':
if (!strcmp("dump-runtime-variables",p))
return dump_runtime_variables();
case 'd':
if (!strcmp("dump-runtime-variables", p))
return dump_runtime_variables();
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
case 'F':
/* just ignore for now */
argc--;
argv++;
break;
case 'f':
iap->FastBoot = TRUE;
if (argc > 1 && argv[1][0] != '-') {
argc--;
argv++;
if (strcmp(*argv,"none")) {
iap->YapPrologRCFile = *argv;
}
break;
}
break;
// execution mode
case 'J':
switch (p[1]) {
case '0':
iap->ExecutionMode = YAPC_INTERPRETED;
break;
case '1':
iap->ExecutionMode = YAPC_MIXED_MODE_USER;
break;
case '2':
iap->ExecutionMode = YAPC_MIXED_MODE_ALL;
break;
case '3':
iap->ExecutionMode = YAPC_COMPILE_USER;
break;
case '4':
iap->ExecutionMode = YAPC_COMPILE_ALL;
break;
default:
fprintf(stderr,"[ YAP unrecoverable error: unknown switch -%c%c ]\n", *p, p[1]);
exit(EXIT_FAILURE);
}
p++;
break;
case 'G':
ssize = &(iap->MaxGlobalSize);
goto GetSize;
break;
case 's':
case 'S':
ssize = &(iap->StackSize);
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS)
if (p[1] == 'l') {
p++;
ssize = &(iap->SchedulerLoop);
}
case 'F':
/* just ignore for now */
argc--;
argv++;
break;
case 'f':
iap->FastBoot = TRUE;
if (argc > 1 && argv[1][0] != '-') {
argc--;
argv++;
if (strcmp(*argv, "none")) {
iap->YapPrologRCFile = *argv;
}
break;
}
break;
// execution mode
case 'J':
switch (p[1]) {
case '0':
iap->ExecutionMode = YAPC_INTERPRETED;
break;
case '1':
iap->ExecutionMode = YAPC_MIXED_MODE_USER;
break;
case '2':
iap->ExecutionMode = YAPC_MIXED_MODE_ALL;
break;
case '3':
iap->ExecutionMode = YAPC_COMPILE_USER;
break;
case '4':
iap->ExecutionMode = YAPC_COMPILE_ALL;
break;
default:
fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c%c ]\n",
*p, p[1]);
exit(EXIT_FAILURE);
}
p++;
break;
case 'G':
ssize = &(iap->MaxGlobalSize);
goto GetSize;
break;
case 's':
case 'S':
ssize = &(iap->StackSize);
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \
defined(YAPOR_THREADS)
if (p[1] == 'l') {
p++;
ssize = &(iap->SchedulerLoop);
}
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
goto GetSize;
case 'a':
case 'A':
ssize = &(iap->AttsSize);
goto GetSize;
case 'T':
ssize = &(iap->MaxTrailSize);
goto get_trail_size;
case 't':
ssize = &(iap->TrailSize);
goto GetSize;
case 'a':
case 'A':
ssize = &(iap->AttsSize);
goto GetSize;
case 'T':
ssize = &(iap->MaxTrailSize);
goto get_trail_size;
case 't':
ssize = &(iap->TrailSize);
#ifdef TABLING
if (p[1] == 's') {
p++;
ssize = &(iap->MaxTableSpaceSize);
}
if (p[1] == 's') {
p++;
ssize = &(iap->MaxTableSpaceSize);
}
#endif /* TABLING */
get_trail_size:
if (*++p == '\0')
{
if (argc > 1)
--argc, p = *++argv;
else
{
fprintf(stderr,"[ YAP unrecoverable error: missing size in flag %s ]", argv[0]);
print_usage();
exit(EXIT_FAILURE);
}
}
{
unsigned long int i = 0, ch;
while ((ch = *p++) >= '0' && ch <= '9')
i = i * 10 + ch - '0';
switch(ch) {
case 'M':
case 'm':
i *= 1024;
ch = *p++;
break;
case 'g':
i *= 1024*1024;
ch = *p++;
break;
case 'k':
case 'K':
ch = *p++;
break;
}
if (ch) {
iap->YapPrologTopLevelGoal = add_end_dot(*argv);
} else {
*ssize = i;
}
}
break;
case 'h':
case 'H':
ssize = &(iap->HeapSize);
GetSize:
if (*++p == '\0')
{
if (argc > 1)
--argc, p = *++argv;
else
{
fprintf(stderr,"[ YAP unrecoverable error: missing size in flag %s ]", argv[0]);
print_usage();
exit(EXIT_FAILURE);
}
}
{
unsigned long int i = 0, ch;
while ((ch = *p++) >= '0' && ch <= '9')
i = i * 10 + ch - '0';
switch(ch) {
case 'M':
case 'm':
i *= 1024;
ch = *p++;
break;
case 'g':
case 'G':
i *= 1024*1024;
ch = *p++;
break;
case 'k':
case 'K':
ch = *p++;
break;
}
if (ch)
{
fprintf(stderr,"[ YAP unrecoverable error: illegal size specification %s ]", argv[-1]);
Yap_exit(1);
}
*ssize = i;
}
break;
#ifdef DEBUG
case 'P':
YAP_SetOutputMessage();
if (p[1] != '\0') {
while (p[1] != '\0') {
int ch = p[1];
if (ch >= 'A' && ch <= 'Z')
ch += ('a'-'A');
if (ch >= 'a' && ch <= 'z')
GLOBAL_Option[ch - 96] = 1;
}
}
break;
#endif
case 'L':
if (p[1] && p[1] >= '0' && p[1] <= '9') /* hack to emulate SWI's L local option */
{
ssize = &(iap->MaxStackSize);
goto GetSize;
}
iap->QuietMode = TRUE;
iap->HaltAfterConsult = TRUE;
case 'l':
p++;
if (!*++argv) {
fprintf(stderr,"%% YAP unrecoverable error: missing load file name\n");
exit(1);
} else if (!strcmp("--",*argv)) {
/* shell script, the next entry should be the file itself */
iap->YapPrologRCFile = argv[1];
argc = 1;
break;
} else {
iap->YapPrologRCFile = *argv;
argc--;
}
if (*p) {
/* we have something, usually, of the form:
-L --
FileName
ExtraArgs
*/
/* being called from a script */
while (*p && (*p == ' ' || *p == '\t'))
p++;
if (p[0] == '-' && p[1] == '-') {
/* ignore what is next */
argc = 1;
}
}
break;
/* run goal before top-level */
case 'g':
if ((*argv)[0] == '\0')
iap->YapPrologGoal = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr," [ YAP unrecoverable error: missing initialization goal for option 'g' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologGoal = *argv;
}
break;
/* run goal as top-level */
case 'z':
if ((*argv)[0] == '\0')
iap->YapPrologTopLevelGoal = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr," [ YAP unrecoverable error: missing goal for option 'z' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologTopLevelGoal = add_end_dot(*argv);
}
break;
case 'n':
if (!strcmp("nosignals", p)) {
iap->PrologShouldHandleInterrupts = FALSE;
break;
}
break;
case '-':
if (!strcmp("-nosignals", p)) {
iap->PrologShouldHandleInterrupts = FALSE;
break;
} else if (!strncmp("-home=",p,strlen("-home="))) {
GLOBAL_Home = p+strlen("-home=");
} else if (!strncmp("-cwd=",p,strlen("-cwd="))) {
#if __WINDOWS__
if (_chdir( p+strlen("-cwd=") ) < 0) {
#else
if (chdir( p+strlen("-cwd=") ) < 0) {
#endif
fprintf(stderr," [ YAP unrecoverable error in setting cwd: %s ]\n", strerror(errno));
}
} else if (!strncmp("-stack=",p,strlen("-stack="))) {
ssize = &(iap->StackSize);
p+=strlen("-stack=");
goto GetSize;
} else if (!strncmp("-trail=",p,strlen("-trail="))) {
ssize = &(iap->TrailSize);
p+=strlen("-trail=");
goto GetSize;
} else if (!strncmp("-heap=",p,strlen("-heap="))) {
ssize = &(iap->HeapSize);
p+=strlen("-heap=");
goto GetSize;
} else if (!strncmp("-goal=",p,strlen("-goal="))) {
iap->YapPrologGoal = p+strlen("-goal=");
} else if (!strncmp("-top-level=",p,strlen("-top-level="))) {
iap->YapPrologTopLevelGoal = p+strlen("-top-level=");
} else if (!strncmp("-table=",p,strlen("-table="))) {
ssize = &(iap->MaxTableSpaceSize);
p +=strlen( "-table=");
goto GetSize;
} else if (!strncmp("-",p,strlen("-="))) {
ssize = &(iap->MaxTableSpaceSize);
p +=strlen( "-table=");
/* skip remaining arguments */
argc = 1;
}
get_trail_size:
if (*++p == '\0') {
if (argc > 1)
--argc, p = *++argv;
else {
fprintf(stderr,
"[ YAP unrecoverable error: missing size in flag %s ]",
argv[0]);
print_usage();
exit(EXIT_FAILURE);
}
}
{
unsigned long int i = 0, ch;
while ((ch = *p++) >= '0' && ch <= '9')
i = i * 10 + ch - '0';
switch (ch) {
case 'M':
case 'm':
i *= 1024;
ch = *p++;
break;
case 'p':
if ((*argv)[0] == '\0')
iap->YapPrologAddPath = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr," [ YAP unrecoverable error: missing paths for option 'p' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologAddPath = *argv;
}
break;
/* nf: Begin preprocessor code */
case 'D':
{
char *var, *value;
++p;
var = p;
if (var == NULL || *var=='\0')
break;
while(*p!='=' && *p!='\0') ++p;
if ( *p=='\0' ) break;
*p='\0';
++p;
value=p;
if ( *value == '\0' ) break;
if (iap->def_c == YAP_MAX_YPP_DEFS)
break;
iap->def_var[iap->def_c]=var;
iap->def_value[iap->def_c]=value;
++(iap->def_c);
break;
}
/* End preprocessor code */
default:
{
fprintf(stderr,"[ YAP unrecoverable error: unknown switch -%c ]\n", *p);
print_usage();
exit(EXIT_FAILURE);
}
}
else {
iap->SavedState = p;
case 'g':
i *= 1024 * 1024;
ch = *p++;
break;
case 'k':
case 'K':
ch = *p++;
break;
}
if (ch) {
iap->YapPrologTopLevelGoal = add_end_dot(*argv);
} else {
*ssize = i;
}
}
break;
case 'h':
case 'H':
ssize = &(iap->HeapSize);
GetSize:
if (*++p == '\0') {
if (argc > 1)
--argc, p = *++argv;
else {
fprintf(stderr,
"[ YAP unrecoverable error: missing size in flag %s ]",
argv[0]);
print_usage();
exit(EXIT_FAILURE);
}
}
{
unsigned long int i = 0, ch;
while ((ch = *p++) >= '0' && ch <= '9')
i = i * 10 + ch - '0';
switch (ch) {
case 'M':
case 'm':
i *= 1024;
ch = *p++;
break;
case 'g':
case 'G':
i *= 1024 * 1024;
ch = *p++;
break;
case 'k':
case 'K':
ch = *p++;
break;
}
if (ch) {
fprintf(
stderr,
"[ YAP unrecoverable error: illegal size specification %s ]",
argv[-1]);
Yap_exit(1);
}
*ssize = i;
}
break;
#ifdef DEBUG
case 'P':
YAP_SetOutputMessage();
if (p[1] != '\0') {
while (p[1] != '\0') {
int ch = p[1];
if (ch >= 'A' && ch <= 'Z')
ch += ('a' - 'A');
if (ch >= 'a' && ch <= 'z')
GLOBAL_Option[ch - 96] = 1;
}
}
break;
#endif
case 'L':
if (p[1] && p[1] >= '0' &&
p[1] <= '9') /* hack to emulate SWI's L local option */
{
ssize = &(iap->MaxStackSize);
goto GetSize;
}
iap->QuietMode = TRUE;
iap->HaltAfterConsult = TRUE;
case 'l':
p++;
if (!*++argv) {
fprintf(stderr,
"%% YAP unrecoverable error: missing load file name\n");
exit(1);
} else if (!strcmp("--", *argv)) {
/* shell script, the next entry should be the file itself */
iap->YapPrologRCFile = argv[1];
argc = 1;
break;
} else {
iap->YapPrologRCFile = *argv;
argc--;
}
if (*p) {
/* we have something, usually, of the form:
-L --
FileName
ExtraArgs
*/
/* being called from a script */
while (*p && (*p == ' ' || *p == '\t'))
p++;
if (p[0] == '-' && p[1] == '-') {
/* ignore what is next */
argc = 1;
}
}
break;
/* run goal before top-level */
case 'g':
if ((*argv)[0] == '\0')
iap->YapPrologGoal = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr, " [ YAP unrecoverable error: missing "
"initialization goal for option 'g' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologGoal = *argv;
}
break;
/* run goal as top-level */
case 'z':
if ((*argv)[0] == '\0')
iap->YapPrologTopLevelGoal = *argv;
else {
argc--;
if (argc == 0) {
fprintf(
stderr,
" [ YAP unrecoverable error: missing goal for option 'z' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologTopLevelGoal = add_end_dot(*argv);
}
break;
case 'n':
if (!strcmp("nosignals", p)) {
iap->PrologShouldHandleInterrupts = FALSE;
break;
}
break;
case '-':
if (!strcmp("-nosignals", p)) {
iap->PrologShouldHandleInterrupts = FALSE;
break;
} else if (!strncmp("-home=", p, strlen("-home="))) {
GLOBAL_Home = p + strlen("-home=");
} else if (!strncmp("-cwd=", p, strlen("-cwd="))) {
#if __WINDOWS__
if (_chdir(p + strlen("-cwd=")) < 0) {
#else
if (chdir(p + strlen("-cwd=")) < 0) {
#endif
fprintf(stderr, " [ YAP unrecoverable error in setting cwd: %s ]\n",
strerror(errno));
}
} else if (!strncmp("-stack=", p, strlen("-stack="))) {
ssize = &(iap->StackSize);
p += strlen("-stack=");
goto GetSize;
} else if (!strncmp("-trail=", p, strlen("-trail="))) {
ssize = &(iap->TrailSize);
p += strlen("-trail=");
goto GetSize;
} else if (!strncmp("-heap=", p, strlen("-heap="))) {
ssize = &(iap->HeapSize);
p += strlen("-heap=");
goto GetSize;
} else if (!strncmp("-goal=", p, strlen("-goal="))) {
iap->YapPrologGoal = p + strlen("-goal=");
} else if (!strncmp("-top-level=", p, strlen("-top-level="))) {
iap->YapPrologTopLevelGoal = p + strlen("-top-level=");
} else if (!strncmp("-table=", p, strlen("-table="))) {
ssize = &(iap->MaxTableSpaceSize);
p += strlen("-table=");
goto GetSize;
} else if (!strncmp("-", p, strlen("-="))) {
ssize = &(iap->MaxTableSpaceSize);
p += strlen("-table=");
/* skip remaining arguments */
argc = 1;
}
break;
case 'p':
if ((*argv)[0] == '\0')
iap->YapPrologAddPath = *argv;
else {
argc--;
if (argc == 0) {
fprintf(
stderr,
" [ YAP unrecoverable error: missing paths for option 'p' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologAddPath = *argv;
}
break;
/* nf: Begin preprocessor code */
case 'D': {
char *var, *value;
++p;
var = p;
if (var == NULL || *var == '\0')
break;
while (*p != '=' && *p != '\0')
++p;
if (*p == '\0')
break;
*p = '\0';
++p;
value = p;
if (*value == '\0')
break;
if (iap->def_c == YAP_MAX_YPP_DEFS)
break;
iap->def_var[iap->def_c] = var;
iap->def_value[iap->def_c] = value;
++(iap->def_c);
break;
}
/* End preprocessor code */
default: {
fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c ]\n",
*p);
print_usage();
exit(EXIT_FAILURE);
}
}
else {
iap->SavedState = p;
}
//___androidlog_print(ANDROID_LOG_INFO, "YAP ", "boot mode %d", BootMode);
}
//___androidlog_print(ANDROID_LOG_INFO, "YAP ", "boot mode %d", BootMode);
return BootMode;
}

View File

@ -115,6 +115,7 @@ add_library(libYap
${STATIC_SOURCES}
${OPTYAP_SOURCES}
${HEADERS}
${WINDLLS}
$<TARGET_OBJECTS:libYAPOs>
$<TARGET_OBJECTS:libOPTYap>
$<TARGET_OBJECTS:myddas>
@ -169,7 +170,7 @@ set(YAP_STARTUP startup.yss)
string(TIMESTAMP YAP_TIMESTAMP)
string( SUBSTRING ${CMAKE_SHARED_LIBRARY_SUFFIX} 1 -1 SO_EXT )
#
include_directories (H include os OPTYap utf8proc JIT/HPP)
include_directories (H H/generated include os OPTYap utf8proc JIT/HPP)
include_directories (BEFORE ${CMAKE_BINARY_DIR})
# rpath stuff, hopefully it works
@ -416,10 +417,21 @@ add_subDIRECTORY (packages/raptor)
add_subDIRECTORY (packages/xml)
# add_subDIRECTORY (docs)
# please install doxygen for prolog first
# git clone http://www.github.com/vscosta/doxygen-yap
# cd doxygen-yap
# mkdir -p build
# cd build
# make; sudo make install
option (WITH_DOCS
"generate YAP docs" OFF)
add_subDIRECTORY (docs)
# add_subDIRECTORY (packages/cuda)
#todo: use cmake target builds
# option (USE_MAXPERFORMANCE
# "try using the best flags for specific architecture" OFF)
@ -493,6 +505,11 @@ target_link_libraries(libYap
${CMAKE_DL_LIBS}
)
if(WIN32)
target_link_libraries(libYap wsock32 ws2_32 Shlwapi
)
endif()
add_executable (yap-bin ${CONSOLE_SOURCES})
set_target_properties (yap-bin PROPERTIES OUTPUT_NAME yap)

View File

@ -14,7 +14,9 @@ include_directories (H include ${CMAKE_BINARY_DIR} ${GMP_INCLUDE_DIR})
target_link_libraries(Yap++ libYap)
install(TARGETS Yap++
LIBRARY DESTINATION ${libdir} )
LIBRARY DESTINATION ${libdir}
ARCHIVE DESTINATION ${libdir}
)
set( CMAKE_REQUIRED_INCLUDES ${CMAKE_REQUIRED_INCLUDES} ${GMP_INCLUDE_DIR} )
#set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${GMP_LIBRARIES} )

View File

@ -1,6 +1,8 @@
#define YAP_CPP_INTERFACE 1
//! @{
/**

View File

@ -1,2 +1,2 @@
#define GIT_SHA1 "713e9dc9d83c385f5bdd57c8cfa4c7771a6cdb12"
#define GIT_SHA1 "703ac357357858351b27cb33b12830193e591282"
const char g_GIT_SHA1[] = GIT_SHA1;

View File

@ -37,7 +37,7 @@
#undef NO_DYN
#endif /* __AIX */
#if HAVE_DLOPEN
#ifdef HAVE_DLOPEN
#define LOAD_DL 1
#ifdef NO_DYN
#undef NO_DYN

View File

@ -590,12 +590,13 @@ typedef enum
#else
#define YAPEnterCriticalSection() \
{ \
LOCAL_PrologMode |= CritMode; \
LOCAL_PrologMode |= CritMode;/* printf("%d, %s:%d\n",LOCAL_CritLocks+1,__FILE__,__LINE__);*/ \
LOCAL_CritLocks++; \
}
#define YAPLeaveCriticalSection() \
{ \
LOCAL_CritLocks--; \
/*printf("%d, %s:%d\n",LOCAL_CritLocks,__FILE__,__LINE__);*/ \
if (!LOCAL_CritLocks) { \
LOCAL_PrologMode &= ~CritMode; \
if (LOCAL_PrologMode & AbortMode) { \

View File

@ -88,9 +88,9 @@ static inline bool isfloat(Term inp) {
return false;
}
INLINE_ONLY inline EXTERN bool ro(Term inp);
static inline bool ro(Term inp);
INLINE_ONLY inline EXTERN bool ro(Term inp) {
static inline bool ro(Term inp) {
if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag: value must be %s",
"bound");
@ -114,9 +114,9 @@ INLINE_ONLY inline EXTERN bool aro(Term inp) {
return false;
}
// INLINE_ONLY inline EXTERN bool boolean( Term inp );
// INLINE_ONLY inline EXTERN bool booleanFlag( Term inp );
static inline bool boolean(Term inp) {
static inline bool booleanFlag(Term inp) {
if (inp == TermTrue || inp == TermFalse || inp == TermOn || inp == TermOff)
return true;
if (IsVarTerm(inp)) {
@ -151,6 +151,17 @@ static bool synerr(Term inp) {
static inline bool filler(Term inp) { return true; }
static inline bool list_filler(Term inp) {
if (IsVarTerm(inp) ||
IsPairTerm(inp) ||
inp == TermNil)
return true;
Yap_Error(TYPE_ERROR_LIST, inp,
"set_prolog_flag in {codes,string}");
return false; }
static bool bqs(Term inp) {
if (inp == TermCodes || inp == TermString || inp == TermSymbolChar)
return true;

View File

@ -42,12 +42,12 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
(zero) disables atom garbage collection.
*/
YAP_FLAG(ALLOW_ASSERT_FOR_STATIC_PREDICATES,
"allow_assert_for_static_predicates", true, boolean, "true",
"allow_assert_for_static_predicates", true, booleanFlag, "true",
NULL), /**< `allow asserting and retracting clauses of static
predicates. */
/* YAP_FLAG( ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG,
"allow_variable_name_as_functor", true, boolean, "false" , NULL ), /\**<
"allow_variable_name_as_functor", true, booleanFlag, "false" , NULL ), /\**<
`allow_variable_name_as_functor` */
/* allow
@ -76,15 +76,15 @@ It is `true` by default, but it is disabled by packages like CLP(BN) and
ProbLog.
*/
#if __APPLE__
YAP_FLAG(APPLE_FLAG, "apple", false, boolean, "true", NULL), /**< `apple`
YAP_FLAG(APPLE_FLAG, "apple", false, booleanFlag, "true", NULL), /**< `apple`
Read-only boolean flag that unifies with `true` if YAP is
Read-only booleanFlag flag that unifies with `true` if YAP is
running on an Apple machine.
*/
#endif
YAP_FLAG(ARCH_FLAG, "arch", false, isatom, YAP_ARCH, NULL),
YAP_FLAG(ARGV_FLAG, "argv", false, argv, "?-", NULL),
YAP_FLAG(ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true, boolean,
YAP_FLAG(ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true, booleanFlag,
"true", NULL),
YAP_FLAG(BACKQUOTED_STRING_FLAG, "backquoted_string", true, isatom,
"string", ), /**>
@ -94,7 +94,7 @@ token is converted to a list of atoms, `chars`, to a list of integers,
the corresponding behavior. The default value is `string`
*/
YAP_FLAG(BOUNDED_FLAG, "bounded", false, boolean, "false",
YAP_FLAG(BOUNDED_FLAG, "bounded", false, booleanFlag, "false",
NULL), /**< `bounded` is iso
Read-only flag telling whether integers are bounded. The value depends
@ -105,36 +105,36 @@ on whether YAP uses the GMP library or not.
YAP_FLAG(C_LDFLAGS_FLAG, "c_ldflags", false, isatom, C_LDFLAGS, NULL),
YAP_FLAG(C_LIBPLSO_FLAG, "c_libplso", false, isatom, C_LIBPLSO, NULL),
YAP_FLAG(C_LIBS_FLAG, "c_libs", false, isatom, C_LIBS, NULL),
YAP_FLAG(CHAR_CONVERSION_FLAG, "char_conversion", true, boolean, "false",
YAP_FLAG(CHAR_CONVERSION_FLAG, "char_conversion", true, booleanFlag, "false",
NULL), /**< `char_conversion is iso`
Writable flag telling whether a character conversion table is used when
reading terms. The default value for this flag is `off` except in
`sicstus` and `iso` language modes, where it is `on`.
*/
YAP_FLAG(CHARACTER_ESCAPES_FLAG, "character_escapes", true, boolean, "true",
YAP_FLAG(CHARACTER_ESCAPES_FLAG, "character_escapes", true, booleanFlag, "true",
NULL), /**< `character_escapes is iso `
Writable flag telling whether a character escapes are enables,
`true`, or disabled, `false`. The default value for this flag is
`true`. */
YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context",
true, boolean, "true", NULL),
true, booleanFlag, "true", NULL),
YAP_FLAG(COMPILED_AT_FLAG, "compiled_at", false, isatom, YAP_COMPILED_AT,
NULL), /**< `compiled_at `
Read-only flag that gives the time when the main YAP binary was compiled. It is
obtained staight from the __TIME__ macro, as defined in the C99.
*/
YAP_FLAG(DEBUG_FLAG, "debug", true, boolean, "false",
YAP_FLAG(DEBUG_FLAG, "debug", true, booleanFlag, "false",
NULL), /**< `debug is iso `
If _Value_ is unbound, tell whether debugging is `true` or
`false`. If _Value_ is bound to `true` enable debugging, and if
it is bound to `false` disable debugging.
*/
YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, boolean, "true", NULL),
YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, boolean, "true",
YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, booleanFlag, "true", NULL),
YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, booleanFlag, "true",
NULL),
YAP_FLAG(DEBUGGER_PRINT_OPTIONS_FLAG, "debugger_print_options", true,
list_option,
@ -144,7 +144,7 @@ it is bound to `false` disable debugging.
If bound, set the argument to the `write_term/3` options the
debugger uses to write terms. If unbound, show the current options.
*/
YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true, boolean,
YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true, booleanFlag,
"false", NULL),
YAP_FLAG(DIALECT_FLAG, "dialect", false, ro, "yap",
NULL), /**< `dialect `
@ -152,13 +152,13 @@ debugger uses to write terms. If unbound, show the current options.
Read-only flag that always returns `yap`.
*/
YAP_FLAG(DISCONTIGUOUS_WARNINGS_FLAG, "discontiguous_warnings", true,
boolean, "true", NULL), /**< `discontiguous_warnings `
booleanFlag, "true", NULL), /**< `discontiguous_warnings `
If `true` (default `true`) YAP checks for definitions of the same predicate that
are separated by clauses for other predicates. This may indicate that different
procedures have the sam*e name.
*/
YAP_FLAG(DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true, boolean,
YAP_FLAG(DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true, booleanFlag,
"false", NULL), /**< `dollar_as_lower_case `
If `off` (default) consider the character `$` a control character, if
@ -178,12 +178,12 @@ the corresponding behavior. The default value is `codes`. */
Read-only flag. It unifies with an atom that gives the
original program path.
*/
YAP_FLAG(FAST_FLAG, "fast", true, boolean, "false", NULL), /**< `fast `
YAP_FLAG(FAST_FLAG, "fast", true, booleanFlag, "false", NULL), /**< `fast `
If `on` allow fast machine code, if `off` (default) disable it. Only
available in experimental implemexbntations.
*/
YAP_FLAG(FILE_NAME_VARIABLES_FLAG, "file_name_variables", true, boolean,
YAP_FLAG(FILE_NAME_VARIABLES_FLAG, "file_name_variables", true, booleanFlag,
"true", NULL),
YAP_FLAG(FLOAT_FORMAT_FLAG, "float_format", true, isatom, "%15e",
NULL), /**< + `float_format `
@ -195,7 +195,7 @@ available in experimental implemexbntations.
printed, `%g` will print all floats using 6 digits instead of the
default 15.
*/
YAP_FLAG(GC_FLAG, "gc", true, boolean, "on", NULL), /**< `gc`
YAP_FLAG(GC_FLAG, "gc", true, booleanFlag, "on", NULL), /**< `gc`
If `on` allow garbage collection (default), if `off` disable it.
*/
@ -216,7 +216,7 @@ collection and stack shifts. Last, if `very_verbose` give detailed
information on data-structures found during the garbage collection
process, namely, on choice-points.
*/
YAP_FLAG(GENERATE_DEBUGGING_INFO_FLAG, "generate_debug_info", true, boolean,
YAP_FLAG(GENERATE_DEBUGGING_INFO_FLAG, "generate_debug_info", true, booleanFlag,
"true", NULL), /**< `generate_debug_info `
If `true` (default) generate debugging information for
@ -226,7 +226,7 @@ source mode is disabled.
*/
YAP_FLAG(GMP_VERSION_FLAG, "gmp_version", false, isatom, "4.8.12", NULL),
YAP_FLAG(HALT_AFTER_CONSULT_FLAG, "halt_after_consult", false, boolean,
YAP_FLAG(HALT_AFTER_CONSULT_FLAG, "halt_after_consult", false, booleanFlag,
"false", NULL),
YAP_FLAG(HOME_FLAG, "home", false, isatom, YAP_ROOTDIR, NULL), /**< home `
@ -264,7 +264,7 @@ the `-L` flag.
Read-only flag telling the rounding function used for integers. Takes the value
`toward_zero` for the current version of YAP.
*/
YAP_FLAG(ISO_FLAG, "iso", true, boolean, "false", NULL),
YAP_FLAG(ISO_FLAG, "iso", true, booleanFlag, "false", NULL),
YAP_FLAG(LANGUAGE_FLAG, "language", true, isatom, "yap",
NULL), /**< `language `
@ -289,26 +289,26 @@ Read-only flag telling the maximum arity of a functor. Takes the value
"INT_MIN", NULL),
YAP_FLAG(N_OF_INTEGER_KEYS_IN_DB_FLAG, "n_of_integer_keys_in_db", false, ro,
"256", NULL),
YAP_FLAG(OCCURS_CHECK_FLAG, "occurs_check", true, boolean, "false", NULL),
YAP_FLAG(OPEN_EXPANDS_FILENAME_FLAG, "open_expands_filename", true, boolean,
YAP_FLAG(OCCURS_CHECK_FLAG, "occurs_check", true, booleanFlag, "false", NULL),
YAP_FLAG(OPEN_EXPANDS_FILENAME_FLAG, "open_expands_filename", true, booleanFlag,
"true", NULL), /**< `open_expands_filename `
If `true` the open/3 builtin performs filename-expansion
before opening a file (SICStus Prolog like). If `false` it does not
(SWI-Prolog like).
*/
YAP_FLAG(OPEN_SHARED_OBJECT_FLAG, "open_shared_object", true, boolean,
YAP_FLAG(OPEN_SHARED_OBJECT_FLAG, "open_shared_object", true, booleanFlag,
"true", NULL), /**< `open_shared_object `
If true, `open_shared_object/2` and friends are implemented,
providing access to shared libraries (`.so` files) or to dynamic link
libraries (`.DLL` files).
*/
YAP_FLAG(OPTIMISE_FLAG, "optimise", true, boolean, "false", NULL),
YAP_FLAG(OPTIMISE_FLAG, "optimise", true, booleanFlag, "false", NULL),
YAP_FLAG(OS_ARGV_FLAG, "os_argv", false, os_argv, "?-", NULL),
YAP_FLAG(PID_FLAG, "pid", false, ro, "0", NULL),
YAP_FLAG(PIPE_FLAG, "pipe", true, boolean, "true", NULL),
YAP_FLAG(PROFILING_FLAG, "profiling", true, boolean, "false",
YAP_FLAG(PIPE_FLAG, "pipe", true, booleanFlag, "true", NULL),
YAP_FLAG(PROFILING_FLAG, "profiling", true, booleanFlag, "false",
NULL), /**< `profiling `
If `off` (default) do not compile call counting information for
@ -325,10 +325,12 @@ toplevel. Default is <tt>groundness</tt>, YAP prompts for alternatives if and
only if the query contains variables. The alternative, default in SWI-Prolog is
<tt>determinism</tt> which implies the system prompts for alternatives if the
goal succeeded while leaving choicepoints. */
YAP_FLAG(QUASI_QUOTATIONS_FLAG, "quasi_quotations", true, boolean, "true",
YAP_FLAG(QUASI_QUOTATIONS_FLAG, "quasi_quotations", true, booleanFlag, "true",
NULL),
YAP_FLAG(READLINE_FLAG, "readline", true, boolean, "true", NULL),
YAP_FLAG(REPORT_ERROR_FLAG, "report_error", true, boolean, "true", NULL),
YAP_FLAG(READLINE_FLAG, "readline", true, booleanFlag, "false", Yap_InitReadline), /**< `readline(boolean, changeable)`
enable the use of the readline library for console interactions, true by default if readline was found. */
YAP_FLAG(REPORT_ERROR_FLAG, "report_error", true, booleanFlag, "true", NULL),
YAP_FLAG(SHARED_OBJECT_EXTENSION_FLAG, "shared_object_extension", false,
isatom, SO_EXT, NULL), /**< `shared_object_extension `
@ -341,20 +343,20 @@ Name of the environment variable used by the system to search for shared
objects.
*/
YAP_FLAG(SIGNALS_FLAG, "signals", true, boolean, "true",
YAP_FLAG(SIGNALS_FLAG, "signals", true, booleanFlag, "true",
NULL), /**< `signals`
If `true` (default) YAP handles Signals such as `^C`
(`SIGINT`).
*/
YAP_FLAG(SOURCE_FLAG, "source", true, boolean, "true", NULL), /**< `source`
YAP_FLAG(SOURCE_FLAG, "source", true, booleanFlag, "true", NULL), /**< `source`
If `true` maintain the source for all clauses. Notice that this is trivially
supported for facts, and always supported for dynamic code.
*/
YAP_FLAG(STRICT_ISO_FLAG, "strict_iso", true, boolean, "false",
YAP_FLAG(STRICT_ISO_FLAG, "strict_iso", true, booleanFlag, "false",
NULL), /**< `strict_iso `
If _Value_ is unbound, tell whether strict ISO compatibility mode
@ -398,7 +400,7 @@ Sets or reads the tabling mode for all tabled predicates. Please
*/
YAP_FLAG(THREADS_FLAG, "threads", false, ro, "MAX_THREADS", NULL),
YAP_FLAG(TIMEZONE_FLAG, "timezone", false, ro, "18000", NULL),
YAP_FLAG(TOPLEVEL_PRINT_ANON_FLAG, "toplevel_print_anon", true, boolean,
YAP_FLAG(TOPLEVEL_PRINT_ANON_FLAG, "toplevel_print_anon", true, booleanFlag,
"true", NULL),
YAP_FLAG(TOPLEVEL_PRINT_OPTIONS_FLAG, "toplevel_print_options", true,
list_option, "[quoted(true),numbervars(true),portrayed(true)]",
@ -412,10 +414,10 @@ backtracked into.
*/
YAP_FLAG(TOPLEVEL_PROMPT_FLAG, "toplevel_prompt", true, isatom, "?- ",
mkprompt),
YAP_FLAG(TTY_CONTROL_FLAG, "tty_control", true, boolean, "true", NULL),
YAP_FLAG(TTY_CONTROL_FLAG, "tty_control", true, booleanFlag, "true", NULL),
YAP_FLAG(UNIX_FLAG, "unix", false, ro, "true", NULL), /**< `unix`
Read-only Boolean flag that unifies with `true` if YAP is
Read-only BooleanFlag flag that unifies with `true` if YAP is
running on an Unix system. Defined if the C-compiler used to compile
this version of YAP either defines `__unix__` or `unix`.
*/
@ -448,7 +450,7 @@ are `error`, `fail`, and `warning`. Yap includes the following extensions:
`fast_fail` does not invoke any handler.
*/
YAP_FLAG(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG,
"variable_names_may_end_with_quotes", true, boolean, "false",
"variable_names_may_end_with_quotes", true, booleanFlag, "false",
NULL),
YAP_FLAG(VERBOSE_FLAG, "verbose", true, isatom, "normal",
NULL), /**< `verbose `
@ -459,9 +461,9 @@ disable printing these messages. It is `normal` by default except if
YAP is booted with the `-q` or `-L` flag.
*/
YAP_FLAG(VERBOSE_AUTOLOAD_FLAG, "verbose_autoload", true, boolean, "false",
YAP_FLAG(VERBOSE_AUTOLOAD_FLAG, "verbose_autoload", true, booleanFlag, "false",
NULL),
YAP_FLAG(VERBOSE_FILE_SEARCH_FLAG, "verbose_file_search", true, boolean,
YAP_FLAG(VERBOSE_FILE_SEARCH_FLAG, "verbose_file_search", true, booleanFlag,
"false", NULL), /**< `verbose_file_search `
If `true` allow printing of informational messages when
@ -505,11 +507,11 @@ xan be used to identify versions that differ on small (or large) updates.
#if __WINDOWS__
YAP_FLAG(WINDOWS_FLAG, "windows", false, ro, "true", NULL), /**< `windows `
Read-only boolean flag that unifies with `true` if YAP is
Read-only booleanFlag flag that unifies with `true` if YAP is
running on an Windows machine.
*/
#endif
YAP_FLAG(WRITE_STRINGS_FLAG, "write_strings", true, boolean, "false",
YAP_FLAG(WRITE_STRINGS_FLAG, "write_strings", true, booleanFlag, "false",
NULL), /**< `write_strings `
Writable flag telling whether the system should write lists of

View File

@ -15,7 +15,16 @@
#ifndef YAP_HANDLES_H
#define YAP_HANDLES_H 1
#include "Regs.h"
#include "Yatom.h"
#define LOCAL_CurHandle LOCAL_CurSlot
#define REMOTE_CurHandle REMOTE_CurSlot
#define LOCAL_NHandles LOCAL_NSlots
#define REMOTE_NHandles REMOTE_NSlots
#define LOCAL_HandleBase LOCAL_SlotBase
#define REMOTE_HanvdleBase SlotBase
/**
@groupdef term_t_slots
@ -30,7 +39,7 @@ garbage-collection.
automatically released at the end
of a function. Hence, slots should always be used as local variables.
Slots are organized as follows:
Handles are organized as follows:
---- Offset of next pointer in chain (tagged as an handle_t)
---- Number of entries (tagged as handle_t), in the example TAG(INT,4)
Entry
@ -39,7 +48,7 @@ Entry
Entry
---- Number of entries (tagged as handle_t), in the example TAG(INT,4)
Slots are not known to the yaam. Instead, A new set of slots is created when the
Handles are not known to the yaam. Instead, A new set of slots is created when the
emulator calls user C-code.
(see YAP_Execute* functions). They are also created:
@ -58,105 +67,119 @@ functions are then exported through corresponding FLI C-functions
/// @brief reboot the slot system.
/// Used when wwe start from scratch (Reset).
#define Yap_RebootSlots(wid) Yap_RebootSlots__(wid PASS_REGS)
#define Yap_RebootHandles(wid) Yap_RebootHandles__(wid PASS_REGS)
#define Yap_RebootSlots(wid) Yap_RebootHandles__(wid PASS_REGS)
static inline void Yap_RebootSlots__(int wid USES_REGS) {
// fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot);
REMOTE_CurSlot(wid) = 1;
static inline void Yap_RebootHandles__(int wid USES_REGS) {
// fprintf(stderr, " StartHandles = %ld", LOCAL_CurHandle);
REMOTE_CurHandle(wid) = 1;
}
/// @brief declares a new set of slots.
/// Used to tell how many slots we had when we entered a segment of code.
//#define Yap_StartSlots() (
// printf("[<<<%s,%s,%d-%ld\n",__FILE__,__FUNCTION__,__LINE__,LOCAL_CurSlot)?Yap_StartSlots__(PASS_REGS1):
/// Used to tell how many slots we have so d=dara when we entered a segment of code.
//#define Yap_StartHandles() (
// printf("[<<<%s,%s,%d-%ld\n",__FILE__,__FUNCTION__,__LINE__,LOCAL_CurHandle)?Yap_StartHandles__(PASS_REGS1):
//-1)
#define Yap_StartSlots() Yap_StartSlots__(PASS_REGS1)
#define Yap_StartHandles() Yap_StartHandles__(PASS_REGS1)
#define Yap_StartSlots() Yap_StartHandles__(PASS_REGS1)
INLINE_ONLY inline EXTERN yhandle_t Yap_StartSlots__(USES_REGS1);
INLINE_ONLY inline EXTERN yhandle_t Yap_StartSlots__(USES_REGS1) {
// // fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot);
INLINE_ONLY inline EXTERN yhandle_t Yap_StartHandles__(USES_REGS1);
INLINE_ONLY inline EXTERN yhandle_t Yap_StartHandles__(USES_REGS1) {
// // fprintf(stderr, " StartHandles = %ld", LOCAL_CurHandle);
// fprintf(stderr,"SS %s:%d\n", __FILE__, __LINE__);;
if (LOCAL_CurSlot < 0) {
Yap_Error(SYSTEM_ERROR_INTERNAL, 0L, " StartSlots = %ld", LOCAL_CurSlot);
if (LOCAL_CurHandle < 0) {
Yap_Error(SYSTEM_ERROR_INTERNAL, 0L, " StartHandles = %ld", LOCAL_CurHandle);
}
return LOCAL_CurSlot;
return LOCAL_CurHandle;
}
/// @brief reset slots to a well-known position in the stack
//#define Yap_CloseSlots(slot) ( printf("- %s,%s,%d
//%ld>>>]\n",__FILE__,__FUNCTION__,__LINE__, slot)?Yap_CloseSlots__(slot
/// @brief reset the nmber of slots _slot_ to the number existing before the call that produce _slot_
///(eg, Yap_StartHandles(), YAP_NewHandles(), or YAP_PushHandle)
//#define Yap_CloseHandles(slot) ( printf("- %s,%s,%d
//%ld>>>]\n",__FILE__,__FUNCTION__,__LINE__, slot)?Yap_CloseHandles__(slot
// PASS_REGS):-1)
#define Yap_CloseSlots(slot) Yap_CloseSlots__(slot PASS_REGS)
#define Yap_CloseHandles(slot) Yap_CloseHandles__(slot PASS_REGS)
#define Yap_CloseSlots(slot) Yap_CloseHandles__(slot PASS_REGS)
INLINE_ONLY inline EXTERN void Yap_CloseSlots__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN void Yap_CloseSlots__(yhandle_t slot USES_REGS) {
// fprintf(stderr,"CS %s:%d\n", __FILE__, __LINE__);;
LOCAL_CurSlot = slot;
INLINE_ONLY inline EXTERN void Yap_CloseHandles__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN void Yap_CloseHandles__(yhandle_t slot USES_REGS) {
// fprintf(stderr,"CS %s:%d\n", __FILE__, __LINE__);
LOCAL_CurHandle = slot;
}
#define Yap_CurrentSlot() Yap_CurrentSlot__(PASS_REGS1)
#define Yap_CurrentHandle() Yap_CurrentHandle__(PASS_REGS1)
#define Yap_CurrentSlot() Yap_CurrentHandle__(PASS_REGS1)
/// @brief report the current position of the slots, assuming that they occupy
/// the top of the stack.
INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentSlot__(USES_REGS1);
INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentSlot__(USES_REGS1) {
return LOCAL_CurSlot;
INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentHandle__(USES_REGS1);
INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentHandle__(USES_REGS1) {
return LOCAL_CurHandle;
}
#define Yap_GetFromSlot(slot) Yap_GetFromSlot__(slot PASS_REGS)
#define Yap_GetFromHandle(slot) Yap_GetFromHandle__(slot PASS_REGS)
#define Yap_GetFromSlot(slot) Yap_GetFromHandle__(slot PASS_REGS)
/// @brief read from a slot.
INLINE_ONLY inline EXTERN Term Yap_GetFromSlot__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN Term Yap_GetFromSlot__(yhandle_t slot USES_REGS) {
INLINE_ONLY inline EXTERN Term Yap_GetFromHandle__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN Term Yap_GetFromHandle__(yhandle_t slot USES_REGS) {
// fprintf(stderr, "GS %s:%d\n", __FILE__, __LINE__);
return Deref(LOCAL_SlotBase[slot]);
return Deref(LOCAL_HandleBase[slot]);
}
#define Yap_GetDerefedFromSlot( slot ) Yap_GetDerefedFromSlot__(slot PASS_REGS)
#define Yap_GetDerefedFromHandle( slot ) Yap_GetDerefedFromHandle__(slot PASS_REGS)
#define Yap_GetDerefedFromSlot( slot ) Yap_GetDerefedFromHandle__(slot PASS_REGS)
/// @brief read from a slot. but does not try to dereference the slot.
INLINE_ONLY inline EXTERN Term Yap_GetDerefedFromSlot__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN Term Yap_GetDerefedFromSlot__(yhandle_t slot USES_REGS) {
INLINE_ONLY inline EXTERN Term Yap_GetDerefedFromHandle__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN Term Yap_GetDerefedFromHandle__(yhandle_t slot USES_REGS) {
// fprintf(stderr,"GDS %s:%d\n", __FILE__, __LINE__);
return LOCAL_SlotBase[slot];
return LOCAL_HandleBase[slot];
}
#define Yap_GetPtrFromSlot( slot ) Yap_GetPtrFromSlot__(slot PASS_REGS)
#define Yap_GetPtrFromHandle( slot ) Yap_GetPtrFromHandle__(slot PASS_REGS)
#define Yap_GetPtrFromSlot( slot ) Yap_GetPtrFromHandle__(slot PASS_REGS)
/// @brief read the object in a slot. but do not try to dereference the slot.
INLINE_ONLY inline EXTERN Term *Yap_GetPtrFromSlot__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN Term *Yap_GetPtrFromSlot__(yhandle_t slot USES_REGS) {
INLINE_ONLY inline EXTERN Term *Yap_GetPtrFromHandle__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN Term *Yap_GetPtrFromHandle__(yhandle_t slot USES_REGS) {
// fprintf(stderr,"GPS %s:%d\n", __FILE__, __LINE__);
return (Term *)LOCAL_SlotBase[slot];
return (Term *)LOCAL_HandleBase[slot];
}
#define Yap_AddressFromSlot(slot) Yap_AddressFromSlot__(slot PASS_REGS)
#define Yap_AddressFromHandle(slot) Yap_AddressFromHandle__(slot PASS_REGS)
#define Yap_AddressFromSlot(slot) Yap_AddressFromHandle__(slot PASS_REGS)
INLINE_ONLY inline EXTERN CELL *Yap_AddressFromSlot__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN CELL *Yap_AddressFromSlot__(yhandle_t slot USES_REGS) {
INLINE_ONLY inline EXTERN CELL *Yap_AddressFromHandle__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN CELL *Yap_AddressFromHandle__(yhandle_t slot USES_REGS) {
/// @brief get the memory address of a slot
return LOCAL_SlotBase + slot;
return LOCAL_HandleBase + slot;
}
#define Yap_PutInSlot(slot, t) Yap_PutInSlot__(slot, t PASS_REGS)
#define Yap_PutInSlot(slot, t) Yap_PutInHandle__(slot, t PASS_REGS)
#define Yap_PutInHandle(slot, t) Yap_PutInHandle__(slot, t PASS_REGS)
/// @brief store term in a slot
INLINE_ONLY inline EXTERN void Yap_PutInSlot__(yhandle_t slot, Term t USES_REGS);
INLINE_ONLY inline EXTERN void Yap_PutInSlot__(yhandle_t slot, Term t USES_REGS) {
INLINE_ONLY inline EXTERN void Yap_PutInHandle__(yhandle_t slot, Term t USES_REGS);
INLINE_ONLY inline EXTERN void Yap_PutInHandle__(yhandle_t slot, Term t USES_REGS) {
// fprintf(stderr,"PS %s:%d\n", __FILE__, __LINE__);
LOCAL_SlotBase[slot] = t;
LOCAL_HandleBase[slot] = t;
}
#ifndef max
#define max(X, Y) (X > Y ? X : Y)
#endif
#define ensure_handles ensure_slots
INLINE_ONLY inline EXTERN void ensure_slots(int N USES_REGS) {
if (LOCAL_CurSlot + N >= LOCAL_NSlots) {
size_t inc = max(16 * 1024, LOCAL_NSlots / 2); // measured in cells
if (LOCAL_CurHandle + N >= LOCAL_NHandles) {
size_t inc = max(16 * 1024, LOCAL_NHandles / 2); // measured in cells
inc = max(inc, N + 16); // measured in cells
LOCAL_SlotBase =
(CELL *)realloc(LOCAL_SlotBase, (inc + LOCAL_NSlots) * sizeof(CELL));
LOCAL_NSlots += inc;
if (!LOCAL_SlotBase) {
unsigned long int kneeds = ((inc + LOCAL_NSlots) * sizeof(CELL)) / 1024;
LOCAL_HandleBase =
(CELL *)realloc(LOCAL_HandleBase, (inc + LOCAL_NHandles) * sizeof(CELL));
LOCAL_NHandles += inc;
if (!LOCAL_HandleBase) {
unsigned long int kneeds = ((inc + LOCAL_NHandles) * sizeof(CELL)) / 1024;
Yap_Error(
SYSTEM_ERROR_INTERNAL, 0 /* TermNil */,
"Out of memory for the term handles (term_t) aka slots, l needed",
@ -166,75 +189,95 @@ INLINE_ONLY inline EXTERN void ensure_slots(int N USES_REGS) {
}
/// @brief create a new slot with term t
// #define Yap_InitSlot(t)
// (printf("+%d %ld %s,%s,%d>>>]\n", 1, LOCAL_CurSlot,__FILE__, __FUNCTION__, __LINE__)
// ? Yap_InitSlot__(t PASS_REGS)
// #define Yap_InitHandle(t)
// (printf("+%d %ld %s,%s,%d>>>]\n", 1, LOCAL_CurHandle,__FILE__, __FUNCTION__, __LINE__)
// ? Yap_InitHandle__(t PASS_REGS)
// : -1)
#define Yap_InitSlot(t) Yap_InitSlot__(t PASS_REGS)
#define Yap_InitHandle(t) Yap_InitHandle__(t PASS_REGS)
#define Yap_PushHandle(t) Yap_InitHandle__(t PASS_REGS)
#define Yap_InitSlot(t) Yap_InitHandle__(t PASS_REGS)
INLINE_ONLY inline EXTERN yhandle_t Yap_InitSlot__(Term t USES_REGS);
INLINE_ONLY inline EXTERN yhandle_t Yap_InitSlot__(Term t USES_REGS) {
yhandle_t old_slots = LOCAL_CurSlot;
INLINE_ONLY inline EXTERN yhandle_t Yap_InitHandle__(Term t USES_REGS);
INLINE_ONLY inline EXTERN yhandle_t Yap_InitHandle__(Term t USES_REGS) {
yhandle_t old_slots = LOCAL_CurHandle;
ensure_slots(1 PASS_REGS);
LOCAL_SlotBase[old_slots] = t;
LOCAL_CurSlot++;
LOCAL_HandleBase[old_slots] = t;
LOCAL_CurHandle++;
return old_slots;
}
//#define Yap_NewSlots(n) ( printf("+%d %ld %s,%s,%d>>>]\n",n,LOCAL_CurSlot,__FILE__,__FUNCTION__,__LINE__) ?Yap_NewSlots__(n PASS_REGS):-1)
#define Yap_NewSlots(n) Yap_NewSlots__(n PASS_REGS)
//#define Yap_NewHandles(n) ( printf("+%d %ld %s,%s,%d>>>]\n",n,LOCAL_CurHandle,__FILE__,__FUNCTION__,__LINE__) ?Yap_NewHandles__(n PASS_REGS):-1)
#define Yap_NewHandles(n) Yap_NewHandles__(n PASS_REGS)
#define Yap_NewSlots(n) Yap_NewHandles__(n PASS_REGS)
INLINE_ONLY inline EXTERN yhandle_t Yap_NewSlots__(int n USES_REGS);
INLINE_ONLY inline EXTERN yhandle_t Yap_NewSlots__(int n USES_REGS) {
yhandle_t old_slots = LOCAL_CurSlot;
INLINE_ONLY inline EXTERN yhandle_t Yap_NewHandles__(int n USES_REGS);
INLINE_ONLY inline EXTERN yhandle_t Yap_NewHandles__(int n USES_REGS) {
yhandle_t old_slots = LOCAL_CurHandle;
int i;
//fprintf(stderr, "NS %s:%d\n", __FILE__, __LINE__);
ensure_slots(n PASS_REGS);
for (i = 0; i < n; i++) {
LOCAL_SlotBase[old_slots + i] = MkVarTerm();
LOCAL_HandleBase[old_slots + i] = MkVarTerm();
}
LOCAL_CurSlot += n;
LOCAL_CurHandle += n;
return old_slots;
}
//#define Yap_InitSlots(n, ts)
// (printf("+%d %d %s,%s,%d>>>]\n", n, LOCAL_CurSlot, __FILE__, __FUNCTION__, __LINE__)
// ? Yap_InitSlots__(n, ts PASS_REGS)
//#define Yap_InitHandles(n, ts)
// (printf("+%d %d %s,%s,%d>>>]\n", n, LOCAL_CurHandle, __FILE__, __FUNCTION__, __LINE__)
// ? Yap_InitHandles__(n, ts PASS_REGS)
// : -1)
#define Yap_InitSlots(n, ts) Yap_InitSlots__(n, ts PASS_REGS)
#define Yap_InitHandles(n, ts) Yap_InitHandles__(n, ts PASS_REGS)
#define Yap_InitSlots(n, ts) Yap_InitHandles__(n, ts PASS_REGS)
/// @brief create n new slots with terms ts[]
INLINE_ONLY inline EXTERN yhandle_t Yap_InitSlots__(int n, Term *ts USES_REGS);
INLINE_ONLY inline EXTERN yhandle_t Yap_InitSlots__(int n, Term *ts USES_REGS) {
yhandle_t old_slots = LOCAL_CurSlot;
INLINE_ONLY inline EXTERN yhandle_t Yap_InitHandles__(int n, Term *ts USES_REGS);
INLINE_ONLY inline EXTERN yhandle_t Yap_InitHandles__(int n, Term *ts USES_REGS) {
yhandle_t old_slots = LOCAL_CurHandle;
int i;
ensure_slots(n PASS_REGS);
for (i = 0; i < n; i++)
LOCAL_SlotBase[old_slots + i] = ts[i];
LOCAL_CurSlot += n;
LOCAL_HandleBase[old_slots + i] = ts[i];
LOCAL_CurHandle += n;
return old_slots;
}
#define Yap_RecoverSlots(n, ts) Yap_RecoverSlots__(n, ts PASS_REGS)
#define Yap_RecoverHandles(n, ts) Yap_RecoverHandles__(n, ts PASS_REGS)
#define Yap_RecoverSlots(n, ts) Yap_RecoverHandles__(n, ts PASS_REGS)
/// @brief Succeeds if it is to recover the space allocated for $n$ contiguos
/// slots starting at topSlot.
static inline bool Yap_RecoverSlots__(int n, yhandle_t topSlot USES_REGS);
static inline bool Yap_RecoverSlots__(int n, yhandle_t topSlot USES_REGS) {
if (topSlot + n < LOCAL_CurSlot)
/// slots starting at topHandle.
static inline bool Yap_RecoverHandles__(int n, yhandle_t topHandle USES_REGS);
static inline bool Yap_RecoverHandles__(int n, yhandle_t topHandle USES_REGS) {
if (topHandle + n < LOCAL_CurHandle)
return false;
#ifdef DEBUG
if (n > LOCAL_CurSlot) {
if (n > LOCAL_CurHandle) {
Yap_Error(SYSTEM_ERROR_INTERNAL, 0,
"Inconsistent slot state in Yap_RecoverSlots.", 0);
"Inconsistent slot state in Yap_RecoverHandles.", 0);
return false;
}
#endif
LOCAL_CurSlot -= n;
//fprintf(stderr,"RS %ld %s:%d\n", LOCAL_CurSlot, __FILE__, __LINE__);
LOCAL_CurHandle -= n;
//fprintf(stderr,"RS %ld %s:%d\n", LOCAL_CurHandle, __FILE__, __LINE__);
return true;
}
#define Yap_PopSlot( ts) Yap_PopHandle__( ts PASS_REGS)
#define Yap_PopHandle( ts) Yap_PopHandle__( ts PASS_REGS)
/// @brief recovers the element at position $n$ dropping any other elements p
static inline Term Yap_PopHandle__( yhandle_t topHandle USES_REGS);
static inline Term Yap_PopHandle__( yhandle_t topHandle USES_REGS) {
if (LOCAL_CurHandle < topHandle)
return TermNil;
else {
LOCAL_CurHandle = topHandle;
//fprintf(stderr,"RS %ld %s:%d\n", LOCAL_CurHandle, __FILE__, __LINE__);≈
return Deref(LOCAL_HandleBase[topHandle]);
}
}
#endif

View File

@ -161,14 +161,14 @@ typedef struct various_codes {
/* memory allocation and management */
special_functors funcs;
#include "heap/hstruct.h"
#include "struct.h"
} all_heap_codes;
#include "heap/hglobals.h"
#include "hglobals.h"
#include "heap/dhstruct.h"
#include "heap/dglobals.h"
#include "dhstruct.h"
#include "dglobals.h"
#else
typedef struct various_codes {
/* memory allocation and management */
@ -184,17 +184,17 @@ typedef struct various_codes {
#define EXTERNAL extern
#endif
#include "heap/h0struct.h"
#include "h0struct.h"
#include "heap/h0globals.h"
#include "h0globals.h"
#endif
#include "heap/hlocals.h"
#include "hlocals.h"
#include "heap/dlocals.h"
#include "dlocals.h"
/* ricardo

View File

@ -20,10 +20,10 @@
@ingroup Flags
*/
YAP_FLAG( AUTOLOAD_FLAG, "autoload", true, boolean, "false" , NULL ),
YAP_FLAG( AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false" , NULL ),
YAP_FLAG( BREAK_LEVEL_FLAG, "break_level", true, nat, "0" , NULL ),
YAP_FLAG( ENCODING_FLAG, "encoding", true, isatom, "utf-8" , getenc ),
YAP_FLAG( FILEERRORS_FLAG, "fileerrors", true, boolean, "true" , NULL ), /**< `fileerrors`
YAP_FLAG( FILEERRORS_FLAG, "fileerrors", true, booleanFlag, "true" , NULL ), /**< `fileerrors`
If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled.
@ -32,7 +32,7 @@ YAP_FLAG( LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap" , NULL ), /*
wweter native mode or trying to emulate a different Prolog.
*/
YAP_FLAG( REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, boolean, "true" , NULL ), /**< `redefine_warnings `
YAP_FLAG( REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, booleanFlag, "true" , NULL ), /**< `redefine_warnings `
If _Value_ is unbound, tell whether warnings for procedures defined
in several different files are `on` or
@ -40,11 +40,11 @@ in several different files are `on` or
and if it is bound to `off` disable them. The default for YAP is
`off`, unless we are in `sicstus` or `iso` mode.
*/
YAP_FLAG( SINGLE_VAR_WARNINGS_FLAG, "single_var_warnings", true, boolean, "true" , NULL ), /**< `single_var_warnings`
YAP_FLAG( SINGLE_VAR_WARNINGS_FLAG, "single_var_warnings", true, booleanFlag, "true" , NULL ), /**< `single_var_warnings`
If `true` (default `true`) YAP checks for singleton variables when loading files. A singleton variable is a variable that appears ony once in a clause. The name must start with a capital letter, variables whose name starts with underscore are never considered singleton.
*/
YAP_FLAG( STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, boolean, "false" , NULL ), /**< `stack_dump_on_error `
YAP_FLAG( STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, booleanFlag, "false" , NULL ), /**< `stack_dump_on_error `
If `true` show a stack dump when YAP finds an error. The default is
`off`.

View File

@ -176,7 +176,8 @@ void Yap_RestartYap(int);
void Yap_exit(int);
bool Yap_Warning(const char *s, ...);
bool Yap_PrintWarning(Term t);
int Yap_HandleError(const char *msg, ...);
bool Yap_HandleError__(const char *file, const char *function, int lineno, const char *s, ...);
#define Yap_HandleError(...) Yap_HandleError__(__FILE__, __FUNCTION__, __LINE__, __VA_ARGS__)
int Yap_SWIHandleError(const char *, ...);
void Yap_InitErrorPreds(void);
@ -295,6 +296,7 @@ extern void Yap_DebugErrorPuts(const char *s);
extern void Yap_DebugWriteIndicator(struct pred_entry *ap);
void Yap_PlWriteToStream(Term, int, int);
/* depth_lim.c */
bool Yap_InitReadline(Term t);
void Yap_InitItDeepenPreds(void);
struct AliasDescS *Yap_InitStandardAliases(void);
@ -485,7 +487,7 @@ struct AtomEntryStruct *Yap_lookupBlob(void *blob, size_t len, void *type,
void Yap_init_optyap_preds(void);
/* pl-file.c */
// struct PL_local_data *Yap_InitThreadIO(int wid);
// struct PL_local_data *Yap_InitThreadIO(int wid);
void Yap_flush(void);
/* pl-yap.c */
@ -495,3 +497,10 @@ Atom Yap_source_file_name(void);
void Yap_install_blobs(void);
yamop *Yap_gcP(void);
#if !HAVE_STRNCAT
#define strncat(X, Y, Z) strcat(X, Y)
#endif
#if !HAVE_STRNCPY
#define strncpy(X, Y, Z) strcpy(X, Y)
#endif

View File

@ -38,7 +38,21 @@ INLINE_ONLY inline EXTERN AtomEntry *RepAtom(Atom a) {
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);
@ -554,6 +568,7 @@ typedef uint64_t pred_flags_t;
#define StatePredFlags (InUsePredFlag|CountPredFlag|SpiedPredFlag|IndexedPredFlag )
#define is_system(pe) (pe->PredFlags & SystemPredFlags)
#define is_dynamic(pe) (pe->PredFlags & DynamicPredFlag)
#define is_foreign(pe) (pe->PredFlags & ForeignPredFlags)
#define is_static(pe) (pe->PredFlags & CompiledPredFlag)
#define is_logupd(pe) (pe->PredFlags & LogUpdatePredFlag)
#ifdef TABLING
@ -1586,7 +1601,7 @@ INLINE_ONLY EXTERN inline void AddPropToAtom(AtomEntry *ae, PropEntry *p) {
INLINE_ONLY inline EXTERN const char *AtomName(Atom at);
/**
* AtomName: get a string with the name of an Atom. Assumes 8 bit
* AtomName(Atom at): get a string with the name of an Atom. Assumes 8 bit
*representation.
*
* @param at the atom
@ -1600,7 +1615,7 @@ INLINE_ONLY inline EXTERN const char *AtomName(Atom at) {
INLINE_ONLY inline EXTERN const char *AtomTermName(Term t);
/**
* AtomTermName: 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.
*
* @param t the atom term

View File

@ -17,6 +17,8 @@
/**
@file eval.h
@defgroup arithmetic Arithmetic in YAP
@ingroup builtins
@ -27,8 +29,6 @@
+ See @ref arithmetic_operators for what arithmetic operations are supported in YAP
@tableofcontents
YAP supports several different numeric types:
<ul>
<li><b>Tagged integers</b><p>
@ -93,14 +93,20 @@ exceptions:
@exception "evaluation_error(undefined( V ), Call)" result is not defined (nan)
@exception "evaluation_error(overflow( V ), Call)" result is arithmetic overflow
@tableofcontents
@secreflist
@refitem is/2
@refitem isnan/1
@endsecreflist
@{
**/
#ifndef EVAL_H
#define EVAL_H 1
#include <stdlib.h>
/* C library used to implement floating point functions */
@ -682,3 +688,7 @@ p_plus(Term t1, Term t2 USES_REGS) {
#ifndef DBL_EPSILON /* normal for IEEE 64-bit double */
#define DBL_EPSILON 0.00000000000000022204
#endif
/// @}
#endif

View File

@ -120,12 +120,12 @@
#define Yap_ExecutionMode Yap_heap_regs->Yap_ExecutionMode_
#define PredsInHashTable Yap_heap_regs->PredsInHashTable_
#define PredHashTableSize Yap_heap_regs->PredHashTableSize_
#define PredHash Yap_heap_regs->PredHash_
#if defined(YAPOR) || defined(THREADS)
#define PredHashRWLock Yap_heap_regs->PredHashRWLock_
#endif
#define PredsInHashTable Yap_heap_regs->PredsInHashTable_
#define PredHashTableSize Yap_heap_regs->PredHashTableSize_
#define CreepCode Yap_heap_regs->CreepCode_
#define UndefCode Yap_heap_regs->UndefCode_

View File

@ -25,14 +25,14 @@
#define LOCAL_encoding LOCAL->encoding_
#define REMOTE_encoding(wid) REMOTE(wid)->encoding_
#define LOCAL_newline LOCAL->newline_
#define REMOTE_newline(wid) REMOTE(wid)->newline_
#define LOCAL_AtPrompt LOCAL->AtPrompt_
#define REMOTE_AtPrompt(wid) REMOTE(wid)->AtPrompt_
#define LOCAL_Prompt LOCAL->Prompt_
#define REMOTE_Prompt(wid) REMOTE(wid)->Prompt_
#define LOCAL_encoding LOCAL->encoding_
#define REMOTE_encoding(wid) REMOTE(wid)->encoding_
#define LOCAL_quasi_quotations LOCAL->quasi_quotations_
#define REMOTE_quasi_quotations(wid) REMOTE(wid)->quasi_quotations_
#define LOCAL_default_priority LOCAL->default_priority_

View File

@ -120,12 +120,12 @@ EXTERNAL UInt GLOBAL_flagCount;
/* Anderson's JIT */
EXTERNAL yap_exec_mode Yap_ExecutionMode;
/* The Predicate Hash Table: fast access to predicates. */
EXTERNAL UInt PredsInHashTable;
EXTERNAL uint64_t PredHashTableSize;
EXTERNAL struct pred_entry **PredHash;
#if defined(YAPOR) || defined(THREADS)
EXTERNAL rwlock_t PredHashRWLock;
#endif
EXTERNAL UInt PredsInHashTable;
EXTERNAL UInt PredHashTableSize;
/* Well-Known Predicates */
EXTERNAL struct pred_entry *CreepCode;
EXTERNAL struct pred_entry *UndefCode;

View File

@ -17,10 +17,10 @@ typedef struct worker_local {
// Used by the prompts to check if they are after a newline, and then a
// prompt should be output, or if we are in the middle of a line.
//
encoding_t encoding_;
bool newline_;
Atom AtPrompt_;
char Prompt_[MAX_PROMPT+1];
encoding_t encoding_;
bool quasi_quotations_;
UInt default_priority_;
bool eot_before_eof_;

View File

@ -120,12 +120,12 @@
/* Anderson's JIT */
yap_exec_mode Yap_ExecutionMode_;
/* The Predicate Hash Table: fast access to predicates. */
UInt PredsInHashTable_;
uint64_t PredHashTableSize_;
struct pred_entry **PredHash_;
#if defined(YAPOR) || defined(THREADS)
rwlock_t PredHashRWLock_;
#endif
UInt PredsInHashTable_;
UInt PredHashTableSize_;
/* Well-Known Predicates */
struct pred_entry *CreepCode_;
struct pred_entry *UndefCode_;

4
H/generated/i0globals.h Normal file
View File

@ -0,0 +1,4 @@
/* This file, iglobals.h, was generated automatically by "yap -L misc/buildlocalglobal"
please do not update, update misc/GLOBALS instead */

View File

@ -120,12 +120,12 @@
Yap_ExecutionMode = INTERPRETED;
PredsInHashTable = 0;
PredHashTableSize = 0;
InitPredHash();
#if defined(YAPOR) || defined(THREADS)
#endif
PredsInHashTable = 0;
CreepCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomCreep,1),PROLOG_MODULE));
UndefCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomUndefp,2),PROLOG_MODULE));

View File

@ -17,10 +17,10 @@ static void InitWorker(int wid) {
REMOTE_encoding(wid) = Yap_DefaultEncoding();
REMOTE_newline(wid) = true;
REMOTE_AtPrompt(wid) = AtomNil;
REMOTE_encoding(wid) = Yap_DefaultEncoding();
REMOTE_quasi_quotations(wid) = false;
REMOTE_default_priority(wid) = 1200;
REMOTE_eot_before_eof(wid) = false;

View File

@ -120,13 +120,13 @@
RestorePredHash();
#if defined(YAPOR) || defined(THREADS)
#endif
CreepCode = PtoPredAdjust(CreepCode);
UndefCode = PtoPredAdjust(UndefCode);
SpyCode = PtoPredAdjust(SpyCode);

View File

@ -968,16 +968,16 @@ static void RestoreBallTerm(int wid) {
}
}
#include "heap/rglobals.h"
#include "rglobals.h"
#include "heap/rlocals.h"
#include "rlocals.h"
/* restore the failcodes */
static void restore_codes(void) {
CACHE_REGS
HeapTop = AddrAdjust(LOCAL_OldHeapTop);
#include "heap/rhstruct.h"
#include "rhstruct.h"
RestoreWorker(worker_id PASS_REGS);
}

13
YAP/CMakeLists.txt Normal file
View File

@ -0,0 +1,13 @@
cmake_minimum_required(VERSION 2.8)
## Use the variable PROJECT_NAME for changing the target name
set( PROJECT_NAME "HelloWorld" )
## Set our project name
project(${PROJECT_NAME})
## Use all the *.cpp files we found under this folder for the project
FILE(GLOB SRCS "*.cpp" "*.c")
## Define the executable
add_executable(${PROJECT_NAME} ${SRCS})

178
YAP/YAP.project Normal file
View File

@ -0,0 +1,178 @@
<?xml version="1.0" encoding="UTF-8"?>
<CodeLite_Project Name="YAP" InternalType="Console">
<Description/>
<Dependencies/>
<Settings Type="Executable">
<GlobalSettings>
<Compiler Options="" C_Options="" Assembler="">
<IncludePath Value="."/>
</Compiler>
<Linker Options="">
<LibraryPath Value="."/>
</Linker>
<ResourceCompiler Options=""/>
</GlobalSettings>
<Configuration Name="Debug_Linux" CompilerType="GCC" DebuggerType="GNU gdb debugger" Type="Executable" BuildCmpWithGlobalSettings="append" BuildLnkWithGlobalSettings="append" BuildResWithGlobalSettings="append">
<Compiler Options="-g;-O0;-Wall" C_Options="-g;-O0;-Wall" Assembler="" Required="yes" PreCompiledHeader="" PCHInCommandLine="no" PCHFlags="" PCHFlagsPolicy="0">
<IncludePath Value="."/>
</Compiler>
<Linker Options="" Required="yes"/>
<ResourceCompiler Options="" Required="no"/>
<General OutputFile="$(IntermediateDirectory)/$(ProjectName)" IntermediateDirectory="./Debug" Command="./build-debug/HelloWorld" CommandArguments="" UseSeparateDebugArgs="no" DebugArguments="" WorkingDirectory="" PauseExecWhenProcTerminates="yes" IsGUIProgram="no" IsEnabled="yes"/>
<Environment EnvVarSetName="&lt;Use Defaults&gt;" DbgSetName="&lt;Use Defaults&gt;">
<![CDATA[]]>
</Environment>
<Debugger IsRemote="no" RemoteHostName="" RemoteHostPort="" DebuggerPath="" IsExtended="no">
<DebuggerSearchPaths/>
<PostConnectCommands/>
<StartupCommands/>
</Debugger>
<PreBuild/>
<PostBuild/>
<CustomBuild Enabled="yes">
<Target Name="cmake">cmake .. -DCMAKE_BUILD_TYPE=Debug -DCMAKE_EXPORT_COMPILE_COMMANDS=1</Target>
<RebuildCommand>make clean &amp;&amp; mingw32-make -j4</RebuildCommand>
<CleanCommand>make clean</CleanCommand>
<BuildCommand>make -j4</BuildCommand>
<PreprocessFileCommand/>
<SingleFileCommand/>
<MakefileGenerationCommand/>
<ThirdPartyToolName>None</ThirdPartyToolName>
<WorkingDirectory>$(WorkspacePath)/build-debug</WorkingDirectory>
</CustomBuild>
<AdditionalRules>
<CustomPostBuild/>
<CustomPreBuild/>
</AdditionalRules>
<Completion EnableCpp11="no" EnableCpp14="no">
<ClangCmpFlagsC/>
<ClangCmpFlags/>
<ClangPP/>
<SearchPaths/>
</Completion>
</Configuration>
<Configuration Name="Debug_Windows" CompilerType="GCC" DebuggerType="GNU gdb debugger" Type="Executable" BuildCmpWithGlobalSettings="append" BuildLnkWithGlobalSettings="append" BuildResWithGlobalSettings="append">
<Compiler Options="-g;-O0;-Wall" C_Options="-g;-O0;-Wall" Assembler="" Required="yes" PreCompiledHeader="" PCHInCommandLine="no" PCHFlags="" PCHFlagsPolicy="0">
<IncludePath Value="."/>
</Compiler>
<Linker Options="" Required="yes"/>
<ResourceCompiler Options="" Required="no"/>
<General OutputFile="$(IntermediateDirectory)/$(ProjectName)" IntermediateDirectory="./Debug" Command="./build-debug/HelloWorld" CommandArguments="" UseSeparateDebugArgs="no" DebugArguments="" WorkingDirectory="" PauseExecWhenProcTerminates="yes" IsGUIProgram="no" IsEnabled="yes"/>
<Environment EnvVarSetName="&lt;Use Defaults&gt;" DbgSetName="&lt;Use Defaults&gt;">
<![CDATA[]]>
</Environment>
<Debugger IsRemote="no" RemoteHostName="" RemoteHostPort="" DebuggerPath="" IsExtended="no">
<DebuggerSearchPaths/>
<PostConnectCommands/>
<StartupCommands/>
</Debugger>
<PreBuild/>
<PostBuild/>
<CustomBuild Enabled="yes">
<Target Name="cmake">cmake .. -G "MinGW Makefiles" -DCMAKE_BUILD_TYPE=Debug -DCMAKE_EXPORT_COMPILE_COMMANDS=1</Target>
<RebuildCommand>mingw32-make clean &amp;&amp; mingw32-make -j4</RebuildCommand>
<CleanCommand>mingw32-make clean</CleanCommand>
<BuildCommand>mingw32-make -j4</BuildCommand>
<PreprocessFileCommand/>
<SingleFileCommand/>
<MakefileGenerationCommand/>
<ThirdPartyToolName>None</ThirdPartyToolName>
<WorkingDirectory>$(WorkspacePath)/build-debug</WorkingDirectory>
</CustomBuild>
<AdditionalRules>
<CustomPostBuild/>
<CustomPreBuild/>
</AdditionalRules>
<Completion EnableCpp11="no" EnableCpp14="no">
<ClangCmpFlagsC/>
<ClangCmpFlags/>
<ClangPP/>
<SearchPaths/>
</Completion>
</Configuration>
<Configuration Name="Release_Linux" CompilerType="GCC" DebuggerType="GNU gdb debugger" Type="Executable" BuildCmpWithGlobalSettings="append" BuildLnkWithGlobalSettings="append" BuildResWithGlobalSettings="append">
<Compiler Options="-g;-O0;-Wall" C_Options="-g;-O0;-Wall" Assembler="" Required="yes" PreCompiledHeader="" PCHInCommandLine="no" PCHFlags="" PCHFlagsPolicy="0">
<IncludePath Value="."/>
</Compiler>
<Linker Options="" Required="yes"/>
<ResourceCompiler Options="" Required="no"/>
<General OutputFile="$(IntermediateDirectory)/$(ProjectName)" IntermediateDirectory="./Release" Command="./build-release/HelloWorld" CommandArguments="" UseSeparateDebugArgs="no" DebugArguments="" WorkingDirectory="" PauseExecWhenProcTerminates="yes" IsGUIProgram="no" IsEnabled="yes"/>
<Environment EnvVarSetName="&lt;Use Defaults&gt;" DbgSetName="&lt;Use Defaults&gt;">
<![CDATA[]]>
</Environment>
<Debugger IsRemote="no" RemoteHostName="" RemoteHostPort="" DebuggerPath="" IsExtended="no">
<DebuggerSearchPaths/>
<PostConnectCommands/>
<StartupCommands/>
</Debugger>
<PreBuild/>
<PostBuild/>
<CustomBuild Enabled="yes">
<Target Name="cmake">cmake .. -DCMAKE_EXPORT_COMPILE_COMMANDS=1</Target>
<RebuildCommand>make clean &amp;&amp; make -j4</RebuildCommand>
<CleanCommand>make clean</CleanCommand>
<BuildCommand>make -j4</BuildCommand>
<PreprocessFileCommand/>
<SingleFileCommand/>
<MakefileGenerationCommand/>
<ThirdPartyToolName>None</ThirdPartyToolName>
<WorkingDirectory>$(WorkspacePath)/build-release</WorkingDirectory>
</CustomBuild>
<AdditionalRules>
<CustomPostBuild/>
<CustomPreBuild/>
</AdditionalRules>
<Completion EnableCpp11="no" EnableCpp14="no">
<ClangCmpFlagsC/>
<ClangCmpFlags/>
<ClangPP/>
<SearchPaths/>
</Completion>
</Configuration>
<Configuration Name="Release_Windows" CompilerType="GCC" DebuggerType="GNU gdb debugger" Type="Executable" BuildCmpWithGlobalSettings="append" BuildLnkWithGlobalSettings="append" BuildResWithGlobalSettings="append">
<Compiler Options="-g;-O0;-Wall" C_Options="-g;-O0;-Wall" Assembler="" Required="yes" PreCompiledHeader="" PCHInCommandLine="no" PCHFlags="" PCHFlagsPolicy="0">
<IncludePath Value="."/>
</Compiler>
<Linker Options="" Required="yes"/>
<ResourceCompiler Options="" Required="no"/>
<General OutputFile="$(IntermediateDirectory)/$(ProjectName)" IntermediateDirectory="./Release" Command="./build-release/HelloWorld" CommandArguments="" UseSeparateDebugArgs="no" DebugArguments="" WorkingDirectory="" PauseExecWhenProcTerminates="yes" IsGUIProgram="no" IsEnabled="yes"/>
<Environment EnvVarSetName="&lt;Use Defaults&gt;" DbgSetName="&lt;Use Defaults&gt;">
<![CDATA[]]>
</Environment>
<Debugger IsRemote="no" RemoteHostName="" RemoteHostPort="" DebuggerPath="" IsExtended="no">
<DebuggerSearchPaths/>
<PostConnectCommands/>
<StartupCommands/>
</Debugger>
<PreBuild/>
<PostBuild/>
<CustomBuild Enabled="yes">
<Target Name="cmake">cmake .. -G "MinGW Makefiles" -DCMAKE_EXPORT_COMPILE_COMMANDS=1</Target>
<RebuildCommand>mingw32-make clean &amp;&amp; mingw32-make -j4</RebuildCommand>
<CleanCommand>mingw32-make clean</CleanCommand>
<BuildCommand>mingw32-make -j4</BuildCommand>
<PreprocessFileCommand/>
<SingleFileCommand/>
<MakefileGenerationCommand/>
<ThirdPartyToolName>None</ThirdPartyToolName>
<WorkingDirectory>$(WorkspacePath)/build-release</WorkingDirectory>
</CustomBuild>
<AdditionalRules>
<CustomPostBuild/>
<CustomPreBuild/>
</AdditionalRules>
<Completion EnableCpp11="no" EnableCpp14="no">
<ClangCmpFlagsC/>
<ClangCmpFlags/>
<ClangPP/>
<SearchPaths/>
</Completion>
</Configuration>
</Settings>
<VirtualDirectory Name="src">
<File Name="main.cpp"/>
</VirtualDirectory>
<VirtualDirectory Name="resources">
<File Name="CMakeLists.txt"/>
</VirtualDirectory>
</CodeLite_Project>

7
YAP/main.cpp Normal file
View File

@ -0,0 +1,7 @@
#include <iostream>
int main(int argc, char **argv)
{
std::cout << "Hello World" << std::endl;
return 0;
}

View File

@ -126,26 +126,26 @@ set(C_INTERFACE_SOURCES
H/compile.h
H/corout.h
H/dlmalloc.h
H/heap/dglobals.h
H/heap/dlocals.h
H/heap/dhstruct.h
H/generated/dglobals.h
H/generated/dlocals.h
H/generated/dhstruct.h
H/eval.h
H/heapgc.h
H/heap/hglobals.h
H/heap/hlocals.h
H/heap/hstruct.h
H/heap/iglobals.h
H/heap/ihstruct.h
H/heap/ilocals.h
H/generated/hglobals.h
H/generated/hlocals.h
H/generated/hstruct.h
H/generated/iglobals.h
H/generated/ihstruct.h
H/generated/ilocals.h
H/index.h
H/inline-only.h
H/iswiatoms.h
H/qly.h
H/rclause.h
H/heap/rglobals.h
H/heap/rlocals.h
H/generated/rglobals.h
H/generated/rlocals.h
H/rheap.h
H/heap/rhstruct.h
H/generated/rhstruct.h
H/threads.h
H/tracer.h
H/trim_trail.h
@ -155,7 +155,9 @@ set(C_INTERFACE_SOURCES
H/YapLFlagInfo.h
H/YapText.h
H/cut_c.h
H/iatoms.h H/ratoms.h H/tatoms.h
H/generated/iatoms.h
H/generated/ratoms.h
H/generated/tatoms.h
CXX/yapdb.hh
CXX/yapi.hh
BEAM/eam.h BEAM/eamamasm.h

18
cmake/disallow.cmake Normal file
View File

@ -0,0 +1,18 @@
function (disallow_intree_builds)
# Adapted from LLVM's/UTF8proc toplevel CMakeLists.txt file
if( CMAKE_SOURCE_DIR STREQUAL CMAKE_BINARY_DIR AND NOT MSVC_IDE )
message(SYSTEM_ERROR_FATAL "
In-source builds are not allowed. Please create a directory
and run cmake from there. Building in a subdirectory is
fine, e.g.:
mkdir build
cd build
cmake ..
This process created the file `CMakeCache.txt' and the
directory `CMakeFiles'. Please delete them.
")
endif()
endfunction()

View File

@ -28,10 +28,10 @@ yap.md
# add a target to generate API documentation with Doxygen
find_package(Doxygen)
option(WITH_DOCUMENTATION "Create and install the HTML based API documentation (requires Doxygen)" ${DOXYGEN_FOUND})
option(WITH_DOCS "Create and install the HTML based API documentation (requires Doxygen)" ${DOXYGEN_FOUND})
if(WITH_DOCUMENTATION)
if (WITH_DOCS)
if(NOT DOXYGEN_FOUND)
message(FATAL_ERROR "Doxygen is needed to build the documentation.")
endif()

View File

@ -8,9 +8,9 @@
#
# All text after a single hash (#) is considered a comment and will be ignored.
# The format is:
# TAG = value [value, ...]
# TAG = value [value, file.]
# For lists, items can also be appended using:
# TAG += value [value, ...]
# TAG += value [value, file.]
# Values that contain spaces should be placed between quotes (\" \").
#---------------------------------------------------------------------------
@ -407,7 +407,7 @@ TYPEDEF_HIDES_STRUCT = NO
# code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small
# doxygen will become slower. If the cache is too large, memory is wasted. The
# cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range
# is 0..9, the default is 0, corresponding to a cache size of 2^16=65536
# is 0file9, the default is 0, corresponding to a cache size of 2^16=65536
# symbols. At the end of a run doxygen will report the cache usage and suggest
# the optimal cache size from a speed point of view.
# Minimum value: 0, maximum value: 9, default value: 0.
@ -636,8 +636,8 @@ GENERATE_BUGLIST = YES
GENERATE_DEPRECATEDLIST= YES
# The ENABLED_SECTIONS tag can be used to enable conditional documentation
# sections, marked by \if <section_label> ... \endif and \cond <section_label>
# ... \endcond blocks.
# sections, marked by \if <section_label> file. \endif and \cond <section_label>
# file. \endcond blocks.
ENABLED_SECTIONS =
@ -1094,6 +1094,7 @@ HTML_FILE_EXTENSION = .html
# This tag requires that the tag GENERATE_HTML is set to YES.
HTML_HEADER =
#/Users/vsc/git/yap-6.3/docs/web/bootstrap/header.html
# The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each
@ -1105,6 +1106,7 @@ HTML_HEADER =
# This tag requires that the tag GENERATE_HTML is set to YES.
HTML_FOOTER =
#/Users/vsc/git/yap-6.3/docs/web/bootstrap/footer.html
# The HTML_STYLESHEET tag can be used to specify a user-defined cascading style
@ -1118,6 +1120,7 @@ HTML_FOOTER =
# This tag requires that the tag GENERATE_HTML is set to YES.
HTML_STYLESHEET =
#/Users/vsc/git/yap-6.3/docs/web/bootstrap/customdoxygen.css
# The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined
@ -1131,7 +1134,9 @@ HTML_STYLESHEET =
# list). For an example see the documentation.
# This tag requires that the tag GENERATE_HTML is set to YES.
HTML_EXTRA_STYLESHEET = /Users/vsc/git/yap-6.3/docs/solarized-light.css
HTML_EXTRA_STYLESHEET =
# /Users/vsc/git/yap-6.3/docs/solarized-light.css
# The HTML_EXTRA_FILES tag can be used to specify one or more extra images or
# other source files which should be copied to the HTML output directory. Note
@ -1142,6 +1147,7 @@ HTML_EXTRA_STYLESHEET = /Users/vsc/git/yap-6.3/docs/solarized-light.css
# This tag requires that the tag GENERATE_HTML is set to YES.
HTML_EXTRA_FILES =
#/Users/vsc/git/yap-6.3/docs/web/bootstrap/doxy-boot.js
# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen
@ -1489,7 +1495,7 @@ MATHJAX_FORMAT = HTML-CSS
# output directory using the MATHJAX_RELPATH option. The destination directory
# should contain the MathJax.js script. For instance, if the mathjax directory
# is located at the same level as the HTML output directory, then
# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax
# MATHJAX_RELPATH should be file/mathjax. The default value points to the MathJax
# Content Delivery Network so you can quickly see the result without installing
# MathJax. However, it is strongly recommended to install a local copy of
# MathJax from http://www.mathjax.org before deployment.
@ -1886,7 +1892,7 @@ MAN_LINKS = NO
# captures the structure of the code including all documentation.
# The default value is: NO.
GENERATE_XML = NO
GENERATE_XML = YES
# The XML_OUTPUT tag is used to specify where the XML pages will be put. If a
# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of
@ -2069,7 +2075,7 @@ SKIP_FUNCTION_MACROS = YES
# a tag file without this location is as follows:
# TAGFILES = file1 file2 ...
# Adding location for the tag files is done as follows:
# TAGFILES = file1=loc1 "file2 = loc2" ...
# TAGFILES = file1=loc1 "file2 = loc2" file.
# where loc1 and loc2 can be relative or absolute paths or URLs. See the
# section "Linking to external documentation" for more information about the use
# of tag files.

View File

@ -774,6 +774,8 @@ YAP Built-ins {#builtins}
+ @ref YAP_Terms
+ @ref InputOutput
+ @ref AbsoluteFileName
+ @ref YAPOS
@ -806,6 +808,9 @@ language. Next, we discuss how to use the most important ones.
The YAP Library {#library}
===============
@defgroup library YAP library files
@{
Library files reside in the library_directory path (set by the
`LIBDIR` variable in the Makefile for YAP). Several files in the
library are originally from the public-domain Edinburgh Prolog library.
@ -861,10 +866,14 @@ The YAP Library {#library}
- @ref wgraphs
- @ref wundgraphs
- @ref ypp
@}
The YAP Packages {#packages}
================
@defgroup packages YAP packages files
@{
+ @ref real
+ @ref BDDs
@ -891,10 +900,16 @@ Leuven packages ported from SWI-Prolog:
+ @subpage clpqr
@}
Compatibility {#swi}
=============
@defgroup swi Compatibility
@{
YAP has been designed to be as compatible as possible with other
Prolog systems, originally with C-Prolog\cite x and SICStus
Prolog~\cite x . More recent work on YAP has striven at making YAP
@ -1075,9 +1090,15 @@ architectures. Otherwise, YAP follows IEEE arithmetic.
Please inform the authors on other incompatibilities that may still
exist.
@}
Foreign Language interface for YAP {#fli}
==================================
@defgroup fli Foreigd Code Interfacing
@{
YAP provides the user with three facilities for writing
predicates in a language other than Prolog. Under Unix systems,
most language implementations were linkable to `C`, and the first interface exported the YAP machinery to the C language. YAP also implements most of the SWI-Prolog foreign language interface.
@ -1088,4 +1109,9 @@ being designed to work with the swig (www.swig.orgv) interface compiler.
+ The @ref swi-c-interface emulates Jan Wielemaker's SWI foreign language interface.
+ The @ref yap-cplus-interface is desiged to interface with the SWI ackage \cite x Object-Oriented systems.
+ The @ref yap-cplus-interface is desiged to interface with the SWIG package by using Object-Oriented concepts
+ The @ref LoadInterface handles the setup of foreign files
@}

View File

@ -1820,80 +1820,10 @@ Given the packaged stream position term _StreamPosition_, unify
*/
/** @pred tell(+ _S_)
If _S_ is a currently opened stream for output, it becomes the
current output stream. If _S_ is an atom it is taken to be a
filename. If there is no output stream currently associated with it,
then it is opened for output, and the new output stream created becomes
the current output stream. If it is not possible to open the file, an
error occurs. If there is a single opened output stream currently
associated with the file, then it becomes the current output stream; if
there are more than one in that condition, one of them is chosen.
Whenever _S_ is a stream not currently opened for output, an error
may be reported, depending on the state of the file_errors flag. The
predicate just fails, if _S_ is neither a stream nor an atom.
*/
/** @pred telling(- _S_)
The current output stream is unified with _S_.
*/
/** @pred told
Closes the current output stream, and the user's terminal becomes again
the current output stream. It is important to remember to close streams
after having finished using them, as the maximum number of
simultaneously opened streams is 17.
*/
/** @pred see(+ _S_)
If _S_ is a currently opened input stream then it is assumed to be
the current input stream. If _S_ is an atom it is taken as a
filename. If there is no input stream currently associated with it, then
it is opened for input, and the new input stream thus created becomes
the current input stream. If it is not possible to open the file, an
error occurs. If there is a single opened input stream currently
associated with the file, it becomes the current input stream; if there
are more than one in that condition, then one of them is chosen.
When _S_ is a stream not currently opened for input, an error may be
reported, depending on the state of the `file_errors` flag. If
_S_ is neither a stream nor an atom the predicates just fails.
*/
/** @pred seeing(- _S_)
The current input stream is unified with _S_.
*/
/** @pred seen
Closes the current input stream (see 6.7.).
*/
/** @defgroup InputOutput_of_Terms Handling Input/Output of Terms
@ingroup YAPBuiltins
@ -4244,7 +4174,7 @@ is sometimes useful. As in other Prolog systems, YAP has
several primitives that allow updating Prolog terms. Note that these
primitives are also backtrackable.
The `setarg/3` primitive allows updating any argument of a Prolog
The setarg/3 primitive allows updating any argument of a Prolog
compound terms. The `mutable` family of predicates provides
<em>mutable variables</em>. They should be used instead of `setarg/3`,
as they allow the encapsulation of accesses to updatable

View File

@ -69,13 +69,6 @@ typedef int _Bool;
#define __WINDOWS__ 1
#endif
#endif
#ifndef X_API
#if (defined(_MSC_VER) || defined(__MINGW32__)) && defined(PL_KERNEL)
#define X_API __declspec(dllexport)
#else
#define X_API
#endif
#endif
#include "pl-types.h"
@ -100,7 +93,7 @@ stuff.
#endif
#ifdef HAVE_DECLSPEC
# ifdef PL_KERNEL
# ifdef _YAP_NOT_INSTALLED_
#define PL_EXPORT(type) __declspec(dllexport) type
#define PL_EXPORT_DATA(type) __declspec(dllexport) type
#define install_t void

View File

@ -370,7 +370,8 @@ typedef enum stream_f {
RepError_Prolog_f = 0x400000, /**< handle representation error as Prolog terms */
RepError_Xml_f = 0x800000, /**< handle representation error as XML objects */
DoNotCloseOnAbort_Stream_f= 0x1000000, /**< do not close the stream after an abort event */
Readline_Stream_f= 0x2000000 /**< the stream is a readline stream */
Readline_Stream_f= 0x2000000, /**< the stream is a readline stream */
FreeOnClose_Stream_f= 0x4000000 /**< the stream buffer should be releaed on close */
} estream_f;
typedef uint64_t stream_flags_t;

View File

@ -1,18 +1,39 @@
///
/// @file YapErrors.h
///
/// @adddtogroup YapError
///
/// The file YapErrors.h contains a list with all the error classes known internally to the YAP system.
BEGIN_ERROR_CLASSES()
/// base case
ECLASS(NO_ERROR, "no_error", 0)
/// bad domain, first argument often is the predicate.
ECLASS(DOMAIN_ERROR, "domain_error", 2)
/// bad arithmetic
ECLASS(EVALUATION_ERROR, "evaluation_error", 2)
/// missing object (I/O mostly)
ECLASS(EXISTENCE_ERROR, "existence_error", 2)
ECLASS(INSTANTIATION_ERROR_CLASS, "instantiation_error", 0)
/// should be bound
ECLASS(INSTANTIATION_ERROR_CLASS, "instantiation_error", 0)
/// bad access, I/O
ECLASS(PERMISSION_ERROR, "permission_error", 3)
ECLASS(REPRESENTATION_ERROR, "representation_error", 2)
/// something that could not be represented into a type
ECLASS(REPRESENTATION_ERROR, "representation_error", 2)
/// not enough ....
ECLASS(RESOURCE_ERROR, "resource_error", 2)
ECLASS(SYNTAX_ERROR_CLASS, "syntax_error", 2)
ECLASS(SYSTEM_ERROR_CLASS, "system_error", 2)
/// bad text
ECLASS(SYNTAX_ERROR_CLASS, "syntax_error", 1)
/// OS or internal
ECLASS(SYSTEM_ERROR_CLASS, "system_error", 2)
/// bad typing
ECLASS(TYPE_ERROR, "type_error", 2)
/// should be unbound
ECLASS(UNINSTANTIATION_ERROR_CLASS, "uninstantiation_error", 1)
ECLASS(EVENT, "event", 2)
/// escape hatch
ECLASS(EVENT, "event", 2)
END_ERROR_CLASSES();
@ -20,10 +41,10 @@ BEGIN_ERRORS()
/* ISO_ERRORS */
E0(YAP_NO_ERROR, NO_ERROR)
E0(YAP_NO_ERROR, NO_ERROR) /// default state
E(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, DOMAIN_ERROR,
"absolute_file_name_option")
"absolute_file_name_option")
E(DOMAIN_ERROR_ARRAY_OVERFLOW, DOMAIN_ERROR, "array_overflow")
E(DOMAIN_ERROR_ARRAY_TYPE, DOMAIN_ERROR, "array_type")
E(DOMAIN_ERROR_FILE_ERRORS, DOMAIN_ERROR, "file_errors")

View File

@ -20,10 +20,10 @@
@defgroup ChYInterface Foreign Language interface to YAP
@brief Core interface to YAP.
q
*/
#ifndef _yap_c_interface_h
#define _yap_c_interface_h 1
@ -31,7 +31,7 @@
#define __YAP_PROLOG__ 1
#ifndef YAPVERSION
#define YAPVERSION 60000 //> default versison
#define YAPVERSION 60000
#endif
#include "YapDefs.h"
@ -40,8 +40,62 @@
#include <stdarg.h>
#endif
#if HAVE_STDBOOL_H
#include <stdbool.h>
#endif
#include <wchar.h>
/*
__BEGIN_DECLS should be used at the beginning of the C declarations,
so that C++ compilers don't mangle their names. __END_DECLS is used
at the end of C declarations.
*/
#undef __BEGIN_DECLS
#undef __END_DECLS
#ifdef __cplusplus
# define __BEGIN_DECLS extern "C" {
# define __END_DECLS }
#else
# define __BEGIN_DECLS /* empty */
# define __END_DECLS /* empty */
#endif /* _cplusplus */
__BEGIN_DECLS
/**
* X_API macro
*
* brif
*
* @param _WIN32
*
* @return
*/
#if defined(_WIN32)
#if YAP_H
#define X_API __declspec(dllexport)
#else
#define X_API __declspec(dllimport)
#endif
#else
#define X_API
#endif
#ifndef Int_FORMAT
#if _WIN64
#define Int_FORMAT "%I64d"
#define Int_ANYFORMAT "%I64i"
#define UInt_FORMAT "%I64u"
#else
#define Int_FORMAT "%ld"
#define Int_ANYFORMAT "%li"
#define UInt_FORMAT "%lu"
#endif
#endif /* portable form of formatted output for Prolog terms */
/**
@defgroup c-interface YAP original C-interface
@ -79,31 +133,6 @@ system.
*/
/*
__BEGIN_DECLS should be used at the beginning of the C declarations,
so that C++ compilers don't mangle their names. __END_DECLS is used
at the end of C declarations.
*/
#undef __BEGIN_DECLS
#undef __END_DECLS
#ifdef __cplusplus
# define __BEGIN_DECLS extern "C" {
# define __END_DECLS }
#else
# define __BEGIN_DECLS /* empty */
# define __END_DECLS /* empty */
#endif /* _cplusplus */
__BEGIN_DECLS
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
#define X_API __declspec(dllexport)
#else
#define X_API
#endif
__END_DECLS
/**
*
* Using the compiler:
@ -1563,68 +1592,12 @@ the future we plan to split this library into several smaller libraries
*/
#define _yap_c_interface_h 1
#define __YAP_PROLOG__ 1
#ifndef YAPVERSION
#define YAPVERSION 60000
#endif
#include "YapDefs.h"
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
#if HAVE_STDBOOL_H
#include <stdbool.h>
#endif
#include <wchar.h>
/*
__BEGIN_DECLS should be used at the beginning of the C declarations,
so that C++ compilers don't mangle their names. __END_DECLS is used
at the end of C declarations.
*/
#undef __BEGIN_DECLS
#undef __END_DECLS
#ifdef __cplusplus
# define __BEGIN_DECLS extern "C" {
# define __END_DECLS }
#else
# define __BEGIN_DECLS /* empty */
# define __END_DECLS /* empty */
#endif /* _cplusplus */
__BEGIN_DECLS
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
#define X_API __declspec(dllexport)
#else
#define X_API
#endif
#ifndef Int_FORMAT
#if _WIN64
#define Int_FORMAT "%I64d"
#define Int_ANYFORMAT "%I64i"
#define UInt_FORMAT "%I64u"
#else
#define Int_FORMAT "%ld"
#define Int_ANYFORMAT "%li"
#define UInt_FORMAT "%lu"
#endif
#endif /* portable form of formatted output for Prolog terms */
/* Primitive Functions */
#define YAP_Deref(t) (t)
extern X_API YAP_Term YAP_A(int);
X_API
extern YAP_Term YAP_A(int);
#define YAP_ARG1 YAP_A(1)
#define YAP_ARG2 YAP_A(2)
#define YAP_ARG3 YAP_A(3)
@ -2146,8 +2119,28 @@ extern X_API YAP_Term YAP_ImportTerm(char *);
extern X_API int YAP_RequiresExtraStack(size_t);
extern X_API int
YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap);
/**
* YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
*
* @param [in] argc the number of arguments to YAP
* @param [in] argv the array of arguments to YAP
* @param [in,out] argc the array with processed settings YAP
*
* @return
*//*
* proccess command line arguments: valid switches are:
* -b boot file
* -l load file
* -L load file, followed by exit.
* -s stack area size (K)
* -h heap area size
* -a aux stack size
* -e emacs_mode -m
* -DVar=Value
* reserved memory for alloc IF DEBUG
* -P only in development versions
*/
extern X_API int YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap);
extern X_API YAP_Int YAP_AtomToInt(YAP_Atom At);

1
include/c_interface.c Normal file
View File

@ -0,0 +1 @@

View File

@ -1,10 +1,4 @@
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
#define X_API __declspec(dllexport)
#else
#define X_API
#endif
struct ClauseList
{
@ -14,14 +8,14 @@ struct ClauseList
};
typedef struct ClauseList *clause_list_t;
X_API clause_list_t Yap_ClauseListInit(clause_list_t in);
clause_list_t Yap_ClauseListInit(clause_list_t in);
X_API int Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred);
X_API void Yap_ClauseListClose(clause_list_t cl);
X_API int Yap_ClauseListDestroy(clause_list_t cl);
X_API void *Yap_ClauseListToClause(clause_list_t cl);
X_API void *Yap_ClauseListCode(clause_list_t cl);
X_API void *Yap_FAILCODE(void);
int Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred);
void Yap_ClauseListClose(clause_list_t cl);
int Yap_ClauseListDestroy(clause_list_t cl);
void *Yap_ClauseListToClause(clause_list_t cl);
void *Yap_ClauseListCode(clause_list_t cl);
void *Yap_FAILCODE(void);
#define Yap_ClauseListCount(cl) ((cl)->n)

View File

@ -82,6 +82,7 @@ if (MPI_C_FOUND)
install(TARGETS yap_mpi
LIBRARY DESTINATION ${dlls}
ARCHIVE DESTINATION ${dlls}
)
endif (MPI_C_FOUND)

View File

@ -8,7 +8,7 @@
*
*/
:- module(line_utils,
:- module(lineutils,
[search_for/2,
search_for/3,
scan_natural/3,
@ -244,7 +244,8 @@ split_unquoted(_, [], []) --> [].
split_quoted( [0'"], More) --> %0'"
"\"".
split_quoted( [0'\\ ,C|New], More) --> %0'"
split_quoted( [0'\\ ,C|New], More) -->
%0'"
"\\",
[C],
split_quoted(New, More).

View File

@ -17,7 +17,8 @@ if (MATLAB_FOUND)
target_link_libraries(matlab libYap $(MATLAB_LIBRARIES) )
install(TARGETS matlab
LIBRARY DESTINATION ${dlls} )
LIBRARY DESTINATION ${dlls}
ARCHIVE DESTINATION ${dlls} )
endif (MATLAB_FOUND)

View File

@ -6,5 +6,7 @@ target_link_libraries(matrix libYap)
set_target_properties (matrix PROPERTIES PREFIX "")
install(TARGETS matrix
LIBRARY DESTINATION ${dlls} )
LIBRARY DESTINATION ${dlls}
ARCHIVE DESTINATION ${dlls}
)

View File

@ -6,5 +6,6 @@ target_link_libraries(yap_random libYap)
set_target_properties (yap_random PROPERTIES PREFIX "")
install(TARGETS yap_random
LIBRARY DESTINATION ${dlls} )
LIBRARY DESTINATION ${dlls}
ARCHIVE DESTINATION ${dlls} )

View File

@ -18,5 +18,6 @@ target_link_libraries(regexp libYap ${REGEX_SOURCES})
set_target_properties (regexp PROPERTIES PREFIX "")
install(TARGETS regexp
LIBRARY DESTINATION ${dlls} )
LIBRARY DESTINATION ${dlls}
ARCHIVE DESTINATION ${dlls} )

View File

@ -11,5 +11,6 @@ target_link_libraries(yap_rl libYap)
set_target_properties (yap_rl PROPERTIES PREFIX "")
install(TARGETS yap_rl
LIBRARY DESTINATION ${dlls} )
LIBRARY DESTINATION ${dlls}
ARCHIVE DESTINATION ${dlls} )

View File

@ -184,8 +184,6 @@ where _LeftTree_ contains all items in _Tree_ less than
greater than _Key_. This operations destroys _Tree_.
*/
*/
splay_access(V, Item, Val, Tree, NewTree):-
bst(access(V), Item, Val, Tree, NewTree).

View File

@ -28,7 +28,8 @@ target_link_libraries(sys libYap)
set_target_properties (sys PROPERTIES PREFIX "")
install(TARGETS sys
LIBRARY DESTINATION ${dlls} )
LIBRARY DESTINATION ${dlls}
ARCHIVE DESTINATION ${dlls} )
configure_file ("sys_config.h.cmake" "sys_config.h" )

View File

@ -0,0 +1,31 @@
/* Define to 1 if you have the <openssl/ripemd.h> header file. */
#ifndef HAVE_APACHE2_UTIL_MD5_H
/* #undef HAVE_APACHE2_UTIL_MD5_H */
#endif
/* Define to 1 if you have the <openssl/ripemd.h> header file. */
#ifndef HAVE_APR_1_APR_MD5_H
#define HAVE_APR_1_APR_MD5_H 1
#endif
/* Define to 1 if you have the <openssl/md5.h> header file. */
#ifndef HAVE_OPENSSL_MD5_H
/* #undef HAVE_OPENSSL_MD5_H */
#endif
/* Define to 1 if you have the <openssl/ripemd.h> header file. */
#ifndef HAVE_OPENSSL_RIPEMD_H
/* #undef HAVE_OPENSSL_RIPEMD_H */
#endif
/* "Define if you have the crypt function." */
#ifndef HAVE_CRYPT
/* #undef HAVE_CRYPT */
#endif
/* Define to 1 if you have the <crypt.h> header file. */
#ifndef HAVE_CRYPT_H
/* #undef HAVE_CRYPT_H */
#endif

View File

@ -12,7 +12,8 @@ target_link_libraries(tries libYap)
set_target_properties (tries PROPERTIES PREFIX "")
install(TARGETS tries
LIBRARY DESTINATION ${dlls} )
LIBRARY DESTINATION ${dlls}
ARCHIVE DESTINATION ${dlls})
set ( ITRIES_SOURCES
@ -28,5 +29,6 @@ target_link_libraries(itries libYap)
set_target_properties (itries PROPERTIES PREFIX "")
install(TARGETS itries
LIBRARY DESTINATION ${dlls} )
LIBRARY DESTINATION ${dlls}
ARCHIVE DESTINATION ${dlls} )

View File

@ -130,12 +130,12 @@ UInt GLOBAL_flagCount Yap_InitFlags(true) RestoreFlags(GLOBAL_flagCount)
yap_exec_mode Yap_ExecutionMode =INTERPRETED void
/* The Predicate Hash Table: fast access to predicates. */
UInt PredsInHashTable =0 void
uint64_t PredHashTableSize =0 void
struct pred_entry **PredHash InitPredHash() RestorePredHash()
#if defined(YAPOR) || defined(THREADS)
rwlock_t PredHashRWLock void
#endif
UInt PredsInHashTable =0 void
uint64_t PredHashTableSize =0 void
/* Well-Known Predicates */

View File

@ -1,161 +0,0 @@
pl_graphs(Dir - Mod) :-
atom( Dir ),
format(' ************* GRAPH: ~a ***********************/~n', [Dir]),
atom_concat([Dir,'/*'], Pattern), % */
expand_file_name( Pattern, Files ),
member( File, Files ),
( ( sub_atom(File,_,_,0,'.yap') ; sub_atom(File,_,_,0,'.pl') ) ->
build_graph( File , Mod )
;
exists_directory( File ),
\+ atom_concat(_, '/.', File),
\+ atom_concat(_, '/..', File),
\+ atom_concat(_, '/.git', File),
pl_graphs( File - Mod )
),
fail.
pl_graphs(_).
%%
% pl_graph( File, Mod)
% adds a node to the file graph and marks which files are modules
%
% main side-effect facts like edge( F0-Mod:File )
% exported( F-M , N/A ) or exported(F- M. Op ),
% module_on ( M, File )
% pred ( M :N/A )
%
build_graph(F, Mod) :-
% writeln(F),
preprocess_file( F, PF ),
catch( open(PF, read, S, [scripting(true)]), _, fail ),
repeat,
nb_getval( current_module, MR ),
catch(read_term( S, T, [term_position(Pos),module(MR),comments(Cs)] ), Throw, (writeln(Throw))),
(
T == end_of_file
->
!,% also, clo ops defined in the module M, if M \= Mod
% ( sub_atom(F,_,_,_,'/matrix.yap') -> start_low_level_trace ; nospyall ),
close(S)
;
stream_position_data( line_count, Pos, Line ),
maplist( comment, Cs ),
nb_setval( line, Line ),
nb_getval( current_module, MC0 ),
( Mod == prolog -> MC = prolog ; MC = MC0 ),
get_graph( T, F, Pos, MC ),
fail
).
get_graph( V , _F, _Pos, _M ) :-
var( V ),
!,
error( instantiation_error ).
get_graph( T, _F, _Pos, _M0 ) :-
var(T),
!.
get_graph( M:T, F, _Pos, _M0 ) :- !,
get_graph( T, F, _Pos, M ).
get_graph( ( M:H :- B), F, _Pos, M0 ) :-
!,
get_graph( (H :- M0:B), F, _Pos, M ).
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( ( A --> B), F, _Pos, M ).
get_graph( (H --> B), F, _Pos, M ) :-
!,
functor( H, N, Ar),
Ar2 is Ar+2,
add_deps( B, M, M:N/Ar2, F, _Pos, 2 ).
get_graph( (H :- B), F, _Pos, M ) :-
!,
functor( H, N, Ar),
add_deps( B, M, M:N/Ar, F, _Pos, 0 ).
%% switches to new file n
get_graph( (:-include( Fs ) ), F, _Pos, M ) :-
!,
source_graphs( M, F, Fs ).
get_graph( (?- _ ), _F, _Pos, _M ) :- !.
get_graph( (:- _ ), _F, _Pos, _M ) :- !.
source_graphs( M, F, Fs ) :-
maplist( source_graph( M, F ), Fs ), !.
source_graphs( M, F, Fs ) :-
search_file( Fs, F, pl, NF ),
build_graph( NF , M ), !.
add_deps(V, _M, _P, _F, _Pos, _) :-
var(V), !.
add_deps(M1:G, _M, _P, _F, _Pos,L) :-
!,
always_strip_module(M1:G, M2, G2),
add_deps(G2, M2, _P, _F, _Pos, L).
add_deps((A,B), M, P, F, _Pos, L) :-
!,
add_deps(A, M, P, F, _Pos, L),
add_deps(B, M, P, F, _Pos, L).
add_deps((A;B), M, P, F, _Pos, L) :- !,
add_deps(A, M, P, F, _Pos, L),
add_deps(B, M, P, F, _Pos, L).
add_deps((A|B), M, P, F, _Pos, L) :- !,
add_deps(A, M, P, F, _Pos, L),
add_deps(B, M, P, F, _Pos, L).
add_deps((A->B), M, P, F, _Pos, L) :- !,
add_deps(A, M, P, F, _Pos, L),
add_deps(B, M, P, F, _Pos, L).
add_deps((A*->B), M, P, F, _Pos, L) :- !,
add_deps(A, M, P, F, _Pos, L),
add_deps(B, M, P, F, _Pos, L).
add_deps(once(A), M, P, F, _Pos, L) :- !,
add_deps(A, M, P, F, _Pos, L).
add_deps({A}, M, P, F, _Pos, 2) :- !,
add_deps(A, M, P, F, _Pos, 0).
add_deps([_|_], M, P, F, Pos, 2) :-
!,
put_dep( (F-M:P :- prolog:'C'/3 ), Pos ).
add_deps(String, _M, _P, _F, _Pos, _) :- string(String), !.
add_deps([], _M, _P, _F, _Pos, 2) :- !.
add_deps(!, _M, _P, _F, _Pos, _) :- !.
add_deps(true, _M, _P, _F, _Pos, 0) :- !.
add_deps(false, _M, _P, _F, _Pos, 0) :- !.
add_deps(fail, _M, _P, _F, _Pos, 0) :- !.
add_deps(repeat, _M, _P, _F, _Pos, 0) :- !.
add_deps(A, M, P, F, Pos, L) :-
% we're home, M:N/Ar -> P=M1:N1/A1
functor(A, N, Ar0),
Ar is Ar0+L,
put_dep( ( F-M:P :- F-M:N/Ar ), Pos ).
put_dep( (Target :- F0-M:Goal ), Pos ) :-
exported( ( F0-M:Goal :- F1-M1:N/Ar ) ), !,
%follow ancestor chain
ancestor( ( F1-M1:N/Ar :- FA-MA:NA/Ar ) ),
put_dep( ( Target :- FA-MA:NA/Ar ), Pos ).
% the base case, copying from the same module ( but maybe not same file 0.
put_dep( ( Target :- _F-M:N/Ar ) , _ ) :-
m_exists(M:N/Ar, F0),
!,
assert_new( edge( ( Target :- F0-M:N/Ar ) ) ).
% prolog is visible ( but maybe not same file ).
put_dep( ( Target :- _F-_prolog:N/Ar ), _ ) :-
m_exists(prolog:N/Ar, F0),
!,
assert_new( edge( ( Target :- F0-prolog:N/Ar ) ) ).
put_dep( ( _Target :- _F-Mod:_N/_Ar ), _Pos) :-
var( Mod ), !.
put_dep( ( Target :- F-Mod:N/Ar ), Pos) :-
atom( Mod ),
stream_position_data( line_count, Pos, Line ),
assert_new( undef( (Target :- F-Mod:N/Ar ), Line) ).
ancestor( ( Younger :- Older) ) :-
exported( ( Mid :- Older ) ), !,
ancestor( ( Younger :- Mid) ).
ancestor( (Older :- Older) ).
m_exists(P, F) :- private( F, P ), !.
m_exists(P, F) :- public( F, P ).

View File

@ -1,694 +0,0 @@
/***********************************************************
load a program into a graph, but do not actually consult it.
***********************************************************/
load( D, _OMAP ) :-
working_directory(_, D),
fail.
load( _, _Map ) :-
% from libraries outside the current directories
assert( node( attributes, woken_att_do/4, 'library/atts.yap', prolog ) ),
fail.
load( _ , Dirs ) :-
dirs( Dirs ),
%%% phase 1: find modules
nb_setval( current_module, user ),
nb_setval( private, false ),
nb_setval( file_entry, user:user ),
init_loop( Dirs ),
maplist( pl_interfs, Dirs ),
%%% phase 2: find C-code predicates
maplist( c_preds, Dirs ).
dirs( Roots ) :-
member( Root-_, Roots ),
% (Root = 'OPTYap' -> start_low_level_trace ; true ),
absolute_file_name( Root, FRoot ),
rdir( FRoot ),
fail.
dirs( _Roots ).
rdir( FRoot ) :-
absolute_file_name( FRoot, [glob(*), solutions(all), file_errors(fail)], File ),
\+ doskip( File ),
(
file_property( File, type(directory) )
->
rdir( File )
;
assert_new( dir( FRoot, File ))
),
fail.
rdir(_).
c_preds(Dir - Mod) :-
atom( Dir ),
absolute_file_name( Dir, [glob(*), solutions(all), file_errors(fail)], File ),
( ( sub_atom(File,_,_,0,'.c')
;
sub_atom(File,_,_,0,'.i')
;
sub_atom(File,_,_,0,'.C')
;
sub_atom(File,_,_,0,'.cpp')
;
sub_atom(File,_,_,0,'.icc')
;
sub_atom(File,_,_,0,'.h')
) ->
\+ doskip( File ),
c_file( File , Mod )
;
exists_directory( File ),
\+ doskip( File ),
c_preds( File - Mod )
),
fail.
c_preds(_).
c_file(F, _Mod) :-
consulted( F, _ ),
!.
c_file(F, Mod) :-
% writeln(F),
assert( consulted( F, Mod ) ),
nb_setval( current_module, Mod ),
open(F, read, S, [alias(c_file)]),
repeat,
read_line_to_string( S, String ),
( String == end_of_file
->
!,
close(S)
;
sub_string(String, _, _, _, `PL_extension`),
%writeln(Fields),
c_ext(S, Mod, F),
fail
;
split_string(String, `,; ()\t\"\'`, Fields), %'
%writeln(Fields),
line_count(S, Lines),
c_line(Fields , Mod, F:Lines),
fail
).
c_line([`}`], Mod, _) :- !,
nb_setval( current_module, Mod ).
c_line(Line, _Mod, _) :-
append( _, [ `CurrentModule`, `=`, M|_], Line),
system_mod(M, _Mod, Mod, _),
nb_setval( current_module, Mod ).
c_line(Line, Mod, F: LineP) :-
break_line( Line, N/A, Fu),
assert( node( Mod, N/A, F-LineP, Fu ) ),
handle_pred( Mod, N, A, F ).
c_ext( S, Mod, F ) :-
repeat,
read_line_to_string( S, String ),
(
sub_string( String, _, _, _, `NULL` ),
!
;
split_string(String, `,; (){}\t\"\'`, [`FRG`, NS,AS,FS|_]), %'
atom_string(N,NS),
atom_string(Fu,FS),
number_string(A, AS),
stream_property( S, position( Pos ) ),
stream_position_data( line_count, Pos, Line ),
assert( node( Mod , N/A, F-Line, Fu ) ),
handle_pred( Mod, N, A, F )
;
split_string(String, `,; (){}\t\"\'`, [NS,AS,FS|_]), %'
atom_string(N,NS),
atom_string(Fu,FS),
number_string(A, AS),
stream_property( S, position( Pos ) ),
stream_position_data( line_count, Pos, Line ),
Line0 is Line-1,
assert( node( Mod, N/A, F-Line0, Fu ) ),
handle_pred( Mod, N, A, F )
).
break_line( Line, N/A, c(Fu)) :-
take_line( Line, NS, AS, FS ), !,
atom_string(N,NS),
atom_string(Fu,FS),
number_string(A, AS).
break_line( Line, N/A, swi(Fu)) :-
take_line( Line, NS, AS, FS ), !,
atom_string(N,NS),
number_string(A, AS),
atomic_concat([`pl_`,FS,`_`,A,`_va`], Fu).
break_line( Line, N/A, bp(Fu)) :-
take_line( Line, NS, AS, FS ), !,
atom_string(N,NS),
number_string(A, AS),
atomic_concat([`pc_`,FS,`_`,A], Fu).
break_line( Line, N/A, c(FuE, FuB)) :-
take_line( Line, NS, AS, FSE, FSB ), !,
atom_string(N,NS),
atom_string(FuE,FSE),
atom_string(FuB,FSB),
number_string(A, AS).
take_line( Line, NS, AS, FS ) :-
append( _, [ `Yap_InitCPred`, NS, AS, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ `Yap_InitAsmPred`, NS, AS, _, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ `Yap_InitCmpPred`, NS, AS, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ `Yap_InitCmpPred`, NS, AS, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ `YAP_UserCPredicate`, NS, FS, AS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ `PRED`, NS0, AS, FS|_], Line), !,
append( [`pl_`, NS0, AS, `_va`], NS ).
take_line( Line, NS, AS, FS ) :-
append( _, [ `PRED_IMPL`, NS0, AS, FS|_], Line), !,
append( [`pl_`, NS0, AS, `_va`], NS ).
take_line( Line, NS, AS, FS ) :-
append( _, [ `PL_register_foreign`, NS, AS, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ `PRED_DEF`, NS0, AS, FS|_], Line), !,
append( [`pl_`, NS0, AS, `_va`], NS ).
take_line( Line, NS, AS, FS ) :-
append( _, [ `FRG`, NS, AS, FS|_], Line), !.
% from odbc
take_line( Line, NS, AS, FS ) :-
append( _, [ `NDET`, NS, AS, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ `DET`, NS, AS, FS|_], Line), !.
take_line( Line, AS, FS ) :-
append( _, [ `REGISTER_CPRED`, FS, AS], Line), !.
take_line( Line, NS, AS, FSE, FSB ) :-
append( _, [ `Yap_InitCPredBack`, NS, AS, _, FSE, FSB|_], Line), !.
system_mod(`ATTRIBUTES_MODULE`, _, attributes, user ).
system_mod(`HACKS_MODULE`, _, '$hacks' , sys ).
system_mod(`USER_MODULE`, _, user, user ).
system_mod(`DBLOAD_MODULE`, _, '$db_load', sys ).
system_mod(`GLOBALS_MODULE`, _, globals, sys ).
system_mod(`ARG_MODULE`, _, arg, sys ).
system_mod(`PROLOG_MODULE`, _ , prolog, sys ).
system_mod(`RANGE_MODULE`, _, range, user ).
system_mod(`SWI_MODULE`, _, swi, sys ).
system_mod(`OPERATING_SYSTEM_MODULE`, _, system , sys ).
system_mod(`TERMS_MODULE`, _, terms , sys).
system_mod(`SYSTEM_MODULE`, _, system, sys ).
system_mod(`IDB_MODULE`, _, idb, user ).
system_mod(`CHARSIO_MODULE`, _, charsio, sys ).
system_mod(`cm`, M, M, user ).
call_c_files( File, Mod, _Fun, [CFile] ) :-
search_file( CFile, File, c, F ),
c_file(F, Mod).
call_c_files( File, Mod, _Fun, CFile ) :-
CFile \= [_|_],
search_file( CFile, File, c, F ),
c_file(F, Mod).
pl_interfs(Dir - Mod) :-
\+ doskip( Dir ),
format('% ************* ~a\n', [Dir]),
nb_setval( current_module, Mod ),
atom( Dir ),
directory_files( Dir , Files),
member( File, Files ),
atom_concat([Dir,'/',File], Path),
( ( sub_atom(File,_,_,0,'.yap') ; sub_atom(File,_,_,0,'.pl') ; sub_atom(File,_,_,0,'.ypp') ) ->
ops_restore,
absolute_file_name( Path, APath ),
pl_interf( APath , Mod )
;
exists_directory( Path ),
\+ atom_concat(_, '/.', Path),
\+ atom_concat(_, '/..', Path),
\+ atom_concat(_, '/.git', Path),
absolute_file_name( Path, APath ),
\+ doskip( APath ),
pl_interfs( APath - Mod )
),
fail.
pl_interfs(_).
%%
% pl_interf( File, Mod)
% adds a node to the file graph and marks which files are modules
%
% main side-effect facts like edge( F0-Mod:File )
% exported( ( FMNATarget :- FMNASource ) ) ou exported(F-M, Op ),
% module_on ( M, File )
%
pl_interf(F, _Mod) :-
module_on( F , _M, _Is),
!.
pl_interf(F, Mod) :-
consulted(F, Mod ),
!.
pl_interf(F, Mod) :-
% ( sub_atom(F,_,_,_,'matrix.yap') -> spy get_interf ; true ),
% ( sub_atom( F, _, _, 0, 'gecode.yap' ) -> spy user_deps; true ),
assert_new(consulted(F, Mod ) ),
nb_getval( private, Default ),
nb_setval( private, false ),
nb_getval( file_entry, OF:OMod ),
nb_setval( file_entry, F:Mod ),
preprocess_file( F, PF ),
catch( open(PF, read, S, [scripting(true)]) , _, fail ),
repeat,
nb_getval( current_module, MR ),
%( sub_atom(F,_,_,_,'e.yap') -> spy get_interf ; nospyall ),
catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, (ypp(F,Throw), fail)),
(
T == end_of_file
->
!,
close(S),
(
c_dep( F, Fc),
c_file( Fc, MR ),
fail
;
build_graph( F, MR ),
fail
% cleanup
;
module_on( F , _M, _Is)
->
% also, close ops defined in the module M, if M \= Mod
nb_setval( current_module, Mod ),
nb_setval( private, Default ),
nb_setval( file_entry, OF:OMod )
;
true
)
;
nb_getval( current_module, MC0 ),
stream_position_data( line_count, Pos, Line ),
nb_setval( line, Line ),
( Mod == prolog -> MC = prolog ; MC = MC0 ),
get_interf( T, F, MC ),
fail
).
get_interf( T, _F, _M0 ) :-
var(T),
!.
get_interf( T, _F, _M0 ) :-
% ( T = (:- op(_,_,_)) -> trace ; true ),
var(T),
!.
get_interf( M:T, F, _M0 ) :- !,
get_interf( T, F, M ).
get_interf( goal_expansion(G, M, _) , F, _M0 ) :-
nonvar( G ),
!,
( var( M ) -> M1 = prolog ; M = M1 ),
functor( G, N, A ),
handle_pred( M1, N, A, F ).
get_interf( goal_expansion(G, _) , F, _M0 ) :-
nonvar( G ),
!,
functor( G, N, A ),
handle_pred( prolog, N, A, F ).
get_interf( ( M:H :- _B), F, _M ) :-
!,
get_interf( H, F, M ).
get_interf( ( goal_expansion(G, M, _) :- _) , F, _M0 ) :-
nonvar( G ),
!,
( var( M ) -> M1 = prolog ; M = M1 ),
functor( G, N, A ),
handle_pred( M1, N, A, F ).
get_interf( ( goal_expansion(G, _) :- _) , F, _M0 ) :-
nonvar( G ),
!,
functor( G, N, A ),
handle_pred( prolog, N, A, F ).
get_interf( ( M:H --> _B), F, _ ) :-
!,
get_interf( ( H --> _B), F, M ).
get_interf( ( A, _ --> _B), F, M ) :-
get_interf( ( A --> _B), F, M ).
get_interf( (H --> _B), F, M ) :-
!,
functor( H, N, Ar),
Ar2 is Ar+2,
functor( H2, N, Ar2),
get_interf( H2, F, M ).
get_interf( (H :- _B), F, M ) :-
!,
get_interf( H, F, M ).
%% switches to new file n
get_interf( (:- V ), _F, _M ) :-
var( V ),
!.
get_interf( (:- module( NM, Is ) ), F, _M ) :-
!,
assert(module_file( F, NM ) ),
nb_setval( current_module, NM ),
assert( module_on( F , NM, Is) ),
maplist( public(F, NM), Is ),
nb_setval( private, true ).
get_interf( (:- reexport( Loc, Is ) ), F, M ) :-
!,
% find the file
search_file( Loc, F, pl, NF ),
include_files( F, M, Is, NF ),
% extend the interface.rg
retract( module_on( F , M, Is0) ),
append( Is0, Is, NIs ),
assert( module_on( F , M, NIs) ),
maplist( public(F, M), NIs ).
get_interf( (:- use_module( Loc, Is ) ), F, M ) :- !,
!,
include_files( F, M, Is, Loc ).
get_interf( (:- use_module( Loc ) ), F, M ) :- !,
!,
include_files( F, M, Loc ).
% nb_getval(current_module,MM), writeln(NM:MM:M).
get_interf( (:- use_module( Loc, Is, _ ) ), F, M ) :- !,
!,
include_files( F, M, Is, Loc ).
get_interf( (:- consult( Files ) ), F, M ) :-
!,
include_files( F, M, Files ).
get_interf( (:- reconsult( Files ) ), F, M ) :-
!,
include_files( F, M, Files ).
get_interf( (:- ensure_loaded( Files ) ), F, M ) :-
!,
include_files( F, M, Files ).
get_interf( (:- include( Files ) ), F, M ) :-
!,
source_files( F, M, Files ).
get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :-
!,
include_files( F, M, Files ).
get_interf( ( :- ( G -> _ ; _ ) ) , F, M) :-
!,
get_interf( (:- G ) , F, M).
get_interf( (:- catch( G , _, _ ) ) , F, M) :-
!,
get_interf( (:- G ) , F, M).
get_interf( (:- initialization( G , now ) ) , F, M) :-
!,
get_interf( (:- G ) , F, M).
get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :-
!,
include_files( F, M, Files ).
get_interf( (:- [F1|Fs] ), F, M ) :-
!,
include_files( F, M, [F1|Fs] ).
% don't actually use this one.
get_interf( (:- load_foreign_files(Fs, _, Fun) ), F, M ) :-
!,
call_c_files( F, M, Fun, Fs ).
get_interf( (:- load_foreign_library(F) ), F0, M ) :-
!,
always_strip_module(M:F, M1, F1),
call_c_files( F0, M1, '', F1 ).
get_interf( (:- load_foreign_library(F,Fun) ), F0, M ) :-
!,
always_strip_module(M:F, M1, F1),
call_c_files( F0, M1, Fun, F1 ).
get_interf( (:- use_foreign_library(F) ), F0, M ) :-
!,
always_strip_module(M:F, M1, F1),
call_c_files( F0, M1, '', F1 ).
get_interf( (:- system_module( _NM, _Publics, _Hiddens) ), _F, _M ) :-
!.
get_interf( (:- style_checker( _ ) ), _F, _M ) :-
!.
get_interf( (:- dynamic T), F, M ) :-
!,
declare_functors( T, F, M ).
get_interf( (:- multifile T), F, M ) :- % public?
!,
declare_functors( T, F, M ).
get_interf( (:- meta_predicate T), F, M ) :-!,
declare_terms( T, F, M ), % public?
!.
get_interf( (:- '$install_meta_predicate'( H, M) ), F, __M ) :-
!,
declare_functors( H, F, M ).
get_interf( (:- thread_local T), F, M ) :-
!,
declare_functors( T, F, M ).
get_interf( (:- op( X, Y, Z) ), F, M ) :-
!,
always_strip_module(M:Z, M1, Z1),
handle_op( F, M1, op( X, Y, Z1) ).
get_interf( (:- record( Records ) ), F, M ) :-
!,
handle_record( Records, F, M).
get_interf( (:- set_prolog_flag(dollar_as_lower_case,On) ), _F, _M ) :-
!,
set_prolog_flag(dollar_as_lower_case,On).
get_interf( (:- _ ), _F, _M ) :- !.
get_interf( (?- _ ), _F, _M ) :- !.
get_interf( V , _F, _M ) :-
var( V ),
!,
error( instantiation_error ).
get_interf( G , F, M ) :-
functor( G, N, A),
handle_pred( M, N, A, F ),
!.
% support SWI package record
handle_record( (Records1, Records2), F, M ) :-
!,
handle_record( Records1, F, M ),
handle_record( Records2, F, M ).
handle_record( Record, F, M ) :-
Record =.. [Constructor|Fields],
atom_concat(Constructor, '_data', Data),
handle_pred( M, Data, 3, F),
atom_concat(default_, Constructor, New),
handle_pred( M, New, 1, F),
atom_concat(is_, Constructor, Is),
handle_pred( M, Is, 1, F),
atom_concat(make_, Constructor, Make),
handle_pred( M, Make, 2, F),
handle_pred( M, Make, 3, F),
atom_concat([set_, Constructor,'_fields'], Sets),
handle_pred( M, Sets, 3, F),
handle_pred( M, Sets, 4, F),
atom_concat([set_, Constructor,'_field'], Set),
handle_pred( M, Set, 3, F),
maplist( handle_record_field( Constructor, F, M) , Fields ).
handle_record_field( Constructor, F, M, Name:_=_ ) :-
!,
handle_record_field_name( Constructor, F, M, Name).
handle_record_field( Constructor, F, M, Name:_ ) :-
!,
handle_record_field_name( Constructor, F, M, Name).
handle_record_field( Constructor, F, M, Name=_ ) :-
!,
handle_record_field_name( Constructor, F, M, Name).
handle_record_field( Constructor, F, M, Name ) :-
handle_record_field_name( Constructor, F, M, Name).
handle_record_field_name( Constructor, F, M, Name) :-
atom_concat([ Constructor,'_', Name], Val),
handle_pred( M, Val, 2, F),
atom_concat([ set_, Name, '_of_', Constructor ], Set),
handle_pred( M, Set, 3, F),
handle_pred( M, Set, 2, F),
atom_concat([ nb_set_, Name, '_of_', Constructor ], Set),
handle_pred( M, Set, 3, F),
handle_pred( M, Set, 2, F).
handle_pred( M, N, A, F ) :-
(
system_mod( _, _, M, sys )
->
(
atom_concat('$',_,N)
->
private( F, M, N/A )
;
public( F, M, N/A )
)
;
( nb_getval( private, false )
->
public( F, M, N/A )
;
private( F, M, N/A )
)
).
handle_op( F, M, Op ) :-
( nb_getval( private, false )
->
public( F, M, Op )
;
private( F, M, Op )
),
Op = op(X, Y, Z ),
( ( M == user ; M == prolog )
->
op( X, Y, prolog:Z )
;
op( X, Y, M:Z )
).
exported( NF, F, NM, M, op(X,Y,Z)) :-
!,
public( NF , NM:op(X,Y,Z) ),
handle_op( F, M , op(X,Y,Z) ).
exported( NF, F, NM, M, N/A) :- !,
% sink no more
retractall( exported(( _ :- F-M:N/A) ) ),
assert_new( exported( (F-M:N/A :- NF-NM:N/A )) ).
exported( NF, F, NM, M, N/A as NN) :- !,
% sink no more
retractall( exported(( _ :- F-M:N/A) ) ),
assert_new( exported( ( F-M:NN/A :- NF-NM:N/A ) ) ).
exported( NF, F, NM, M, N//A) :- !,
A2 is A+2,
% sink no more
retractall( exported(( _ :- F-M:N/A2) ) ),
assert_new( exported( (F-M:N/A2 :- NF-NM:N/A2) ) ).
exported( NF, F, NM, M, N//A as NN) :- !,
A2 is A+2,
% sink no more
retractall( exported(( _ :- F-M:N/A2) ) ),
assert_new( exported( ( F-M:NN/A2 :- NF-NM:N/A2 )) ).
import_publics( F, ProducerMod, ConsumerMod ) :-
public(F, ProducerMod:op(X,Y,Z) ),
handle_op( F, ConsumerMod, op(X,Y,Z) ),
fail.
import_publics( _F, _ProducerMod, _ConsumerMod ).
all_imported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod ) :-
public(ProducerFile, ProducerMod:op(X,Y,Z) ),
handle_op( ConsumerFile, ConsumerMod, op(X,Y,Z) ),
fail.
all_imported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod ) :-
public(ProducerFile, ProducerMod:N/A ),
exported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod, N/A ),
fail.
all_imported( _ProducerFile, _ConsumerFile, _ProducerMod, _ConsumerMod ).
include_files( F, M, Files ) :-
include_files( F, M, _Is, Files ).
include_files( F, M, Is, Files ) :-
maplist( include_files( F, M, Is ), Files ),
!.
include_files( F, M, Is, -Files ) :-
!,
include_files( F, M, Is, Files).
include_files( F, M, Is, Files ) :-
!,
always_strip_module(M:Files, M1, NFiles),
include_file( F, M1, Is, NFiles ).
include_files( F, M, Is, Loc ) :-
include_file( F, M, Is, Loc ).
include_file( F, M, Is, Loc ) :-
is_list( Loc ), !,
maplist( include_file( F, M, Is), Loc ).
include_file( F, M, Is0, Loc ) :-
nb_getval( private, Private ),
% find the file
once( search_file( Loc, F, pl, NF ) ),
% depth visit
pl_interf(NF, M), % should verify Is in _Is
% link b
( module_on(NF, NM, Is)
->
( var(Is0) -> Is = Is0 ; true ),
maplist( exported( NF, F, NM, M) , Is0 )
;
all_imported( NF, F, NM, M)
),
nb_setval( private, Private ).
source_files( F, M, Files ) :-
maplist( source_files( F, M ), Files ),
!.
source_files( F, M, Loc ) :-
source_file( F, M, Loc ).
source_file( F, M, Loc ) :-
once( search_file( Loc, F, pl, NF ) ),
% depth visit
pl_source(NF, F, M). % should verify Is in _Is
pl_source(F, F0, Mod) :-
% writeln( -F ),
preprocess_file( F, PF ),
catch( open(PF, read, S, []) , _, fail ),
repeat,
nb_getval( current_module, MR ),
%( sub_atom(F,_,_,_,'examples/matrix.yap') -> spy get_interf ; nospyall ),
catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, (writeln(F:MR:Throw), break, fail)),
(
T == end_of_file
->
!,
close(S)
;
nb_getval( current_module, MC0 ),
stream_position_data( line_count, Pos, Line ),
nb_setval( line, Line ),
( Mod == prolog -> MC = prolog ; MC = MC0 ),
get_interf( T, F0, MC ),
fail
).
declare_functors( T, _F, _M1) :- var(T), !,
error( unbound_variable ).
declare_functors( M:T, F, _M1) :- !,
declare_functors( T, F, M).
declare_functors( (T1,T2), F, M1) :- !,
declare_functors( T1, F, M1),
declare_functors( T2, F, M1).
declare_functors( Ts, F, M1) :-
maplist( declare_functor( F, M1), Ts ), !.
declare_functors( T, F, M1) :-
declare_functor( F, M1, T).
declare_functor(File, M, N/A) :-
handle_pred( M, N, A, File ).
declare_terms( T, _F, _M1) :- var(T), !,
error( unbound_variable ).
declare_terms( M:T, F, _M1) :- !,
declare_functors( T, F, M).
declare_terms( (N1,N2), F, M) :-
number(N1),
number(N2),
!,
declare_term( F, M, (N1,N2)).
declare_terms( (T1,T2), F, M1) :- !,
declare_terms( T1, F, M1),
declare_terms( T2, F, M1).
declare_terms( Ts, F, M1) :-
maplist( declare_term( F, M1), Ts ), !.
declare_terms( T, F, M1) :-
declare_term( F, M1, T).
declare_term(F, M, S) :-
functor(S, N, A),
handle_pred( M, N, A, F ).

View File

@ -13,9 +13,9 @@
main :-
warning(Warning),
file_filter_with_init('misc/ATOMS','H/tatoms.h',gen_fields, Warning, ['tatoms.h']),
file_filter_with_init('misc/ATOMS','H/iatoms.h',gen_decl, Warning, ['iatoms.h']),
file_filter_with_init('misc/ATOMS','H/ratoms.h',gen_rcov, Warning, ['ratoms.h']).
file_filter_with_init('misc/ATOMS','H/heap/tatoms.h',gen_fields, Warning, ['tatoms.h']),
file_filter_with_init('misc/ATOMS','H/heap/iatoms.h',gen_decl, Warning, ['iatoms.h']),
file_filter_with_init('misc/ATOMS','H/heap/ratoms.h',gen_rcov, Warning, ['ratoms.h']).
warning('~n /* This file, ~a, was generated automatically by \"yap -L misc/buildatoms\"~n please do not update, update misc/ATOMS instead */~n~n').

View File

@ -30,7 +30,7 @@ main :-
file_filter_with_initialization('misc/GLOBALS','H/heap/hglobals.h',gen_struct,Warning,['hglobals.h','GLOBALS']),
file_filter_with_initialization('misc/GLOBALS','H/heap/dglobals.h',gen_dstruct,Warning,['dglobals.h','GLOBALS']),
file_filter_with_initialization('misc/GLOBALS','H/heap/iglobals.h',gen_init,Warning,['iglobals.h','GLOBALS']),
file_filter_with_initialization('misc/GLOBALS','H/heap/i0globals.h',gen_0init,Warning,['iglobals.h','GLOBALS']),
%% file_filter_with_initialization('misc/GLOBALS','H/heap/i0globals.h',gen_0init,Warning,['iglobals.h','GLOBALS']),
file_filter_with_initialization('misc/LOCALS','H/heap/hlocals.h',gen_struct,Warning,['hlocals.h','LOCALS']),
file_filter_with_initialization('misc/LOCALS','H/heap/dlocals.h',gen_dstruct,Warning,['dlocals.h','LOCALS']),
file_filter_with_initialization('misc/LOCALS','H/heap/rlocals.h',gen_hstruct,Warning,['rlocals.h','LOCALS']),

View File

@ -449,8 +449,8 @@ Legal values:
"use_module" "volatile"))
(yap
("block" "char_conversion" "discontiguous" "dynamic" "encoding"
"ensure_loaded" "export" "expects_dialect" "export_list" "import"
"meta_predicate" "module" "module_transparent" "multifile" "require"
"ensure_loaded" "export" "expects_dialect" "meta_predicate" "module"
"module_transparent" "multifile" "reexport"
"table" "thread_local" "use_module" "wait"))
(gnu
("built_in" "char_conversion" "discontiguous" "dynamic" "ensure_linked"
@ -652,7 +652,7 @@ nil means send actual operating system end of file."
'((eclipse "^[a-zA-Z0-9()]* *\\?- \\|^\\[[a-zA-Z]* [0-9]*\\]:")
(sicstus "| [ ?][- ] *")
(swi "^\\(\\[[a-zA-Z]*\\] \\)?[1-9]?[0-9]*[ ]?\\?- \\|^| +")
(yap "^\\(\\[[a-zA-Z]*\\] \\)?[1-9]?[0-9]*[ ]?\\?- \\|^| +")
(yap "| [ ?][- ] *")
(t "^ *\\?-"))
"*Alist of prompts of the prolog system command line."
:group 'prolog-inferior

View File

@ -36,14 +36,15 @@ set (YAPOS_HEADERS
include_directories (../H ../include ../OPTYap . ${GMP_INCLUDE_DIR} ${PROJECT_BINARY_DIR})
option (READLINE "GNU readline console" ON)
if (READLINE)
macro_optional_find_package (Readline ON)
macro_log_feature (READLINE_FOUND "libreadline"
"Readline line editing library"
"http://cnswww.cns.cwru.edu/php/chet/readline/rltop.html")
macro_optional_find_package (Readline ON)
macro_log_feature (READLINE_FOUND "libreadline"
"Readline line editing library"
"http://cnswww.cns.cwru.edu/php/chet/readline/rltop.html")
if (READLINE_FOUND)
if (READLINE_FOUND)
# - Find the readline library
# This module defines
# READLINE_INCLUDE_DIR, path to readline/readline.h, etc.
@ -57,6 +58,8 @@ if (READLINE_FOUND)
set(YAP_SYSTEM_OPTIONS "readline " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE)
set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${READLINE_LIBRARIES} )
check_library_exists( readline readline "" HAVE_LIBREADLINE )
check_include_files( "stdio.h;readline/readline.h" HAVE_READLINE_READLINE_H )
check_include_files( "stdio.h;readline/history.h" HAVE_READLINE_HISTORY_H )
if (HAVE_READLINE_READLINE_H)
@ -80,6 +83,8 @@ if (READLINE_FOUND)
endif()
endif (READLINE_FOUND)
endif (READLINE)
set (POSITION_INDEPENDENT_CODE TRUE)
add_library (libYAPOs OBJECT
@ -102,5 +107,4 @@ configure_file ("${PROJECT_SOURCE_DIR}/os/YapIOConfig.h.cmake"
set( READLINE_LIBS ${READLINE_LIBRARIES} PARENT_SCOPE)
#set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${GMP_LIBRARIES} )

View File

@ -1,6 +1,6 @@
/* Define if you have libreadline */
#ifndef HAVE_LIBREADLINE
#cmakedefine USE_READLINE ${USE_READLINE}
#cmakedefine HAVE_LIBREADLINE ${HAVE_LIBREADLINE}
#endif
/* Define to 1 if you have the <readline/history.h> header file. */
@ -10,7 +10,11 @@
/* Define to 1 if you have the <readline/readline.h> header file. */
#ifndef HAVE_READLINE_READLINE_H
#cmakedefine HAVE_READLINE_READLINE_H ${HAVE_READLINE_READLINE_H}
#cmakedefine HAVE_READLINE_READLINE_H ${HAVE_READLINE_READLINE_H}
#endif
#if defined(HAVE_LIBREADLINE) && defined(HAVE_READLINE_READLINE_H)
#define USE_READLINE 1
#endif
/* Define to 1 if you have the declaration of `rl_catch_signals ', and to 0 if

View File

@ -30,8 +30,8 @@ static char SccsId[] = "%W% %G%";
/**
* @group
*
* @defgroup Aliases
* @ingroup InputOutput
*
* Aliases:
* This file defines the main operations on aliases, a second name for a file. Aliases are always

View File

@ -105,7 +105,10 @@ Int Yap_peek(int sno) {
Int ch;
s = GLOBAL_Stream + sno;
if (s->status & Readline_Stream_f) {
#if USE_READLINE
if (s->status & Readline_Stream_f
&& trueGlobalPrologFlag(READLINE_FLAG)
) {
ch = Yap_ReadlinePeekChar(sno);
if (ch == EOFCHAR) {
s->stream_getc = EOFPeek;
@ -114,6 +117,7 @@ Int Yap_peek(int sno) {
}
return ch;
}
#endif
ocharcount = s->charcount;
olinecount = s->linecount;
olinepos = s->linepos;
@ -155,6 +159,7 @@ Int Yap_peek(int sno) {
ungetc(c / 1 << 16, s->file);
c %= 1 << 16;
}
return c;
} else if (s->encoding == ENC_UTF16_LE) {
/* do the ungetc as if a write .. */
unsigned long int c = ch;
@ -238,7 +243,9 @@ static Int at_end_of_stream_0(USES_REGS1) { /* at_end_of_stream */
}
static int yap_fflush(int sno) {
#if USE_READLINE
Yap_ReadlineFlush(sno);
#endif
if ((GLOBAL_Stream[sno].status & Output_Stream_f) &&
!(GLOBAL_Stream[sno].status &
(Null_Stream_f | InMemory_Stream_f | Socket_Stream_f | Pipe_Stream_f |
@ -601,7 +608,7 @@ static Int put_char(USES_REGS1) { /* '$put'(Stream,N) */
return (TRUE);
}
/** @pred tab(+ _N_)
/** @pred tab_1(+ _N_)
Outputs _N_ spaces to the current output stream.

View File

@ -31,6 +31,10 @@ static char SccsId[] = "%W% %G%";
/// @addtogroup CharProps
/**
* @defgroup CharIO Character-Based Input/Output
* @ingroup InputOutput
*/
/*
* This file includes the definition of a character properties.

View File

@ -18,36 +18,23 @@
static char SccsId[] = "%W% %G%";
#endif
/**
* @file console.c
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Wed Jan 20 00:56:23 2016
*
* @brief
*
*
*/
/*
* This file includes the interface to the console IO, tty style. Refer also to the readline library.
*
* @defgroup console Support for console-based interaction.
* @ingroup InputOutput
*/
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "yapio.h"
#include <stdlib.h>
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
#ifdef _WIN32
#if HAVE_IO_H
/* Windows */
#include <io.h>
#endif
#if HAVE_SOCKET
#include <winsock2.h>
#endif
#include <windows.h>
#ifndef S_ISDIR
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
#endif
#endif
#include "iopreds.h"
#include "sysbits.h"
static Int prompt( USES_REGS1 );
static Int prompt1( USES_REGS1 );
@ -83,7 +70,8 @@ is_same_tty(FILE *f1, FILE *f2)
#if HAVE_TTYNAME
return(ttyname(fileno(f1)) == ttyname(fileno(f2)));
#else
return;
// assume a single console, for now
return true;
#endif
}
@ -103,14 +91,18 @@ is_same_tty2 (USES_REGS1)
void
Yap_ConsoleOps( StreamDesc *s )
{
Yap_DefaultStreamOps( s );
/* the putc routine only has to check it is putting out a newline */
s->stream_putc = ConsolePutc;
#if USE_READLINE
/* if a tty have a special routine to call readline */
if (!Yap_ReadlineOps( s )) {
/* else just PlGet plus checking for prompt */
s->stream_getc = ConsoleGetc;
}
Yap_DefaultStreamOps( s );
if (( s->status & Readline_Stream_f) &&
trueGlobalPrologFlag(READLINE_FLAG) ) {
if (Yap_ReadlineOps( s ))
return;
}
#endif
s->stream_getc = ConsoleGetc;
}
/* static */
@ -144,7 +136,7 @@ ConsoleGetc(int sno)
/* keep the prompt around, just in case, but don't actually
show it in silent mode */
if (LOCAL_newline) {
if (silentMode()) {
if (!silentMode()) {
char *cptr = LOCAL_Prompt, ch;
/* use the default routine */
@ -181,6 +173,13 @@ ConsoleGetc(int sno)
return console_post_process_read_char(ch, s);
}
/** @pred prompt1(+ _A__)
Changes YAP input prompt for the .
*/
static Int
prompt1 ( USES_REGS1 )
@ -198,7 +197,13 @@ prompt1 ( USES_REGS1 )
return (TRUE);
}
/** @pred prompt(- _A_,+ _B_)
Changes YAP input prompt from _A_ to _B_, active on *next* standard input interaction.
*/
static Int
prompt ( USES_REGS1 )
{ /* prompt(Old,New) */
@ -211,7 +216,7 @@ prompt ( USES_REGS1 )
a = AtomOfTerm (t);
if (strlen(RepAtom (a)->StrOfAE) > MAX_PROMPT) {
Yap_Error(SYSTEM_ERROR_INTERNAL,t,"prompt %s is too long", RepAtom (a)->StrOfAE);
return(FALSE);
return false;
}
strncpy(LOCAL_Prompt, (char *)RepAtom (LOCAL_AtPrompt)->StrOfAE, MAX_PROMPT);
LOCAL_AtPrompt = a;
@ -223,7 +228,10 @@ Yap_GetCharForSIGINT(void)
{
CACHE_REGS
int ch;
if ((ch = Yap_ReadlineForSIGINT()) == 0)
#if USE_READLINE
if (trueGlobalPrologFlag(READLINE_FLAG) ||
(ch = Yap_ReadlineForSIGINT()) == 0)
#endif
{ /* ask for a new line */
fprintf(stderr, "Action (h for help): ");
ch = getc(stdin);
@ -237,6 +245,7 @@ Yap_GetCharForSIGINT(void)
void Yap_InitConsole(void) {
LOCAL_newline = true;
Yap_InitCPred ("prompt", 1, prompt1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("prompt1", 1, prompt1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$is_same_tty", 2, is_same_tty2, SafePredFlag|SyncPredFlag|HiddenPredFlag);

View File

@ -1,7 +1,37 @@
%
% Edinburgh IO.
/**
* @file edio.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Wed Jan 20 01:07:02 2016
*
* @brief Input/Output according to the DEC-10 Prolog. PLease consider using the ISO
* standard predicates for new code.
*
*
*/
%
/** @pred see(+ _S_)
If _S_ is a currently opened input stream then it is assumed to be
the current input stream. If _S_ is an atom it is taken as a
filename. If there is no input stream currently associated with it, then
it is opened for input, and the new input stream thus created becomes
the current input stream. If it is not possible to open the file, an
error occurs. If there is a single opened input stream currently
associated with the file, it becomes the current input stream; if there
are more than one in that condition, then one of them is chosen.
When _S_ is a stream not currently opened for input, an error may be
reported, depending on the state of the `file_errors` flag. If
_S_ is neither a stream nor an atom the predicates just fails.
*/
see(user) :- !, set_input(user_input).
see(F) :- var(F), !,
'$do_error'(instantiation_error,see(F)).
@ -13,6 +43,13 @@ see(Stream) :- '$stream'(Stream), current_stream(_,read,Stream), !,
set_input(Stream).
see(F) :- open(F,read,Stream), set_input(Stream).
/** @pred seeing(- _S_)
The current input stream is unified with _S_.
*/
seeing(File) :- current_input(Stream),
stream_property(Stream,file_name(NFile)),
(
@ -23,8 +60,33 @@ seeing(File) :- current_input(Stream),
NFile = File
).
/** @pred seen
Closes the current input stream, as opened by see/1. Standard input
stream goes to the original ùser_input`.
*/
seen :- current_input(Stream), close(Stream), set_input(user).
/** @pred tell(+ _S_)
If _S_ is a currently opened stream for output, it becomes the
current output stream. If _S_ is an atom it is taken to be a
filename. If there is no output stream currently associated with it,
then it is opened for output, and the new output stream created becomes
the current output stream. If it is not possible to open the file, an
error occurs. If there is a single opened output stream currently
associated with the file, then it becomes the current output stream; if
there are more than one in that condition, one of them is chosen.
Whenever _S_ is a stream not currently opened for output, an error
may be reported, depending on the state of the file_errors flag. The
predicate just fails, if _S_ is neither a stream nor an atom.
*/
tell(user) :- !, set_output(user_output).
tell(F) :- var(F), !,
'$do_error'(instantiation_error,tell(F)).
@ -43,12 +105,29 @@ tell(Stream) :-
tell(F) :-
open(F,append,Stream),
set_output(Stream).
/** @pred telling(- _S_)
The current output stream is unified with _S_.
*/
telling(File) :-
current_output(Stream),
stream_property(Stream,file_name(NFile)),
( stream_property(user_output,file_name(NFile)) -> File = user ; File = NFile ).
/** @pred told
Closes the current output stream, and the user's terminal becomes again
the current output stream. It is important to remember to close streams
after having finished using them, as the maximum number of
simultaneously opened streams is 17.
*/
told :- current_output(Stream),
!,
set_output(user),

View File

@ -24,75 +24,8 @@ static char SccsId[] = "%W% %G%";
*
*/
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "yapio.h"
#include "eval.h"
#include "YapText.h"
#include <stdlib.h>
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
#if HAVE_CTYPE_H
#include <ctype.h>
#endif
#if HAVE_WCTYPE_H
#include <wctype.h>
#endif
#if HAVE_LIMITS_H
#include <limits.h>
#endif
#if HAVE_SYS_PARAMS_H
#include <sys/params.h>
#endif
#if HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
#endif
#if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__)
#include <sys/select.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_STRING_H
#include <string.h>
#endif
#if HAVE_LIBGEN_H
#include <libgen.h>
#endif
#if HAVE_SIGNAL_H
#include <signal.h>
#endif
#if HAVE_FCNTL_H
/* for O_BINARY and O_TEXT in WIN32 */
#include <fcntl.h>
#endif
#ifdef _WIN32
#if HAVE_IO_H
/* Windows */
#include <io.h>
#endif
#endif
#if !HAVE_STRNCAT
#define strncat(X,Y,Z) strcat(X,Y)
#endif
#if !HAVE_STRNCPY
#define strncpy(X,Y,Z) strcpy(X,Y)
#endif
#if _MSC_VER || defined(__MINGW32__)
#if HAVE_SOCKET
#include <winsock2.h>
#endif
#include <windows.h>
#ifndef S_ISDIR
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
#endif
#endif
#include "iopreds.h"
#include "sysbits.h"
#if _MSC_VER || defined(__MINGW32__)
#define SYSTEM_STAT _stat
@ -341,16 +274,35 @@ time_file(USES_REGS1)
} else {
const char *n = RepAtom(AtomOfTerm(tname))->StrOfAE;
#if __WIN32
FILETIME ftWrite;
if ((hdl = CreateFile( n, 0, 0, NULL, OPEN_EXISTING, NULL)) == 0)
FILETIME ft;
HANDLE hdl;
Term rc;
if ((hdl = CreateFile( n, 0, 0, NULL, OPEN_EXISTING, 0, 0)) == 0)
return false;
if (GetFileTime(hdl, NULL,NULL,&ftWrite))
if (GetFileTime(hdl, NULL,NULL,&ft))
return false;
// Convert the last-write time to local time.
// FileTimeToSystemTime(&ftWrite, &stUTC);
// SystemTimeToTzSpecificLocalTime(NULL, &stUTC, &stLocal);
CloseHandle( hdl );
return Yap_unify(ARG2, MkIntegerTerm(ftWrite));
ULONGLONG qwResult;
// Copy the time into a quadword.
qwResult = (((ULONGLONG) ft.dwHighDateTime) << 32) + ft.dwLowDateTime;
#if SIZEOF_INT_P==8
rc = MkIntegerTerm(qwResult);
#elif USE_GMP
char s[64];
MP_INT rop;
snprintf(s, 64, "%I64d", (long long int)n);
mpz_init_set_str (&rop, s, 10);
rc = Yap_MkBigNumTerm((void *)&rop) PASS_REGS);
#else
rc = MkIntegerTerm(ft.dwHighDateTime);
#endif
return Yap_unify(ARG2, rc);
#elif HAVE_STAT
struct SYSTEM_STAT ss;
@ -505,7 +457,7 @@ is_absolute_file_name ( USES_REGS1 )
at = AtomOfTerm(t);
if (IsWideAtom(at)) {
#if _WIN32
return PathisRelativeW(RepAtom(at)->WStrOfAE[0]);
return PathIsRelativeW(RepAtom(at)->WStrOfAE);
#else
return RepAtom(at)->WStrOfAE[0] == '/';
#endif

View File

@ -14,7 +14,14 @@
// See the License for the specific language governing permissions and
// limitations under the License.
//
//
/**
* @file memopen.c
* @defgroup Memory Streams.
* @in.
* @return Description of returned value.
*/
#ifdef __APPLE__
#include <stdio.h>

View File

@ -18,9 +18,16 @@
static char SccsId[] = "%W% %G%";
#endif
/**
* @file iopreds.c
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Wed Jan 20 00:45:56 2016
*
* @brief main open and close predicates over generic streams.
*
*/
/*
* This file includes the definition of a miscellania of standard predicates
* for yap refering to: Files and GLOBAL_Streams, Simple Input/Output,
* This file includes the definition of a miscellania of standard predicates * for yap refering to: Files and GLOBAL_Streams, Simple Input/Output,
*
*/
@ -170,10 +177,10 @@ static void unix_upd_stream_info(StreamDesc *s) {
Yap_socketStream(s);
#if _MSC_VER || defined(__MINGW32__)
{
if (_isatty(_fileno(s->u.file.file))) {
if (_isatty(_fileno(s->file))) {
s->status |= Tty_Stream_f | Reset_Eof_Stream_f | Promptable_Stream_f;
/* make all console descriptors unbuffered */
setvbuf(s->u.file.file, NULL, _IONBF, 0);
setvbuf(s->file, NULL, _IONBF, 0);
return;
}
#if _MSC_VER
@ -1009,11 +1016,7 @@ Int GetStreamFd(int sno) {
} else
#endif
if (GLOBAL_Stream[sno].status & Pipe_Stream_f) {
#if _MSC_VER || defined(__MINGW32__)
return ((Int)(GLOBAL_Stream[sno].u.pipe.hdl));
#else
return (GLOBAL_Stream[sno].u.pipe.fd);
#endif
} else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
return (-1);
}
@ -1022,7 +1025,7 @@ Int GetStreamFd(int sno) {
Int Yap_GetStreamFd(int sno) { return GetStreamFd(sno); }
static int binary_file(char *file_name) {
static int binary_file(const char *file_name) {
#if HAVE_STAT
#if _MSC_VER || defined(__MINGW32__)
struct _stat ss;
@ -1229,20 +1232,52 @@ static void check_bom(int sno, StreamDesc *st) {
return true;
}
static bool
open_header( int sno, Atom open_mode)
{
if (open_mode == AtomWrite) {
const char *ptr;
const char s[] = "#!";
int ch;
ptr = s;
while ((ch = *ptr++))
GLOBAL_Stream[sno].stream_wputc( sno, ch );
const char *b = Yap_FindExecutable();
ptr = b;
while ((ch = *ptr++))
GLOBAL_Stream[sno].stream_wputc( sno, ch );
const char *l = " -L --\n\n YAP script\n#\n# .\n";
ptr = l;
while ((ch = *ptr++))
GLOBAL_Stream[sno].stream_wputc( sno, ch );
} else if (open_mode == AtomRead) {
// skip header
int ch;
while ((ch =Yap_peek(sno)) == '#' ) {
while ((ch = GLOBAL_Stream[sno].stream_wgetc( sno )) != 10 && ch != -1 );
}
}
return true;
}
#define OPEN_DEFS() \
PAR("alias", isatom, OPEN_ALIAS), PAR("bom", boolean, OPEN_BOM), \
PAR("alias", isatom, OPEN_ALIAS), PAR("bom", booleanFlag, OPEN_BOM), \
PAR("buffer", isatom, OPEN_BUFFER), \
PAR("close_on_abort", boolean, OPEN_CLOSE_ON_ABORT), \
PAR("close_on_abort", booleanFlag, OPEN_CLOSE_ON_ABORT), \
PAR("create", isatom, OPEN_CREATE), \
PAR("encoding", isatom, OPEN_ENCODING), \
PAR("eof_action", isatom, OPEN_EOF_ACTION), \
PAR("expand_filename", boolean, OPEN_EXPAND_FILENAME), \
PAR("expand_filename", booleanFlag, OPEN_EXPAND_FILENAME), \
PAR("file_name", isatom, OPEN_FILE_NAME), PAR("input", ok, OPEN_INPUT), \
PAR("locale", isatom, OPEN_LOCALE), PAR("lock", isatom, OPEN_LOCK), \
PAR("mode", isatom, OPEN_MODE), PAR("output", ok, OPEN_OUTPUT), \
PAR("representation_errors", boolean, OPEN_REPRESENTATION_ERRORS), \
PAR("reposition", boolean, OPEN_REPOSITION), \
PAR("type", isatom, OPEN_TYPE), PAR("wait", boolean, OPEN_WAIT), \
PAR("representation_errors", booleanFlag, OPEN_REPRESENTATION_ERRORS), \
PAR("reposition", booleanFlag, OPEN_REPOSITION), \
PAR("script", booleanFlag, OPEN_SCRIPT), \
PAR("type", isatom, OPEN_TYPE), PAR("wait", booleanFlag, OPEN_WAIT), \
PAR(NULL, ok, OPEN_END)
#define PAR(x, y, z) z
@ -1267,7 +1302,7 @@ do_open(Term file_name, Term t2,
char io_mode[8];
StreamDesc *st;
bool avoid_bom = false, needs_bom = false;
char *fname;
const char *fname;
stream_flags_t flags;
FILE *fd;
encoding_t encoding;
@ -1352,6 +1387,10 @@ do_open(Term file_name, Term t2,
fname = Yap_AbsoluteFile(fname, LOCAL_FileNameBuf, ok);
st->name = Yap_LookupAtom(fname);
// Skip scripts that start with !#/.. or similar
bool script = (args[OPEN_SCRIPT].used
? args[OPEN_SCRIPT].tvalue == TermTrue
: false);
// binary type
if (args[OPEN_TYPE].used) {
Term t = args[OPEN_TYPE].tvalue;
@ -1395,7 +1434,7 @@ do_open(Term file_name, Term t2,
(!(flags & Binary_Stream_f) && binary_file(fname))) {
UNLOCK(st->streamlock);
if (errno == ENOENT)
return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, ARG6, "%s: %s", fname,
return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%s: %s", fname,
strerror(errno)));
else {
return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK, file_name, "%s: %s",
@ -1416,6 +1455,10 @@ do_open(Term file_name, Term t2,
} else if ( open_mode == AtomRead && !avoid_bom ) {
check_bom(sno, st); // can change encoding
}
if (script)
open_header(sno, open_mode);
UNLOCK(st->streamlock);
{
@ -1423,10 +1466,109 @@ do_open(Term file_name, Term t2,
return (Yap_unify(ARG3, t));
}
}
/** @pred open(+ _F_,+ _M_,- _S_) is iso
Opens the file with name _F_ in mode _M_ (`read`, `write` or
`append`), returning _S_ unified with the stream name.
Yap allows 64 streams opened at the same time. If you need more,
redefine the MaxStreams constant. Each stream is either an input or
an output stream but not both. There are always 3 open streams:
user_input for reading, user_output for writing and user_error for
writing. If there is no ambiguity, the atoms user_input and
user_output may be referred to as `user`.
The `file_errors` flag controls whether errors are reported when in
mode `read` or `append` the file _F_ does not exist or is not
readable, and whether in mode `write` or `append` the file is not
writable.
*/
static Int open3(USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */
return do_open(Deref(ARG1), Deref(ARG2), TermNil PASS_REGS);
}
/** @pred open(+ _F_,+ _M_,- _S_,+ _Opts_) is iso
Opens the file with name _F_ in mode _M_ (`read`, `write` or
`append`), returning _S_ unified with the stream name, and following
these options:
+ `type(+ _T_)` is iso
Specify whether the stream is a `text` stream (default), or a
`binary` stream.
+ `reposition(+ _Bool_)` is iso
Specify whether it is possible to reposition the stream (`true`), or
not (`false`). By default, YAP enables repositioning for all
files, except terminal files and sockets.
+ `eof(+ _Action_)` is iso
Specify the action to take if attempting to input characters from a
stream where we have previously found an `end_of_file`. The possible
actions are `error`, that raises an error, `reset`, that tries to
reset the stream and is used for `tty` type files, and `eof_code`,
which generates a new `end_of_file` (default for non-tty files).
+ `alias(+ _Name_)` is iso
Specify an alias to the stream. The alias <tt>Name</tt> must be an atom. The
alias can be used instead of the stream descriptor for every operation
concerning the stream.
The operation will fail and give an error if the alias name is already
in use. YAP allows several aliases for the same file, but only
one is returned by stream_property/2
+ `bom(+ _Bool_)`
If present and `true`, a BOM (<em>Byte Order Mark</em>) was
detected while opening the file for reading or a BOM was written while
opening the stream. See BOM for details.
+ `encoding(+ _Encoding_)`
Set the encoding used for text. See Encoding for an overview of
wide character and encoding issues.
+ `representation_errors(+ _Mode_)`
Change the behaviour when writing characters to the stream that cannot
be represented by the encoding. The behaviour is one of `error`
(throw and Input/Output error exception), `prolog` (write `\u...\`
escape code or `xml` (write `\&#...;` XML character entity).
The initial mode is `prolog` for the user streams and
`error` for all other streams. See also Encoding.
+ `expand_filename(+ _Mode_)`
If _Mode_ is `true` then do filename expansion, then ask Prolog
to do file name expansion before actually trying to opening the file:
this includes processing `~` characters and processing `$`
environment variables at the beginning of the file. Otherwise, just try
to open the file using the given name.
The default behavior is given by the Prolog flag
open_expands_filename.
+ `script( + _Boolean_ )` YAP extension.
The file may be a Prolog script. In `read` mode just check for
initial lines if they start with the hash symbol, and skip them. In
`write` mode output an header that can be used to launch the file by
calling `yap -l file -- $*`. Note that YAP will not set file
permissions as executable. In `append` mode ignore the flag.
*/
static Int open4(USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */
return do_open(Deref(ARG1), Deref(ARG2), Deref(ARG4) PASS_REGS);
}
@ -1605,6 +1747,12 @@ int Yap_GetFreeStreamDForReading(void) {
return sno;
}
/**
* @pred always_prompt_user
*
* Ensure that the stream always prompts before asking the standard input stream for data.
*/
static Int always_prompt_user(USES_REGS1) {
StreamDesc *s = GLOBAL_Stream + StdInStream;
@ -1621,7 +1769,17 @@ static Int always_prompt_user(USES_REGS1) {
return (TRUE);
}
static Int close1(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
static Int close1/** @pred close(+ _S_) is iso
Closes the stream _S_. If _S_ does not stand for a stream
currently opened an error is reported. The streams user_input,
user_output, and user_error can never be closed.
*/
(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
Int sno = CheckStream(
ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2");
if (sno < 0)
@ -1636,7 +1794,7 @@ static Int close1(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
}
#define CLOSE_DEFS() \
PAR("force", boolean, CLOSE_FORCE), PAR(NULL, ok, CLOSE_END)
PAR("force", booleanFlag, CLOSE_FORCE), PAR(NULL, ok, CLOSE_END)
#define PAR(x, y, z) z
@ -1650,6 +1808,15 @@ typedef enum close_enum_choices { CLOSE_DEFS() } close_choices_t;
static const param_t close_defs[] = {CLOSE_DEFS()};
#undef PAR
/** @pred close(+ _S_,+ _O_) is iso
Closes the stream _S_, following options _O_.
The only valid options are `force(true)` and `force(false)`.
YAP currently ignores these options.
*/
static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
Int sno = CheckStream(
ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2");
@ -1685,14 +1852,14 @@ Term read_line(int sno) {
#define ABSOLUTE_FILE_NAME_DEFS() \
PAR("access", isatom, ABSOLUTE_FILE_NAME_ACCESS), \
PAR("expand", boolean, ABSOLUTE_FILE_NAME_EXPAND), \
PAR("expand", booleanFlag, ABSOLUTE_FILE_NAME_EXPAND), \
PAR("extensions", ok, ABSOLUTE_FILE_NAME_EXTENSIONS), \
PAR("file_type", is_file_type, ABSOLUTE_FILE_NAME_FILE_TYPE), \
PAR("file_errors", is_file_errors, ABSOLUTE_FILE_NAME_FILE_ERRORS), \
PAR("glob", ok, ABSOLUTE_FILE_NAME_GLOB), \
PAR("relative_to", isatom, ABSOLUTE_FILE_NAME_RELATIVE_TO), \
PAR("solutions", issolutions, ABSOLUTE_FILE_NAME_SOLUTIONS), \
PAR("verbose_file_search", boolean, \
PAR("verbose_file_search", booleanFlag, \
ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH), \
PAR(NULL, ok, ABSOLUTE_FILE_NAME_END)
@ -1838,7 +2005,9 @@ void Yap_InitIOPreds(void) {
Yap_InitReadTPreds();
Yap_InitFormat();
Yap_InitRandomPreds();
Yap_InitReadline();
#if USE_READLINE
Yap_InitReadlinePreds();
#endif
Yap_InitSockets();
Yap_InitSignalPreds();
Yap_InitSysPreds();

View File

@ -13,6 +13,11 @@ static char SccsId[] = "%W% %G%";
#ifndef IOPREDS_H
#define IOPREDS_H 1
#if _WIN32
#define USE_SOCKET 1
#define HAVE_SOCKET 1
#endif
#include <stdlib.h>
#include "Yap.h"
#include "Atoms.h"
@ -32,6 +37,15 @@ extern size_t Yap_page_size;
#include <wchar.h>
#define Yap_CheckStream( arg, kind, msg) Yap_CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
extern int Yap_CheckStream__(const char *, const char *, int , Term, int, const char *);
#define Yap_CheckTextStream( arg, kind, msg) Yap_CheckTextStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
extern int Yap_CheckTextStream__(const char *, const char *, int , Term, int, const char *);
extern bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name,
encoding_t encoding, stream_flags_t flags,
Atom open_mode);
#if HAVE_SOCKET
extern int Yap_sockets_io;
@ -50,14 +64,7 @@ typedef enum{ /* we accept two domains for the moment, IPV6 may follow */
af_unix /* or AF_FILE */
} socket_domain;
extern bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name,
encoding_t encoding, stream_flags_t flags,
Atom open_mode);
extern Term Yap_InitSocketStream(int, socket_info, socket_domain);
#define Yap_CheckStream( arg, kind, msg) Yap_CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
extern int Yap_CheckStream__(const char *, const char *, int , Term, int, const char *);
#define Yap_CheckTextStream( arg, kind, msg) Yap_CheckTextStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
extern int Yap_CheckTextStream__(const char *, const char *, int , Term, int, const char *);
extern int Yap_CheckSocketStream(Term, const char *);
extern socket_domain Yap_GetSocketDomain(int);
extern socket_info Yap_GetSocketStatus(int);
@ -181,11 +188,7 @@ typedef struct stream_desc
} file;
memHandle mem_string;
struct {
#if defined(__MINGW32__) || defined(_MSC_VER)
HANDLE hdl;
#else
int fd;
#endif
} pipe;
#if HAVE_SOCKET
struct {
@ -276,6 +279,7 @@ Term Yap_scan_num(struct stream_desc *);
void Yap_DefaultStreamOps( StreamDesc *st );
void Yap_PipeOps( StreamDesc *st );
void Yap_MemOps( StreamDesc *st );
bool Yap_CloseMemoryStream( int sno );
void Yap_ConsolePipeOps( StreamDesc *st );
void Yap_SocketOps( StreamDesc *st );
void Yap_ConsoleSocketOps( StreamDesc *st );
@ -294,7 +298,8 @@ void Yap_InitSockets( void );
void Yap_InitSocketLayer(void);
void Yap_InitMems( void );
void Yap_InitConsole( void );
void Yap_InitReadline( void );
void Yap_InitReadlinePreds( void );
bool Yap_InitReadline( Term );
void Yap_InitChtypes(void);
void Yap_InitCharsio(void);
void Yap_InitFormat(void);

Some files were not shown because too many files have changed in this diff Show More