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

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
parent 143684731e ec999c1126
commit c8305988ca
173 changed files with 6345 additions and 6576 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitignore vendored
View File

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

34
C/absmi.c
View File

@ -1062,6 +1062,39 @@ interrupt_pexecute( PredEntry *pen USES_REGS )
return interrupt_handler( pen PASS_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?) */ /* don't forget I cannot creep at deallocate (where to?) */
/* also, this is unusual in that I have already done deallocate, /* also, this is unusual in that I have already done deallocate,
so I don't need to redo it. so I don't need to redo it.
@ -1085,6 +1118,7 @@ interrupt_deallocate( USES_REGS1 )
/* keep on going if there is something else */ /* keep on going if there is something else */
(P->opc != Yap_opcode(_procceed) && (P->opc != Yap_opcode(_procceed) &&
P->opc != Yap_opcode(_cut_e))) { P->opc != Yap_opcode(_cut_e))) {
execute_dealloc( PASS_REGS1 );
return 1; return 1;
} else { } else {
CELL cut_b = LCL0-(CELL *)(S[E_CB]); CELL cut_b = LCL0-(CELL *)(S[E_CB]);

2
C/atomic.c
View File

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

6
C/blobs.c
View File

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

419
C/c_interface.c
View File

@ -1,332 +1,20 @@
/************************************************************************* * /************************************************************************* *
* YAP Prolog * * YAP Prolog *
* Yap Prolog was developed at NCCUP - Universidade do Porto * * Yap Prolog was developed at NCCUP - Universidade do Porto *
* * * *
* Copyright L.Damas, V.Santos Costa and Universidade do Porto 1985-- * * Copyright L.Damas, V.Santos Costa and Universidade do Porto 1985-- *
* * * *
************************************************************************** **************************************************************************
* * * *
* File: c_interface.c * * File: c_interface.c *
* comments: c_interface primitives definition * * comments: c_interface primitives definition *
* * * *
* Last rev: $Date: 2008-08-07 20:51:21 $,$Author: vsc $ * Last rev: $Date: 2008-08-07 20:51:21 $,$Author: vsc $
** **
* $Log: not supported by cvs2svn $ * $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
* *
* *
*************************************************************************/
/** /**
@file c_interface.c @file c_interface.c
@ -370,11 +58,11 @@
#include <malloc.h> #include <malloc.h>
#endif #endif
typedef enum { typedef enum {
FRG_FIRST_CALL = 0, /* Initial call */ FRG_FIRST_CALL = 0, /* Initial call */
FRG_CUTTED = 1, /* Context was cutted */ FRG_CUTTED = 1, /* Context was cutted */
FRG_REDO = 2 /* Normal redo */ FRG_REDO = 2 /* Normal redo */
} frg_code; } frg_code;
struct foreign_context { struct foreign_context {
uintptr_t context; /* context value */ 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) #define strncat(X, Y, Z) strcat(X, Y)
#endif #endif
#if defined(_MSC_VER) && defined(YAP_EXPORTS) #if defined(_WIN32)
#define X_API __declspec(dllexport) #define X_API __declspec(dllexport)
#endif #endif
@ -1626,11 +1314,12 @@ X_API void YAP_FreeSpaceFromYap(void *ptr) { Yap_FreeCodeSpace(ptr); }
* @param bufsize bu * @param bufsize bu
* *
* @return * @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 CACHE_REGS
seq_tv_t inp, out; seq_tv_t inp, out;
inp.val.t = t; 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; inp.max = bufsize;
out.type = YAP_STRING_CHARS; out.type = YAP_STRING_CHARS;
out.val.c = buf; out.val.c = buf;
@ -1723,7 +1412,8 @@ X_API Term YAP_ReadBuffer(const char *s, Term *tp) {
BACKUP_H(); BACKUP_H();
LOCAL_ErrorMessage = NULL; 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 (LOCAL_ErrorMessage) {
if (!strcmp(LOCAL_ErrorMessage, "Stack Overflow")) { if (!strcmp(LOCAL_ErrorMessage, "Stack Overflow")) {
if (!Yap_dogc(0, NULL PASS_REGS)) { 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); bool consulted = (mode == YAP_CONSULT_MODE);
Yap_init_consult(consulted, filename); 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) if (!f)
return -1; return -1;
sno = Yap_OpenStream(f, NULL, TermNil, Input_Stream_f); 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]; utf8proc_uint8_t dst[8];
size_t sz = 0; size_t sz = 0;
if (IsPairTerm( t )) { if (IsPairTerm(t)) {
while (t != TermNil) { while (t != TermNil) {
int c; int c;
Term hd = HeadOfTerm( t ); Term hd = HeadOfTerm(t);
if (IsAtomTerm(hd)) { if (IsAtomTerm(hd)) {
Atom at = AtomOfTerm(hd); Atom at = AtomOfTerm(hd);
if (IsWideAtom(at)) if (IsWideAtom(at))
c = RepAtom(at)->WStrOfAE[0]; c = RepAtom(at)->WStrOfAE[0];
else else
c = RepAtom(at)->StrOfAE[0]; c = RepAtom(at)->StrOfAE[0];
} else if (IsIntegerTerm(hd)) { } else if (IsIntegerTerm(hd)) {
c = IntegerOfTerm( hd ); c = IntegerOfTerm(hd);
} else { } else {
c = '\0'; c = '\0';
} }
sz += utf8proc_encode_char(c, dst); sz += utf8proc_encode_char(c, dst);
t = TailOfTerm(t); t = TailOfTerm(t);
} }
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t); Atom at = AtomOfTerm(t);
if (IsWideAtom(at)) { if (IsWideAtom(at)) {
const wchar_t *s = RepAtom(at)->WStrOfAE; const wchar_t *s = RepAtom(at)->WStrOfAE;
int c; int c;
while ((c = *s++)) { while ((c = *s++)) {
sz += utf8proc_encode_char(c, dst); sz += utf8proc_encode_char(c, dst);
} }
} else { } else {
const unsigned char *s = (const unsigned char *)RepAtom(at)->StrOfAE; const unsigned char *s = (const unsigned char *)RepAtom(at)->StrOfAE;
int c; int c;
while ((c = *s++)) { while ((c = *s++)) {
sz += utf8proc_encode_char(c, dst); sz += utf8proc_encode_char(c, dst);
} }
} }
} else if (IsStringTerm(t)) { } else if (IsStringTerm(t)) {
sz = strlen(StringOfTerm( t )) ; sz = strlen(StringOfTerm(t));
} }
return sz; return sz;
} }

8
C/cdmgr.c
View File

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

92
C/clause_list.c
View File

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

7
C/cmppreds.c
View File

@ -15,11 +15,13 @@
* comments: comparing two prolog terms * * comments: comparing two prolog terms *
* * * *
*************************************************************************/ *************************************************************************/
/// @file cmppreds.c /// @file cmppreds.c
/** @defgroup Comparing_Terms Comparing Terms /**
@defgroup Comparing_Terms Comparing Terms
@ingroup builtins @ingroup builtins
The following predicates are used to compare and order terms, using the 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 variables come before numbers, numbers come before atoms which in turn
come before compound terms, i.e.: variables @< numbers @< atoms @< come before compound terms, i.e.: variables @< numbers @< atoms @<
compound terms. 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); first);
+ +
Floating point numbers are sorted in increasing order; Floating point numbers are sorted in increasing order;

54
C/errors.c
View File

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

2
C/fail_absmi_insts.h
View File

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

10
C/flags.c
View File

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

8
C/init.c
View File

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

4
C/load_dll.c
View File

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

18
C/mavar.c
View File

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

124
C/modules.c
View File

@ -14,7 +14,7 @@
* comments: module support * * comments: module support *
* * * *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCSLookupSystemModule
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
#endif #endif
@ -26,9 +26,69 @@ static Int current_module(USES_REGS1);
static Int current_module1(USES_REGS1); static Int current_module1(USES_REGS1);
static ModEntry *LookupModule(Term a); static ModEntry *LookupModule(Term a);
static ModEntry *LookupSystemModule(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) static ModEntry *FetchModuleEntry(Atom at)
/* get predicate entry for ap/arity; create it if neccessary. */
{ {
Prop p0; Prop p0;
AtomEntry *ae = RepAtom(at); AtomEntry *ae = RepAtom(at);
@ -47,40 +107,6 @@ static ModEntry *LookupSystemModule(Term a);
return NULL; 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) { Term Yap_getUnknownModule(ModEntry *m) {
if (m && m->flags & UNKNOWN_ERROR) { if (m && m->flags & UNKNOWN_ERROR) {
return TermError; return TermError;
@ -109,21 +135,20 @@ bool Yap_getUnknown ( Term mod) {
Term Yap_Module_Name(PredEntry *ap) { Term Yap_Module_Name(PredEntry *ap) {
CACHE_REGS CACHE_REGS
Term mod; Term mod;
if (!ap)
return TermUser;
if (!ap->ModuleOfPred) 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 module for the metacall, which I will suppose has to be
reachable from the current module anyway. reachable from the current module anyway.
So I will return the current module in case the system So I will return the current module in case the system
predicate is a meta-call. Otherwise it will still work. predicate is a meta-call. Otherwise it will still work.
*/ */
mod = CurrentModule; return TermProlog;
else { else {
mod = ap->ModuleOfPred; return ap->ModuleOfPred;
} }
if (mod)
return mod;
return TermProlog;
} }
@ -135,13 +160,16 @@ static ModEntry *LookupSystemModule(Term a) {
/* prolog module */ /* prolog module */
if (a == 0) { if (a == 0) {
return GetModuleEntry(AtomProlog); a = TermProlog;
} }
at = AtomOfTerm(a); at = AtomOfTerm(a);
me = GetModuleEntry(at); me = GetModuleEntry(at);
if (!me)
return NULL;
me->flags |= M_SYSTEM; me->flags |= M_SYSTEM;
me->OwnerFile = Yap_ConsultingFile( PASS_REGS1 ); me->OwnerFile = Yap_ConsultingFile( PASS_REGS1 );
return me;} return me;
}
static ModEntry *LookupModule(Term a) { static ModEntry *LookupModule(Term a) {
@ -201,7 +229,7 @@ void Yap_NewModulePred(Term mod, struct pred_entry *ap) {
} }
static Int static Int
current_module(USES_REGS1) { /* $current_module(Old,New) */ current_module(USES_REGS1) { /* $current_module(Old,N) */
Term t; Term t;
if (CurrentModule) { if (CurrentModule) {
@ -225,7 +253,7 @@ static Int
return TRUE; return TRUE;
} }
static Int change_module(USES_REGS1) { /* $change_module(New) */ static Int change_module(USES_REGS1) { /* $change_module(N) */
Term mod = Deref(ARG1); Term mod = Deref(ARG1);
LookupModule(mod); LookupModule(mod);
CurrentModule = mod; CurrentModule = mod;
@ -347,8 +375,8 @@ static Int new_system_module( USES_REGS1 )
Yap_Error(TYPE_ERROR_ATOM, t, NULL); Yap_Error(TYPE_ERROR_ATOM, t, NULL);
return false; return false;
} }
me = LookupSystemModule( t ); if ((me = LookupSystemModule( t ) ))
me->OwnerFile = Yap_ConsultingFile( PASS_REGS1); me->OwnerFile = Yap_ConsultingFile( PASS_REGS1);
return me != NULL; return me != NULL;
} }

2
C/or_absmi_insts.h
View File

@ -32,7 +32,7 @@
Op(either, Osblp); Op(either, Osblp);
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) { 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 #endif
#ifdef COROUTINING #ifdef COROUTINING

7
C/save.c
View File

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

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

2
C/stack.c
View File

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

289
C/stdpreds.c
View File

@ -13,255 +13,7 @@
* comments: General-purpose C implemented system predicates * * comments: General-purpose C implemented system predicates *
* * * *
* Last rev: $Date: 2008-07-24 16:02:00 $,$Author: vsc $ * 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 #ifdef SCCS
@ -1008,12 +760,14 @@ static PredEntry *firstModulesPred(PredEntry *npp, ModEntry *m, Term task) {
static Int cont_current_predicate(USES_REGS1) { static Int cont_current_predicate(USES_REGS1) {
UInt Arity; UInt Arity;
Term name, task; Term name, task;
Term t1 = ARG1, t2 = ARG2, t3 = ARG3; Term t1 = ARG1, t2 = Deref(ARG2), t3 = ARG3;
bool rc, will_cut = false; bool rc, will_cut = false;
Functor f; Functor f;
PredEntry *pp; PredEntry *pp;
t1 = Yap_YapStripModule(t1, &t2); t1 = Yap_YapStripModule(t1, &t2);
t3 = Yap_YapStripModule(t3, &t2); t3 = Yap_YapStripModule(t3, &t2);
t1 = Deref(t1);
t2 = Deref(t2);
task = Deref(ARG4); task = Deref(ARG4);
pp = AddressOfTerm(EXTRA_CBACK_ARG(4, 1)); pp = AddressOfTerm(EXTRA_CBACK_ARG(4, 1));
@ -1102,17 +856,34 @@ static Int cont_current_predicate(USES_REGS1) {
if (!pp) { if (!pp) {
if (!IsAtomTerm(t2)) { 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); ModEntry *m = Yap_GetModuleEntry(t2);
pp = firstModulePred(m->PredForME, task); pp = firstModulePred(m->PredForME, task);
if (!pp) if (!pp) {
cut_fail(); /* try Prolog Module */
if (task != TermUser) {
ModEntry *m = Yap_GetModuleEntry(TermProlog);
pp = firstModulePred(m->PredForME, task);
if (!pp) {
cut_fail();
}
}
}
} }
npp = firstModulePred(pp, task); npp = firstModulePred(pp, task);
if (!npp) if (!npp) {
will_cut = true; 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 // just try next one
else { else {
EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(npp); EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(npp);
@ -1164,11 +935,13 @@ static Int cont_current_predicate(USES_REGS1) {
} }
} }
if (Arity) { if (Arity) {
rc = Yap_unify(t3, Yap_MkNewApplTerm(f, Arity)); rc = Yap_unify(ARG3, Yap_MkNewApplTerm(f, Arity));
} else { } 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 (will_cut) {
if (rc) if (rc)
cut_succeed(); cut_succeed();

21
C/tracer.c
View File

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

850
C/yap-args.c
View File

@ -19,6 +19,7 @@
#include "config.h" #include "config.h"
#include "Yap.h" #include "Yap.h"
#include "YapHeap.h" #include "YapHeap.h"
#include "YapInterface.h"
#if HAVE_UNISTD_H #if HAVE_UNISTD_H
#include <unistd.h> #include <unistd.h>
#endif #endif
@ -28,8 +29,8 @@
#include <stdlib.h> #include <stdlib.h>
#include <stddef.h> #include <stddef.h>
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */ #ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
#ifdef HAVE_UNISTD_H #ifdef HAVE_UNISTD_H
#undef HAVE_UNISTD_H #undef HAVE_UNISTD_H
#endif #endif
#endif #endif
@ -44,78 +45,77 @@
#include <direct.h> #include <direct.h>
#endif #endif
void YAP_SetOutputMessage(void);
int YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap);
#if (DefTrailSpace < MinTrailSpace) #if (DefTrailSpace < MinTrailSpace)
#undef DefTrailSpace #undef DefTrailSpace
#define DefTrailSpace MinTrailSpace #define DefTrailSpace MinTrailSpace
#endif #endif
#if (DefStackSpace < MinStackSpace) #if (DefStackSpace < MinStackSpace)
#undef DefStackSpace #undef DefStackSpace
#define DefStackSpace MinStackSpace #define DefStackSpace MinStackSpace
#endif #endif
#if (DefHeapSpace < MinHeapSpace) #if (DefHeapSpace < MinHeapSpace)
#undef DefHeapSpace #undef DefHeapSpace
#define DefHeapSpace MinHeapSpace #define DefHeapSpace MinHeapSpace
#endif #endif
#define DEFAULT_NUMBERWORKERS 1 #define DEFAULT_NUMBERWORKERS 1
#define DEFAULT_SCHEDULERLOOP 10 #define DEFAULT_SCHEDULERLOOP 10
#define DEFAULT_DELAYEDRELEASELOAD 3 #define DEFAULT_DELAYEDRELEASELOAD 3
static void static void print_usage(void) {
print_usage(void) fprintf(stderr, "\n[ Valid switches for command line arguments: ]\n");
{ fprintf(stderr, " -? Shows this screen\n");
fprintf(stderr,"\n[ Valid switches for command line arguments: ]\n"); fprintf(stderr, " -b Boot file \n");
fprintf(stderr," -? Shows this screen\n"); fprintf(stderr, " -dump-runtime-variables\n");
fprintf(stderr," -b Boot file \n"); fprintf(stderr, " -f initialization file or \"none\"\n");
fprintf(stderr," -dump-runtime-variables\n"); fprintf(stderr, " -g Run Goal Before Top-Level \n");
fprintf(stderr," -f initialization file or \"none\"\n"); fprintf(stderr, " -z Run Goal Before Top-Level \n");
fprintf(stderr," -g Run Goal Before Top-Level \n"); fprintf(stderr, " -q start with informational messages off\n");
fprintf(stderr," -z Run Goal Before Top-Level \n"); fprintf(stderr, " -l load Prolog file\n");
fprintf(stderr," -q start with informational messages off\n"); fprintf(stderr, " -L run Prolog file and exit\n");
fprintf(stderr," -l load Prolog file\n"); fprintf(stderr, " -p extra path for file-search-path\n");
fprintf(stderr," -L run Prolog file and exit\n"); fprintf(stderr, " -hSize Heap area in Kbytes (default: %d, minimum: %d)\n",
fprintf(stderr," -p extra path for file-search-path\n"); DefHeapSpace, MinHeapSpace);
fprintf(stderr," -hSize Heap area in Kbytes (default: %d, minimum: %d)\n", fprintf(stderr,
DefHeapSpace, MinHeapSpace); " -sSize Stack area in Kbytes (default: %d, minimum: %d)\n",
fprintf(stderr," -sSize Stack area in Kbytes (default: %d, minimum: %d)\n", DefStackSpace, MinStackSpace);
DefStackSpace, MinStackSpace); fprintf(stderr,
fprintf(stderr," -tSize Trail area in Kbytes (default: %d, minimum: %d)\n", " -tSize Trail area in Kbytes (default: %d, minimum: %d)\n",
DefTrailSpace, MinTrailSpace); DefTrailSpace, MinTrailSpace);
fprintf(stderr," -GSize Max Area for Global Stack\n"); fprintf(stderr, " -GSize Max Area for Global Stack\n");
fprintf(stderr," -LSize Max Area for Local Stack (number must follow L)\n"); fprintf(stderr,
fprintf(stderr," -TSize Max Area for Trail (number must follow L)\n"); " -LSize Max Area for Local Stack (number must follow L)\n");
fprintf(stderr," -nosignals disable signal handling from Prolog\n"); fprintf(stderr, " -TSize Max Area for Trail (number must follow L)\n");
fprintf(stderr,"\n[Execution Modes]\n"); fprintf(stderr, " -nosignals disable signal handling from Prolog\n");
fprintf(stderr," -J0 Interpreted mode (default)\n"); fprintf(stderr, "\n[Execution Modes]\n");
fprintf(stderr," -J1 Mixed mode only for user predicates\n"); fprintf(stderr, " -J0 Interpreted mode (default)\n");
fprintf(stderr," -J2 Mixed mode for all predicates\n"); fprintf(stderr, " -J1 Mixed mode only for user predicates\n");
fprintf(stderr," -J3 Compile all user predicates\n"); fprintf(stderr, " -J2 Mixed mode for all predicates\n");
fprintf(stderr," -J4 Compile all predicates\n"); fprintf(stderr, " -J3 Compile all user predicates\n");
fprintf(stderr, " -J4 Compile all predicates\n");
#ifdef TABLING #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 */ #endif /* TABLING */
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS) #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \
fprintf(stderr," -w Number of workers (default: %d)\n", defined(YAPOR_THREADS)
DEFAULT_NUMBERWORKERS); fprintf(stderr, " -w Number of workers (default: %d)\n",
fprintf(stderr," -sl Loop scheduler executions before look for hiden shared work (default: %d)\n", DEFAULT_NUMBERWORKERS);
fprintf(stderr, " -sl Loop scheduler executions before look for hiden "
"shared work (default: %d)\n",
DEFAULT_SCHEDULERLOOP); DEFAULT_SCHEDULERLOOP);
fprintf(stderr," -d Value of delayed release of load (default: %d)\n", fprintf(stderr, " -d Value of delayed release of load (default: %d)\n",
DEFAULT_DELAYEDRELEASELOAD); DEFAULT_DELAYEDRELEASELOAD);
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
/* nf: Preprocessor */ /* nf: Preprocessor */
/* fprintf(stderr," -DVar=Name Persistent definition\n"); */ /* fprintf(stderr," -DVar=Name Persistent definition\n"); */
fprintf(stderr,"\n"); fprintf(stderr, "\n");
} }
static int static int myisblank(int c) {
myisblank(int c)
{
switch (c) { switch (c) {
case ' ': case ' ':
case '\t': case '\t':
@ -127,47 +127,34 @@ myisblank(int c)
} }
} }
static char * static char *add_end_dot(char arg[]) {
add_end_dot(char arg[])
{
int sz = strlen(arg), i; int sz = strlen(arg), i;
i = sz; i = sz;
while (i && myisblank(arg[--i])); while (i && myisblank(arg[--i]))
;
if (i && arg[i] != ',') { if (i && arg[i] != ',') {
char *p = (char *)malloc(sz+2); char *p = (char *)malloc(sz + 2);
if (!p) if (!p)
return NULL; return NULL;
strncpy(p,arg,sz); strncpy(p, arg, sz);
p[sz] = '.'; p[sz] = '.';
p[sz+1] = '\0'; p[sz + 1] = '\0';
return p; return p;
} }
return arg; return arg;
} }
static int static int dump_runtime_variables(void) {
dump_runtime_variables(void) fprintf(stdout, "CC=\"%s\"\n", C_CC);
{ fprintf(stdout, "YAP_ROOTDIR=\"%s\"\n", YAP_ROOTDIR);
fprintf(stdout,"CC=\"%s\"\n",C_CC); fprintf(stdout, "YAP_LIBS=\"%s\"\n", C_LIBS);
fprintf(stdout,"YAP_ROOTDIR=\"%s\"\n",YAP_ROOTDIR); fprintf(stdout, "YAP_SHLIB_SUFFIX=\"%s\"\n", SO_EXT);
fprintf(stdout,"YAP_LIBS=\"%s\"\n",C_LIBS); fprintf(stdout, "YAP_VERSION=%s\n", YAP_NUMERIC_VERSION);
fprintf(stdout,"YAP_SHLIB_SUFFIX=\"%s\"\n",SO_EXT);
fprintf(stdout,"YAP_VERSION=%s\n",YAP_NUMERIC_VERSION);
exit(0); exit(0);
return 1; return 1;
} }
/* X_API int YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) {
* 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)
{
char *p; char *p;
int BootMode = YAP_BOOT_FROM_SAVED_CODE; int BootMode = YAP_BOOT_FROM_SAVED_CODE;
unsigned long int *ssize; unsigned long int *ssize;
@ -204,359 +191,372 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
iap->ErrorCause = NULL; iap->ErrorCause = NULL;
iap->QuietMode = FALSE; iap->QuietMode = FALSE;
while (--argc > 0) while (--argc > 0) {
{ p = *++argv;
p = *++argv; if (*p == '-')
if (*p == '-') switch (*++p) {
switch (*++p) case 'b':
{ BootMode = YAP_BOOT_FROM_PROLOG;
case 'b': iap->YapPrologBootFile = *++argv;
BootMode = YAP_BOOT_FROM_PROLOG; argc--;
iap->YapPrologBootFile = *++argv; break;
argc--; case '?':
break; print_usage();
case '?': exit(EXIT_SUCCESS);
print_usage(); case 'q':
exit(EXIT_SUCCESS); iap->QuietMode = TRUE;
case 'q': break;
iap->QuietMode = TRUE; #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \
break; defined(YAPOR_THREADS)
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS) case 'w':
case 'w': ssize = &(iap->NumberWorkers);
ssize = &(iap->NumberWorkers); goto GetSize;
goto GetSize; case 'd':
case 'd': if (!strcmp("dump-runtime-variables", p))
if (!strcmp("dump-runtime-variables",p)) return dump_runtime_variables();
return dump_runtime_variables(); ssize = &(iap->DelayedReleaseLoad);
ssize = &(iap->DelayedReleaseLoad); goto GetSize;
goto GetSize;
#else #else
case 'd': case 'd':
if (!strcmp("dump-runtime-variables",p)) if (!strcmp("dump-runtime-variables", p))
return dump_runtime_variables(); return dump_runtime_variables();
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
case 'F': case 'F':
/* just ignore for now */ /* just ignore for now */
argc--; argc--;
argv++; argv++;
break; break;
case 'f': case 'f':
iap->FastBoot = TRUE; iap->FastBoot = TRUE;
if (argc > 1 && argv[1][0] != '-') { if (argc > 1 && argv[1][0] != '-') {
argc--; argc--;
argv++; argv++;
if (strcmp(*argv,"none")) { if (strcmp(*argv, "none")) {
iap->YapPrologRCFile = *argv; iap->YapPrologRCFile = *argv;
} }
break; break;
} }
break; break;
// execution mode // execution mode
case 'J': case 'J':
switch (p[1]) { switch (p[1]) {
case '0': case '0':
iap->ExecutionMode = YAPC_INTERPRETED; iap->ExecutionMode = YAPC_INTERPRETED;
break; break;
case '1': case '1':
iap->ExecutionMode = YAPC_MIXED_MODE_USER; iap->ExecutionMode = YAPC_MIXED_MODE_USER;
break; break;
case '2': case '2':
iap->ExecutionMode = YAPC_MIXED_MODE_ALL; iap->ExecutionMode = YAPC_MIXED_MODE_ALL;
break; break;
case '3': case '3':
iap->ExecutionMode = YAPC_COMPILE_USER; iap->ExecutionMode = YAPC_COMPILE_USER;
break; break;
case '4': case '4':
iap->ExecutionMode = YAPC_COMPILE_ALL; iap->ExecutionMode = YAPC_COMPILE_ALL;
break; break;
default: default:
fprintf(stderr,"[ YAP unrecoverable error: unknown switch -%c%c ]\n", *p, p[1]); fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c%c ]\n",
exit(EXIT_FAILURE); *p, p[1]);
} exit(EXIT_FAILURE);
p++; }
break; p++;
case 'G': break;
ssize = &(iap->MaxGlobalSize); case 'G':
goto GetSize; ssize = &(iap->MaxGlobalSize);
break; goto GetSize;
case 's': break;
case 'S': case 's':
ssize = &(iap->StackSize); case 'S':
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS) ssize = &(iap->StackSize);
if (p[1] == 'l') { #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \
p++; defined(YAPOR_THREADS)
ssize = &(iap->SchedulerLoop); if (p[1] == 'l') {
} p++;
ssize = &(iap->SchedulerLoop);
}
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
goto GetSize; goto GetSize;
case 'a': case 'a':
case 'A': case 'A':
ssize = &(iap->AttsSize); ssize = &(iap->AttsSize);
goto GetSize; goto GetSize;
case 'T': case 'T':
ssize = &(iap->MaxTrailSize); ssize = &(iap->MaxTrailSize);
goto get_trail_size; goto get_trail_size;
case 't': case 't':
ssize = &(iap->TrailSize); ssize = &(iap->TrailSize);
#ifdef TABLING #ifdef TABLING
if (p[1] == 's') { if (p[1] == 's') {
p++; p++;
ssize = &(iap->MaxTableSpaceSize); ssize = &(iap->MaxTableSpaceSize);
} }
#endif /* TABLING */ #endif /* TABLING */
get_trail_size: get_trail_size:
if (*++p == '\0') if (*++p == '\0') {
{ if (argc > 1)
if (argc > 1) --argc, p = *++argv;
--argc, p = *++argv; else {
else fprintf(stderr,
{ "[ YAP unrecoverable error: missing size in flag %s ]",
fprintf(stderr,"[ YAP unrecoverable error: missing size in flag %s ]", argv[0]); argv[0]);
print_usage(); print_usage();
exit(EXIT_FAILURE); exit(EXIT_FAILURE);
} }
} }
{ {
unsigned long int i = 0, ch; unsigned long int i = 0, ch;
while ((ch = *p++) >= '0' && ch <= '9') while ((ch = *p++) >= '0' && ch <= '9')
i = i * 10 + ch - '0'; i = i * 10 + ch - '0';
switch(ch) { switch (ch) {
case 'M': case 'M':
case 'm': case 'm':
i *= 1024; i *= 1024;
ch = *p++; 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;
}
break; break;
case 'p': case 'g':
if ((*argv)[0] == '\0') i *= 1024 * 1024;
iap->YapPrologAddPath = *argv; ch = *p++;
else { break;
argc--; case 'k':
if (argc == 0) { case 'K':
fprintf(stderr," [ YAP unrecoverable error: missing paths for option 'p' ]\n"); ch = *p++;
exit(EXIT_FAILURE); break;
} }
argv++; if (ch) {
iap->YapPrologAddPath = *argv; iap->YapPrologTopLevelGoal = add_end_dot(*argv);
} } else {
break; *ssize = i;
/* nf: Begin preprocessor code */ }
case 'D': }
{ break;
char *var, *value; case 'h':
++p; case 'H':
var = p; ssize = &(iap->HeapSize);
if (var == NULL || *var=='\0') GetSize:
break; if (*++p == '\0') {
while(*p!='=' && *p!='\0') ++p; if (argc > 1)
if ( *p=='\0' ) break; --argc, p = *++argv;
*p='\0'; else {
++p; fprintf(stderr,
value=p; "[ YAP unrecoverable error: missing size in flag %s ]",
if ( *value == '\0' ) break; argv[0]);
if (iap->def_c == YAP_MAX_YPP_DEFS) print_usage();
break; exit(EXIT_FAILURE);
iap->def_var[iap->def_c]=var; }
iap->def_value[iap->def_c]=value; }
++(iap->def_c); {
break; unsigned long int i = 0, ch;
} while ((ch = *p++) >= '0' && ch <= '9')
/* End preprocessor code */ i = i * 10 + ch - '0';
default: switch (ch) {
{ case 'M':
fprintf(stderr,"[ YAP unrecoverable error: unknown switch -%c ]\n", *p); case 'm':
print_usage(); i *= 1024;
exit(EXIT_FAILURE); ch = *p++;
} break;
} case 'g':
else { case 'G':
iap->SavedState = p; 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; return BootMode;
} }

21
CMakeLists.txt
View File

@ -115,6 +115,7 @@ add_library(libYap
${STATIC_SOURCES} ${STATIC_SOURCES}
${OPTYAP_SOURCES} ${OPTYAP_SOURCES}
${HEADERS} ${HEADERS}
${WINDLLS}
$<TARGET_OBJECTS:libYAPOs> $<TARGET_OBJECTS:libYAPOs>
$<TARGET_OBJECTS:libOPTYap> $<TARGET_OBJECTS:libOPTYap>
$<TARGET_OBJECTS:myddas> $<TARGET_OBJECTS:myddas>
@ -169,7 +170,7 @@ set(YAP_STARTUP startup.yss)
string(TIMESTAMP YAP_TIMESTAMP) string(TIMESTAMP YAP_TIMESTAMP)
string( SUBSTRING ${CMAKE_SHARED_LIBRARY_SUFFIX} 1 -1 SO_EXT ) 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}) include_directories (BEFORE ${CMAKE_BINARY_DIR})
# rpath stuff, hopefully it works # rpath stuff, hopefully it works
@ -416,10 +417,21 @@ add_subDIRECTORY (packages/raptor)
add_subDIRECTORY (packages/xml) 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) # add_subDIRECTORY (packages/cuda)
#todo: use cmake target builds #todo: use cmake target builds
# option (USE_MAXPERFORMANCE # option (USE_MAXPERFORMANCE
# "try using the best flags for specific architecture" OFF) # "try using the best flags for specific architecture" OFF)
@ -493,6 +505,11 @@ target_link_libraries(libYap
${CMAKE_DL_LIBS} ${CMAKE_DL_LIBS}
) )
if(WIN32)
target_link_libraries(libYap wsock32 ws2_32 Shlwapi
)
endif()
add_executable (yap-bin ${CONSOLE_SOURCES}) add_executable (yap-bin ${CONSOLE_SOURCES})
set_target_properties (yap-bin PROPERTIES OUTPUT_NAME yap) set_target_properties (yap-bin PROPERTIES OUTPUT_NAME yap)

4
CXX/CMakeLists.txt
View File

@ -14,7 +14,9 @@ include_directories (H include ${CMAKE_BINARY_DIR} ${GMP_INCLUDE_DIR})
target_link_libraries(Yap++ libYap) target_link_libraries(Yap++ libYap)
install(TARGETS Yap++ 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_INCLUDES ${CMAKE_REQUIRED_INCLUDES} ${GMP_INCLUDE_DIR} )
#set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${GMP_LIBRARIES} ) #set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${GMP_LIBRARIES} )

2
CXX/yapi.hh
View File

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

2
GitSHA1.c
View File

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

2
H/Foreign.h
View File

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

3
H/Yap.h
View File

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

19
H/YapFlags.h
View File

@ -88,9 +88,9 @@ static inline bool isfloat(Term inp) {
return false; 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)) { if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag: value must be %s", Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag: value must be %s",
"bound"); "bound");
@ -114,9 +114,9 @@ INLINE_ONLY inline EXTERN bool aro(Term inp) {
return false; 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) if (inp == TermTrue || inp == TermFalse || inp == TermOn || inp == TermOff)
return true; return true;
if (IsVarTerm(inp)) { if (IsVarTerm(inp)) {
@ -151,6 +151,17 @@ static bool synerr(Term inp) {
static inline bool filler(Term inp) { return true; } 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) { static bool bqs(Term inp) {
if (inp == TermCodes || inp == TermString || inp == TermSymbolChar) if (inp == TermCodes || inp == TermString || inp == TermSymbolChar)
return true; return true;

84
H/YapGFlagInfo.h
View File

@ -42,12 +42,12 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
(zero) disables atom garbage collection. (zero) disables atom garbage collection.
*/ */
YAP_FLAG(ALLOW_ASSERT_FOR_STATIC_PREDICATES, 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 NULL), /**< `allow asserting and retracting clauses of static
predicates. */ predicates. */
/* YAP_FLAG( ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG, /* 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_variable_name_as_functor` */
/* allow /* allow
@ -76,15 +76,15 @@ It is `true` by default, but it is disabled by packages like CLP(BN) and
ProbLog. ProbLog.
*/ */
#if __APPLE__ #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. running on an Apple machine.
*/ */
#endif #endif
YAP_FLAG(ARCH_FLAG, "arch", false, isatom, YAP_ARCH, NULL), YAP_FLAG(ARCH_FLAG, "arch", false, isatom, YAP_ARCH, NULL),
YAP_FLAG(ARGV_FLAG, "argv", false, argv, "?-", 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), "true", NULL),
YAP_FLAG(BACKQUOTED_STRING_FLAG, "backquoted_string", true, isatom, YAP_FLAG(BACKQUOTED_STRING_FLAG, "backquoted_string", true, isatom,
"string", ), /**> "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` 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 NULL), /**< `bounded` is iso
Read-only flag telling whether integers are bounded. The value depends 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_LDFLAGS_FLAG, "c_ldflags", false, isatom, C_LDFLAGS, NULL),
YAP_FLAG(C_LIBPLSO_FLAG, "c_libplso", false, isatom, C_LIBPLSO, 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(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` NULL), /**< `char_conversion is iso`
Writable flag telling whether a character conversion table is used when Writable flag telling whether a character conversion table is used when
reading terms. The default value for this flag is `off` except in reading terms. The default value for this flag is `off` except in
`sicstus` and `iso` language modes, where it is `on`. `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 ` NULL), /**< `character_escapes is iso `
Writable flag telling whether a character escapes are enables, Writable flag telling whether a character escapes are enables,
`true`, or disabled, `false`. The default value for this flag is `true`, or disabled, `false`. The default value for this flag is
`true`. */ `true`. */
YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context", 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, YAP_FLAG(COMPILED_AT_FLAG, "compiled_at", false, isatom, YAP_COMPILED_AT,
NULL), /**< `compiled_at ` NULL), /**< `compiled_at `
Read-only flag that gives the time when the main YAP binary was compiled. It is 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. 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 ` NULL), /**< `debug is iso `
If _Value_ is unbound, tell whether debugging is `true` or If _Value_ is unbound, tell whether debugging is `true` or
`false`. If _Value_ is bound to `true` enable debugging, and if `false`. If _Value_ is bound to `true` enable debugging, and if
it is bound to `false` disable debugging. it is bound to `false` disable debugging.
*/ */
YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, boolean, "true", NULL), YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, booleanFlag, "true", NULL),
YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, boolean, "true", YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, booleanFlag, "true",
NULL), NULL),
YAP_FLAG(DEBUGGER_PRINT_OPTIONS_FLAG, "debugger_print_options", true, YAP_FLAG(DEBUGGER_PRINT_OPTIONS_FLAG, "debugger_print_options", true,
list_option, 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 If bound, set the argument to the `write_term/3` options the
debugger uses to write terms. If unbound, show the current options. 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), "false", NULL),
YAP_FLAG(DIALECT_FLAG, "dialect", false, ro, "yap", YAP_FLAG(DIALECT_FLAG, "dialect", false, ro, "yap",
NULL), /**< `dialect ` NULL), /**< `dialect `
@ -152,13 +152,13 @@ debugger uses to write terms. If unbound, show the current options.
Read-only flag that always returns `yap`. Read-only flag that always returns `yap`.
*/ */
YAP_FLAG(DISCONTIGUOUS_WARNINGS_FLAG, "discontiguous_warnings", true, 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 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 are separated by clauses for other predicates. This may indicate that different
procedures have the sam*e name. 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 ` "false", NULL), /**< `dollar_as_lower_case `
If `off` (default) consider the character `$` a control character, if 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 Read-only flag. It unifies with an atom that gives the
original program path. 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 If `on` allow fast machine code, if `off` (default) disable it. Only
available in experimental implemexbntations. 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), "true", NULL),
YAP_FLAG(FLOAT_FORMAT_FLAG, "float_format", true, isatom, "%15e", YAP_FLAG(FLOAT_FORMAT_FLAG, "float_format", true, isatom, "%15e",
NULL), /**< + `float_format ` NULL), /**< + `float_format `
@ -195,7 +195,7 @@ available in experimental implemexbntations.
printed, `%g` will print all floats using 6 digits instead of the printed, `%g` will print all floats using 6 digits instead of the
default 15. 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. 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 information on data-structures found during the garbage collection
process, namely, on choice-points. 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 ` "true", NULL), /**< `generate_debug_info `
If `true` (default) generate debugging information for 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(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), "false", NULL),
YAP_FLAG(HOME_FLAG, "home", false, isatom, YAP_ROOTDIR, NULL), /**< home ` 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 Read-only flag telling the rounding function used for integers. Takes the value
`toward_zero` for the current version of YAP. `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", YAP_FLAG(LANGUAGE_FLAG, "language", true, isatom, "yap",
NULL), /**< `language ` NULL), /**< `language `
@ -289,26 +289,26 @@ Read-only flag telling the maximum arity of a functor. Takes the value
"INT_MIN", NULL), "INT_MIN", NULL),
YAP_FLAG(N_OF_INTEGER_KEYS_IN_DB_FLAG, "n_of_integer_keys_in_db", false, ro, YAP_FLAG(N_OF_INTEGER_KEYS_IN_DB_FLAG, "n_of_integer_keys_in_db", false, ro,
"256", NULL), "256", NULL),
YAP_FLAG(OCCURS_CHECK_FLAG, "occurs_check", true, boolean, "false", NULL), YAP_FLAG(OCCURS_CHECK_FLAG, "occurs_check", true, booleanFlag, "false", NULL),
YAP_FLAG(OPEN_EXPANDS_FILENAME_FLAG, "open_expands_filename", true, boolean, YAP_FLAG(OPEN_EXPANDS_FILENAME_FLAG, "open_expands_filename", true, booleanFlag,
"true", NULL), /**< `open_expands_filename ` "true", NULL), /**< `open_expands_filename `
If `true` the open/3 builtin performs filename-expansion If `true` the open/3 builtin performs filename-expansion
before opening a file (SICStus Prolog like). If `false` it does not before opening a file (SICStus Prolog like). If `false` it does not
(SWI-Prolog like). (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 ` "true", NULL), /**< `open_shared_object `
If true, `open_shared_object/2` and friends are implemented, If true, `open_shared_object/2` and friends are implemented,
providing access to shared libraries (`.so` files) or to dynamic link providing access to shared libraries (`.so` files) or to dynamic link
libraries (`.DLL` files). 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(OS_ARGV_FLAG, "os_argv", false, os_argv, "?-", NULL),
YAP_FLAG(PID_FLAG, "pid", false, ro, "0", NULL), YAP_FLAG(PID_FLAG, "pid", false, ro, "0", NULL),
YAP_FLAG(PIPE_FLAG, "pipe", true, boolean, "true", NULL), YAP_FLAG(PIPE_FLAG, "pipe", true, booleanFlag, "true", NULL),
YAP_FLAG(PROFILING_FLAG, "profiling", true, boolean, "false", YAP_FLAG(PROFILING_FLAG, "profiling", true, booleanFlag, "false",
NULL), /**< `profiling ` NULL), /**< `profiling `
If `off` (default) do not compile call counting information for 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 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 <tt>determinism</tt> which implies the system prompts for alternatives if the
goal succeeded while leaving choicepoints. */ 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), NULL),
YAP_FLAG(READLINE_FLAG, "readline", true, boolean, "true", NULL), YAP_FLAG(READLINE_FLAG, "readline", true, booleanFlag, "false", Yap_InitReadline), /**< `readline(boolean, changeable)`
YAP_FLAG(REPORT_ERROR_FLAG, "report_error", true, boolean, "true", NULL),
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, YAP_FLAG(SHARED_OBJECT_EXTENSION_FLAG, "shared_object_extension", false,
isatom, SO_EXT, NULL), /**< `shared_object_extension ` 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. objects.
*/ */
YAP_FLAG(SIGNALS_FLAG, "signals", true, boolean, "true", YAP_FLAG(SIGNALS_FLAG, "signals", true, booleanFlag, "true",
NULL), /**< `signals` NULL), /**< `signals`
If `true` (default) YAP handles Signals such as `^C` If `true` (default) YAP handles Signals such as `^C`
(`SIGINT`). (`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 If `true` maintain the source for all clauses. Notice that this is trivially
supported for facts, and always supported for dynamic code. 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 ` NULL), /**< `strict_iso `
If _Value_ is unbound, tell whether strict ISO compatibility mode 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(THREADS_FLAG, "threads", false, ro, "MAX_THREADS", NULL),
YAP_FLAG(TIMEZONE_FLAG, "timezone", false, ro, "18000", 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), "true", NULL),
YAP_FLAG(TOPLEVEL_PRINT_OPTIONS_FLAG, "toplevel_print_options", true, YAP_FLAG(TOPLEVEL_PRINT_OPTIONS_FLAG, "toplevel_print_options", true,
list_option, "[quoted(true),numbervars(true),portrayed(true)]", list_option, "[quoted(true),numbervars(true),portrayed(true)]",
@ -412,10 +414,10 @@ backtracked into.
*/ */
YAP_FLAG(TOPLEVEL_PROMPT_FLAG, "toplevel_prompt", true, isatom, "?- ", YAP_FLAG(TOPLEVEL_PROMPT_FLAG, "toplevel_prompt", true, isatom, "?- ",
mkprompt), 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` 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 running on an Unix system. Defined if the C-compiler used to compile
this version of YAP either defines `__unix__` or `unix`. 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. `fast_fail` does not invoke any handler.
*/ */
YAP_FLAG(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG, 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), NULL),
YAP_FLAG(VERBOSE_FLAG, "verbose", true, isatom, "normal", YAP_FLAG(VERBOSE_FLAG, "verbose", true, isatom, "normal",
NULL), /**< `verbose ` 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 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), 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 ` "false", NULL), /**< `verbose_file_search `
If `true` allow printing of informational messages when 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__ #if __WINDOWS__
YAP_FLAG(WINDOWS_FLAG, "windows", false, ro, "true", NULL), /**< `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. running on an Windows machine.
*/ */
#endif #endif
YAP_FLAG(WRITE_STRINGS_FLAG, "write_strings", true, boolean, "false", YAP_FLAG(WRITE_STRINGS_FLAG, "write_strings", true, booleanFlag, "false",
NULL), /**< `write_strings ` NULL), /**< `write_strings `
Writable flag telling whether the system should write lists of Writable flag telling whether the system should write lists of

221
H/YapHandles.h
View File

@ -15,7 +15,16 @@
#ifndef YAP_HANDLES_H #ifndef YAP_HANDLES_H
#define YAP_HANDLES_H 1 #define YAP_HANDLES_H 1
#include "Regs.h" #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 @groupdef term_t_slots
@ -30,7 +39,7 @@ garbage-collection.
automatically released at the end automatically released at the end
of a function. Hence, slots should always be used as local variables. 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) ---- Offset of next pointer in chain (tagged as an handle_t)
---- Number of entries (tagged as handle_t), in the example TAG(INT,4) ---- Number of entries (tagged as handle_t), in the example TAG(INT,4)
Entry Entry
@ -39,7 +48,7 @@ Entry
Entry Entry
---- Number of entries (tagged as handle_t), in the example TAG(INT,4) ---- 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. emulator calls user C-code.
(see YAP_Execute* functions). They are also created: (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. /// @brief reboot the slot system.
/// Used when wwe start from scratch (Reset). /// 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) { static inline void Yap_RebootHandles__(int wid USES_REGS) {
// fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot); // fprintf(stderr, " StartHandles = %ld", LOCAL_CurHandle);
REMOTE_CurSlot(wid) = 1; REMOTE_CurHandle(wid) = 1;
} }
/// @brief declares a new set of slots. /// @brief declares a new set of slots.
/// Used to tell how many slots we had when we entered a segment of code. /// Used to tell how many slots we have so d=dara when we entered a segment of code.
//#define Yap_StartSlots() ( //#define Yap_StartHandles() (
// printf("[<<<%s,%s,%d-%ld\n",__FILE__,__FUNCTION__,__LINE__,LOCAL_CurSlot)?Yap_StartSlots__(PASS_REGS1): // printf("[<<<%s,%s,%d-%ld\n",__FILE__,__FUNCTION__,__LINE__,LOCAL_CurHandle)?Yap_StartHandles__(PASS_REGS1):
//-1) //-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_StartHandles__(USES_REGS1);
INLINE_ONLY inline EXTERN yhandle_t Yap_StartSlots__(USES_REGS1) { INLINE_ONLY inline EXTERN yhandle_t Yap_StartHandles__(USES_REGS1) {
// // fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot); // // fprintf(stderr, " StartHandles = %ld", LOCAL_CurHandle);
// fprintf(stderr,"SS %s:%d\n", __FILE__, __LINE__);; // fprintf(stderr,"SS %s:%d\n", __FILE__, __LINE__);;
if (LOCAL_CurSlot < 0) { if (LOCAL_CurHandle < 0) {
Yap_Error(SYSTEM_ERROR_INTERNAL, 0L, " StartSlots = %ld", LOCAL_CurSlot); 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 /// @brief reset the nmber of slots _slot_ to the number existing before the call that produce _slot_
//#define Yap_CloseSlots(slot) ( printf("- %s,%s,%d ///(eg, Yap_StartHandles(), YAP_NewHandles(), or YAP_PushHandle)
//%ld>>>]\n",__FILE__,__FUNCTION__,__LINE__, slot)?Yap_CloseSlots__(slot //#define Yap_CloseHandles(slot) ( printf("- %s,%s,%d
//%ld>>>]\n",__FILE__,__FUNCTION__,__LINE__, slot)?Yap_CloseHandles__(slot
// PASS_REGS):-1) // 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_CloseHandles__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN void Yap_CloseSlots__(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__);; // fprintf(stderr,"CS %s:%d\n", __FILE__, __LINE__);
LOCAL_CurSlot = slot; 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 /// @brief report the current position of the slots, assuming that they occupy
/// the top of the stack. /// the top of the stack.
INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentSlot__(USES_REGS1); INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentHandle__(USES_REGS1);
INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentSlot__(USES_REGS1) { INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentHandle__(USES_REGS1) {
return LOCAL_CurSlot; 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. /// @brief read from a slot.
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_GetFromSlot__(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__); // 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. /// @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_GetDerefedFromHandle__(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) {
// fprintf(stderr,"GDS %s:%d\n", __FILE__, __LINE__); // 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. /// @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_GetPtrFromHandle__(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) {
// fprintf(stderr,"GPS %s:%d\n", __FILE__, __LINE__); // 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_AddressFromHandle__(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) {
/// @brief get the memory address of a slot /// @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 /// @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_PutInHandle__(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) {
// fprintf(stderr,"PS %s:%d\n", __FILE__, __LINE__); // fprintf(stderr,"PS %s:%d\n", __FILE__, __LINE__);
LOCAL_SlotBase[slot] = t; LOCAL_HandleBase[slot] = t;
} }
#ifndef max #ifndef max
#define max(X, Y) (X > Y ? X : Y) #define max(X, Y) (X > Y ? X : Y)
#endif #endif
#define ensure_handles ensure_slots
INLINE_ONLY inline EXTERN void ensure_slots(int N USES_REGS) { INLINE_ONLY inline EXTERN void ensure_slots(int N USES_REGS) {
if (LOCAL_CurSlot + N >= LOCAL_NSlots) { if (LOCAL_CurHandle + N >= LOCAL_NHandles) {
size_t inc = max(16 * 1024, LOCAL_NSlots / 2); // measured in cells size_t inc = max(16 * 1024, LOCAL_NHandles / 2); // measured in cells
inc = max(inc, N + 16); // measured in cells inc = max(inc, N + 16); // measured in cells
LOCAL_SlotBase = LOCAL_HandleBase =
(CELL *)realloc(LOCAL_SlotBase, (inc + LOCAL_NSlots) * sizeof(CELL)); (CELL *)realloc(LOCAL_HandleBase, (inc + LOCAL_NHandles) * sizeof(CELL));
LOCAL_NSlots += inc; LOCAL_NHandles += inc;
if (!LOCAL_SlotBase) { if (!LOCAL_HandleBase) {
unsigned long int kneeds = ((inc + LOCAL_NSlots) * sizeof(CELL)) / 1024; unsigned long int kneeds = ((inc + LOCAL_NHandles) * sizeof(CELL)) / 1024;
Yap_Error( Yap_Error(
SYSTEM_ERROR_INTERNAL, 0 /* TermNil */, SYSTEM_ERROR_INTERNAL, 0 /* TermNil */,
"Out of memory for the term handles (term_t) aka slots, l needed", "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 /// @brief create a new slot with term t
// #define Yap_InitSlot(t) // #define Yap_InitHandle(t)
// (printf("+%d %ld %s,%s,%d>>>]\n", 1, LOCAL_CurSlot,__FILE__, __FUNCTION__, __LINE__) // (printf("+%d %ld %s,%s,%d>>>]\n", 1, LOCAL_CurHandle,__FILE__, __FUNCTION__, __LINE__)
// ? Yap_InitSlot__(t PASS_REGS) // ? Yap_InitHandle__(t PASS_REGS)
// : -1) // : -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_InitHandle__(Term t USES_REGS);
INLINE_ONLY inline EXTERN yhandle_t Yap_InitSlot__(Term t USES_REGS) { INLINE_ONLY inline EXTERN yhandle_t Yap_InitHandle__(Term t USES_REGS) {
yhandle_t old_slots = LOCAL_CurSlot; yhandle_t old_slots = LOCAL_CurHandle;
ensure_slots(1 PASS_REGS); ensure_slots(1 PASS_REGS);
LOCAL_SlotBase[old_slots] = t; LOCAL_HandleBase[old_slots] = t;
LOCAL_CurSlot++; LOCAL_CurHandle++;
return old_slots; 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_NewHandles(n) ( printf("+%d %ld %s,%s,%d>>>]\n",n,LOCAL_CurHandle,__FILE__,__FUNCTION__,__LINE__) ?Yap_NewHandles__(n PASS_REGS):-1)
#define Yap_NewSlots(n) Yap_NewSlots__(n PASS_REGS) #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_NewHandles__(int n USES_REGS);
INLINE_ONLY inline EXTERN yhandle_t Yap_NewSlots__(int n USES_REGS) { INLINE_ONLY inline EXTERN yhandle_t Yap_NewHandles__(int n USES_REGS) {
yhandle_t old_slots = LOCAL_CurSlot; yhandle_t old_slots = LOCAL_CurHandle;
int i; int i;
//fprintf(stderr, "NS %s:%d\n", __FILE__, __LINE__); //fprintf(stderr, "NS %s:%d\n", __FILE__, __LINE__);
ensure_slots(n PASS_REGS); ensure_slots(n PASS_REGS);
for (i = 0; i < n; i++) { 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; return old_slots;
} }
//#define Yap_InitSlots(n, ts) //#define Yap_InitHandles(n, ts)
// (printf("+%d %d %s,%s,%d>>>]\n", n, LOCAL_CurSlot, __FILE__, __FUNCTION__, __LINE__) // (printf("+%d %d %s,%s,%d>>>]\n", n, LOCAL_CurHandle, __FILE__, __FUNCTION__, __LINE__)
// ? Yap_InitSlots__(n, ts PASS_REGS) // ? Yap_InitHandles__(n, ts PASS_REGS)
// : -1) // : -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[] /// @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_InitHandles__(int n, Term *ts USES_REGS);
INLINE_ONLY inline EXTERN yhandle_t Yap_InitSlots__(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_CurSlot; yhandle_t old_slots = LOCAL_CurHandle;
int i; int i;
ensure_slots(n PASS_REGS); ensure_slots(n PASS_REGS);
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
LOCAL_SlotBase[old_slots + i] = ts[i]; LOCAL_HandleBase[old_slots + i] = ts[i];
LOCAL_CurSlot += n; LOCAL_CurHandle += n;
return old_slots; 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 /// @brief Succeeds if it is to recover the space allocated for $n$ contiguos
/// slots starting at topSlot. /// slots starting at topHandle.
static inline bool Yap_RecoverSlots__(int n, yhandle_t topSlot USES_REGS); static inline bool Yap_RecoverHandles__(int n, yhandle_t topHandle USES_REGS);
static inline bool Yap_RecoverSlots__(int n, yhandle_t topSlot USES_REGS) { static inline bool Yap_RecoverHandles__(int n, yhandle_t topHandle USES_REGS) {
if (topSlot + n < LOCAL_CurSlot) if (topHandle + n < LOCAL_CurHandle)
return false; return false;
#ifdef DEBUG #ifdef DEBUG
if (n > LOCAL_CurSlot) { if (n > LOCAL_CurHandle) {
Yap_Error(SYSTEM_ERROR_INTERNAL, 0, Yap_Error(SYSTEM_ERROR_INTERNAL, 0,
"Inconsistent slot state in Yap_RecoverSlots.", 0); "Inconsistent slot state in Yap_RecoverHandles.", 0);
return false; return false;
} }
#endif #endif
LOCAL_CurSlot -= n; LOCAL_CurHandle -= n;
//fprintf(stderr,"RS %ld %s:%d\n", LOCAL_CurSlot, __FILE__, __LINE__); //fprintf(stderr,"RS %ld %s:%d\n", LOCAL_CurHandle, __FILE__, __LINE__);
return true; 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 #endif

16
H/YapHeap.h
View File

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

10
H/YapLFlagInfo.h
View File

@ -20,10 +20,10 @@
@ingroup Flags @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( BREAK_LEVEL_FLAG, "break_level", true, nat, "0" , NULL ),
YAP_FLAG( ENCODING_FLAG, "encoding", true, isatom, "utf-8" , getenc ), 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) If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled. `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. 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 If _Value_ is unbound, tell whether warnings for procedures defined
in several different files are `on` or 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 and if it is bound to `off` disable them. The default for YAP is
`off`, unless we are in `sicstus` or `iso` mode. `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. 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 If `true` show a stack dump when YAP finds an error. The default is
`off`. `off`.

13
H/Yapproto.h
View File

@ -176,7 +176,8 @@ void Yap_RestartYap(int);
void Yap_exit(int); void Yap_exit(int);
bool Yap_Warning(const char *s, ...); bool Yap_Warning(const char *s, ...);
bool Yap_PrintWarning(Term t); 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 *, ...); int Yap_SWIHandleError(const char *, ...);
void Yap_InitErrorPreds(void); void Yap_InitErrorPreds(void);
@ -295,6 +296,7 @@ extern void Yap_DebugErrorPuts(const char *s);
extern void Yap_DebugWriteIndicator(struct pred_entry *ap); extern void Yap_DebugWriteIndicator(struct pred_entry *ap);
void Yap_PlWriteToStream(Term, int, int); void Yap_PlWriteToStream(Term, int, int);
/* depth_lim.c */ /* depth_lim.c */
bool Yap_InitReadline(Term t);
void Yap_InitItDeepenPreds(void); void Yap_InitItDeepenPreds(void);
struct AliasDescS *Yap_InitStandardAliases(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); void Yap_init_optyap_preds(void);
/* pl-file.c */ /* pl-file.c */
// struct PL_local_data *Yap_InitThreadIO(int wid); // struct PL_local_data *Yap_InitThreadIO(int wid);
void Yap_flush(void); void Yap_flush(void);
/* pl-yap.c */ /* pl-yap.c */
@ -495,3 +497,10 @@ Atom Yap_source_file_name(void);
void Yap_install_blobs(void); void Yap_install_blobs(void);
yamop *Yap_gcP(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

21
H/Yatom.h
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);
INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p) { return (Atom)(p); }
INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p) { return (Atom)(p); }
INLINE_ONLY inline EXTERN AtomEntry *RepAtom(Atom a); INLINE_ONLY inline EXTERN AtomEntry *RepAtom(Atom a);
@ -554,6 +568,7 @@ typedef uint64_t pred_flags_t;
#define StatePredFlags (InUsePredFlag|CountPredFlag|SpiedPredFlag|IndexedPredFlag ) #define StatePredFlags (InUsePredFlag|CountPredFlag|SpiedPredFlag|IndexedPredFlag )
#define is_system(pe) (pe->PredFlags & SystemPredFlags) #define is_system(pe) (pe->PredFlags & SystemPredFlags)
#define is_dynamic(pe) (pe->PredFlags & DynamicPredFlag) #define is_dynamic(pe) (pe->PredFlags & DynamicPredFlag)
#define is_foreign(pe) (pe->PredFlags & ForeignPredFlags)
#define is_static(pe) (pe->PredFlags & CompiledPredFlag) #define is_static(pe) (pe->PredFlags & CompiledPredFlag)
#define is_logupd(pe) (pe->PredFlags & LogUpdatePredFlag) #define is_logupd(pe) (pe->PredFlags & LogUpdatePredFlag)
#ifdef TABLING #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); 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. *representation.
* *
* @param at the atom * @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); 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. *bit representation.
* *
* @param t the atom term * @param t the atom term

14
H/eval.h
View File

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

0
H/heap/dglobals.h → H/generated/dglobals.h
View File

4
H/heap/dhstruct.h → H/generated/dhstruct.h
View File

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

4
H/heap/dlocals.h → H/generated/dlocals.h
View File

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

0
H/heap/h0globals.h → H/generated/h0globals.h
View File

4
H/heap/h0struct.h → H/generated/h0struct.h
View File

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

0
H/heap/hglobals.h → H/generated/hglobals.h
View File

2
H/heap/hlocals.h → H/generated/hlocals.h
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 // 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. // prompt should be output, or if we are in the middle of a line.
// //
encoding_t encoding_;
bool newline_; bool newline_;
Atom AtPrompt_; Atom AtPrompt_;
char Prompt_[MAX_PROMPT+1]; char Prompt_[MAX_PROMPT+1];
encoding_t encoding_;
bool quasi_quotations_; bool quasi_quotations_;
UInt default_priority_; UInt default_priority_;
bool eot_before_eof_; bool eot_before_eof_;

4
H/heap/hstruct.h → H/generated/hstruct.h
View File

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

0
H/iatoms.h → H/generated/iatoms.h
View File

0
H/heap/iglobals.h → H/generated/iglobals.h
View File

4
H/heap/ihstruct.h → H/generated/ihstruct.h
View File

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

2
H/heap/ilocals.h → H/generated/ilocals.h
View File

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

0
H/ratoms.h → H/generated/ratoms.h
View File

0
H/heap/rglobals.h → H/generated/rglobals.h
View File

4
H/heap/rhstruct.h → H/generated/rhstruct.h
View File

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

0
H/heap/rlocals.h → H/generated/rlocals.h
View File

0
H/tatoms.h → H/generated/tatoms.h
View File

6
H/rheap.h
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 */ /* restore the failcodes */
static void restore_codes(void) { static void restore_codes(void) {
CACHE_REGS CACHE_REGS
HeapTop = AddrAdjust(LOCAL_OldHeapTop); HeapTop = AddrAdjust(LOCAL_OldHeapTop);
#include "heap/rhstruct.h" #include "rhstruct.h"
RestoreWorker(worker_id PASS_REGS); 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;
}

28
cmake/Sources.cmake
View File

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

4
docs/CMakeLists.txt
View File

@ -28,10 +28,10 @@ yap.md
# add a target to generate API documentation with Doxygen # add a target to generate API documentation with Doxygen
find_package(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) if(NOT DOXYGEN_FOUND)
message(FATAL_ERROR "Doxygen is needed to build the documentation.") message(FATAL_ERROR "Doxygen is needed to build the documentation.")
endif() endif()

24
docs/Doxyfile
View File

@ -8,9 +8,9 @@
# #
# All text after a single hash (#) is considered a comment and will be ignored. # All text after a single hash (#) is considered a comment and will be ignored.
# The format is: # The format is:
# TAG = value [value, ...] # TAG = value [value, file.]
# For lists, items can also be appended using: # For lists, items can also be appended using:
# TAG += value [value, ...] # TAG += value [value, file.]
# Values that contain spaces should be placed between quotes (\" \"). # 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 # 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 # 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 # 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 # 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. # the optimal cache size from a speed point of view.
# Minimum value: 0, maximum value: 9, default value: 0. # Minimum value: 0, maximum value: 9, default value: 0.
@ -636,8 +636,8 @@ GENERATE_BUGLIST = YES
GENERATE_DEPRECATEDLIST= YES GENERATE_DEPRECATEDLIST= YES
# The ENABLED_SECTIONS tag can be used to enable conditional documentation # The ENABLED_SECTIONS tag can be used to enable conditional documentation
# sections, marked by \if <section_label> ... \endif and \cond <section_label> # sections, marked by \if <section_label> file. \endif and \cond <section_label>
# ... \endcond blocks. # file. \endcond blocks.
ENABLED_SECTIONS = ENABLED_SECTIONS =
@ -1094,6 +1094,7 @@ HTML_FILE_EXTENSION = .html
# This tag requires that the tag GENERATE_HTML is set to YES. # This tag requires that the tag GENERATE_HTML is set to YES.
HTML_HEADER = HTML_HEADER =
#/Users/vsc/git/yap-6.3/docs/web/bootstrap/header.html #/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 # 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. # This tag requires that the tag GENERATE_HTML is set to YES.
HTML_FOOTER = HTML_FOOTER =
#/Users/vsc/git/yap-6.3/docs/web/bootstrap/footer.html #/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 # 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. # This tag requires that the tag GENERATE_HTML is set to YES.
HTML_STYLESHEET = HTML_STYLESHEET =
#/Users/vsc/git/yap-6.3/docs/web/bootstrap/customdoxygen.css #/Users/vsc/git/yap-6.3/docs/web/bootstrap/customdoxygen.css
# The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined # 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. # list). For an example see the documentation.
# This tag requires that the tag GENERATE_HTML is set to YES. # 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 # 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 # 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. # This tag requires that the tag GENERATE_HTML is set to YES.
HTML_EXTRA_FILES = HTML_EXTRA_FILES =
#/Users/vsc/git/yap-6.3/docs/web/bootstrap/doxy-boot.js #/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 # 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 # output directory using the MATHJAX_RELPATH option. The destination directory
# should contain the MathJax.js script. For instance, if the mathjax 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 # 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 # 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. However, it is strongly recommended to install a local copy of
# MathJax from http://www.mathjax.org before deployment. # MathJax from http://www.mathjax.org before deployment.
@ -1886,7 +1892,7 @@ MAN_LINKS = NO
# captures the structure of the code including all documentation. # captures the structure of the code including all documentation.
# The default value is: NO. # 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 # 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 # 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: # a tag file without this location is as follows:
# TAGFILES = file1 file2 ... # TAGFILES = file1 file2 ...
# Adding location for the tag files is done as follows: # 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 # 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 # section "Linking to external documentation" for more information about the use
# of tag files. # of tag files.

28
docs/yap.md
View File

@ -774,6 +774,8 @@ YAP Built-ins {#builtins}
+ @ref YAP_Terms + @ref YAP_Terms
+ @ref InputOutput + @ref InputOutput
+ @ref AbsoluteFileName
+ @ref YAPOS + @ref YAPOS
@ -806,6 +808,9 @@ language. Next, we discuss how to use the most important ones.
The YAP Library {#library} The YAP Library {#library}
=============== ===============
@defgroup library YAP library files
@{
Library files reside in the library_directory path (set by the Library files reside in the library_directory path (set by the
`LIBDIR` variable in the Makefile for YAP). Several files in the `LIBDIR` variable in the Makefile for YAP). Several files in the
library are originally from the public-domain Edinburgh Prolog library. library are originally from the public-domain Edinburgh Prolog library.
@ -861,10 +866,14 @@ The YAP Library {#library}
- @ref wgraphs - @ref wgraphs
- @ref wundgraphs - @ref wundgraphs
- @ref ypp - @ref ypp
@}
The YAP Packages {#packages} The YAP Packages {#packages}
================ ================
@defgroup packages YAP packages files
@{
+ @ref real + @ref real
+ @ref BDDs + @ref BDDs
@ -891,10 +900,16 @@ Leuven packages ported from SWI-Prolog:
+ @subpage clpqr + @subpage clpqr
@}
Compatibility {#swi} Compatibility {#swi}
============= =============
@defgroup swi Compatibility
@{
YAP has been designed to be as compatible as possible with other YAP has been designed to be as compatible as possible with other
Prolog systems, originally with C-Prolog\cite x and SICStus Prolog systems, originally with C-Prolog\cite x and SICStus
Prolog~\cite x . More recent work on YAP has striven at making YAP 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 Please inform the authors on other incompatibilities that may still
exist. exist.
@}
Foreign Language interface for YAP {#fli} Foreign Language interface for YAP {#fli}
================================== ==================================
@defgroup fli Foreigd Code Interfacing
@{
YAP provides the user with three facilities for writing YAP provides the user with three facilities for writing
predicates in a language other than Prolog. Under Unix systems, 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. 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 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
@}

72
docs/yapdocs.yap
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 /** @defgroup InputOutput_of_Terms Handling Input/Output of Terms
@ingroup YAPBuiltins @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 several primitives that allow updating Prolog terms. Note that these
primitives are also backtrackable. 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 compound terms. The `mutable` family of predicates provides
<em>mutable variables</em>. They should be used instead of `setarg/3`, <em>mutable variables</em>. They should be used instead of `setarg/3`,
as they allow the encapsulation of accesses to updatable as they allow the encapsulation of accesses to updatable

9
include/SWI-Prolog.h
View File

@ -69,13 +69,6 @@ typedef int _Bool;
#define __WINDOWS__ 1 #define __WINDOWS__ 1
#endif #endif
#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" #include "pl-types.h"
@ -100,7 +93,7 @@ stuff.
#endif #endif
#ifdef HAVE_DECLSPEC #ifdef HAVE_DECLSPEC
# ifdef PL_KERNEL # ifdef _YAP_NOT_INSTALLED_
#define PL_EXPORT(type) __declspec(dllexport) type #define PL_EXPORT(type) __declspec(dllexport) type
#define PL_EXPORT_DATA(type) __declspec(dllexport) type #define PL_EXPORT_DATA(type) __declspec(dllexport) type
#define install_t void #define install_t void

3
include/YapDefs.h
View File

@ -370,7 +370,8 @@ typedef enum stream_f {
RepError_Prolog_f = 0x400000, /**< handle representation error as Prolog terms */ RepError_Prolog_f = 0x400000, /**< handle representation error as Prolog terms */
RepError_Xml_f = 0x800000, /**< handle representation error as XML objects */ RepError_Xml_f = 0x800000, /**< handle representation error as XML objects */
DoNotCloseOnAbort_Stream_f= 0x1000000, /**< do not close the stream after an abort event */ 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; } estream_f;
typedef uint64_t stream_flags_t; typedef uint64_t stream_flags_t;

35
include/YapErrors.h
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() BEGIN_ERROR_CLASSES()
/// base case
ECLASS(NO_ERROR, "no_error", 0) ECLASS(NO_ERROR, "no_error", 0)
/// bad domain, first argument often is the predicate.
ECLASS(DOMAIN_ERROR, "domain_error", 2) ECLASS(DOMAIN_ERROR, "domain_error", 2)
/// bad arithmetic
ECLASS(EVALUATION_ERROR, "evaluation_error", 2) ECLASS(EVALUATION_ERROR, "evaluation_error", 2)
/// missing object (I/O mostly)
ECLASS(EXISTENCE_ERROR, "existence_error", 2) 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(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(RESOURCE_ERROR, "resource_error", 2)
ECLASS(SYNTAX_ERROR_CLASS, "syntax_error", 2) /// bad text
ECLASS(SYSTEM_ERROR_CLASS, "system_error", 2) 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) ECLASS(TYPE_ERROR, "type_error", 2)
/// should be unbound
ECLASS(UNINSTANTIATION_ERROR_CLASS, "uninstantiation_error", 1) ECLASS(UNINSTANTIATION_ERROR_CLASS, "uninstantiation_error", 1)
ECLASS(EVENT, "event", 2) /// escape hatch
ECLASS(EVENT, "event", 2)
END_ERROR_CLASSES(); END_ERROR_CLASSES();
@ -20,10 +41,10 @@ BEGIN_ERRORS()
/* ISO_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, 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_OVERFLOW, DOMAIN_ERROR, "array_overflow")
E(DOMAIN_ERROR_ARRAY_TYPE, DOMAIN_ERROR, "array_type") E(DOMAIN_ERROR_ARRAY_TYPE, DOMAIN_ERROR, "array_type")
E(DOMAIN_ERROR_FILE_ERRORS, DOMAIN_ERROR, "file_errors") E(DOMAIN_ERROR_FILE_ERRORS, DOMAIN_ERROR, "file_errors")

169
include/YapInterface.h
View File

@ -20,10 +20,10 @@
@defgroup ChYInterface Foreign Language interface to YAP @defgroup ChYInterface Foreign Language interface to YAP
@brief Core interface to YAP.
q
*/ */
#ifndef _yap_c_interface_h #ifndef _yap_c_interface_h
#define _yap_c_interface_h 1 #define _yap_c_interface_h 1
@ -31,7 +31,7 @@
#define __YAP_PROLOG__ 1 #define __YAP_PROLOG__ 1
#ifndef YAPVERSION #ifndef YAPVERSION
#define YAPVERSION 60000 //> default versison #define YAPVERSION 60000
#endif #endif
#include "YapDefs.h" #include "YapDefs.h"
@ -40,8 +40,62 @@
#include <stdarg.h> #include <stdarg.h>
#endif #endif
#if HAVE_STDBOOL_H
#include <stdbool.h>
#endif
#include <wchar.h> #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 @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: * 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 */ /* Primitive Functions */
#define YAP_Deref(t) (t) #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_ARG1 YAP_A(1)
#define YAP_ARG2 YAP_A(2) #define YAP_ARG2 YAP_A(2)
#define YAP_ARG3 YAP_A(3) #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_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); extern X_API YAP_Int YAP_AtomToInt(YAP_Atom At);

1
include/c_interface.c Normal file
View File

@ -0,0 +1 @@

20
include/clause_list.h
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 struct ClauseList
{ {
@ -14,14 +8,14 @@ struct ClauseList
}; };
typedef struct ClauseList *clause_list_t; 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); int Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred);
X_API void Yap_ClauseListClose(clause_list_t cl); void Yap_ClauseListClose(clause_list_t cl);
X_API int Yap_ClauseListDestroy(clause_list_t cl); int Yap_ClauseListDestroy(clause_list_t cl);
X_API void *Yap_ClauseListToClause(clause_list_t cl); void *Yap_ClauseListToClause(clause_list_t cl);
X_API void *Yap_ClauseListCode(clause_list_t cl); void *Yap_ClauseListCode(clause_list_t cl);
X_API void *Yap_FAILCODE(void); void *Yap_FAILCODE(void);
#define Yap_ClauseListCount(cl) ((cl)->n) #define Yap_ClauseListCount(cl) ((cl)->n)

0
library/examples/matrix.yap → library/examples/mat.yap
View File

1
library/lammpi/CMakeLists.txt
View File

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

5
library/lineutils.yap
View File

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

3
library/matlab/CMakeLists.txt
View File

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

4
library/matrix/CMakeLists.txt
View File

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

3
library/random/CMakeLists.txt
View File

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

3
library/regex/CMakeLists.txt
View File

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

3
library/rltree/CMakeLists.txt
View File

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

2
library/splay.yap
View File

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

3
library/system/CMakeLists.txt
View File

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

31
library/system/sys_config.h Normal file
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

0
OPTYap/ → library/systest.yap
View File

6
library/tries/CMakeLists.txt
View File

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

4
misc/HEAPFIELDS
View File

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

161
misc/analysis/graphs.yap
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 ).

694
misc/analysis/load.yap
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 ).

6
misc/buildatoms
View File

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

2
misc/buildlocalglobal
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/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/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/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/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/dlocals.h',gen_dstruct,Warning,['dlocals.h','LOCALS']),
file_filter_with_initialization('misc/LOCALS','H/heap/rlocals.h',gen_hstruct,Warning,['rlocals.h','LOCALS']), file_filter_with_initialization('misc/LOCALS','H/heap/rlocals.h',gen_hstruct,Warning,['rlocals.h','LOCALS']),

6
misc/prolog.el
View File

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

18
os/CMakeLists.txt
View File

@ -36,14 +36,15 @@ set (YAPOS_HEADERS
include_directories (../H ../include ../OPTYap . ${GMP_INCLUDE_DIR} ${PROJECT_BINARY_DIR}) 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) if (READLINE_FOUND)
macro_log_feature (READLINE_FOUND "libreadline"
"Readline line editing library"
"http://cnswww.cns.cwru.edu/php/chet/readline/rltop.html")
if (READLINE_FOUND)
# - Find the readline library # - Find the readline library
# This module defines # This module defines
# READLINE_INCLUDE_DIR, path to readline/readline.h, etc. # 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(YAP_SYSTEM_OPTIONS "readline " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE)
set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${READLINE_LIBRARIES} ) 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/readline.h" HAVE_READLINE_READLINE_H )
check_include_files( "stdio.h;readline/history.h" HAVE_READLINE_HISTORY_H ) check_include_files( "stdio.h;readline/history.h" HAVE_READLINE_HISTORY_H )
if (HAVE_READLINE_READLINE_H) if (HAVE_READLINE_READLINE_H)
@ -80,6 +83,8 @@ if (READLINE_FOUND)
endif() endif()
endif (READLINE_FOUND) endif (READLINE_FOUND)
endif (READLINE)
set (POSITION_INDEPENDENT_CODE TRUE) set (POSITION_INDEPENDENT_CODE TRUE)
add_library (libYAPOs OBJECT 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( READLINE_LIBS ${READLINE_LIBRARIES} PARENT_SCOPE)
#set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${GMP_LIBRARIES} ) #set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${GMP_LIBRARIES} )

8
os/YapIOConfig.h.cmake
View File

@ -1,6 +1,6 @@
/* Define if you have libreadline */ /* Define if you have libreadline */
#ifndef HAVE_LIBREADLINE #ifndef HAVE_LIBREADLINE
#cmakedefine USE_READLINE ${USE_READLINE} #cmakedefine HAVE_LIBREADLINE ${HAVE_LIBREADLINE}
#endif #endif
/* Define to 1 if you have the <readline/history.h> header file. */ /* 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. */ /* Define to 1 if you have the <readline/readline.h> header file. */
#ifndef HAVE_READLINE_READLINE_H #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 #endif
/* Define to 1 if you have the declaration of `rl_catch_signals ', and to 0 if /* Define to 1 if you have the declaration of `rl_catch_signals ', and to 0 if

4
os/alias.c
View File

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

11
os/charsio.c
View File

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

4
os/chartypes.c
View File

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

79
os/console.c
View File

@ -18,36 +18,23 @@
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
#endif #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. * 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 "sysbits.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"
static Int prompt( USES_REGS1 ); static Int prompt( USES_REGS1 );
static Int prompt1( USES_REGS1 ); static Int prompt1( USES_REGS1 );
@ -83,7 +70,8 @@ is_same_tty(FILE *f1, FILE *f2)
#if HAVE_TTYNAME #if HAVE_TTYNAME
return(ttyname(fileno(f1)) == ttyname(fileno(f2))); return(ttyname(fileno(f1)) == ttyname(fileno(f2)));
#else #else
return; // assume a single console, for now
return true;
#endif #endif
} }
@ -103,14 +91,18 @@ is_same_tty2 (USES_REGS1)
void void
Yap_ConsoleOps( StreamDesc *s ) Yap_ConsoleOps( StreamDesc *s )
{ {
Yap_DefaultStreamOps( s );
/* the putc routine only has to check it is putting out a newline */ /* the putc routine only has to check it is putting out a newline */
s->stream_putc = ConsolePutc; s->stream_putc = ConsolePutc;
#if USE_READLINE
/* if a tty have a special routine to call readline */ /* if a tty have a special routine to call readline */
if (!Yap_ReadlineOps( s )) { if (( s->status & Readline_Stream_f) &&
/* else just PlGet plus checking for prompt */ trueGlobalPrologFlag(READLINE_FLAG) ) {
s->stream_getc = ConsoleGetc; if (Yap_ReadlineOps( s ))
} return;
Yap_DefaultStreamOps( s ); }
#endif
s->stream_getc = ConsoleGetc;
} }
/* static */ /* static */
@ -144,7 +136,7 @@ ConsoleGetc(int sno)
/* keep the prompt around, just in case, but don't actually /* keep the prompt around, just in case, but don't actually
show it in silent mode */ show it in silent mode */
if (LOCAL_newline) { if (LOCAL_newline) {
if (silentMode()) { if (!silentMode()) {
char *cptr = LOCAL_Prompt, ch; char *cptr = LOCAL_Prompt, ch;
/* use the default routine */ /* use the default routine */
@ -181,6 +173,13 @@ ConsoleGetc(int sno)
return console_post_process_read_char(ch, s); return console_post_process_read_char(ch, s);
} }
/** @pred prompt1(+ _A__)
Changes YAP input prompt for the .
*/
static Int static Int
prompt1 ( USES_REGS1 ) prompt1 ( USES_REGS1 )
@ -198,7 +197,13 @@ prompt1 ( USES_REGS1 )
return (TRUE); return (TRUE);
} }
/** @pred prompt(- _A_,+ _B_)
Changes YAP input prompt from _A_ to _B_, active on *next* standard input interaction.
*/
static Int static Int
prompt ( USES_REGS1 ) prompt ( USES_REGS1 )
{ /* prompt(Old,New) */ { /* prompt(Old,New) */
@ -211,7 +216,7 @@ prompt ( USES_REGS1 )
a = AtomOfTerm (t); a = AtomOfTerm (t);
if (strlen(RepAtom (a)->StrOfAE) > MAX_PROMPT) { if (strlen(RepAtom (a)->StrOfAE) > MAX_PROMPT) {
Yap_Error(SYSTEM_ERROR_INTERNAL,t,"prompt %s is too long", RepAtom (a)->StrOfAE); 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); strncpy(LOCAL_Prompt, (char *)RepAtom (LOCAL_AtPrompt)->StrOfAE, MAX_PROMPT);
LOCAL_AtPrompt = a; LOCAL_AtPrompt = a;
@ -223,7 +228,10 @@ Yap_GetCharForSIGINT(void)
{ {
CACHE_REGS CACHE_REGS
int ch; int ch;
if ((ch = Yap_ReadlineForSIGINT()) == 0) #if USE_READLINE
if (trueGlobalPrologFlag(READLINE_FLAG) ||
(ch = Yap_ReadlineForSIGINT()) == 0)
#endif
{ /* ask for a new line */ { /* ask for a new line */
fprintf(stderr, "Action (h for help): "); fprintf(stderr, "Action (h for help): ");
ch = getc(stdin); ch = getc(stdin);
@ -237,6 +245,7 @@ Yap_GetCharForSIGINT(void)
void Yap_InitConsole(void) { void Yap_InitConsole(void) {
LOCAL_newline = true;
Yap_InitCPred ("prompt", 1, prompt1, SafePredFlag|SyncPredFlag); Yap_InitCPred ("prompt", 1, prompt1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("prompt1", 1, prompt1, SafePredFlag|SyncPredFlag); Yap_InitCPred ("prompt1", 1, prompt1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$is_same_tty", 2, is_same_tty2, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$is_same_tty", 2, is_same_tty2, SafePredFlag|SyncPredFlag|HiddenPredFlag);

81
os/edio.yap
View File

@ -1,7 +1,37 @@
% %
% Edinburgh IO. % 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(user) :- !, set_input(user_input).
see(F) :- var(F), !, see(F) :- var(F), !,
'$do_error'(instantiation_error,see(F)). '$do_error'(instantiation_error,see(F)).
@ -13,6 +43,13 @@ see(Stream) :- '$stream'(Stream), current_stream(_,read,Stream), !,
set_input(Stream). set_input(Stream).
see(F) :- open(F,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), seeing(File) :- current_input(Stream),
stream_property(Stream,file_name(NFile)), stream_property(Stream,file_name(NFile)),
( (
@ -23,8 +60,33 @@ seeing(File) :- current_input(Stream),
NFile = File 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). 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(user) :- !, set_output(user_output).
tell(F) :- var(F), !, tell(F) :- var(F), !,
'$do_error'(instantiation_error,tell(F)). '$do_error'(instantiation_error,tell(F)).
@ -43,12 +105,29 @@ tell(Stream) :-
tell(F) :- tell(F) :-
open(F,append,Stream), open(F,append,Stream),
set_output(Stream). set_output(Stream).
/** @pred telling(- _S_)
The current output stream is unified with _S_.
*/
telling(File) :- telling(File) :-
current_output(Stream), current_output(Stream),
stream_property(Stream,file_name(NFile)), stream_property(Stream,file_name(NFile)),
( stream_property(user_output,file_name(NFile)) -> File = user ; File = 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), told :- current_output(Stream),
!, !,
set_output(user), set_output(user),

100
os/files.c
View File

@ -24,75 +24,8 @@ static char SccsId[] = "%W% %G%";
* *
*/ */
#include "Yap.h" #include "sysbits.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"
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
#define SYSTEM_STAT _stat #define SYSTEM_STAT _stat
@ -341,16 +274,35 @@ time_file(USES_REGS1)
} else { } else {
const char *n = RepAtom(AtomOfTerm(tname))->StrOfAE; const char *n = RepAtom(AtomOfTerm(tname))->StrOfAE;
#if __WIN32 #if __WIN32
FILETIME ftWrite; FILETIME ft;
if ((hdl = CreateFile( n, 0, 0, NULL, OPEN_EXISTING, NULL)) == 0) HANDLE hdl;
Term rc;
if ((hdl = CreateFile( n, 0, 0, NULL, OPEN_EXISTING, 0, 0)) == 0)
return false; return false;
if (GetFileTime(hdl, NULL,NULL,&ftWrite)) if (GetFileTime(hdl, NULL,NULL,&ft))
return false; return false;
// Convert the last-write time to local time. // Convert the last-write time to local time.
// FileTimeToSystemTime(&ftWrite, &stUTC); // FileTimeToSystemTime(&ftWrite, &stUTC);
// SystemTimeToTzSpecificLocalTime(NULL, &stUTC, &stLocal); // SystemTimeToTzSpecificLocalTime(NULL, &stUTC, &stLocal);
CloseHandle( hdl ); 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 #elif HAVE_STAT
struct SYSTEM_STAT ss; struct SYSTEM_STAT ss;
@ -505,7 +457,7 @@ is_absolute_file_name ( USES_REGS1 )
at = AtomOfTerm(t); at = AtomOfTerm(t);
if (IsWideAtom(at)) { if (IsWideAtom(at)) {
#if _WIN32 #if _WIN32
return PathisRelativeW(RepAtom(at)->WStrOfAE[0]); return PathIsRelativeW(RepAtom(at)->WStrOfAE);
#else #else
return RepAtom(at)->WStrOfAE[0] == '/'; return RepAtom(at)->WStrOfAE[0] == '/';
#endif #endif

7
os/fmemopen.c
View File

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

213
os/iopreds.c
View File

@ -18,9 +18,16 @@
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
#endif #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 * This file includes the definition of a miscellania of standard predicates * for yap refering to: Files and GLOBAL_Streams, Simple Input/Output,
* 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); Yap_socketStream(s);
#if _MSC_VER || defined(__MINGW32__) #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; s->status |= Tty_Stream_f | Reset_Eof_Stream_f | Promptable_Stream_f;
/* make all console descriptors unbuffered */ /* make all console descriptors unbuffered */
setvbuf(s->u.file.file, NULL, _IONBF, 0); setvbuf(s->file, NULL, _IONBF, 0);
return; return;
} }
#if _MSC_VER #if _MSC_VER
@ -1009,11 +1016,7 @@ Int GetStreamFd(int sno) {
} else } else
#endif #endif
if (GLOBAL_Stream[sno].status & Pipe_Stream_f) { 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); return (GLOBAL_Stream[sno].u.pipe.fd);
#endif
} else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { } else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
return (-1); return (-1);
} }
@ -1022,7 +1025,7 @@ Int GetStreamFd(int sno) {
Int Yap_GetStreamFd(int sno) { return GetStreamFd(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 HAVE_STAT
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
struct _stat ss; struct _stat ss;
@ -1229,20 +1232,52 @@ static void check_bom(int sno, StreamDesc *st) {
return true; 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() \ #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("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("create", isatom, OPEN_CREATE), \
PAR("encoding", isatom, OPEN_ENCODING), \ PAR("encoding", isatom, OPEN_ENCODING), \
PAR("eof_action", isatom, OPEN_EOF_ACTION), \ 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("file_name", isatom, OPEN_FILE_NAME), PAR("input", ok, OPEN_INPUT), \
PAR("locale", isatom, OPEN_LOCALE), PAR("lock", isatom, OPEN_LOCK), \ PAR("locale", isatom, OPEN_LOCALE), PAR("lock", isatom, OPEN_LOCK), \
PAR("mode", isatom, OPEN_MODE), PAR("output", ok, OPEN_OUTPUT), \ PAR("mode", isatom, OPEN_MODE), PAR("output", ok, OPEN_OUTPUT), \
PAR("representation_errors", boolean, OPEN_REPRESENTATION_ERRORS), \ PAR("representation_errors", booleanFlag, OPEN_REPRESENTATION_ERRORS), \
PAR("reposition", boolean, OPEN_REPOSITION), \ PAR("reposition", booleanFlag, OPEN_REPOSITION), \
PAR("type", isatom, OPEN_TYPE), PAR("wait", boolean, OPEN_WAIT), \ PAR("script", booleanFlag, OPEN_SCRIPT), \
PAR("type", isatom, OPEN_TYPE), PAR("wait", booleanFlag, OPEN_WAIT), \
PAR(NULL, ok, OPEN_END) PAR(NULL, ok, OPEN_END)
#define PAR(x, y, z) z #define PAR(x, y, z) z
@ -1267,7 +1302,7 @@ do_open(Term file_name, Term t2,
char io_mode[8]; char io_mode[8];
StreamDesc *st; StreamDesc *st;
bool avoid_bom = false, needs_bom = false; bool avoid_bom = false, needs_bom = false;
char *fname; const char *fname;
stream_flags_t flags; stream_flags_t flags;
FILE *fd; FILE *fd;
encoding_t encoding; encoding_t encoding;
@ -1352,6 +1387,10 @@ do_open(Term file_name, Term t2,
fname = Yap_AbsoluteFile(fname, LOCAL_FileNameBuf, ok); fname = Yap_AbsoluteFile(fname, LOCAL_FileNameBuf, ok);
st->name = Yap_LookupAtom(fname); 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 // binary type
if (args[OPEN_TYPE].used) { if (args[OPEN_TYPE].used) {
Term t = args[OPEN_TYPE].tvalue; Term t = args[OPEN_TYPE].tvalue;
@ -1395,7 +1434,7 @@ do_open(Term file_name, Term t2,
(!(flags & Binary_Stream_f) && binary_file(fname))) { (!(flags & Binary_Stream_f) && binary_file(fname))) {
UNLOCK(st->streamlock); UNLOCK(st->streamlock);
if (errno == ENOENT) 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))); strerror(errno)));
else { else {
return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK, file_name, "%s: %s", 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 ) { } else if ( open_mode == AtomRead && !avoid_bom ) {
check_bom(sno, st); // can change encoding check_bom(sno, st); // can change encoding
} }
if (script)
open_header(sno, open_mode);
UNLOCK(st->streamlock); UNLOCK(st->streamlock);
{ {
@ -1423,10 +1466,109 @@ do_open(Term file_name, Term t2,
return (Yap_unify(ARG3, t)); 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) */ static Int open3(USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */
return do_open(Deref(ARG1), Deref(ARG2), TermNil PASS_REGS); 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) */ static Int open4(USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */
return do_open(Deref(ARG1), Deref(ARG2), Deref(ARG4) PASS_REGS); return do_open(Deref(ARG1), Deref(ARG2), Deref(ARG4) PASS_REGS);
} }
@ -1605,6 +1747,12 @@ int Yap_GetFreeStreamDForReading(void) {
return sno; 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) { static Int always_prompt_user(USES_REGS1) {
StreamDesc *s = GLOBAL_Stream + StdInStream; StreamDesc *s = GLOBAL_Stream + StdInStream;
@ -1621,7 +1769,17 @@ static Int always_prompt_user(USES_REGS1) {
return (TRUE); 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( Int sno = CheckStream(
ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2"); ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2");
if (sno < 0) if (sno < 0)
@ -1636,7 +1794,7 @@ static Int close1(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
} }
#define CLOSE_DEFS() \ #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 #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()}; static const param_t close_defs[] = {CLOSE_DEFS()};
#undef PAR #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) */ static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
Int sno = CheckStream( Int sno = CheckStream(
ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2"); 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() \ #define ABSOLUTE_FILE_NAME_DEFS() \
PAR("access", isatom, ABSOLUTE_FILE_NAME_ACCESS), \ 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("extensions", ok, ABSOLUTE_FILE_NAME_EXTENSIONS), \
PAR("file_type", is_file_type, ABSOLUTE_FILE_NAME_FILE_TYPE), \ PAR("file_type", is_file_type, ABSOLUTE_FILE_NAME_FILE_TYPE), \
PAR("file_errors", is_file_errors, ABSOLUTE_FILE_NAME_FILE_ERRORS), \ PAR("file_errors", is_file_errors, ABSOLUTE_FILE_NAME_FILE_ERRORS), \
PAR("glob", ok, ABSOLUTE_FILE_NAME_GLOB), \ PAR("glob", ok, ABSOLUTE_FILE_NAME_GLOB), \
PAR("relative_to", isatom, ABSOLUTE_FILE_NAME_RELATIVE_TO), \ PAR("relative_to", isatom, ABSOLUTE_FILE_NAME_RELATIVE_TO), \
PAR("solutions", issolutions, ABSOLUTE_FILE_NAME_SOLUTIONS), \ PAR("solutions", issolutions, ABSOLUTE_FILE_NAME_SOLUTIONS), \
PAR("verbose_file_search", boolean, \ PAR("verbose_file_search", booleanFlag, \
ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH), \ ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH), \
PAR(NULL, ok, ABSOLUTE_FILE_NAME_END) PAR(NULL, ok, ABSOLUTE_FILE_NAME_END)
@ -1838,7 +2005,9 @@ void Yap_InitIOPreds(void) {
Yap_InitReadTPreds(); Yap_InitReadTPreds();
Yap_InitFormat(); Yap_InitFormat();
Yap_InitRandomPreds(); Yap_InitRandomPreds();
Yap_InitReadline(); #if USE_READLINE
Yap_InitReadlinePreds();
#endif
Yap_InitSockets(); Yap_InitSockets();
Yap_InitSignalPreds(); Yap_InitSignalPreds();
Yap_InitSysPreds(); Yap_InitSysPreds();

29
os/iopreds.h
View File

@ -13,6 +13,11 @@ static char SccsId[] = "%W% %G%";
#ifndef IOPREDS_H #ifndef IOPREDS_H
#define IOPREDS_H 1 #define IOPREDS_H 1
#if _WIN32
#define USE_SOCKET 1
#define HAVE_SOCKET 1
#endif
#include <stdlib.h> #include <stdlib.h>
#include "Yap.h" #include "Yap.h"
#include "Atoms.h" #include "Atoms.h"
@ -32,6 +37,15 @@ extern size_t Yap_page_size;
#include <wchar.h> #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 #if HAVE_SOCKET
extern int Yap_sockets_io; 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 */ af_unix /* or AF_FILE */
} socket_domain; } 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); 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 int Yap_CheckSocketStream(Term, const char *);
extern socket_domain Yap_GetSocketDomain(int); extern socket_domain Yap_GetSocketDomain(int);
extern socket_info Yap_GetSocketStatus(int); extern socket_info Yap_GetSocketStatus(int);
@ -181,11 +188,7 @@ typedef struct stream_desc
} file; } file;
memHandle mem_string; memHandle mem_string;
struct { struct {
#if defined(__MINGW32__) || defined(_MSC_VER)
HANDLE hdl;
#else
int fd; int fd;
#endif
} pipe; } pipe;
#if HAVE_SOCKET #if HAVE_SOCKET
struct { struct {
@ -276,6 +279,7 @@ Term Yap_scan_num(struct stream_desc *);
void Yap_DefaultStreamOps( StreamDesc *st ); void Yap_DefaultStreamOps( StreamDesc *st );
void Yap_PipeOps( StreamDesc *st ); void Yap_PipeOps( StreamDesc *st );
void Yap_MemOps( StreamDesc *st ); void Yap_MemOps( StreamDesc *st );
bool Yap_CloseMemoryStream( int sno );
void Yap_ConsolePipeOps( StreamDesc *st ); void Yap_ConsolePipeOps( StreamDesc *st );
void Yap_SocketOps( StreamDesc *st ); void Yap_SocketOps( StreamDesc *st );
void Yap_ConsoleSocketOps( StreamDesc *st ); void Yap_ConsoleSocketOps( StreamDesc *st );
@ -294,7 +298,8 @@ void Yap_InitSockets( void );
void Yap_InitSocketLayer(void); void Yap_InitSocketLayer(void);
void Yap_InitMems( void ); void Yap_InitMems( void );
void Yap_InitConsole( void ); void Yap_InitConsole( void );
void Yap_InitReadline( void ); void Yap_InitReadlinePreds( void );
bool Yap_InitReadline( Term );
void Yap_InitChtypes(void); void Yap_InitChtypes(void);
void Yap_InitCharsio(void); void Yap_InitCharsio(void);
void Yap_InitFormat(void); void Yap_InitFormat(void);

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