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

Merge ../../yap-6.3

Browse Source
This commit is contained in:
Vitor Santos Costa 2018-11-17 23:56:48 +00:00
commit 40633a3f83
298 changed files with 24601 additions and 12276 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.configure-custom.sh
View File

@ -12,11 +12,15 @@ WITH_VARS="swig|yes|WITH_SWIG \
mpi|yes|WITH_MPI \
gecode|yes|WITH_GECODE \
docs|yes|WITH_DOCS \
r|yes|WITH_REAL \
r|yes|WITH_R \
myddas|yes|WITH_MYDDAS \
cudd|yes|WITH_CUDD \
xml2|yes|WITH_XML2 \
raptor|yes|WITH_RAPTOR \
python|yes|WITH_PYTHON \
openssl|yes|WITH_OPENSSL\
java|yes|WITH_JAVA
lbfgs|yes|WITH_LBFGS
extensions|yes|WITH_EXTENSIONS
readline|yes|WITH_READLINE \
gmp|yes|WITH_GMP"

31
C/absmi.c
View File

@ -219,12 +219,12 @@ static int check_alarm_fail_int(int CONT USES_REGS) {
}
static int stack_overflow(PredEntry *pe, CELL *env, yamop *cp,
arity_t nargs USES_REGS) {
arity_t nargs USES_REGS) {
if (Unsigned(YREG) - Unsigned(HR) < StackGap(PASS_REGS1) ||
Yap_get_signal(YAP_STOVF_SIGNAL)) {
S = (CELL *)pe;
if (!Yap_locked_gc(nargs, env, cp)) {
Yap_NilError(RESOURCE_ERROR_STACK, LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK, "stack overflow: gc failed");
return 0;
}
return 1;
@ -239,7 +239,7 @@ static int code_overflow(CELL *yenv USES_REGS) {
/* do a garbage collection first to check if we can recover memory */
if (!Yap_locked_growheap(false, 0, NULL)) {
Yap_NilError(RESOURCE_ERROR_HEAP, "YAP failed to grow heap: %s",
LOCAL_ErrorMessage);
"malloc/mmap failed");
return 0;
}
CACHE_A1();
@ -689,7 +689,7 @@ static int interrupt_deallocate(USES_REGS1) {
return rc;
}
if (!Yap_locked_gc(0, ENV, YESCODE)) {
Yap_NilError(RESOURCE_ERROR_STACK, LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK, "stack overflow: gc failed");
}
S = ASP;
S[E_CB] = (CELL)(LCL0 - cut_b);
@ -751,7 +751,7 @@ static int interrupt_cut_e(USES_REGS1) {
if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) {
return v;
}
if (!Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) {
if (Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) {
return 2;
}
/* find something to fool S */
@ -957,35 +957,32 @@ static void undef_goal(USES_REGS1) {
} else {
d0 = AbsAppl(HR);
*HR++ = (CELL)pe->FunctorOfPred;
CELL *ip=HR, *imax = HR+pe->ArityOfPE;
HR = imax;
BEGP(pt1);
pt1 = XREGS + 1;
for (; ip < imax; ip++) {
CELL *ip=HR;
UInt imax = pe->ArityOfPE;
HR += imax;
UInt i = 1;
for (; i <= imax; ip++, i++) {
BEGD(d1);
BEGP(pt0);
pt0 = pt1++;
d1 = *pt0;
d1 = XREGS[i];
deref_head(d1, undef_unk);
undef_nonvar:
/* just copy it to the heap */
*ip = d1;
continue;
derefa_body(d1, pt0, undef_unk, undef_nonvar);
if (pt0 <= HR) {
deref_body(d1, pt0, undef_unk, undef_nonvar);
if (pt0 < HR) {
/* variable is safe */
*ip = (CELL)pt0;
} else {
/* bind it, in case it is a local variable */
d1 = Unsigned(ip);
RESET_VARIABLE(ip);
Bind_Local(pt0, d1);
Bind_Local(pt0, Unsigned(ip));
}
ENDP(pt0);
ENDD(d1);
}
ENDP(pt1);
}
ARG1 = AbsPair(HR);
HR[1] = d0;

18
C/absmi_insts.i
View File

@ -1102,7 +1102,7 @@
PP = NULL;
#endif
if (!Yap_gc(3, ENV, CP)) {
Yap_NilError(RESOURCE_ERROR_STACK, LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK, "stack overflow: gc failed");
FAIL();
}
#if defined(YAPOR) || defined(THREADS)
@ -1226,7 +1226,7 @@
PREG = NEXTOP(PREG,Osbpa);
saveregs();
if (!Yap_gcl(sz, arity, YENV, PREG)) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed");
setregs();
FAIL();
} else {
@ -10927,7 +10927,7 @@
/* make sure we have something to show for our trouble */
saveregs();
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,xxx),Osbpp))) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed");
setregs();
JMPNext();
} else {
@ -11044,7 +11044,7 @@
/* make sure we have something to show for our trouble */
saveregs();
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,xxc),Osbpp))) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed");
setregs();
JMPNext();
} else {
@ -11154,7 +11154,7 @@
/* make sure we have something to show for our trouble */
saveregs();
if (!Yap_gc(0, YREG, NEXTOP(NEXTOP(PREG,xxn),Osbpp))) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed");
setregs();
JMPNext();
} else {
@ -11261,7 +11261,7 @@
/* make sure we have something to show for our trouble */
saveregs();
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxx),Osbpp))) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed");
setregs();
JMPNext();
} else {
@ -11388,7 +11388,7 @@
/* make sure we have something to show for our trouble */
saveregs();
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxc),Osbpp))) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed");
setregs();
JMPNext();
} else {
@ -11516,7 +11516,7 @@
/* make sure we have something to show for our trouble */
saveregs();
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxn),Osbpp))) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed");
setregs();
JMPNext();
} else {
@ -11892,7 +11892,7 @@
/* make sure we have something to show for our trouble */
saveregs();
if (!Yap_gcl((1+d1)*sizeof(CELL), 3, YREG, NEXTOP(NEXTOP(PREG,e),Osbmp))) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed" );
setregs();
JMPNext();
} else {

17
C/alloc.c
View File

@ -42,6 +42,12 @@ static char SccsId[] = "%W% %G%";
#if HAVE_FCNTL_H
#include <fcntl.h>
#endif
#if HAVE_SYS_TIME_H
#include <sys/time.h>
#endif
#if HAVE_SYS_RESOURCE_H
#include <sys/resource.h>
#endif
#if HAVE_SYS_STAT_H
#include <sys/stat.h>
#endif
@ -383,6 +389,17 @@ void Yap_InitHeap(void *heap_addr) {
HeapMax = 0;
}
// get an approximation to total memory data-base size.
size_t Yap_HeapUsed(void)
{
#if HAVE_MALLINFO
struct mallinfo mi = mallinfo();
return mi.uordblks - (LOCAL_TrailTop-LOCAL_GlobalBase);
#else
return Yap_ClauseSpace+Yap_IndexSpace_Tree+Yap_LUClauseSpace+Yap_LUIndexSpace_CP;
#endif
}
static void InitExStacks(int wid, int Trail, int Stack) {
CACHE_REGS
UInt pm, sa;

20
C/arith0.c
View File

@ -112,6 +112,7 @@ static char SccsId[] = "%W% %G%";
#include "Yatom.h"
#include "YapHeap.h"
#include "YapEval.h"
#include "alloc.h"
@ -172,9 +173,11 @@ eval0(Int fi) {
}
case op_heapused:
/// - heapused
/// Heap (data-base) space used, in bytes.
/// Heap (data-base) space used, in bytes. In fact YAP either reports
/// the total memory malloced, or the amount of allocated space in
/// predicates.
///
RINT(HeapUsed);
RINT(Yap_HeapUsed());
case op_localsp:
/// - local
/// Local stack in use, in bytes
@ -183,18 +186,6 @@ eval0(Int fi) {
RINT((Int)ASP);
#else
RINT(LCL0 - ASP);
#endif
case op_b:
/// - $b
/// current choicepoint
///
#if YAPOR_SBA
RINT((Int)B);
#else
if (B)
RINT(LCL0 - (CELL *)B);
else
RINT(0);
#endif
case op_env:
/// - $env
@ -254,7 +245,6 @@ static InitConstEntry InitConstTab[] = {
{"heapused", op_heapused},
{"local_sp", op_localsp},
{"global_sp", op_globalsp},
{"$last_choice_pt", op_b},
{"$env", op_env},
{"$tr", op_tr},
{"stackfree", op_stackfree},

184
C/arrays.c
View File

@ -1,21 +1,19 @@
/******************************************************************""*******
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: arrays.c *
* Last rev: *
* mods: *
* comments: Array Manipulation Routines *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: arrays.c * Last rev:
** mods: * comments: Array Manipulation Routines *
* *
*************************************************************************/
/**
/**
@file arrays.c
@ -106,9 +104,9 @@ The following predicates manipulate arrays:
*/
#include "Yap.h"
#include "YapEval.h"
#include "Yatom.h"
#include "clause.h"
#include "YapEval.h"
#include "heapgc.h"
#if HAVE_ERRNO_H
#include <errno.h>
@ -373,7 +371,7 @@ static ArrayEntry *GetArrayEntry(Atom at, int owner) {
#if THREADS
&& pp->owner_id != worker_id
#endif
)
)
pp = RepArrayProp(pp->NextOfPE);
READ_UNLOCK(ae->ARWLock);
return pp;
@ -986,7 +984,7 @@ restart:
#if THREADS
&& ((ArrayEntry *)pp)->owner_id != worker_id
#endif
)
)
pp = RepProp(pp->NextOfPE);
if (EndOfPAEntr(pp)) {
if (HR + 1 + size > ASP - 1024) {
@ -1025,22 +1023,49 @@ restart:
return (FALSE);
}
#define CREATE_ARRAY_DEFS() \
PAR("type", isatom, CREATE_ARRAY_TYPE), \
PAR("address", filler, CREATE_ARRAY_ADDRESS), \
PAR("int", filler, CREATE_ARRAY_INT), \
PAR("dbref", filler, CREATE_ARRAY_DBREF), \
PAR("float", filler, CREATE_ARRAY_FLOAT), \
PAR("ptr", filler, CREATE_ARRAY_PTR), \
PAR("atom", filler, CREATE_ARRAY_ATOM), \
PAR("char", filler, CREATE_ARRAY_CHAR), \
PAR("unsigned_char", filler, CREATE_ARRAY_UNSIGNED_CHAR), \
PAR("term", filler, CREATE_ARRAY_TERM), \
PAR("nb_term", filler, CREATE_ARRAY_NB_TERM)
#define PAR(x, y, z) z
typedef enum create_array_enum_choices {
CREATE_ARRAY_DEFS()
} create_array_choices_t;
#undef PAR
#define PAR(x, y, z) \
{ x, y, z }
static const param_t create_array_defs[] = {CREATE_ARRAY_DEFS()};
#undef PAR
/* create an array (+Name, + Size, +Props) */
static Int
/** @pred static_array(+ _Name_, + _Size_, + _Type_)
/** @pred static_array(+ _Name_, + _Size_, + _Type_)
Create a new static array with name _Name_. Note that the _Name_
must be an atom (named array). The _Size_ must evaluate to an
integer. The _Type_ must be bound to one of types mentioned
previously.
*/
create_static_array(USES_REGS1) {
Create a new static array with name _Name_. Note that the _Name_
must be an atom (named array). The _Size_ must evaluate to an
integer. The _Type_ must be bound to one of types mentioned
previously.
*/
static Int create_static_array(USES_REGS1) {
Term ti = Deref(ARG2);
Term t = Deref(ARG1);
Term tprops = Deref(ARG3);
Int size;
static_array_types props;
void *address = NULL;
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR, ti, "create static array");
@ -1055,40 +1080,62 @@ static Int
return (FALSE);
}
}
if (IsVarTerm(tprops)) {
Yap_Error(INSTANTIATION_ERROR, tprops, "create static array");
return (FALSE);
} else if (IsAtomTerm(tprops)) {
char *atname = (char *)RepAtom(AtomOfTerm(tprops))->StrOfAE;
if (!strcmp(atname, "int"))
props = array_of_ints;
else if (!strcmp(atname, "dbref"))
props = array_of_dbrefs;
else if (!strcmp(atname, "float"))
props = array_of_doubles;
else if (!strcmp(atname, "ptr"))
props = array_of_ptrs;
else if (!strcmp(atname, "atom"))
props = array_of_atoms;
else if (!strcmp(atname, "char"))
props = array_of_chars;
else if (!strcmp(atname, "unsigned_char"))
props = array_of_uchars;
else if (!strcmp(atname, "term"))
props = array_of_terms;
else if (!strcmp(atname, "nb_term"))
props = array_of_nb_terms;
else {
Yap_Error(DOMAIN_ERROR_ARRAY_TYPE, tprops, "create static array");
return (FALSE);
xarg *args =
Yap_ArgListToVector(tprops, create_array_defs, CREATE_ARRAY_NB_TERM,
DOMAIN_ERROR_CREATE_ARRAY_OPTION);
if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
Yap_Error(LOCAL_Error_TYPE, tprops, NULL);
}
} else {
Yap_Error(TYPE_ERROR_ATOM, tprops, "create static array");
return (FALSE);
return false;
}
if (args[CREATE_ARRAY_TYPE].used) {
tprops = args[CREATE_ARRAY_TYPE].tvalue;
{
char *atname = (char *)RepAtom(AtomOfTerm(tprops))->StrOfAE;
if (!strcmp(atname, "int"))
props = array_of_ints;
else if (!strcmp(atname, "dbref"))
props = array_of_dbrefs;
else if (!strcmp(atname, "float"))
props = array_of_doubles;
else if (!strcmp(atname, "ptr"))
props = array_of_ptrs;
else if (!strcmp(atname, "atom"))
props = array_of_atoms;
else if (!strcmp(atname, "char"))
props = array_of_chars;
else if (!strcmp(atname, "unsigned_char"))
props = array_of_uchars;
else if (!strcmp(atname, "term"))
props = array_of_terms;
else if (!strcmp(atname, "nb_term"))
props = array_of_nb_terms;
}
}
if (args[CREATE_ARRAY_ADDRESS].used) {
address = AddressOfTerm(args[CREATE_ARRAY_ADDRESS].tvalue);
}
if (args[CREATE_ARRAY_INT].used)
props = array_of_ints;
if (args[CREATE_ARRAY_DBREF].used)
props = array_of_dbrefs;
if (args[CREATE_ARRAY_FLOAT].used)
props = array_of_doubles;
if (args[CREATE_ARRAY_PTR].used)
props = array_of_ptrs;
if (args[CREATE_ARRAY_ATOM].used)
props = array_of_atoms;
if (args[CREATE_ARRAY_CHAR].used)
props = array_of_chars;
if (args[CREATE_ARRAY_UNSIGNED_CHAR].used)
props = array_of_uchars;
if (args[CREATE_ARRAY_TERM].used)
props = array_of_terms;
if (args[CREATE_ARRAY_NB_TERM].used)
props = array_of_nb_terms;
StaticArrayEntry *pp;
StaticArrayEntry *pp;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "create static array");
return (FALSE);
@ -1104,9 +1151,9 @@ static Int
app = (ArrayEntry *)pp;
if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
pp = CreateStaticArray(ae, size, props, NULL, pp PASS_REGS);
pp = CreateStaticArray(ae, size, props, address, pp PASS_REGS);
if (pp == NULL || pp->ValueOfVE.ints == NULL) {
return TRUE;
return TRUE;
}
} else if (ArrayIsDynamic(app)) {
if (IsVarTerm(app->ValueOfVE) && IsUnboundVar(&app->ValueOfVE)) {
@ -1115,24 +1162,25 @@ static Int
Yap_Error(PERMISSION_ERROR_CREATE_ARRAY, t,
"cannot create static array over dynamic array");
}
} else {
} else {
if (pp->ArrayType != props) {
Yap_Error(TYPE_ERROR_ATOM, t, "create static array %d/%d %d/%d", pp->ArrayEArity,size,pp->ArrayType,props);
pp = NULL;
Yap_Error(TYPE_ERROR_ATOM, t, "create static array %d/%d %d/%d",
pp->ArrayEArity, size, pp->ArrayType, props);
pp = NULL;
} else {
AllocateStaticArraySpace(pp, props, pp->ValueOfVE.ints, size PASS_REGS);
AllocateStaticArraySpace(pp, props, pp->ValueOfVE.ints, size PASS_REGS);
}
}
WRITE_UNLOCK(ae->ARWLock);
if (!pp) {
if (!pp) {
return false;
}
return true;
}
return true;
}
return false;
}
/// create a new vectir in a given name Name. If one exists, destroy prrexisting
/// create a new vector in a given name Name. If one exists, destroy prrexisting
/// onr
StaticArrayEntry *Yap_StaticVector(Atom Name, size_t size,
static_array_types props) {

2
C/atomic.c
View File

@ -326,7 +326,7 @@ restart_aux:
return false;
}
// verify if an atom, int, float or bi§gnnum
NewT = Yap_AtomicToListOfCodes(t1 PASS_REGS);
NewT = Yap_AtomSWIToListOfCodes(t1 PASS_REGS);
if (NewT) {
pop_text_stack(l);
return Yap_unify(NewT, ARG2);

2
C/attvar.c
View File

@ -193,7 +193,7 @@ static void WakeAttVar(CELL *pt1, CELL reg2 USES_REGS) {
if (!IsVarTerm(attv->Value) || !IsUnboundVar(&attv->Value)) {
/* oops, our goal is on the queue to be woken */
if (!Yap_unify(attv->Value, reg2)) {
AddFailToQueue(PASS_REGS1);
AddFailToQueue(PASS_REGS1);
}
return;
}

205
C/c_interface.c
View File

@ -218,6 +218,11 @@ X_API YAP_Term YAP_A(int i) {
return (Deref(XREGS[i]));
}
X_API YAP_Term YAP_SetA(int i, YAP_Term t) {
CACHE_REGS
return (Deref(XREGS[i]));
}
X_API YAP_Bool YAP_IsIntTerm(YAP_Term t) { return IsIntegerTerm(t); }
X_API YAP_Bool YAP_IsNumberTerm(YAP_Term t) {
@ -288,23 +293,23 @@ X_API Term YAP_MkIntTerm(Int n) {
}
X_API Term YAP_MkStringTerm(const char *n) {
CACHE_REGS
Term I;
BACKUP_H();
CACHE_REGS
Term I;
BACKUP_H();
I = MkStringTerm(n);
RECOVER_H();
return I;
I = MkStringTerm(n);
RECOVER_H();
return I;
}
X_API Term YAP_MkCharPTerm( char *n) {
CACHE_REGS
Term I;
BACKUP_H();
X_API Term YAP_MkCharPTerm(char *n) {
CACHE_REGS
Term I;
BACKUP_H();
I = MkStringTerm(n);
RECOVER_H();
return I;
I = MkStringTerm(n);
RECOVER_H();
return I;
}
X_API Term YAP_MkUnsignedStringTerm(const unsigned char *n) {
@ -1352,8 +1357,8 @@ X_API void YAP_FreeSpaceFromYap(void *ptr) { Yap_FreeCodeSpace(ptr); }
* @param bufsize bu
*
* @return
*/ X_API char *
YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) {
*/
X_API char *YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) {
CACHE_REGS
BACKUP_MACHINE_REGS();
seq_tv_t inp, out;
@ -1464,7 +1469,8 @@ X_API Term YAP_ReadBuffer(const char *s, Term *tp) {
else
tv = (Term)0;
LOCAL_ErrorMessage = NULL;
while (!(t = Yap_BufferToTermWithPrioBindings(s, TermNil, tv, strlen(s) + 1, GLOBAL_MaxPriority))) {
while (!(t = Yap_BufferToTermWithPrioBindings(s, TermNil, tv, strlen(s) + 1,
GLOBAL_MaxPriority))) {
if (LOCAL_ErrorMessage) {
if (!strcmp(LOCAL_ErrorMessage, "Stack Overflow")) {
if (!Yap_dogc(0, NULL PASS_REGS)) {
@ -1492,7 +1498,7 @@ X_API Term YAP_ReadBuffer(const char *s, Term *tp) {
return 0L;
}
LOCAL_ErrorMessage = NULL;
RECOVER_H();
RECOVER_H();
return 0;
} else {
break;
@ -1731,7 +1737,9 @@ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
CACHE_REGS
PredEntry *pe = ape;
bool out;
// fprintf(stderr,"EnterGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n",HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot);
// fprintf(stderr,"EnterGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
// Slots=%d\n",HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP,
// LOCAL_CurSlot);
BACKUP_MACHINE_REGS();
LOCAL_ActiveError->errorNo = YAP_NO_ERROR;
@ -1748,12 +1756,14 @@ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
// slot=%d", pe, pe->CodeOfPred->opc, FAILCODE, Deref(ARG1), Deref(ARG2),
// LOCAL_CurSlot);
dgi->b = LCL0 - (CELL *)B;
dgi->h = HR-H0;
dgi->tr = (CELL*)TR-LCL0;
//fprintf(stderr,"PrepGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n",
// HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot);
dgi->h = HR - H0;
dgi->tr = (CELL *)TR - LCL0;
// fprintf(stderr,"PrepGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n",
// HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot);
out = Yap_exec_absmi(true, false);
// fprintf(stderr,"EnterGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n", out,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot);
// fprintf(stderr,"EnterGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
// Slots=%d\n", out,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP,
// LOCAL_CurSlot);
dgi->b = LCL0 - (CELL *)B;
if (out) {
dgi->EndSlot = LOCAL_CurSlot;
@ -1768,13 +1778,13 @@ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) {
CACHE_REGS
choiceptr myB, myB0;
choiceptr myB, myB0;
bool out;
BACKUP_MACHINE_REGS();
myB = (choiceptr)(LCL0 - dgi->b);
myB0 = (choiceptr)(LCL0 - dgi->b0);
CP = myB->cp_cp;
CP = myB->cp_cp;
/* sanity check */
if (B >= myB0) {
return false;
@ -1783,8 +1793,8 @@ X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) {
// get rid of garbage choice-points
B = myB;
}
//fprintf(stderr,"RetryGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n",
// HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot);
// fprintf(stderr,"RetryGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n",
// HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot);
P = FAILCODE;
/* make sure we didn't leave live slots when we backtrack */
ASP = (CELL *)B;
@ -1792,7 +1802,7 @@ X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) {
out = run_emulator(PASS_REGS1);
if (out) {
dgi->EndSlot = LOCAL_CurSlot;
dgi->b = LCL0-(CELL *)B;
dgi->b = LCL0 - (CELL *)B;
} else {
LOCAL_CurSlot =
dgi->CurSlot; // ignore any slots created within the called goal
@ -1803,48 +1813,49 @@ X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) {
X_API bool YAP_LeaveGoal(bool successful, YAP_dogoalinfo *dgi) {
CACHE_REGS
choiceptr myB, handler;
choiceptr myB, handler;
// fprintf(stderr,"LeaveGoal success=%d: H=%d ENV=%p B=%ld myB=%ld TR=%d P=%p CP=%p Slots=%d\n", successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,dgi->b0,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot);
// fprintf(stderr,"LeaveGoal success=%d: H=%d ENV=%p B=%ld myB=%ld TR=%d
// P=%p CP=%p Slots=%d\n",
// successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,dgi->b0,(CELL*)TR-LCL0, P, CP,
// LOCAL_CurSlot);
BACKUP_MACHINE_REGS();
myB = (choiceptr)(LCL0 - dgi->b0);
myB = (choiceptr)(LCL0 - dgi->b);
if (LOCAL_PrologMode & AsyncIntMode) {
Yap_signal(YAP_FAIL_SIGNAL);
}
handler = B;
while (handler
//&& LOCAL_CBorder > LCL0 - (CELL *)handler
//&& handler->cp_ap != NOCODE
&& handler->cp_b != NULL
&& handler != myB
) {
handler->cp_ap = TRUSTFAILCODE;
while (handler &&
LCL0 - LOCAL_CBorder > (CELL *)handler
//&& handler->cp_ap != NOCODE
&& handler->cp_b != NULL && handler != myB) {
if (handler < myB) {
handler->cp_ap = TRUSTFAILCODE;
}
B = handler;
handler = handler->cp_b;
if (successful) {
Yap_TrimTrail();
} else if (!(LOCAL_PrologMode & AsyncIntMode)) {
P = FAILCODE;
Yap_exec_absmi(true, YAP_EXEC_ABSMI);
}
}
if (LOCAL_PrologMode & AsyncIntMode) {
Yap_signal(YAP_FAIL_SIGNAL);
}
B = handler;
if (successful) {
Yap_TrimTrail();
CP = dgi->cp;
P = dgi->p;
} else {
Yap_exec_absmi(true, YAP_EXEC_ABSMI);
LOCAL_CurSlot = dgi->CurSlot;
ENV = YENV = B->cp_env;
HR = B->cp_h;
TR = B->cp_tr;
// use the current choicepoint
// B=B->cp_b;
ASP=(CELL*)B;
}
P = dgi->p;
CP = dgi->cp;
RECOVER_MACHINE_REGS();
// fprintf(stderr,"LeftGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n", successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot);
// fprintf(stderr,"LeftGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
// Slots=%d\n", successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P,
// CP, LOCAL_CurSlot);
return TRUE;
}
X_API Int YAP_RunGoal(Term t) {
CACHE_REGS
Term out;
yamop *old_CP = CP;
yhandle_t cslot = LOCAL_CurSlot;
BACKUP_MACHINE_REGS();
@ -1854,24 +1865,6 @@ X_API Int YAP_RunGoal(Term t) {
LOCAL_PrologMode = UserCCallMode;
// should we catch the exception or pass it through?
// We'll pass it through
Yap_RaiseException();
if (out) {
P = (yamop *)ENV[E_CP];
ENV = (CELL *)ENV[E_E];
CP = old_CP;
LOCAL_AllowRestart = TRUE;
// we are back to user code again, need slots */
} else {
ENV = B->cp_env;
ENV = (CELL *)ENV[E_E];
CP = old_CP;
HR = B->cp_h;
TR = B->cp_tr;
B = B->cp_b;
LOCAL_AllowRestart = FALSE;
SET_ASP(ENV, E_CB * sizeof(CELL));
// make sure the slots are ok.
}
RECOVER_MACHINE_REGS();
LOCAL_CurSlot = cslot;
return out;
@ -1955,7 +1948,7 @@ X_API Int YAP_RunGoalOnce(Term t) {
CSlot = Yap_StartSlots();
LOCAL_PrologMode = UserMode;
// Yap_heap_regs->yap_do_low_level_trace=true;
out = Yap_RunTopGoal(t, true);
out = Yap_RunTopGoal(t, true);
LOCAL_PrologMode = oldPrologMode;
// Yap_CloseSlots(CSlot);
if (!(oldPrologMode & UserCCallMode)) {
@ -2111,14 +2104,16 @@ X_API void YAP_ClearExceptions(void) {
Yap_ResetException(worker_id);
}
X_API int YAP_InitConsult(int mode, const char *fname, char **full, int *osnop) {
X_API int YAP_InitConsult(int mode, const char *fname, char **full,
int *osnop) {
CACHE_REGS
int sno;
BACKUP_MACHINE_REGS();
const char *fl = NULL;
int lvl = push_text_stack();
if (mode == YAP_BOOT_MODE) {
mode = YAP_CONSULT_MODE; }
mode = YAP_CONSULT_MODE;
}
if (fname == NULL || fname[0] == '\0') {
fl = Yap_BOOTFILE;
}
@ -2129,26 +2124,27 @@ X_API int YAP_InitConsult(int mode, const char *fname, char **full, int *osnop)
*full = NULL;
return -1;
} else {
*full = pop_output_text_stack(lvl,fl);
*full = pop_output_text_stack(lvl, fl);
}
} else {
pop_text_stack(lvl);
pop_text_stack(lvl);
}
lvl = push_text_stack();
char *d = Malloc(strlen(fl)+1);
strcpy(d,fl);
bool consulted = (mode == YAP_CONSULT_MODE);
char *d = Malloc(strlen(fl) + 1);
strcpy(d, fl);
bool consulted = (mode == YAP_CONSULT_MODE);
Term tat = MkAtomTerm(Yap_LookupAtom(d));
sno = Yap_OpenStream(tat, "r", MkAtomTerm(Yap_LookupAtom(fname)), LOCAL_encoding);
if (sno < 0 ||
!Yap_ChDir(dirname((char *)d))) {
pop_text_stack(lvl);
*full = NULL;
return -1;
} LOCAL_PrologMode = UserMode;
sno = Yap_OpenStream(tat, "r", MkAtomTerm(Yap_LookupAtom(fname)),
LOCAL_encoding);
if (sno < 0 || !Yap_ChDir(dirname((char *)d))) {
pop_text_stack(lvl);
*full = NULL;
return -1;
}
LOCAL_PrologMode = UserMode;
Yap_init_consult(consulted, pop_output_text_stack__(lvl,fl));
Yap_init_consult(consulted, pop_output_text_stack__(lvl, fl));
RECOVER_MACHINE_REGS();
UNLOCK(GLOBAL_Stream[sno].streamlock);
return sno;
@ -2176,16 +2172,19 @@ X_API void YAP_EndConsult(int sno, int *osnop, const char *full) {
BACKUP_MACHINE_REGS();
Yap_CloseStream(sno);
int lvl = push_text_stack();
char *d = Malloc(strlen(full)+1);
strcpy(d,full);
char *d = Malloc(strlen(full) + 1);
strcpy(d, full);
Yap_ChDir(dirname(d));
if (osnop >= 0)
Yap_AddAlias(AtomLoopStream, *osnop);
Yap_end_consult();
__android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " closing %s:%s(%d), %d",
CurrentModule == 0? "prolog": RepAtom(AtomOfTerm(CurrentModule))->StrOfAE, full, *osnop, sno);
// LOCAL_CurSlot);
pop_text_stack(lvl);
__android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " closing %s:%s(%d), %d",
CurrentModule == 0
? "prolog"
: RepAtom(AtomOfTerm(CurrentModule))->StrOfAE,
full, *osnop, sno);
// LOCAL_CurSlot);
pop_text_stack(lvl);
RECOVER_MACHINE_REGS();
}
@ -2212,7 +2211,13 @@ X_API Term YAP_ReadFromStream(int sno) {
X_API Term YAP_ReadClauseFromStream(int sno, Term vs, Term pos) {
BACKUP_MACHINE_REGS();
Term t = Yap_read_term(sno,MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames,1),1,&vs), MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition,1),1,&pos), TermNil)), true);
Term t = Yap_read_term(
sno,
MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &vs),
MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition, 1),
1, &pos),
TermNil)),
true);
RECOVER_MACHINE_REGS();
return t;
}
@ -2272,7 +2277,7 @@ X_API int YAP_WriteDynamicBuffer(YAP_Term t, char *buf, size_t sze,
BACKUP_MACHINE_REGS();
b = Yap_TermToBuffer(t, flags);
strncpy(buf, b, sze-1);
strncpy(buf, b, sze - 1);
buf[sze] = 0;
RECOVER_MACHINE_REGS();
return true;
@ -2312,7 +2317,7 @@ X_API bool YAP_CompileClause(Term t) {
}
RECOVER_MACHINE_REGS();
if (!ok) {
return NULL;
return NULL;
}
return ok;
}
@ -2537,12 +2542,12 @@ X_API int YAP_HaltRegisterHook(HaltHookFunc hook, void *closure) {
X_API char *YAP_cwd(void) {
CACHE_REGS
char *buf = Yap_AllocCodeSpace(FILENAME_MAX+1);
char *buf = Yap_AllocCodeSpace(FILENAME_MAX + 1);
int len;
if (!Yap_getcwd(buf, FILENAME_MAX))
return FALSE;
len = strlen(buf);
buf = Yap_ReallocCodeSpace(buf,len+1);
buf = Yap_ReallocCodeSpace(buf, len + 1);
return buf;
}

314
C/cdmgr.c
View File

@ -1,4 +1,3 @@
/*************************************************************************
* *
* YAP Prolog *
@ -33,10 +32,10 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#if HAVE_STRING_H
#include <string.h>
#endif
#include <Yatom.h>
#include <assert.h>
#include <heapgc.h>
#include <iopreds.h>
#include <Yatom.h>
static void retract_all(PredEntry *, int);
static void add_first_static(PredEntry *, yamop *, int);
@ -78,7 +77,7 @@ static void kill_first_log_iblock(LogUpdIndex *, LogUpdIndex *, PredEntry *);
static void InitConsultStack(void) {
CACHE_REGS
LOCAL_ConsultLow = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj) *
InitialConsultCapacity);
InitialConsultCapacity);
if (LOCAL_ConsultLow == NULL) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "No Heap Space in InitCodes");
return;
@ -95,20 +94,32 @@ void Yap_ResetConsultStack(void) {
LOCAL_ConsultCapacity = InitialConsultCapacity;
}
/**
* Are we compiling a file?
*
*/
bool Yap_Consulting(USES_REGS1) {
return LOCAL_ConsultBase != NULL
&& LOCAL_ConsultSp != LOCAL_ConsultLow+LOCAL_ConsultCapacity;
}
/******************************************************************
ADDING AND REMOVE INFO TO A PROCEDURE
******************************************************************/
/*
* we have three kinds of predicates: dynamic DynamicPredFlag
* static CompiledPredFlag fast FastPredFlag all the
/**
* we have three kinds of predicates:
* + dynamic DynamicPredFlag
* + static CompiledPredFlag fast
* + fast FastPredFlag.
*
* all the
* database predicates are supported for dynamic predicates only abolish and
* assertz are supported for static predicates no database predicates are
* supportted for fast predicates
*/
PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) {
Term t0 = t;
@ -252,9 +263,9 @@ void Yap_BuildMegaClause(PredEntry *ap) {
if (ap->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MegaClausePredFlag
#ifdef TABLING
| TabledPredFlag
| TabledPredFlag
#endif /* TABLING */
| UDIPredFlag) ||
| UDIPredFlag) ||
ap->cs.p_code.FirstClause == NULL || ap->cs.p_code.NOfClauses < 16) {
return;
}
@ -1387,7 +1398,7 @@ static void expand_consult(void) {
new_cs = new_cl + InitialConsultCapacity;
/* start copying */
memmove((void *)new_cs, (void *)LOCAL_ConsultLow,
OldConsultCapacity * sizeof(consult_obj));
OldConsultCapacity * sizeof(consult_obj));
/* copying done, release old space */
Yap_FreeCodeSpace((char *)LOCAL_ConsultLow);
/* next, set up pointers correctly */
@ -1453,33 +1464,36 @@ static int not_was_reconsulted(PredEntry *p, Term t, int mode) {
return TRUE; /* careful */
}
static yamop * addcl_permission_error(const char *file, const char *function, int lineno, AtomEntry *ap, Int Arity, int in_use) {
static yamop *addcl_permission_error(const char *file, const char *function,
int lineno, AtomEntry *ap, Int Arity,
int in_use) {
CACHE_REGS
Term culprit;
if (Arity == 0)
culprit = MkAtomTerm(AbsAtom(ap));
else
culprit = Yap_MkNewApplTerm(Yap_MkFunctor(AbsAtom(ap),Arity), Arity);
return
(in_use ?
(Arity == 0 ?
Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit,
"static predicate %s is in use", ap->StrOfAE)
:
Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit,
"static predicate %s/" Int_FORMAT " is in use", ap->StrOfAE, Arity)
)
:
(Arity == 0 ?
Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit,
"system predicate %s is in use", ap->StrOfAE)
:
Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit,
"system predicate %s/" Int_FORMAT, ap->StrOfAE, Arity)
)
);
}
Term culprit;
if (Arity == 0)
culprit = MkAtomTerm(AbsAtom(ap));
else
culprit = Yap_MkNewApplTerm(Yap_MkFunctor(AbsAtom(ap), Arity), Arity);
return (in_use
? (Arity == 0
? Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "static predicate %s is in use",
ap->StrOfAE)
: Yap_Error__(
false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit,
"static predicate %s/" Int_FORMAT " is in use",
ap->StrOfAE, Arity))
: (Arity == 0
? Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "system predicate %s is in use",
ap->StrOfAE)
: Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "system predicate %s/" Int_FORMAT,
ap->StrOfAE, Arity)));
}
PredEntry *Yap_PredFromClause(Term t USES_REGS) {
Term cmod = LOCAL_SourceModule;
@ -1650,7 +1664,7 @@ Atom Yap_source_file_name(void) {
}
/**
* @brief we cannot add clauses to the proceduree
* @brief we cannot add clauses to the procedure
*
* @param p predicate
*
@ -1738,7 +1752,8 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref)
PELOCK(20, p);
/* we are redefining a prolog module predicate */
if (Yap_constPred(p)) {
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), Arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), Arity,
FALSE);
UNLOCKPE(30, p);
return false;
}
@ -1768,7 +1783,8 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref)
disc[2] = Yap_Module_Name(p);
sc[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomDiscontiguous, 3), 3, disc);
sc[1] = MkIntegerTerm(Yap_source_line_no());
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "source %s ", RepAtom(LOCAL_SourceFileName)->StrOfAE);
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "source %s ",
RepAtom(LOCAL_SourceFileName)->StrOfAE);
sc[2] = MkAtomTerm(LOCAL_SourceFileName);
sc[3] = t;
t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, sc);
@ -2044,7 +2060,7 @@ static Int p_compile(USES_REGS1) { /* '$compile'(+C,+Flags,+C0,-Ref) */
Yap_addclause(t, code_adr, t1, mod, &ARG5);
YAPLeaveCriticalSection();
}
if (LOCAL_ErrorMessage ) {
if (LOCAL_ErrorMessage) {
Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
YAPLeaveCriticalSection();
return false;
@ -2436,12 +2452,14 @@ static Int new_multifile(USES_REGS1) {
}
if (pe->PredFlags & (TabledPredFlag | ForeignPredFlags)) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__,RepAtom(at), arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
FALSE);
return false;
}
if (pe->cs.p_code.NOfClauses) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__,RepAtom(at), arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
FALSE);
return false;
}
pe->PredFlags &= ~UndefPredFlag;
@ -2675,7 +2693,8 @@ static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
(UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)) {
UNLOCKPE(30, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__,RepAtom(at), arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
FALSE);
return false;
}
if (pe->PredFlags & LogUpdatePredFlag) {
@ -2688,7 +2707,8 @@ static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
}
if (pe->cs.p_code.NOfClauses != 0) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
FALSE);
return false;
}
if (pe->OpcodeOfPred == UNDEF_OPCODE) {
@ -2738,7 +2758,8 @@ static Int new_meta_pred(USES_REGS1) {
}
if (pe->cs.p_code.NOfClauses) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
FALSE);
return false;
}
pe->PredFlags |= MetaPredFlag;
@ -3082,133 +3103,100 @@ static Int p_clean_up_dead_clauses(USES_REGS1) {
void Yap_HidePred(PredEntry *pe) {
if (pe->PredFlags & HiddenPredFlag)
return;
pe->PredFlags |= (HiddenPredFlag | NoSpyPredFlag | NoTracePredFlag);
}
if (pe->NextOfPE) {
UInt hash = PRED_HASH(pe->FunctorOfPred, CurrentModule, PredHashTableSize);
READ_LOCK(PredHashRWLock);
PredEntry *p, **op = PredHash + hash;
p = *op;
static Int /* $system_predicate(P) */
p_stash_predicate(USES_REGS1) {
PredEntry *pe;
Term t1 = Deref(ARG1);
Term mod = Deref(ARG2);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
Atom a = AtomOfTerm(t1);
pe = RepPredProp(Yap_GetPredPropByAtom(a, mod));
} else if (IsApplTerm(t1)) {
Functor funt = FunctorOfTerm(t1);
if (IsExtensionFunctor(funt)) {
return (FALSE);
}
if (funt == FunctorModule) {
Term nmod = ArgOfTerm(1, t1);
if (IsVarTerm(nmod)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "hide_predicate/1");
return (FALSE);
while (p) {
if (p == pe) {
*op = p->NextPredOfHash;
break;
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG1, "hide_predicate/1");
return (FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
op = &p->NextPredOfHash;
p = p->NextPredOfHash;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
} else if (IsPairTerm(t1)) {
return TRUE;
} else
return FALSE;
if (EndOfPAEntr(pe))
return FALSE;
Yap_HidePred(pe);
return TRUE;
}
static Int /* $system_predicate(P) */
hide_predicate(USES_REGS1) {
PredEntry *pe;
Term t1 = Deref(ARG1);
Term mod = Deref(ARG2);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
Atom a = AtomOfTerm(t1);
pe = RepPredProp(Yap_GetPredPropByAtom(a, mod));
} else if (IsApplTerm(t1)) {
Functor funt = FunctorOfTerm(t1);
if (IsExtensionFunctor(funt)) {
return (FALSE);
pe->NextPredOfHash = NULL;
}
{
Prop *op, p;
if (pe->ArityOfPE == 0) {
op = &RepAtom(AtomOfTerm((Term)(pe->FunctorOfPred)))->PropsOfAE;
} else {
op = &pe->FunctorOfPred->PropsOfFE;
}
if (funt == FunctorModule) {
Term nmod = ArgOfTerm(1, t1);
if (IsVarTerm(nmod)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "hide_predicate/1");
return (FALSE);
p = *op;
while (p) {
if (p == AbsPredProp(pe)) {
*op = p->NextOfPE;
break;
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG1, "hide_predicate/1");
return (FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
op = &p->NextOfPE;
p = p->NextOfPE;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
} else if (IsPairTerm(t1)) {
return true;
} else
return false;
if (EndOfPAEntr(pe))
return false;
pe->PredFlags |= (HiddenPredFlag | NoSpyPredFlag | NoTracePredFlag);
return true;
pe->NextOfPE = RepAtom(AtomFoundVar)->PropsOfAE;
RepAtom(AtomFoundVar)->PropsOfAE = AbsPredProp(pe);
}
{
PredEntry *p,
**op = &Yap_GetModuleEntry(Yap_Module(pe->ModuleOfPred))->PredForME;
p = *op;
while (p) {
if (p == pe) {
*op = p->NextPredOfModule;
break;
}
op = &p->NextPredOfModule;
p = p->NextPredOfModule;
}
pe->NextPredOfModule = NULL;
}
}
static Int /* $hidden_predicate(P) */
p_hidden_predicate(USES_REGS1) {
PredEntry *pe;
Term t1 = Deref(ARG1);
Term mod = Deref(ARG2);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
pe = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t1), mod));
} else if (IsApplTerm(t1)) {
Functor funt = FunctorOfTerm(t1);
if (IsExtensionFunctor(funt)) {
return (FALSE);
}
if (funt == FunctorModule) {
Term nmod = ArgOfTerm(1, t1);
if (IsVarTerm(nmod)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "hide_predicate/1");
return (FALSE);
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG1, "hide_predicate/1");
return (FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
} else if (IsPairTerm(t1)) {
return (TRUE);
hide_predicate(USES_REGS1) {
PredEntry *pe =
Yap_get_pred(Deref(ARG1), Deref(ARG2), "while checking for a procedure");
if (pe) {
Yap_HidePred(pe);
return true;
} else
return (FALSE);
if (EndOfPAEntr(pe))
return (FALSE);
return (pe->PredFlags & HiddenPredFlag);
return false;
}
static Int /* $hidden_predicate(P) */
stash_predicate(USES_REGS1) {
PredEntry *pe =
Yap_get_pred(Deref(ARG1), Deref(ARG2), "while checking for a procedure");
if (pe) {
pe->PredFlags |= (HiddenPredFlag | NoSpyPredFlag | NoTracePredFlag);
/*
char ns[1024];
const char *s = (pe->ModuleOfPred == PROLOG_MODULE ?
"__prolog__stash__" :
snprintf(sn,1023,"__%s__".RepAtom(AtomOfTerm(
pe->ModuleOfPred )))); pe->ModuleOfPred = MkAtomTerm(Yap_LookupAtom(s));
*/
return true;
} else
return false;
}
static Int /* $hidden_predicate(P) */
hidden_predicate(USES_REGS1) {
PredEntry *pe =
Yap_get_pred(Deref(ARG1), Deref(ARG2), "while checking for a procedure");
if (pe)
return (pe->PredFlags & HiddenPredFlag);
else
return false;
}
static Int fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb,
@ -4799,8 +4787,8 @@ void Yap_InitCdMgr(void) {
Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
Yap_InitCPred("$set_pred_owner", 2, p_set_pred_owner, SafePredFlag);
Yap_InitCPred("$hide_predicate", 2, hide_predicate, SafePredFlag);
Yap_InitCPred("$stash_predicate", 2, p_stash_predicate, SafePredFlag);
Yap_InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag);
Yap_InitCPred("$stash_predicate", 2, stash_predicate, SafePredFlag);
Yap_InitCPred("$hidden_predicate", 2, hidden_predicate, SafePredFlag);
Yap_InitCPred("$log_update_clause", 4, p_log_update_clause, SyncPredFlag);
Yap_InitCPred("$continue_log_update_clause", 5, p_continue_log_update_clause,
SafePredFlag | SyncPredFlag);

3
C/control_absmi_insts.h
View File

@ -427,6 +427,8 @@ ructions *
Op(deallocate, p);
CACHE_Y_AS_ENV(YREG);
// do this before checking
SREG = YREG;
check_trail(TR);
#ifndef NO_CHECKING
/* check stacks */
@ -435,7 +437,6 @@ ructions *
PREG = NEXTOP(PREG, p);
/* other instructions do depend on S being set by deallocate
:-( */
SREG = YREG;
CPREG = (yamop *) ENV_YREG[E_CP];
ENV = ENV_YREG = (CELL *) ENV_YREG[E_E];
#ifdef DEPTH_LIMIT

158
C/dbase.c
View File

@ -25,91 +25,87 @@ static char SccsId[] = "%W% %G%";
*
* @brief record and other forms of storing terms.
*
* @namespace prolog
*
*
*
*/
/** @defgroup Internal_Database Internal Data Base
@ingroup builtins
@{
Some programs need global information for, e.g. counting or collecting
data obtained by backtracking. As a rule, to keep this information, the
internal data base should be used instead of asserting and retracting
clauses (as most novice programmers do), .
In YAP (as in some other Prolog systems) the internal data base (i.d.b.
for short) is faster, needs less space and provides a better insulation of
program and data than using asserted/retracted clauses.
The i.d.b. is implemented as a set of terms, accessed by keys that
unlikely what happens in (non-Prolog) data bases are not part of the
term. Under each key a list of terms is kept. References are provided so that
terms can be identified: each term in the i.d.b. has a unique reference
(references are also available for clauses of dynamic predicates).
There is a strong analogy between the i.d.b. and the way dynamic
predicates are stored. In fact, the main i.d.b. predicates might be
implemented using dynamic predicates:
~~~~~
recorda(X,T,R) :- asserta(idb(X,T),R).
recordz(X,T,R) :- assertz(idb(X,T),R).
recorded(X,T,R) :- clause(idb(X,T),R).
~~~~~
We can take advantage of this, the other way around, as it is quite
easy to write a simple Prolog interpreter, using the i.d.b.:
~~~~~
asserta(G) :- recorda(interpreter,G,_).
assertz(G) :- recordz(interpreter,G,_).
retract(G) :- recorded(interpreter,G,R), !, erase(R).
call(V) :- var(V), !, fail.
call((H :- B)) :- !, recorded(interpreter,(H :- B),_), call(B).
call(G) :- recorded(interpreter,G,_).
~~~~~
In YAP, much attention has been given to the implementation of the
i.d.b., especially to the problem of accelerating the access to terms kept in
a large list under the same key. Besides using the key, YAP uses an internal
lookup function, transparent to the user, to find only the terms that might
unify. For instance, in a data base containing the terms
~~~~~
b
b(a)
c(d)
e(g)
b(X)
e(h)
~~~~~
stored under the key k/1, when executing the query
~~~~~
:- recorded(k(_),c(_),R).
~~~~~
`recorded` would proceed directly to the third term, spending almost the
time as if `a(X)` or `b(X)` was being searched.
The lookup function uses the functor of the term, and its first three
arguments (when they exist). So, `recorded(k(_),e(h),_)` would go
directly to the last term, while `recorded(k(_),e(_),_)` would find
first the fourth term, and then, after backtracking, the last one.
This mechanism may be useful to implement a sort of hierarchy, where
the functors of the terms (and eventually the first arguments) work as
secondary keys.
In the YAP's i.d.b. an optimized representation is used for
terms without free variables. This results in a faster retrieval of terms
and better space usage. Whenever possible, avoid variables in terms in terms
stored in the i.d.b.
*/
*
* @ingroup builtins
* @{
*
* Some programs need global information for, e.g. counting or collecting
* data obtained by backtracking. As a rule, to keep this information, the
* internal data base should be used instead of asserting and retracting
* clauses (as most novice programmers do), .
* In YAP (as in some other Prolog systems) the internal data base (i.d.b.
* for short) is faster, needs less space and provides a better insulation of
* program and data than using asserted/retracted clauses.
* The i.d.b. is implemented as a set of terms, accessed by keys that
* unlikely what happens in (non-Prolog) data bases are not part of the
* term. Under each key a list of terms is kept. References are provided so that
* terms can be identified: each term in the i.d.b. has a unique reference
* (references are also available for clauses of dynamic predicates).
*
* There is a strong analogy between the i.d.b. and the way dynamic
* predicates are stored. In fact, the main i.d.b. predicates might be
* implemented using dynamic predicates:
*
* ~~~~~
* recorda(X,T,R) :- asserta(idb(X,T),R).
* recordz(X,T,R) :- assertz(idb(X,T),R).
* recorded(X,T,R) :- clause(idb(X,T),R).
* ~~~~~
* We can take advantage of this, the other way around, as it is quite
* easy to write a simple Prolog interpreter, using the i.d.b.:
*
* ~~~~~
* asserta(G) :- recorda(interpreter,G,_).
* assertz(G) :- recordz(interpreter,G,_).
* retract(G) :- recorded(interpreter,G,R), !, erase(R).
* call(V) :- var(V), !, fail.
* call((H :- B)) :- !, recorded(interpreter,(H :- B),_), call(B).
* call(G) :- recorded(interpreter,G,_).
* ~~~~~
* In YAP, much attention has been given to the implementation of the
* i.d.b., especially to the problem of accelerating the access to terms kept in
* a large list under the same key. Besides using the key, YAP uses an internal
* lookup function, transparent to the user, to find only the terms that might
* unify. For instance, in a data base containing the terms
*
* ~~~~~
* b
* b(a)
* c(d)
* e(g)
* b(X)
* e(h)
* ~~~~~
*
* stored under the key k/1, when executing the query
*
* ~~~~~
* :- recorded(k(_),c(_),R).
* ~~~~~
*
* `recorded` would proceed directly to the third term, spending almost the
* time as if `a(X)` or `b(X)` was being searched.
* The lookup function uses the functor of the term, and its first three
* arguments (when they exist). So, `recorded(k(_),e(h),_)` would go
* directly to the last term, while `recorded(k(_),e(_),_)` would find
* first the fourth term, and then, after backtracking, the last one.
*
* This mechanism may be useful to implement a sort of hierarchy, where
* the functors of the terms (and eventually the first arguments) work as
* secondary keys.
*
* In the YAP's i.d.b. an optimized representation is used for
* terms without free variables. This results in a faster retrieval of terms
* and better space usage. Whenever possible, avoid variables in terms in terms
* stored in the i.d.b.
*
*
*
*/
#include "Yap.h"
#include "attvar.h"

200
C/errors.c
View File

@ -35,7 +35,7 @@
#define set_key_b(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \
i->k = t == TermTrue ? true : false; \
i->k = ( t == TermTrue ? true : false); \
return i->k || t == TermFalse; \
}
@ -67,40 +67,44 @@ static bool setErr(const char *q, yap_error_descriptor_t *i, Term t) {
set_key_s(errorFunction, "errorFunction", q, i, t);
set_key_s(errorFile, "errorFile", q, i, t);
set_key_i(prologPredLine, "prologPredLine", q, i, t);
set_key_i(prologPredFirstLine, "prologPredFirstLine", q, i, t);
set_key_i(prologPredLastLine, "prologPredLastLine", q, i, t);
set_key_s(prologPredName, "prologPredName", q, i, t);
set_key_i(prologPredArity, "prologPredArity", q, i, t);
set_key_s(prologPredModule, "prologPredModule", q, i, t);
set_key_s(prologPredFile, "prologPredFile", q, i, t);
set_key_i(prologParserPos, "prologParserPos", q, i, t);
set_key_i(prologParserLine, "prologParserLine", q, i, t);
set_key_i(prologParserFirstLine, "prologParserFirstLine", q, i, t);
set_key_i(prologParserLastLine, "prologParserLastLine", q, i, t);
set_key_s(prologParserText, "prologParserText", q, i, t);
set_key_s(prologParserFile, "prologParserFile", q, i, t);
set_key_i(parserPos, "parserPos", q, i, t);
set_key_i(parserLine, "parserLine", q, i, t);
set_key_i(parserFirstLine, "parserFirstLine", q, i, t);
set_key_i(parserLastLine, "parserLastLine", q, i, t);
set_key_s(parserTextA, "parserTextA", q, i, t);
set_key_s(parserTextB, "parserTextB", q, i, t);
set_key_s(parserFile, "parserFile", q, i, t);
set_key_b(parserReadingCode, "parserReadingcode", q, i, t);
set_key_b(prologConsulting, "prologConsulting", q, i, t);
set_key_s(culprit, "culprit", q, i, t);
set_key_s(prologStack, "prologStack", q, i, t);
set_key_s(errorMsg, "errorMsg", q, i, t);
set_key_i(errorMsgLen, "errorMsgLen", q, i, t);
return false;
}
#define query_key_b(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \
#define query_key_b(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \
return i->k ? TermTrue : TermFalse; \
}
#define query_key_i(k, ks, q, i) if (strcmp(ks, q) == 0) { \
#define query_key_i(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \
return MkIntegerTerm(i->k); \
}
#define query_key_s(k, ks, q, i) \
if (strcmp(ks, q) == 0 && i->k) { \
return MkAtomTerm(Yap_LookupAtom(i->k)); } else {return TermNil;}
#define query_key_s(k, ks, q, i) \
if (strcmp(ks, q) == 0 ) \
{ if (i->k) return MkAtomTerm(Yap_LookupAtom(i->k)); else return TermNil; }
#define query_key_t(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \
if (i->k == NULL) return TermNil; \
Term t; if((t = Yap_BufferToTerm(i->k, TermNil) ) == 0 ) return TermNil; return t; }
static Term queryErr(const char *q, yap_error_descriptor_t *i) {
@ -113,20 +117,21 @@ static Term queryErr(const char *q, yap_error_descriptor_t *i) {
query_key_s(errorFunction, "errorFunction", q, i);
query_key_s(errorFile, "errorFile", q, i);
query_key_i(prologPredLine, "prologPredLine", q, i);
query_key_i(prologPredFirstLine, "prologPredFirstLine", q, i);
query_key_i(prologPredLastLine, "prologPredLastLine", q, i);
query_key_s(prologPredName, "prologPredName", q, i);
query_key_i(prologPredArity, "prologPredArity", q, i);
query_key_s(prologPredModule, "prologPredModule", q, i);
query_key_s(prologPredFile, "prologPredFile", q, i);
query_key_i(prologParserPos, "prologParserPos", q, i);
query_key_i(prologParserLine, "prologParserLine", q, i);
query_key_i(prologParserFirstLine, "prologParserFirstLine", q, i);
query_key_i(prologParserLastLine, "prologParserLastLine", q, i);
query_key_s(prologParserText, "prologParserText", q, i);
query_key_s(prologParserFile, "prologParserFile", q, i);
query_key_i(parserPos, "parserPos", q, i);
query_key_i(parserLine, "parserLine", q, i);
query_key_i(parserFirstLine, "parserFirstLine", q, i);
query_key_i(parserLastLine, "parserLastLine", q, i);
query_key_s(parserTextA, "parserTextA", q, i);
query_key_s(parserTextB, "parserTextB", q, i);
query_key_s(parserFile, "parserFile", q, i);
query_key_b(parserReadingCode, "parserReadingCode", q, i);
query_key_b(prologConsulting, "prologConsulting", q, i);
query_key_t(culprit, "culprit", q, i);
query_key_s(prologStack, "prologStack", q, i);
query_key_s(culprit, "culprit", q, i);
query_key_s(errorMsg, "errorMsg", q, i);
query_key_i(errorMsgLen, "errorMsgLen", q, i);
return TermNil;
@ -159,20 +164,21 @@ static void printErr(yap_error_descriptor_t *i) {
print_key_s("errorFunction", i->errorFunction);
print_key_s("errorFile", i->errorFile);
print_key_i("prologPredLine", i->prologPredLine);
print_key_i("prologPredFirstLine", i->prologPredFirstLine);
print_key_i("prologPredLastLine", i->prologPredLastLine);
print_key_s("prologPredName", i->prologPredName);
print_key_i("prologPredArity", i->prologPredArity);
print_key_s("prologPredModule", i->prologPredModule);
print_key_s("prologPredFile", i->prologPredFile);
print_key_i("prologParserPos", i->prologParserPos);
print_key_i("prologParserLine", i->prologParserLine);
print_key_i("prologParserFirstLine", i->prologParserFirstLine);
print_key_i("prologParserLastLine", i->prologParserLastLine);
print_key_s("prologParserText", i->prologParserText);
print_key_s("prologParserFile", i->prologParserFile);
print_key_i("parserPos", i->parserPos);
print_key_i("parserLine", i->parserLine);
print_key_i("parserFirstLine", i->parserFirstLine);
print_key_i("parserLastLine", i->parserLastLine);
print_key_s("parserTextA", i->parserTextA);
print_key_s("parserTextB", i->parserTextB);
print_key_s("parserFile", i->parserFile);
print_key_b("parserReadingCode", i->parserReadingCode);
print_key_b("prologConsulting", i->prologConsulting);
print_key_s("culprit", i->culprit);
print_key_s("prologStack", i->prologStack);
if (i->errorMsgLen) {
print_key_s("errorMsg", i->errorMsg);
print_key_i("errorMsgLen", i->errorMsgLen);
@ -217,20 +223,21 @@ static Term err2list(yap_error_descriptor_t *i) {
o = add_key_s("errorFunction", i->errorFunction, o);
o = add_key_s("errorFile", i->errorFile, o);
o = add_key_i("prologPredLine", i->prologPredLine, o);
o = add_key_i("prologPredFirstLine", i->prologPredFirstLine, o);
o = add_key_i("prologPredLastLine", i->prologPredLastLine, o);
o = add_key_s("prologPredName", i->prologPredName, o);
o = add_key_i("prologPredArity", i->prologPredArity, o);
o = add_key_s("prologPredModule", i->prologPredModule, o);
o = add_key_s("prologPredFile", i->prologPredFile, o);
o = add_key_i("prologParserPos", i->prologParserPos, o);
o = add_key_i("prologParserLine", i->prologParserLine, o);
o = add_key_i("prologParserFirstLine", i->prologParserFirstLine, o);
o = add_key_i("prologParserLastLine", i->prologParserLastLine, o);
o = add_key_s("prologParserText", i->prologParserText, o);
o = add_key_s("prologParserFile", i->prologParserFile, o);
o = add_key_i("parserPos", i->parserPos, o);
o = add_key_i("parserLine", i->parserLine, o);
o = add_key_i("parserFirstLine", i->parserFirstLine, o);
o = add_key_i("parserLastLine", i->parserLastLine, o);
o = add_key_s("parserTextA", i->parserTextA, o);
o = add_key_s("parserTextB", i->parserTextB, o);
o = add_key_s("parserFile", i->parserFile, o);
o = add_key_b("parserReadingCode", i->parserReadingCode, o);
o = add_key_b("prologConsulting", i->prologConsulting, o);
o = add_key_s("culprit", i->culprit, o);
o = add_key_s("prologStack", i->prologStack, o);
if (i->errorMsgLen) {
o = add_key_s("errorMsg", i->errorMsg, o);
o = add_key_i("errorMsgLen", i->errorMsgLen, o);
@ -314,7 +321,7 @@ void Yap_InitError__(const char *file, const char *function, int lineno,
if (fmt) {
LOCAL_Error_Size = strlen(tmpbuf);
LOCAL_ActiveError->errorMsg = malloc(LOCAL_Error_Size + 1);
strcpy(LOCAL_ActiveError->errorMsg, tmpbuf);
strcpy((char *)LOCAL_ActiveError->errorMsg, tmpbuf);
} else {
LOCAL_Error_Size = 0;
}
@ -331,18 +338,20 @@ bool Yap_PrintWarning(Term twarning) {
Term ts[2], err;
if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError &&
LOCAL_ActiveError->errorClass != WARNING &&
(err = LOCAL_ActiveError->errorNo)) {
fprintf(stderr, "%% Warning %s while processing error: %s %s\n",
Yap_TermToBuffer(twarning,
Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f),
Quote_illegal_f | Ignore_ops_f),
Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err));
return false;
}
LOCAL_PrologMode |= InErrorMode;
if (pred->OpcodeOfPred == UNDEF_OPCODE || pred->OpcodeOfPred == FAIL_OPCODE) {
fprintf(stderr, "warning message:\n");
Yap_DebugPlWrite(twarning);
fprintf(stderr, "\n");
fprintf(stderr, "%s:%ld/* d:%d warning */:\n",
LOCAL_ActiveError->errorFile,
LOCAL_ActiveError->errorLine, 0 );
Yap_DebugPlWriteln(twarning);
LOCAL_DoingUndefp = false;
LOCAL_PrologMode &= ~InErrorMode;
CurrentModule = cmod;
@ -420,9 +429,7 @@ int Yap_SWIHandleError(const char *s, ...) {
yap_error_number err = LOCAL_Error_TYPE;
char *serr;
if (LOCAL_ErrorMessage) {
serr = LOCAL_ErrorMessage;
} else {
if (s) {
serr = (char *)s;
}
switch (err) {
@ -521,6 +528,7 @@ static char tmpbuf[YAP_BUF_SIZE];
#define BEGIN_ERRORS() \
static Term mkerrort(yap_error_number e, Term culprit, Term info) { \
if (!e || !info) return TermNil; \
switch (e) {
#define E0(A, B) \
@ -571,9 +579,12 @@ static char tmpbuf[YAP_BUF_SIZE];
#include "YapErrors.h"
bool Yap_pushErrorContext(bool pass, yap_error_descriptor_t *new_error) {
/// add a new error descriptor, either to the top of the stack,
/// or replacing the top;
bool Yap_pushErrorContext(bool link , yap_error_descriptor_t *new_error) {
memset(new_error, 0, sizeof(yap_error_descriptor_t));
new_error->top_error = LOCAL_ActiveError;
if (link)
new_error->top_error = LOCAL_ActiveError;
LOCAL_ActiveError = new_error;
return true;
}
@ -594,6 +605,7 @@ yap_error_descriptor_t *Yap_popErrorContext(bool mdnew, bool pass) {
memmove(ep, e, sizeof(*e));
ep->top_error = epp;
}
free(e);
return LOCAL_ActiveError;
}
/**
@ -621,7 +633,7 @@ void Yap_ThrowError__(const char *file, const char *function, int lineno,
// fprintf(stderr, "warning: ");
Yap_Error__(true, file, function, lineno, type, where, tmpbuf);
} else {
Yap_Error__(true, file, function, lineno, type, where);
Yap_Error__(true, file, function, lineno, type, where, NULL);
}
if (LOCAL_RestartEnv && !LOCAL_delay) {
Yap_RestartYap(5);
@ -640,20 +652,30 @@ void Yap_ThrowExistingError(void) {
Yap_exit(5);
}
Term Yap_MkFullError(void)
{
yap_error_descriptor_t *i = Yap_local.ActiveError;
i->errorAsText = Yap_errorName( i->errorNo );
i->errorClass = Yap_errorClass( i-> errorNo );
i->classAsText = Yap_errorClassName(i->errorClass);
return mkerrort(i->errorNo, TermNil , MkSysError(i) );
}
bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
const char *function, int lineno, yap_error_number type,
Term where, const char *s) {
if (!Yap_pc_add_location(r, CP, B, ENV))
Term where, const char *s) {
if (!Yap_pc_add_location(r, P, B, ENV))
Yap_env_add_location(r, CP, B, ENV, 0);
if (where == 0L || where == TermNil || type == INSTANTIATION_ERROR) {
if (where == 0L || where == TermNil) {
r->culprit = NULL;
} else {
r->culprit = Yap_TermToBuffer(
where, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
where, Quote_illegal_f | Ignore_ops_f);
}
if (LOCAL_consult_level > 0) {
r->prologParserFile = Yap_ConsultingFile(PASS_REGS1)->StrOfAE;
r->prologParserLine = Yap_source_line_no();
if (type != SYNTAX_ERROR && LOCAL_consult_level > 0) {
r->parserFile = Yap_ConsultingFile(PASS_REGS1)->StrOfAE;
r->parserLine = Yap_source_line_no();
}
r->errorNo = type;
r->errorAsText = Yap_errorName(type);
@ -662,10 +684,11 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
r->errorLine = lineno;
r->errorFunction = function;
r->errorFile = file;
Yap_prolog_add_culprit(r PASS_REGS1);
r->prologConsulting = Yap_Consulting();
LOCAL_PrologMode |= InErrorMode;
Yap_ClearExs();
// first, obtain current location
// sprintf(LOCAL_FileNameBuf, "%s:%d in C-function %s ", file, lineno,
// function);
// tf = MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf));
@ -690,13 +713,11 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
}
// fprintf(stderr, "warning: ");
if (s && s[0]) {
char *ns;
r->errorMsgLen = strlen(s) + 1;
r->errorMsg = malloc(r->errorMsgLen);
strcpy(r->errorMsg, s);
} else if (LOCAL_ErrorMessage && LOCAL_ErrorMessage[0]) {
r->errorMsgLen = strlen(LOCAL_ErrorMessage) + 1;
r->errorMsg = malloc(r->errorMsgLen);
strcpy(r->errorMsg, LOCAL_ErrorMessage);
ns = malloc(r->errorMsgLen);
strcpy(ns, s);
r->errorMsg = ns;
} else {
r->errorMsgLen = 0;
r->errorMsg = 0;
@ -739,7 +760,7 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
if (LOCAL_PrologMode & BootMode) {
fprintf(stderr, "%% YAP crashed while booting %s\n", tmpbuf);
} else {
Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, YAP_BUF_SIZE);
Yap_output_bug_location(P, FIND_PRED_FROM_ANYWHERE, YAP_BUF_SIZE);
if (tmpbuf[0]) {
fprintf(stderr, "%% Bug found while executing %s\n", tmpbuf);
}
@ -842,7 +863,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
#ifdef DEBUG
// DumpActiveGoals( USES_REGS1 );
#endif /* DEBUG */
if (LOCAL_ActiveError->errorNo!= SYNTAX_ERROR)
LOCAL_ActiveError->prologStack=Yap_dump_stack();
CalculateStackGap(PASS_REGS1);
#if DEBUG
// DumpActiveGoals( PASS_REGS1 );
@ -1019,7 +1041,27 @@ static Int print_exception(USES_REGS1) {
static Int query_exception(USES_REGS1) {
const char *query;
const char *query = NULL;
Term t;
if (IsAtomTerm((t = Deref(ARG1))))
query = RepAtom(AtomOfTerm(t))->StrOfAE;
if (IsStringTerm(t))
query = StringOfTerm(t);
if (!IsAddressTerm(Deref(ARG2)))
return false;
yap_error_descriptor_t *y = AddressOfTerm(Deref(ARG2));
// if (IsVarTerm(t3)) {
Term rc = queryErr(query, y);
// Yap_DebugPlWriteln(rc);
return Yap_unify(ARG3, rc);
// } else {
// return setErr(query, y, t3);
// }
}
static Int set_exception(USES_REGS1) {
const char *query = NULL;
Term t;
if (IsAtomTerm((t = Deref(ARG1))))
@ -1031,15 +1073,14 @@ static Int query_exception(USES_REGS1) {
yap_error_descriptor_t *y = AddressOfTerm(Deref(ARG2));
Term t3 = Deref(ARG3);
if (IsVarTerm(t3)) {
Term rc = queryErr(query, y);
// Yap_DebugPlWriteln(rc);
return Yap_unify(ARG3, rc);
return false;
} else {
return setErr(query, y, t3);
}
}
static Int drop_exception(USES_REGS1) {
yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1));
free(t);
@ -1063,7 +1104,9 @@ static Int get_exception(USES_REGS1) {
(i->errorClass == EVENT || i->errorNo == SYNTAX_ERROR)) {
t = i->errorRawTerm;
} else if (i->culprit != NULL) {
t = mkerrort(i->errorNo, Yap_BufferToTerm(i->culprit, TermNil),
Term culprit = Yap_BufferToTerm(i->culprit, TermNil);
if (culprit == 0) culprit = TermNil;
t = mkerrort(i->errorNo,culprit ,
MkSysError(i));
} else {
t = mkerrort(i->errorNo, TermNil, MkSysError(i));
@ -1152,7 +1195,7 @@ yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) {
n = t2;
}
i->errorGoal = Yap_TermToBuffer(
n, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
n, Quote_illegal_f | Ignore_ops_f );
}
Yap_prolog_add_culprit(i PASS_REGS);
return i;
@ -1183,22 +1226,22 @@ static Int is_callable(USES_REGS1) {
// Term Context = Deref(ARG2);
while (true) {
if (IsVarTerm(G)) {
Yap_Error(INSTANTIATION_ERROR, G, NULL);
Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
return false;
}
if (IsApplTerm(G)) {
Functor f = FunctorOfTerm(G);
if (IsExtensionFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
}
if (f == FunctorModule) {
Term tm = ArgOfTerm(1, G);
if (IsVarTerm(tm)) {
Yap_Error(INSTANTIATION_ERROR, G, NULL);
Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
return false;
}
if (!IsAtomTerm(tm)) {
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
return false;
}
G = ArgOfTerm(2, G);
@ -1208,7 +1251,7 @@ static Int is_callable(USES_REGS1) {
} else if (IsPairTerm(G) || IsAtomTerm(G)) {
return true;
} else {
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
return false;
}
}
@ -1248,6 +1291,7 @@ void Yap_InitErrorPreds(void) {
Yap_InitCPred("$reset_exception", 1, reset_exception, 0);
Yap_InitCPred("$new_exception", 1, new_exception, 0);
Yap_InitCPred("$get_exception", 1, get_exception, 0);
Yap_InitCPred("$set_exception", 3, set_exception, 0);
Yap_InitCPred("$read_exception", 2, read_exception, 0);
Yap_InitCPred("$query_exception", 3, query_exception, 0);
Yap_InitCPred("$drop_exception", 1, drop_exception, 0);

6
C/exec.c
View File

@ -113,7 +113,7 @@ static inline bool CallPredicate(PredEntry *pen, choiceptr cut_pt,
* @return did we fiid it?
*/
inline static bool CallMetaCall(Term t, Term mod USES_REGS) {
// we have a creep requesr waiting
// we have a creep requesr waiting
ARG1 = t;
ARG2 = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
@ -327,7 +327,7 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
/* I cannot use the standard macro here because
otherwise I would dereference the argument and
might skip a svar */
if (pen->PredFlags & (MetaPredFlag | UndefPredFlag)) {
if (pen->PredFlags & (MetaPredFlag | UndefPredFlag | SpiedPredFlag)) {
return CallMetaCall(t0, mod0 PASS_REGS);
}
pt = RepAppl(t) + 1;
@ -1615,6 +1615,8 @@ void Yap_fail_all(choiceptr bb USES_REGS) {
saved_p = P;
saved_cp = CP;
/* prune away choicepoints */
if (B == bb)
return;
while (B->cp_b && B->cp_b != bb && B->cp_ap != NOCODE) {
B = B->cp_b;
#ifdef YAPOR

21
C/flags.c
View File

@ -25,10 +25,12 @@
*/
/**
@{
@defgroup YAPFlags_Impl C-code to handle Prolog flags.
@defgroup YAPFlags C-code to handle Prolog flags.
@ingroup YAPFlags
@{
@brief Low-level code to support flags.
Prolog Flags can be:
@ -313,7 +315,7 @@ static bool mkprompt(Term inp) {
CACHE_REGS
if (IsVarTerm(inp)) {
return Yap_unify(inp, MkAtomTerm(Yap_LookupAtom(LOCAL_Prompt)));
}
}
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
@ -1207,8 +1209,9 @@ Term Yap_UnknownFlag(Term mod) {
Term getYapFlag(Term tflag) {
FlagEntry *fv;
flag_term *tarr;
if (IsVarTerm(tflag)) {
flag_term *tarr;
tflag = Deref(tflag);
if (IsVarTerm(tflag)) {
Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2");
return (FALSE);
}
@ -1234,6 +1237,10 @@ Term getYapFlag(Term tflag) {
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
return (FALSE);
}
if (tflag == TermSilent)
{
Yap_DebugPlWriteln(TermSilent);
}
fv = GetFlagProp(AtomOfTerm(tflag));
if (!fv) {
Term fl = GLOBAL_Flags[USER_FLAGS_FLAG].at;
@ -1792,10 +1799,6 @@ void Yap_InitFlags(bool bootstrap) {
Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag,
cont_yap_flag, 0);
TR = tr0;
/** @pred prolog_flag( ?Flag, - Value)
Obtain the value for a YAP Prolog flag, same as current_prolog_flag/2.
*/
Yap_InitCPredBack("prolog_flag", 3, 1, prolog_flag, cont_yap_flag,
0);
Yap_InitCPredBack("yap_flag", 3, 1, yap_flag, cont_yap_flag, 0);

4
C/fli_absmi_insts.h
View File

@ -623,6 +623,10 @@
BOp(undef_p, e);
/* save S for module name */
if (LOCAL_DoingUndefp) {
PREG=FAILCODE;
JMPNext();
}
LOCAL_DoingUndefp = true;
saveregs();
undef_goal(PASS_REGS1);

6
C/globals.c
View File

@ -352,9 +352,9 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
}
#define expand_stack(S0,SP,SF,TYPE) \
size_t sz = SF-S0, used = SP-S0; \
{ size_t sz = SF-S0, used = SP-S0; \
S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \
SP = S0+used; SF = S0+sz;
SP = S0+used; SF = S0+sz; }
static int copy_complex_term(register CELL *pt0, register CELL *pt0_end,
int share, int copy_att_vars, CELL *ptf,
@ -502,7 +502,7 @@ loop:
ptf++;
/* store the terms to visit */
#ifdef RATIONAL_TREES
if (to_visit + 1 >= to_visit_max) {
if (to_visit + 32 >= to_visit_max) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
to_visit->start_cp = pt0;

78
C/gprof.c
View File

@ -35,7 +35,7 @@
* Revision 1.3 2006/01/17 14:10:40 vsc
* YENV may be an HW register (breaks some tabling code)
* All YAAM instructions are now brackedted, so Op introduced an { and EndOp introduces an }. This is because Ricardo assumes that.
* Fix attvars when COROUTING is undefined.
* Fix attvars
*
* Revision 1.2 2005/12/23 00:20:13 vsc
* updates to gprof
@ -47,40 +47,40 @@
* *
*************************************************************************/
/// @file gprof.c
/** @defgroup Tick_Profiler Tick Profiler
@ingroup Profiling
@{
The tick profiler works by interrupting the Prolog code every so often
and checking at each point the code was. The profiler must be able to
retrace the state of the abstract machine at every moment. The major
advantage of this approach is that it gives the actual amount of time
being spent per procedure, or whether garbage collection dominates
execution time. The major drawback is that tracking down the state of
the abstract machine may take significant time, and in the worst case
may slow down the whole execution.
The following procedures are available:
+ profinit
Initialise the data-structures for the profiler. Unnecessary for
dynamic profiler.
+ profon
Start profiling.
+ profoff
Stop profiling.
*/
/** @addtogroup Tick_Profiler
* @ingroup Profiling@{
*
* The tick profiler works by interrupting the Prolog code every so often
* and checking at each point the code was. The pro/filer must be able to
* retrace the state of the abstract machine at every moment. The major
* advantage of this approach is that it gives the actual amount of time
* being spent per procedure, or whether garbage collection dominates
* execution time. The major drawback is that tracking down the state of
* the abstract machine may take significant time, and in the worst case
* may slow down the whole execution.
*
* The following procedures are available:
*
* + profinit/0
* Initialise the data-structures for the profiler. Unnecessary for
* dynamic profiler.
*
* + profon/0
* Start profiling.
*
* + profoff/0
* Stop profiling.
*
* + profoff/0
* Stop profiling.
*
* + showprofres/0 and showprofres/1
* Stop tick counts per predicate.
*
*
*/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
@ -728,20 +728,18 @@ return GLOBAL_DIRNAME;
char *profile_names(int);
char *profile_names(int k) {
static char *FNAME=NULL;
char *FNAME=NULL;
int size=200;
if (GLOBAL_DIRNAME==NULL) set_profile_dir(NULL);
size=strlen(GLOBAL_DIRNAME)+40;
if (FNAME!=NULL) free(FNAME);
FNAME=malloc(size);
if (FNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); }
strcpy(FNAME,GLOBAL_DIRNAME);
if (k==PROFILING_FILE) {
sprintf(FNAME,"%s/PROFILING_%d",FNAME,getpid());
sprintf(FNAME,"%s/PROFILING_%d",GLOBAL_DIRNAME,getpid());
} else {
sprintf(FNAME,"%s/PROFPREDS_%d",FNAME,getpid());
sprintf(FNAME,"%s/PROFPREDS_%d",GLOBAL_DIRNAME,getpid());
}
// printf("%s\n",FNAME);
@ -841,7 +839,7 @@ static void RemoveCode(CODEADDR clau)
}
}
static int
static Int
showprofres( USES_REGS1 ) {
buf_ptr buf;

19
C/parser.c
View File

@ -60,12 +60,12 @@ static void syntax_msg(const char *msg, ...) {
va_list ap;
if (!LOCAL_ErrorMessage ||
(LOCAL_Error_TYPE == SYNTAX_ERROR &&
LOCAL_tokptr->TokPos < LOCAL_ActiveError->prologParserPos)) {
LOCAL_tokptr->TokPos < LOCAL_ActiveError->parserPos)) {
if (!LOCAL_ErrorMessage) {
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE + 1);
}
LOCAL_ActiveError->prologParserLine = LOCAL_tokptr->TokLine;
LOCAL_ActiveError->prologParserPos = LOCAL_tokptr->TokPos;
LOCAL_ActiveError->parserLine = LOCAL_tokptr->TokLine;
LOCAL_ActiveError->parserPos = LOCAL_tokptr->TokPos;
va_start(ap, msg);
vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, msg, ap);
va_end(ap);
@ -911,12 +911,17 @@ Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) {
CACHE_REGS
// ensure that if we throw an exception
// t will be 0.
LOCAL_ActiveError->errorMsg=NULL;
LOCAL_ActiveError->errorMsgLen=0;
Volatile Term t = 0;
JMPBUFF FailBuff;
yhandle_t sls = Yap_StartSlots();
LOCAL_ErrorMessage = NULL;
LOCAL_toktide = LOCAL_tokptr;
if (!sigsetjmp(FailBuff.JmpBuff, 0)) {
LOCAL_ActiveError->errorMsg=NULL;
LOCAL_ActiveError->errorMsgLen=0;
t = ParseTerm(prio, &FailBuff, enc, cmod PASS_REGS);
#if DEBUG
@ -936,9 +941,13 @@ Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) {
if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) {
LOCAL_Error_TYPE = SYNTAX_ERROR;
if (LOCAL_tokptr->TokNext) {
LOCAL_ErrorMessage = "bracket or operator expected.";
size_t sz = strlen("bracket or operator expected.");
LOCAL_ErrorMessage =malloc(sz+1);
strncpy(LOCAL_ErrorMessage, "bracket or operator expected.", sz );
} else {
LOCAL_ErrorMessage = "term must end with . or EOF.";
size_t sz = strlen("term must end with . or EOF.");
LOCAL_ErrorMessage =malloc(sz+1);
strncpy(LOCAL_ErrorMessage,"term must end with . or EOF.", sz );
}
t = 0;
}

5
C/qlyr.c
View File

@ -836,6 +836,7 @@ static void ReadHash(FILE *stream) {
UInt sz = read_UInt(stream);
UInt nrefs = read_UInt(stream);
LogUpdClause *ncl = (LogUpdClause *)Yap_AlwaysAllocCodeSpace(sz);
Yap_LUClauseSpace += sz;
if (!ncl) {
QLYR_ERROR(OUT_OF_CODE_SPACE);
}
@ -874,6 +875,7 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses,
nrefs = cl->ClRefCount;
} else {
cl = (LogUpdClause *)Yap_AlwaysAllocCodeSpace(size);
Yap_LUClauseSpace += size;
}
read_bytes(stream, cl, size);
cl->ClFlags &= ~InUseMask;
@ -887,6 +889,7 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses,
char *base = (void *)read_UInt(stream);
UInt mask = read_UInt(stream);
UInt size = read_UInt(stream);
Yap_ClauseSpace += size;
MegaClause *cl = (MegaClause *)Yap_AlwaysAllocCodeSpace(size);
if (nclauses) {
@ -918,6 +921,7 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses,
char *base = (void *)read_UInt(stream);
UInt size = read_UInt(stream);
DynamicClause *cl = (DynamicClause *)Yap_AlwaysAllocCodeSpace(size);
Yap_LUClauseSpace += size;
LOCAL_HDiff = (char *)cl - base;
read_bytes(stream, cl, size);
@ -948,6 +952,7 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses,
char *base = (void *)read_UInt(stream);
UInt size = read_UInt(stream);
StaticClause *cl = (StaticClause *)Yap_AlwaysAllocCodeSpace(size);
Yap_ClauseSpace += size;
LOCAL_HDiff = (char *)cl - base;
read_bytes(stream, cl, size);

1
C/save.c
View File

@ -1469,6 +1469,7 @@ int Yap_SavedInfo(const char *FileName, CELL *ATrail,
mode = OpenRestore(FileName, &MyState, &MyTrail, &MyStack, &MyHeap,
NULL);
if (mode == FAIL_RESTORE) {
fprintf(stderr, "restore failed to open %s as a valid state\n", FileName);
return -1;
}
close_file();

15
C/scanner.c
View File

@ -1340,7 +1340,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
TokEntry *t, *l, *p;
enum TokenKinds kind;
int solo_flag = TRUE;
int32_t ch, och;
int32_t ch, och = ' ';
struct qq_struct_t *cur_qq = NULL;
int sign = 1;
@ -1423,12 +1423,13 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
case UC:
case UL:
case LC: {
int32_t och = ch;
case LC:
och = ch;
ch = getchr(st);
size_t sz = 512;
TokImage = Malloc(sz PASS_REGS);
scan_name:
{
size_t sz = 1024;
TokImage = Malloc(sz PASS_REGS);
charp = (unsigned char *)TokImage;
isvar = (chtype(och) != LC);
add_ch_to_buff(och);
@ -1514,8 +1515,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
case 'e':
case 'E':
och = cherr;
TokImage = Malloc(1024 PASS_REGS);
goto scan_name;
goto scan_name;
break;
case '=':
case '_':
@ -1981,6 +1981,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
return l;
default: {
kind = Error_tok;
char err[1024];
snprintf(err, 1023, "\n++++ token: unrecognised char %c (%d), type %c\n",
ch, ch, chtype(ch));

232
C/stack.c
View File

@ -105,6 +105,8 @@ restart:
return NULL;
}
extern char * Yap_output_bug_location(yamop *yap_pc, int where_from, int psize);
static PredEntry *PredForChoicePt(yamop *p_code, op_numbers *opn) {
while (TRUE) {
op_numbers opnum;
@ -656,7 +658,7 @@ static Int code_in_pred(PredEntry *pp, Atom *pat, UInt *parity,
PELOCK(40, pp);
/* check if the codeptr comes from the indexing code */
if (pp->PredFlags & IndexedPredFlag && pp->OpcodeOfPred != INDEX_OPCODE) {
if (pp->PredFlags & IndexedPredFlag && pp->OpcodeOfPred != INDEX_OPCODE) {
if (pp->PredFlags & LogUpdatePredFlag) {
if (code_in_pred_lu_index(
ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
@ -885,7 +887,7 @@ static PredEntry *ClauseInfoForCode(yamop *codeptr, void **startp,
if (codeptr >= COMMA_CODE && codeptr < FAILCODE) {
pp = RepPredProp(Yap_GetPredPropByFunc(FunctorComma, CurrentModule));
*startp = (CODEADDR)COMMA_CODE;
*endp = (CODEADDR)(FAILCODE - 1);
*endp = (CODEADDR)(FAILCODE);
return pp;
}
pc = codeptr;
@ -1124,7 +1126,7 @@ static Term clause_info(yamop *codeptr, PredEntry *pp) {
yap_error_descriptor_t *set_clause_info(yap_error_descriptor_t *t,
yamop *codeptr, PredEntry *pp) {
CACHE_REGS
Term ts[2];
void *begin;
if (pp->ArityOfPE == 0) {
t->prologPredName = AtomName((Atom)pp->FunctorOfPred);
@ -1138,36 +1140,18 @@ yap_error_descriptor_t *set_clause_info(yap_error_descriptor_t *t,
: "prolog");
t->prologPredFile = RepAtom(pp->src.OwnerFile)->StrOfAE;
if (codeptr->opc == UNDEF_OPCODE) {
t->prologPredFirstLine = 0;
t->prologPredLine = 0;
t->prologPredLastLine = 0;
return t;
} else if (pp->cs.p_code.NOfClauses) {
if ((t->prologPredCl = find_code_in_clause(pp, codeptr, &begin, NULL)) <=
if ((t->prologPredLine = find_code_in_clause(pp, codeptr, &begin, NULL)) <=
0) {
t->prologPredLine = 0;
} else {
t->prologPredLine = IntegerOfTerm(clause_loc(begin, pp));
}
if (pp->PredFlags & LogUpdatePredFlag) {
t->prologPredFirstLine =
clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp);
t->prologPredLastLine =
clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause), pp);
} else {
t->prologPredFirstLine = IntegerOfTerm(
ts[0] = clause_loc(
ClauseCodeToStaticClause(pp->cs.p_code.FirstClause), pp));
t->prologPredLastLine = IntegerOfTerm(
ts[1] = clause_loc(ClauseCodeToStaticClause(pp->cs.p_code.LastClause),
pp));
}
return t;
} else {
t->prologPredFirstLine = 0;
t->prologPredLine = t->errorLine;
t->prologPredLastLine = 0;
t->prologPredFile = t->errorFile;
return t;
}
@ -1720,8 +1704,6 @@ parent_pred(USES_REGS1) {
Yap_unify(ARG2, MkAtomTerm(at)) && Yap_unify(ARG3, MkIntTerm(arity));
}
void Yap_dump_stack(void);
void DumpActiveGoals(CACHE_TYPE1);
static int hidden(Atom);
@ -1785,173 +1767,191 @@ static bool handled_exception(USES_REGS1) {
return !found_handler;
}
void Yap_dump_stack(void) {
#define ADDBUF( CMD ) { \
while (true) { \
size_t sz = CMD; \
if (sz < lbufsz-256) { \
lbuf += sz; \
lbufsz -= sz; \
break; \
} \
char *nbuf = Realloc(buf, bufsize += 1024); \
lbuf = nbuf + (lbuf-buf); \
buf = nbuf; \
lbufsz += 1024; \
} \
}
const char *Yap_dump_stack(void) {
CACHE_REGS
choiceptr b_ptr = B;
CELL *env_ptr = ENV;
char tp[256];
char *tp;
yamop *ipc = CP;
int max_count = 200;
int lvl = push_text_stack();
char *buf = Malloc(4096), *lbuf = buf;
size_t bufsize = 4096, lbufsz = bufsize-256;
/* check if handled */
if (handled_exception(PASS_REGS1))
return;
#if DEBU
fprintf(stderr, "%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n",
P, CP, ASP, HR, TR, HeapTop);
#endif
// if (handled_exception(PASS_REGS1))
// return;
#if DEBUG
ADDBUF(snprintf(lbuf, lbufsz ,
"%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p~n", P,
CP, ASP, HR, TR, HeapTop));
fprintf(stderr, "%% \n%% =====================================\n%%\n");
fprintf(stderr, "%% \n%% YAP Status:\n");
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% =====================================~n%%~n"));
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Status:~n"));
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
yap_error_number errnbr = LOCAL_Error_TYPE;
yap_error_class_number classno = Yap_errorClass(errnbr);
fprintf(stderr, "%% Error STATUS: %s/%s\n\n", Yap_errorName(errnbr),
Yap_errorClassName(classno));
ADDBUF(snprintf(lbuf, lbufsz , "%% Error STATUS: %s/%s~n~n", Yap_errorName(errnbr),
Yap_errorClassName(classno)));
fprintf(stderr, "%% Execution mode\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Execution mode~n"));
if (LOCAL_PrologMode & BootMode)
fprintf(stderr, "%% Bootstrap\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Bootstrap~n"));
if (LOCAL_PrologMode & UserMode)
fprintf(stderr, "%% User Prolo\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% User Prolo~n"));
if (LOCAL_PrologMode & CritMode)
fprintf(stderr, "%% Exclusive Access Mode\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Exclusive Access Mode~n"));
if (LOCAL_PrologMode & AbortMode)
fprintf(stderr, "%% Abort\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Abort~n"));
if (LOCAL_PrologMode & InterruptMode)
fprintf(stderr, "%% Interrupt\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Interrupt~n"));
if (LOCAL_PrologMode & InErrorMode)
fprintf(stderr, "%% Error\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Error~n"));
if (LOCAL_PrologMode & ConsoleGetcMode)
fprintf(stderr, "%% Prompt Console\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Prompt Console~n"));
if (LOCAL_PrologMode & ExtendStackMode)
fprintf(stderr, "%% Stack expansion \n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Stack expansion ~n"));
if (LOCAL_PrologMode & GrowHeapMode)
fprintf(stderr, "%% Data Base Expansion\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Data Base Expansion~n"));
if (LOCAL_PrologMode & GrowStackMode)
fprintf(stderr, "%% User Prolog\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% User Prolog~n"));
if (LOCAL_PrologMode & GCMode)
fprintf(stderr, "%% Garbage Collection\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Garbage Collection~n"));
if (LOCAL_PrologMode & ErrorHandlingMode)
fprintf(stderr, "%% Error handler\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Error handler~n"));
if (LOCAL_PrologMode & CCallMode)
fprintf(stderr, "%% System Foreign Code\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% System Foreign Code~n"));
if (LOCAL_PrologMode & UnifyMode)
fprintf(stderr, "%% Off-line Foreign Code\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Off-line Foreign Code~n"));
if (LOCAL_PrologMode & UserCCallMode)
fprintf(stderr, "%% User Foreig C\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% User Foreig C~n"));
if (LOCAL_PrologMode & MallocMode)
fprintf(stderr, "%% Heap Allocaror\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Heap Allocaror~n"));
if (LOCAL_PrologMode & SystemMode)
fprintf(stderr, "%% Prolog Internals\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Prolog Internals~n"));
if (LOCAL_PrologMode & AsyncIntMode)
fprintf(stderr, "%% Async Interruot mode\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Async Interruot mode~n"));
if (LOCAL_PrologMode & InReadlineMode)
fprintf(stderr, "%% Readline Console\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% Readline Console~n"));
if (LOCAL_PrologMode & TopGoalMode)
fprintf(stderr, "%% Creating new query\n");
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
fprintf(stderr, "%% \n%% YAP Program:\n");
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
fprintf(stderr, "%% Program Position: %s\n\n", Yap_errorName(errno) );
fprintf(stderr, "%% PC: %s\n", (char *)HR);
Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "%% Continuation: %s\n", (char *)HR);
Yap_detect_bug_location(B->cp_ap, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "%% Alternative: %s\n", (char *)HR);
ADDBUF(snprintf(lbuf, lbufsz , "%% Creating new query~n"));
#endif
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Program:~n"));
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
ADDBUF(snprintf(lbuf, lbufsz , "%% Program Position: %s~n~n", Yap_errorName(errno)));
ADDBUF(snprintf(lbuf, lbufsz , "%% PC: %s~n", (char *)HR));
Yap_output_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
ADDBUF(snprintf(lbuf, lbufsz , "%% Continuation: %s~n", (char *)HR));
Yap_output_bug_location(B->cp_ap, FIND_PRED_FROM_ANYWHERE, 256);
ADDBUF(snprintf(lbuf, lbufsz , "%% Alternative: %s~n", (char *)HR));
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
fprintf(stderr, "%% \n%% YAP Stack Usage:\n");
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Stack Usage:~n"));
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
if (HR > ASP || HR > LCL0) {
fprintf(stderr, "%% YAP ERROR: Global Collided against Local (%p--%p)\n",
HR, ASP);
ADDBUF(snprintf(lbuf, lbufsz , "%% YAP ERROR: Global Collided against Local (%p--%p)~n",
HR, ASP));
} else if (HeapTop > (ADDR)LOCAL_GlobalBase) {
fprintf(stderr,
"%% YAP ERROR: Code Space Collided against Global (%p--%p)\n",
HeapTop, LOCAL_GlobalBase);
ADDBUF(snprintf(lbuf, lbufsz ,
"%% YAP ERROR: Code Space Collided against Global (%p--%p)~n",
HeapTop, LOCAL_GlobalBase));
} else {
#if !USE_SYSTEM_MALLOC
fprintf(stderr, "%%ldKB of Code Space (%p--%p)\n",
ADDBUF(snprintf(lbuf, lbufsz , "%%ldKB of Code Space (%p--%p)~n",
(long int)((CELL)HeapTop - (CELL)Yap_HeapBase) / 1024, Yap_HeapBase,
HeapTop);
HeapTop));
#if USE_DL_MALLOC
if (Yap_NOfMemoryHoles) {
UInt i;
for (i = 0; i < Yap_NOfMemoryHoles; i++)
fprintf(stderr, " Current hole: %p--%p\n", Yap_MemoryHoles[i].start,
Yap_MemoryHoles[i].end);
ADDBUF(snprintf(lbuf, lbufsz , " Current hole: %p--%p~n", Yap_MemoryHoles[i].start,
Yap_MemoryHoles[i].end));
}
#endif
#endif
fprintf(stderr, "%% %luKB of Global Stack (%p--%p)\n",
(unsigned long int)(sizeof(CELL) * (HR - H0)) / 1024, H0, HR);
fprintf(stderr, "%% %luKB of Local Stack (%p--%p)\n",
(unsigned long int)(sizeof(CELL) * (LCL0 - ASP)) / 1024, ASP, LCL0);
fprintf(stderr, "%% %luKB of Trail (%p--%p)\n",
ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Global Stack (%p--%p)~n",
(unsigned long int)(sizeof(CELL) * (HR - H0)) / 1024, H0, HR));
ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Local Stack (%p--%p)~n",
(unsigned long int)(sizeof(CELL) * (LCL0 - ASP)) / 1024, ASP, LCL0));
ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Trail (%p--%p)~n",
(unsigned long int)((ADDR)TR - LOCAL_TrailBase) / 1024,
LOCAL_TrailBase, TR);
fprintf(stderr, "%% Performed %ld garbage collections\n",
(unsigned long int)LOCAL_GcCalls);
LOCAL_TrailBase, TR));
ADDBUF(snprintf(lbuf, lbufsz , "%% Performed %ld garbage collections~n",
(unsigned long int)LOCAL_GcCalls));
#if LOW_LEVEL_TRACER
{
extern long long vsc_count;
if (vsc_count) {
#if _WIN32
fprintf(stderr, "Trace Counter at %I64d\n", vsc_count);
ADDBUF(snprintf(lbuf, lbufsz , "Trace Counter at %I64d~n", vsc_count));
#else
fprintf(stderr, "Trace Counter at %lld\n", vsc_count);
ADDBUF(snprintf(lbuf, lbufsz , "Trace Counter at %lld~n", vsc_count));
#endif
}
}
#endif
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
fprintf(stderr, "%% \n%% YAP Stack:\n");
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
fprintf(stderr, "%% All Active Calls and\n");
fprintf(stderr, "%% Goals With Alternatives Open (Global In "
"Use--Local In Use)\n%%\n");
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Stack:~n"));
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
ADDBUF(snprintf(lbuf, lbufsz , "%% All Active Calls and~n"));
ADDBUF(snprintf(lbuf, lbufsz , "%% Goals With Alternatives Open (Global In "
"Use--Local In Use)~n%%~n"));
while (b_ptr != NULL) {
while (env_ptr && env_ptr <= (CELL *)b_ptr) {
Yap_detect_bug_location(ipc, FIND_PRED_FROM_ENV, 256);
tp = Yap_output_bug_location(ipc, FIND_PRED_FROM_ENV, 256);
if (env_ptr == (CELL *)b_ptr && (choiceptr)env_ptr[E_CB] > b_ptr) {
b_ptr = b_ptr->cp_b;
fprintf(stderr, "%% %s\n", tp);
ADDBUF(snprintf(lbuf, lbufsz , "%% %s~n", tp));
} else {
fprintf(stderr, "%% %s\n", tp);
ADDBUF(snprintf(lbuf, lbufsz , "%% %s~n", tp));
}
if (!max_count--) {
fprintf(stderr, "%% .....\n");
return;
ADDBUF(snprintf(lbuf, lbufsz , "%% .....~n"));
return pop_output_text_stack(lvl, buf);
}
ipc = (yamop *)(env_ptr[E_CP]);
env_ptr = (CELL *)(env_ptr[E_E]);
}
if (b_ptr) {
if (!max_count--) {
fprintf(stderr, "// .....\n");
return;
ADDBUF(snprintf(lbuf, lbufsz , "// .....~n"));
return pop_output_text_stack(lvl, buf);
}
if (b_ptr->cp_ap && /* tabling */
b_ptr->cp_ap->opc != Yap_opcode(_or_else) &&
b_ptr->cp_ap->opc != Yap_opcode(_or_last) &&
b_ptr->cp_ap->opc != Yap_opcode(_Nstop)) {
/* we can safely ignore ; because there is always an upper env */
Yap_detect_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256);
fprintf(stderr, "%% %s (%luKB--%luKB)\n", tp,
tp = Yap_output_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256);
ADDBUF(snprintf(lbuf, lbufsz , "%% %s (%luKB--%luKB)~n", tp,
(unsigned long int)((b_ptr->cp_h - H0) * sizeof(CELL) / 1024),
(unsigned long int)((ADDR)LCL0 - (ADDR)b_ptr) / 1024);
(unsigned long int)((ADDR)LCL0 - (ADDR)b_ptr) / 1024));
}
b_ptr = b_ptr->cp_b;
}
}
}
return pop_output_text_stack(lvl, buf);
}
void DumpActiveGoals(USES_REGS1) {
/* try to dump active goals */
CELL *ep = YENV; /* and current environment */
@ -2065,7 +2065,7 @@ void DumpActiveGoals(USES_REGS1) {
if (i > 0)
fputc(',', stderr);
fputc('_', stderr);
}
}
fputs(") :- ... ( _ ; _ ", stderr);
} else {
Term *args = &(b_ptr->cp_a1);
@ -2086,28 +2086,34 @@ void DumpActiveGoals(USES_REGS1) {
}
}
void Yap_detect_bug_location(yamop *yap_pc, int where_from, int psize) {
/**
* Used for debugging.
*
*/
char * Yap_output_bug_location(yamop *yap_pc, int where_from, int psize) {
Atom pred_name;
UInt pred_arity;
Term pred_module;
Int cl;
char *o = Malloc(256);
if ((cl = Yap_PredForCode(yap_pc, where_from, &pred_name, &pred_arity,
&pred_module)) == 0) {
/* system predicate */
fprintf(stderr, "%% %s", "meta-call");
snprintf(o, 255, "%% %s", "meta-call");
} else if (pred_module == 0) {
fprintf(stderr, "in prolog:%s/%lu", RepAtom(pred_name)->StrOfAE,
snprintf(o, 255, "in prolog:%s/%lu", RepAtom(pred_name)->StrOfAE,
(unsigned long int)pred_arity);
} else if (cl < 0) {
fprintf(stderr, "%% %s:%s/%lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE,
snprintf(o, 255, "%% %s:%s/%lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE,
RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity);
} else {
fprintf(stderr, "%% %s:%s/%lu at clause %lu",
snprintf(o, 255, "%% %s:%s/%lu at clause %lu",
RepAtom(AtomOfTerm(pred_module))->StrOfAE,
RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity,
(unsigned long int)cl);
}
return o;
}
static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p,

140
C/text.c
View File

@ -59,54 +59,6 @@ typedef struct TextBuffer_manager {
} text_buffer_t;
int AllocLevel(void) { return LOCAL_TextBuffer->lvl; }
int push_text_stack__(USES_REGS1) {
int i = LOCAL_TextBuffer->lvl;
i++;
LOCAL_TextBuffer->lvl = i;
return i;
}
int pop_text_stack__(int i) {
int lvl = LOCAL_TextBuffer->lvl;
while (lvl >= i) {
struct mblock *p = LOCAL_TextBuffer->first[lvl];
while (p) {
struct mblock *np = p->next;
free(p);
p = np;
}
LOCAL_TextBuffer->first[lvl] = NULL;
LOCAL_TextBuffer->last[lvl] = NULL;
lvl--;
}
LOCAL_TextBuffer->lvl = lvl;
return lvl;
}
void *pop_output_text_stack__(int i, const void *export) {
int lvl = LOCAL_TextBuffer->lvl;
while (lvl >= i) {
struct mblock *p = LOCAL_TextBuffer->first[lvl];
while (p) {
struct mblock *np = p->next;
if (p + 1 == export) {
size_t sz = p->sz - sizeof(struct mblock);
memmove(p, p + 1, sz);
export = p;
} else {
free(p);
}
p = np;
}
LOCAL_TextBuffer->first[lvl] = NULL;
LOCAL_TextBuffer->last[lvl] = NULL;
lvl--;
}
LOCAL_TextBuffer->lvl = lvl;
return (void *)export;
}
// void pop_text_stack(int i) { LOCAL_TextBuffer->lvl = i; }
void insert_block(struct mblock *o) {
int lvl = o->lvl;
@ -138,6 +90,68 @@ void release_block(struct mblock *o) {
o->next->prev = o->prev;
}
int push_text_stack__(USES_REGS1) {
int i = LOCAL_TextBuffer->lvl;
i++;
LOCAL_TextBuffer->lvl = i;
return i;
}
int pop_text_stack__(int i) {
int lvl = LOCAL_TextBuffer->lvl;
while (lvl >= i) {
struct mblock *p = LOCAL_TextBuffer->first[lvl];
while (p) {
struct mblock *np = p->next;
free(p);
p = np;
}
LOCAL_TextBuffer->first[lvl] = NULL;
LOCAL_TextBuffer->last[lvl] = NULL;
lvl--;
}
LOCAL_TextBuffer->lvl = lvl;
return lvl;
}
void *pop_output_text_stack__(int i, const void *export) {
int lvl = LOCAL_TextBuffer->lvl;
bool found = false;
while (lvl >= i) {
struct mblock *p = LOCAL_TextBuffer->first[lvl];
while (p) {
struct mblock *np = p->next;
if (p + 1 == export) {
found = true;
} else {
free(p);
}
p = np;
}
LOCAL_TextBuffer->first[lvl] = NULL;
LOCAL_TextBuffer->last[lvl] = NULL;
lvl--;
}
LOCAL_TextBuffer->lvl = lvl;
if (found) {
if (lvl) {
struct mblock *o = (struct mblock *)export-1;
o->lvl = lvl;
o->prev = o->next = 0;
insert_block(o);
} else {
struct mblock *p = (struct mblock *)export-1;
size_t sz = p->sz - sizeof(struct mblock);
memmove(p, p + 1, sz);
export = p;
}
}
return (void *)export;
}
void *Malloc(size_t sz USES_REGS) {
int lvl = LOCAL_TextBuffer->lvl;
if (sz == 0)
@ -176,14 +190,21 @@ void *MallocAtLevel(size_t sz, int atL USES_REGS) {
}
void *Realloc(void *pt, size_t sz USES_REGS) {
sz += sizeof(struct mblock);
struct mblock *old = pt, *o;
old--;
release_block(old);
sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), CELL);
o = realloc(old, sz);
if (o->next) {
o->next->prev = o;
} else {
LOCAL_TextBuffer->last[o->lvl] = o;
}
if (o->prev) {
o->prev->next = o;
} else {
LOCAL_TextBuffer->first[o->lvl] = o;
}
o->sz = sz;
insert_block(o);
return o + 1;
}
@ -544,7 +565,7 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
#endif
if (inp->type & YAP_STRING_TERM) {
pop_text_stack(lvl);
return Yap_TermToBuffer(inp->val.t, 0);
return (unsigned char *)Yap_TermToBuffer(inp->val.t, 0);
}
if (inp->type & YAP_STRING_CHARS) {
@ -558,7 +579,7 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
}
pop_text_stack(lvl);
return inp->val.c;
return inp->val.uc;
}
if (inp->type & YAP_STRING_WCHARS) {
// printf("%S\n",inp->val.w);
@ -969,7 +990,7 @@ bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) {
else
fprintf(stderr, "%s", out->val.c);
fprintf(stderr, "\n]\n"); */
pop_text_stack(l);
out->val.uc = pop_output_text_stack(l,out->val.uc);
return rc;
}
@ -1020,10 +1041,11 @@ bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) {
void **bufv;
unsigned char *buf;
int i, j;
// int lvl = push_text_stack();
int lvl = push_text_stack();
bufv = Malloc(tot * sizeof(unsigned char *));
if (!bufv) {
// pop_text_stack(lvl);
pop_text_stack(lvl);
return NULL;
}
for (i = 0, j = 0; i < tot; i++) {
@ -1031,7 +1053,7 @@ bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) {
unsigned char *nbuf = Yap_readText(inp + i PASS_REGS);
if (!nbuf) {
// pop_text_stack(lvl);
pop_text_stack(lvl);
return NULL;
}
// if (!nbuf[0])
@ -1047,7 +1069,7 @@ bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) {
buf = concat(tot, bufv PASS_REGS);
}
bool rc = write_Text(buf, out PASS_REGS);
// pop_text_stack( lvl );
pop_text_stack( lvl );
return rc;
}

4
C/tracer.c
View File

@ -91,7 +91,8 @@ static char *send_tracer_message(char *start, char *name, arity_t arity,
Quote_illegal_f | Handle_vars_f);
size_t sz;
if (sn == NULL) {
sn = "<* error *>";
sn = malloc(strlen("<* error *>")+1);
strcpy((char*)sn, "<* error *>");
}
sz = strlen(sn);
if (max <= sz) {
@ -100,6 +101,7 @@ static char *send_tracer_message(char *start, char *name, arity_t arity,
continue;
}
strcpy(s, sn);
sn = NULL;
s += sz;
max -= sz;
}

430
C/utilpreds.c
View File

@ -77,12 +77,12 @@ static int
copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL *HLow USES_REGS)
{
struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace();
struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace() ;
CELL *HB0 = HB;
tr_fr_ptr TR0 = TR;
int ground = TRUE;
HB = HLow;
HB = HR;
to_visit0 = to_visit;
loop:
while (pt0 < pt0_end) {
@ -103,7 +103,6 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
}
*ptf = AbsPair(HR);
ptf++;
#ifdef RATIONAL_TREES
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow;
}
@ -115,18 +114,6 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
/* fool the system into thinking we had a variable there */
*pt0 = AbsPair(HR);
to_visit ++;
#else
if (pt0 < pt0_end) {
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow;
}
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
to_visit->to = ptf;
to_visit->ground = ground;
to_visit ++;
}
#endif
ground = TRUE;
pt0 = ap2 - 1;
pt0_end = ap2 + 1;
@ -192,7 +179,6 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
*ptf = AbsAppl(HR);
ptf++;
/* store the terms to visit */
#ifdef RATIONAL_TREES
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow;
}
@ -204,18 +190,6 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
/* fool the system into thinking we had a variable there */
*pt0 = AbsAppl(HR);
to_visit ++;
#else
if (pt0 < pt0_end) {
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow;
}
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
to_visit->to = ptf;
to_visit->ground = ground;
to_visit ++;
}
#endif
ground = (f != FunctorMutable);
d0 = ArityOfFunctor(f);
pt0 = ap2;
@ -267,9 +241,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
}
Bind_NonAtt(ptd0, (CELL)ptf);
ptf++;
#ifdef COROUTINING
}
#endif
}
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
@ -288,9 +260,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
#ifdef RATIONAL_TREES
*pt0 = to_visit->oldv;
#endif
ground = (ground && to_visit->ground);
goto loop;
}
@ -306,7 +276,6 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->start_cp;
@ -314,7 +283,6 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
ptf = to_visit->to;
*pt0 = to_visit->oldv;
}
#endif
reset_trail(TR0);
/* follow chain of multi-assigned variables */
return -1;
@ -325,7 +293,6 @@ trail_overflow:
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->start_cp;
@ -333,7 +300,6 @@ trail_overflow:
ptf = to_visit->to;
*pt0 = to_visit->oldv;
}
#endif
{
tr_fr_ptr oTR = TR;
reset_trail(TR0);
@ -349,7 +315,6 @@ trail_overflow:
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->start_cp;
@ -357,11 +322,10 @@ trail_overflow:
ptf = to_visit->to;
*pt0 = to_visit->oldv;
}
#endif
reset_trail(TR0);
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
return -3;
}
}
static Term
@ -372,7 +336,7 @@ handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t)
switch(res) {
case -1:
if (!Yap_gcl((ASP-HR)*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermFoundVar, LOCAL_ErrorMessage);
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return 0L;
}
return Deref(XREGS[arity+1]);
@ -531,25 +495,279 @@ p_copy_term_no_delays( USES_REGS1 ) /* copy term t to a new instance */
typedef struct bp_frame {
CELL *start_cp;
CELL *end_cp;
CELL *to;
CELL *oldp;
CELL oldv;
} bp_frame_t;
typedef struct copy_frame {
CELL *start_cp;
CELL *end_cp;
CELL *to;
} copy_frame_t;
static Term *
add_to_list( Term *out_e, Term v, Term t USES_REGS)
static Term
add_to_list( Term inp, Term v, Term t PASS_REGS)
{
Term ta[2], tv;
Term ta[2];
ta[0] = v;
ta[1] = t;
*out_e = tv = MkPairTerm(Yap_MkApplTerm( FunctorEq, 2, ta ), TermNil);
return RepPair(tv)+1;
return MkPairTerm(Yap_MkApplTerm( FunctorEq, 2, ta ), inp);
}
static int
break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS)
break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Term vin,CELL *HLow USES_REGS)
{
struct bp_frame *to_visit0, *to_visit = (struct bp_frame *)Yap_PreAllocCodeSpace() ;
CELL *HB0 = HB;
tr_fr_ptr TR0 = TR;
HB = HR;
to_visit0 = to_visit;
loop:
while (pt0 < pt0_end) {
register CELL d0;
register CELL *ptd0;
++ pt0;
ptd0 = pt0;
d0 = *ptd0;
deref_head(d0, copy_term_unk);
copy_term_nvar:
{
if (IsPairTerm(d0)) {
CELL *ap2 = RepPair(d0);
fprintf(stderr, "%ld \n", RepPair(ap2[0])- ptf);
if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]),HR)) {
Term v = MkVarTerm();
*ptf = v;
vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf) );
ptf++;
continue;
}
if (to_visit+1 >= (struct bp_frame *)AuxSp) {
goto heap_overflow;
}
*ptf++ = (CELL)(HR);
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
to_visit->to = ptf;
to_visit->oldp = ap2;
d0 = to_visit->oldv = ap2[0];
/* fool the system into thinking we had a variable there */
to_visit ++;
pt0 = ap2;
pt0_end = ap2 + 1;
ptf = HR;
*ap2 = AbsPair(HR);
HR += 2;
if (HR > ASP - 2048) {
goto overflow;
}
if (IsVarTerm(d0) && d0 == (CELL)ap2) {
RESET_VARIABLE(ptf);
ptf++;
continue;
}
d0 = Deref(d0);
if (!IsVarTerm(d0)) {
goto copy_term_nvar;
} else {
*ptf++ = d0;
}
continue;
} else if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2;
/* store the terms to visit */
ap2 = RepAppl(d0)+1;
f = (Functor)(ap2[-1]);
if (IsExtensionFunctor(f)) {
*ptf++ = d0; /* you can just copy other extensions. */
continue;
}
if (IsApplTerm(ap2[0]) && IN_BETWEEN(HB, RepAppl(ap2[0]),HR)) {
RESET_VARIABLE(ptf);
vin = add_to_list(vin, (CELL)ptf, ap2[0] );
ptf++;
continue;
}
arity_t arity = ArityOfFunctor(f);
if (to_visit+1 >= (struct bp_frame *)AuxSp) {
goto heap_overflow;
}
*ptf++ = AbsAppl(HR);
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
to_visit->to = ptf;
to_visit->oldp = ap2;
d0 = to_visit->oldv = ap2[0];
/* fool the system into thinking we had a variable there */
to_visit ++;
pt0 = ap2;
pt0_end = ap2 + (arity-1);
ptf = HR;
if (HR > ASP - 2048) {
goto overflow;
}
*ptf++ =(CELL)f;
*ap2 = AbsAppl(HR);
HR += (arity+1);
if (IsVarTerm(d0) && d0 == (CELL)(ap2)) {
RESET_VARIABLE(ptf);
ptf++;
continue;
}
d0 = Deref(d0);
if (!IsVarTerm(d0)) {
goto copy_term_nvar;
} else {
*ptf++ = d0;
}
continue;
} else {
/* just copy atoms or integers */
*ptf++ = d0;
}
continue;
}
derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar);
*ptf++ = (CELL) ptd0;
}
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
to_visit --;
*to_visit->oldp = to_visit->oldv;
ptf = to_visit->to;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
goto loop;
}
/* restore our nice, friendly, term to its original state */
HB = HB0;
*vout = vin;
return true;
overflow:
/* oops, we're in trouble */
HR = HLow;
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
*to_visit->oldp = to_visit->oldv;
}
#endif
reset_trail(TR0);
/* follow chain of multi-assigned variables */
return -1;
heap_overflow:
/* oops, we're in trouble */
HR = HLow;
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
*to_visit->oldp = to_visit->oldv;
}
#endif
reset_trail(TR0);
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
return -3;
}
Term
Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) {
Term t = Deref(inp);
Term tii = ti;
tr_fr_ptr TR0 = TR;
if (IsVarTerm(t)) {
*to = ti;
return t;
} else if (IsPrimitiveTerm(t)) {
*to = ti;
return t;
} else if (IsPairTerm(t)) {
CELL *ap;
CELL *Hi;
restart_list:
ap = RepPair(t);
Hi = HR;
HR += 2;
{
Int res;
if ((res = break_rationals_complex_term(ap-1, ap+1, Hi, to, ti, Hi PASS_REGS)) < 0) {
HR = Hi;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
goto restart_list;
} else if (*to == tii) {
HR = Hi;
return t;
} else {
return AbsPair(Hi);
}
}
} else {
Functor f;
CELL *HB0;
CELL *ap;
restart_appl:
f = FunctorOfTerm(t);
if (IsExtensionFunctor(f)) {
*to = ti;
return t;
}
HB0 = HR;
ap = RepAppl(t);
HR[0] = (CELL)f;
arity = ArityOfFunctor(f);
HR += 1+arity;
{
Int res;
if ((res = break_rationals_complex_term(ap, ap+(arity), HB0+1, to, ti, HB0 PASS_REGS)) < 0) {
HR = HB0;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
goto restart_appl;
} else if (*to == ti) {
HR = HB0;
return t;
} else {
return AbsAppl(HB0);
}
}
}
}
static int
break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS)
{
struct copy_frame *to_visit0, *to_visit = (struct copy_frame *)Yap_PreAllocCodeSpace();
@ -586,7 +804,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term
if (!IsVarTerm(*newp)) {
Term v = (CELL)newp, t = *newp;
RESET_VARIABLE(newp);
of = add_to_list( of, v, t PASS_REGS);
oi = add_to_list( oi, v, t PASS_REGS);
}
*ptf++ = (CELL)newp;
continue;
@ -667,8 +885,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term
/* restore our nice, friendly, term to its original state */
HB = HB0;
reset_trail(TR0);
RESET_VARIABLE(of);
Yap_unify((CELL)of, oi);
*of = oi;
return TRUE;
overflow:
@ -677,14 +894,12 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
}
#endif
reset_trail(TR0);
/* follow chain of multi-assigned variables */
return -1;
@ -695,28 +910,27 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
}
#endif
reset_trail(TR0);
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
return -3;
}
static Term
BreakRational(Term inp, UInt arity, Term *of, Term oi USES_REGS) {
Term
Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) {
Term t = Deref(inp);
tr_fr_ptr TR0 = TR;
if (IsVarTerm(t)) {
*to = ti;
return t;
} else if (IsPrimitiveTerm(t)) {
*to = ti;
return t;
} else {
CELL *ap;
@ -728,7 +942,7 @@ BreakRational(Term inp, UInt arity, Term *of, Term oi USES_REGS) {
{
int res;
if ((res = break_rationals_complex_term(ap-1, ap, Hi, of, oi, Hi PASS_REGS)) < 0) {
if ((res = break_complex_term(ap-1, ap, Hi, to, ti, Hi PASS_REGS)) < 0) {
HR = Hi;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
@ -739,11 +953,12 @@ BreakRational(Term inp, UInt arity, Term *of, Term oi USES_REGS) {
}
}
static Int
p_break_rational( USES_REGS1 )
{
Term tf;
return Yap_unify(ARG2, BreakRational(ARG1, 4, &tf, ARG4 PASS_REGS)) &&
return Yap_unify(ARG2, Yap_BreakTerm(ARG1, 4, &tf, ARG4 PASS_REGS)) &&
Yap_unify(tf, ARG3);
}
@ -752,7 +967,7 @@ static Int
p_break_rational3( USES_REGS1 )
{
Term tf;
return Yap_unify(ARG2, BreakRational(ARG1, 4, &tf, TermNil PASS_REGS)) &&
return Yap_unify(ARG2, Yap_BreakTerm(ARG1, 4, &tf, TermNil PASS_REGS)) &&
Yap_unify(tf, ARG3);
}
@ -1349,7 +1564,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -1377,7 +1592,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -1683,7 +1898,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
}
{
CELL *npt0 = RepPair(d0);
if(Deref(npt0[0]) == TermFoundVar) {
if(IsAtomicTerm(Deref(npt0[0]))) {
pt0 = npt0;
pt0_end = pt0 + 1;
continue;
@ -1694,7 +1909,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -1722,7 +1937,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -1741,7 +1956,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar);
if (IsAttVar(ptd0)) {
/* do or pt2 are unbound */
*ptd0 = TermFoundVar;
*ptd0 = TermNil;
/* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */
@ -1762,12 +1977,12 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
goto aux_overflow;
}
#ifdef RATIONAL_TREES
to_visit->beg = pt0;
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -1963,7 +2178,7 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end,
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -2160,7 +2375,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -2188,7 +2403,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -2205,7 +2420,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
/* do or pt2 are unbound */
*ptd0 = TermFoundVar;
*ptd0 = TermNil;
/* leave an empty slot to fill in later */
if (HR+1024 > ASP) {
goto global_overflow;
@ -2350,7 +2565,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -2378,7 +2593,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -2395,7 +2610,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
/* do or pt2 are unbound */
*ptd0 = TermFoundVar;
*ptd0 = TermNil;
/* leave an empty slot to fill in later */
if (HR+1024 > ASP) {
goto global_overflow;
@ -2428,7 +2643,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
if (HR != InitialH+1) {
if (HR != InitialH) {
InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR-InitialH)-1);
return AbsAppl(InitialH);
} else {
@ -2507,7 +2722,7 @@ static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -2535,7 +2750,7 @@ static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -2706,7 +2921,7 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -2735,7 +2950,7 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
@ -2751,9 +2966,9 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt
CELL *pt2 = pt0;
while(IsVarTerm(*pt2))
pt2 = (CELL *)(*pt2);
HR[1] = AbsPair(HR+2);
HR[0] = AbsPair(HR+2);
HR += 2;
HR[-2] = (CELL)pt2;
HR[-1] = (CELL)pt2;
*pt2 = TermRefoundVar;
}
continue;
@ -2768,24 +2983,28 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt
}
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
#ifdef RATIONAL_TREES
to_visit -= 3;
pt0 = to_visit[0];
pt0_end = to_visit[1];
*pt0 = (CELL)to_visit[2];
#else
to_visit -= 2;
pt0 = to_visit[0];
pt0_end = to_visit[1];
#endif
goto loop;
}
clean_tr(TR0 PASS_REGS);
if (HR != InitialH) {
/* close the list */
RESET_VARIABLE(HR-1);
Yap_unify((CELL)(HR-1),ARG2);
CELL *pt0 = InitialH, *pt1 = pt0;
while (pt0 < InitialH) {
if(Deref(pt0[0]) == TermFoundVar) {
pt1[0] = pt0[0];
pt1[1] = AbsAppl(pt1+2);
pt1 += 2;
}
pt0 += 2;
}
}
if (HR != InitialH) {
/* close the list */
HR[-1] = Deref(ARG2);
return output;
} else {
return ARG2;
@ -2816,7 +3035,7 @@ p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */
while (TRUE) {
t = Deref(ARG1);
if (IsVarTerm(t)) {
out = MkPairTerm(t,ARG2);
out = ARG2;
} else if (IsPrimitiveTerm(t)) {
out = ARG2;
} else if (IsPairTerm(t)) {
@ -2864,7 +3083,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -2892,7 +3111,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
@ -3043,7 +3262,7 @@ static Int sz_ground_complex_term(register CELL *pt0, register CELL *pt0_end, in
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -3072,7 +3291,7 @@ static Int sz_ground_complex_term(register CELL *pt0, register CELL *pt0_end, in
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
@ -3191,7 +3410,7 @@ static Int var_in_complex_term(register CELL *pt0,
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -3221,7 +3440,7 @@ static Int var_in_complex_term(register CELL *pt0,
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
@ -3251,7 +3470,7 @@ static Int var_in_complex_term(register CELL *pt0,
return(TRUE);
}
/* do or pt2 are unbound */
*ptd0 = TermFoundVar;
*ptd0 = TermNil;
/* next make sure noone will see this as a variable again */
TrailTerm(TR++) = (CELL)ptd0;
}
@ -4623,19 +4842,11 @@ loop:
if (to_visit + 32 >= to_visit_max) {
goto aux_overflow;
}
#ifdef RATIONAL_TREES
to_visit->beg = pt0;
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermFoundVar;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit += 2;
}
#endif
*pt0 = TermNil;
pt0 = RepPair(d0) - 1;
pt0_end = RepPair(d0) + 1;
} else if (IsApplTerm(d0)) {
@ -4655,14 +4866,11 @@ loop:
if (to_visit + 32 >= to_visit_max) {
goto aux_overflow;
}
#ifdef RATIONAL_TREES
#else
to_visit->beg = pt0;
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermFoundVar;
#endif
*pt0 = TermNil;
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;

194
C/write.c
View File

@ -1,4 +1,3 @@
/*************************************************************************
* *
* YAP Prolog *
@ -101,6 +100,12 @@ static bool callPortray(Term t, int sno USES_REGS) {
return false;
}
#define PROTECT(t, F) \
{ \
yhandle_t yt = Yap_InitHandle(t); \
F; \
t = Yap_PopHandle(yt); \
}
static void wrputn(Int, struct write_globs *);
static void wrputf(Float, struct write_globs *);
static void wrputref(CODEADDR, int, struct write_globs *);
@ -671,61 +676,6 @@ static void putUnquotedString(Term string, struct write_globs *wglb)
lastw = alphanum;
}
static Term from_pointer(CELL *ptr0, struct rewind_term *rwt,
struct write_globs *wglb) {
CACHE_REGS
Term t;
CELL *ptr = ptr0;
while (IsVarTerm(*ptr) && !IsUnboundVar(ptr))
ptr = (CELL *)*ptr;
t = *ptr;
if (wglb->Keep_terms) {
struct rewind_term *x = rwt->parent;
rwt->u_sd.s.old = Yap_InitSlot(t);
rwt->u_sd.s.ptr = Yap_InitSlot((CELL)ptr0);
if (!IsAtomicTerm(t) && !IsVarTerm(t)) {
while (x) {
if (Yap_GetDerefedFromSlot(x->u_sd.s.old) == t)
return TermFoundVar;
x = x->parent;
}
}
} else {
rwt->u_sd.d.old = t;
rwt->u_sd.d.ptr = ptr0;
if (!IsVarTerm(t) && !IsAtomicTerm(t)) {
struct rewind_term *x = rwt->parent;
while (x) {
if (x->u_sd.d.old == t)
return TermFoundVar;
x = x->parent;
}
}
}
return t;
}
static CELL *restore_from_write(struct rewind_term *rwt,
struct write_globs *wglb) {
CACHE_REGS
CELL *ptr;
if (wglb->Keep_terms) {
ptr = Yap_GetPtrFromSlot(rwt->u_sd.s.ptr);
Yap_RecoverSlots(2, rwt->u_sd.s.old);
// printf("leak=%d %d\n", LOCALCurSlot,rwt->u_sd.s.old) ;
} else {
ptr = rwt->u_sd.d.ptr;
}
rwt->u_sd.s.ptr = 0;
return ptr;
}
/* writes an unbound variable */
static void write_var(CELL *t, struct write_globs *wglb,
struct rewind_term *rwt) {
CACHE_REGS
@ -745,23 +695,17 @@ static void write_var(CELL *t, struct write_globs *wglb,
wglb->Portray_delays = FALSE;
if (ext == attvars_ext) {
yhandle_t h = Yap_InitHandle((CELL)t);
attvar_record *attv = RepAttVar(t);
CELL *l = &attv->Value; /* dirty low-level hack, check atts.h */
wrputs("$AT(", wglb->stream);
write_var(t, wglb, rwt);
wrputc(',', wglb->stream);
writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt);
l = restore_from_write(&nrwt, wglb);
PROTECT(*t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt));
attv = RepAttVar(t);
wrputc(',', wglb->stream);
attv = RepAttVar((CELL *)Yap_GetFromHandle(h));
l = &attv->Value;
;
l++;
writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
writeTerm(*l, 999, 1, FALSE, wglb, &nrwt);
wrclose_bracket(wglb, TRUE);
}
wglb->Portray_delays = TRUE;
@ -774,25 +718,6 @@ static void write_var(CELL *t, struct write_globs *wglb,
}
}
static Term check_infinite_loop(Term t, struct rewind_term *x,
struct write_globs *wglb) {
CACHE_REGS
if (wglb->Keep_terms) {
while (x) {
if (Yap_GetFromSlot(x->u_sd.s.old) == t)
return TermFoundVar;
x = x->parent;
}
} else {
while (x) {
if (x->u_sd.d.old == t)
return TermFoundVar;
x = x->parent;
}
}
return t;
}
static void write_list(Term t, int direction, int depth,
struct write_globs *wglb, struct rewind_term *rwt) {
Term ti;
@ -804,14 +729,11 @@ static void write_list(Term t, int direction, int depth,
int ndirection;
int do_jump;
writeTerm(from_pointer(RepPair(t), &nrwt, wglb), 999, depth + 1, FALSE,
wglb, &nrwt);
t = AbsPair(restore_from_write(&nrwt, wglb));
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
ti = TailOfTerm(t);
if (IsVarTerm(ti))
break;
if (!IsPairTerm(ti) ||
!IsPairTerm((ti = check_infinite_loop(ti, rwt, wglb))))
if (!IsPairTerm(ti))
break;
ndirection = RepPair(ti) - RepPair(t);
/* make sure we're not trapped in loops */
@ -842,29 +764,17 @@ static void write_list(Term t, int direction, int depth,
t = ti;
}
if (IsPairTerm(ti)) {
Term nt = from_pointer(RepPair(t) + 1, &nrwt, wglb);
/* we found an infinite loop */
if (IsAtomTerm(nt)) {
if (lastw == symbol || lastw == separator) {
wrputc(' ', wglb->stream);
}
wrputc('|', wglb->stream);
writeTerm(nt, 999, depth, FALSE, wglb, rwt);
} else {
/* keep going on the list */
wrputc(',', wglb->stream);
write_list(nt, direction, depth, wglb, &nrwt);
}
restore_from_write(&nrwt, wglb);
/* keep going on the list */
wrputc(',', wglb->stream);
write_list(ti, direction, depth, wglb, &nrwt);
} else if (ti != MkAtomTerm(AtomNil)) {
if (lastw == symbol || lastw == separator) {
wrputc(' ', wglb->stream);
}
wrputc('|', wglb->stream);
lastw = separator;
writeTerm(from_pointer(RepPair(t) + 1, &nrwt, wglb), 999, depth, FALSE,
wglb, &nrwt);
restore_from_write(&nrwt, wglb);
writeTerm(ti, 999, depth, FALSE, wglb, &nrwt);
}
}
@ -872,7 +782,6 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
struct write_globs *wglb, struct rewind_term *rwt)
/* term to write */
/* context priority */
{
CACHE_REGS
struct rewind_term nrwt;
@ -896,13 +805,9 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrputs("'.'(", wglb->stream);
lastw = separator;
writeTerm(from_pointer(RepPair(t), &nrwt, wglb), 999, depth + 1, FALSE,
wglb, &nrwt);
t = AbsPair(restore_from_write(&nrwt, wglb));
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
wrputs(",", wglb->stream);
writeTerm(from_pointer(RepPair(t) + 1, &nrwt, wglb), 999, depth + 1,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt);
wrclose_bracket(wglb, TRUE);
return;
}
@ -968,9 +873,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
*p++;
lastw = separator;
/* cannot use the term directly with the SBA */
writeTerm(from_pointer(p, &nrwt, wglb), 999, depth + 1, FALSE, wglb,
&nrwt);
p = restore_from_write(&nrwt, wglb) + 1;
PROTECT(t, writeTerm(*p, 999, depth + 1, FALSE, wglb, &nrwt));
if (*p)
wrputc(',', wglb->stream);
argno++;
@ -998,9 +901,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
} else if (atom == AtomMinus) {
last_minus = TRUE;
}
writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), rp, depth + 1, TRUE,
wglb, &nrwt);
restore_from_write(&nrwt, wglb);
writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt);
if (bracket_right) {
wrclose_bracket(wglb, TRUE);
}
@ -1033,9 +934,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (bracket_left) {
wropen_bracket(wglb, TRUE);
}
writeTerm(from_pointer(RepAppl(t) + offset, &nrwt, wglb), lp, depth + 1,
rinfixarg, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
writeTerm(ArgOfTerm(offset, t), lp, depth + 1, rinfixarg, wglb, &nrwt);
if (bracket_left) {
wrclose_bracket(wglb, TRUE);
}
@ -1080,9 +979,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (bracket_left) {
wropen_bracket(wglb, TRUE);
}
writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), lp, depth + 1,
rinfixarg, wglb, &nrwt);
t = AbsAppl(restore_from_write(&nrwt, wglb) - 1);
PROTECT(
t, writeTerm(ArgOfTerm(1, t), lp, depth + 1, rinfixarg, wglb, &nrwt));
if (bracket_left) {
wrclose_bracket(wglb, TRUE);
}
@ -1101,9 +999,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (bracket_right) {
wropen_bracket(wglb, TRUE);
}
writeTerm(from_pointer(RepAppl(t) + 2, &nrwt, wglb), rp, depth + 1, TRUE,
wglb, &nrwt);
restore_from_write(&nrwt, wglb);
writeTerm(ArgOfTerm(2, t), rp, depth + 1, TRUE, wglb, &nrwt);
if (bracket_right) {
wrclose_bracket(wglb, TRUE);
}
@ -1143,17 +1039,14 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
} else {
wrputs("'$VAR'(", wglb->stream);
lastw = separator;
writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), 999, depth + 1,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
writeTerm(ArgOfTerm(1, t), 999, depth + 1, FALSE, wglb, &nrwt);
wrclose_bracket(wglb, TRUE);
}
} else if (!wglb->Ignore_ops && functor == FunctorBraces) {
wrputc('{', wglb->stream);
lastw = separator;
writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), GLOBAL_MaxPriority,
depth + 1, FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority, depth + 1, FALSE, wglb,
&nrwt);
wrputc('}', wglb->stream);
lastw = separator;
} else if (atom == AtomArray) {
@ -1164,35 +1057,34 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrputs("...", wglb->stream);
break;
}
writeTerm(from_pointer(RepAppl(t) + op, &nrwt, wglb), 999, depth + 1,
FALSE, wglb, &nrwt);
t = AbsAppl(restore_from_write(&nrwt, wglb) - op);
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
if (op != Arity) {
PROTECT(t, writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb,
&nrwt));
wrputc(',', wglb->stream);
lastw = separator;
}
}
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
wrputc('}', wglb->stream);
lastw = separator;
} else {
putAtom(atom, wglb->Quote_illegal, wglb);
lastw = separator;
wropen_bracket(wglb, FALSE);
for (op = 1; op <= Arity; ++op) {
for (op = 1; op < Arity; ++op) {
if (op == wglb->MaxArgs) {
wrputc('.', wglb->stream);
wrputc('.', wglb->stream);
wrputc('.', wglb->stream);
break;
}
writeTerm(from_pointer(RepAppl(t) + op, &nrwt, wglb), 999, depth + 1,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
if (op != Arity) {
wrputc(',', wglb->stream);
lastw = separator;
}
PROTECT(
t, writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt));
wrputc(',', wglb->stream);
lastw = separator;
}
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
wrclose_bracket(wglb, TRUE);
}
}
@ -1232,8 +1124,18 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
rwt.parent = NULL;
wglb.Ignore_ops = flags & Ignore_ops_f;
wglb.Write_strings = flags & BackQuote_String_f;
if (!(flags & Ignore_cyclics_f) && false) {
Term ts[2];
ts[0] = Yap_BreakRational(t, 0, ts + 1, TermNil PASS_REGS);
// fprintf(stderr, "%lx %lx %lx\n", t, ts[0], ts[1]);
// Yap_DebugPlWriteln(ts[0]);
// ap_DebugPlWriteln(ts[1[);
if (ts[1] != TermNil) {
t = Yap_MkApplTerm(FunctorAtSymbol, 2, ts);
}
}
/* protect slots for portray */
writeTerm(from_pointer(&t, &rwt, &wglb), priority, 1, FALSE, &wglb, &rwt);
writeTerm(t, priority, 1, FALSE, &wglb, &rwt);
if (flags & New_Line_f) {
if (flags & Fullstop_f) {
wrputc('.', wglb.stream);
@ -1247,8 +1149,6 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
wrputc(' ', wglb.stream);
}
}
restore_from_write(&rwt, &wglb);
Yap_CloseSlots(sls);
pop_text_stack(lvl);
}

3
C/yap-args.c
View File

@ -1052,6 +1052,9 @@ X_API void YAP_Init(YAP_init_args *yap_init) {
MkAtomTerm(Yap_LookupAtom(Yap_BOOTFILE)));
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false);
} else {
if (yap_init->QuietMode) {
setVerbosity(TermSilent);
}
Yap_Restore(Yap_INPUT_STARTUP);
init_globals(yap_init);

836
CMakeLists.txt Normal file → Executable file
View File

File diff suppressed because it is too large Load Diff

26
CXX/CMakeLists.txt
View File

@ -5,27 +5,27 @@ set(SO_MINOR 0)
set(SO_PATCH 0)
set (CXX_SOURCES
yapi.cpp
)
yapi.cpp
)
list(APPEND LIBYAP_SOURCES ${CXX_SOURCES} PARENT_SCOPE)
if ( WIN32 OR ANDROID)
add_component (YAP++ ${CXX_SOURCES} )
add_component (YAP++ ${CXX_SOURCES} )
set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS "_YAP_NOT_INSTALLED_=1;HAVE_CONFIG_H=1;_GNU_SOURCE;YAP_KERNEL=1" )
else()
add_lib(YAP++ ${CXX_SOURCES} )
if (WITH_PYTHON)
target_link_libraries(YAP++ Py4YAP )
endif()
target_link_libraries(YAP++ ${CMAKE_DL_LIBS} libYap)
add_lib(YAP++ ${CXX_SOURCES} )
if (WITH_PYTHON)
target_link_libraries(YAP++ Py4YAP )
endif()
target_link_libraries(YAP++ ${CMAKE_DL_LIBS} libYap)
MY_install(TARGETS YAP++
LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}
RUNTIME DESTINATION ${YAP_INSTALL_DLLDIR}
ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR}
)
MY_install(TARGETS YAP++
LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}
RUNTIME DESTINATION ${CMAKE_INSTALL_LIBDIR}
ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR}
)
endif()

16
CXX/yapi.cpp
View File

@ -18,6 +18,8 @@ extern "C" {
#include "YapBlobs.h"
#include "YapInterface.h"
#include "iopreds.h"
#include "YapInit.h"
X_API char *Yap_TermToBuffer(Term t, int flags);
@ -667,8 +669,10 @@ Term YAPEngine::fun(Term t) {
throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE, t, 0);
return 0L;
}
XREGS[arity + 1] = MkVarTerm();
Term ot = XREGS[arity + 1] = MkVarTerm();
yhandle_t h = Yap_InitHandle(ot);
arity++;
HR += arity;
f = Yap_MkFunctor(name, arity);
ap = (PredEntry *)(PredPropByFunc(f, tmod));
if (ap == nullptr || ap->OpcodeOfPred == UNDEF_OPCODE) {
@ -683,12 +687,16 @@ Term YAPEngine::fun(Term t) {
//__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec ");
bool result = (bool)YAP_EnterGoal(ap, nullptr, &q);
YAPCatchError();
if (result)
ot = Yap_GetFromHandle(h);
else
ot = TermNone;
YAPCatchError();
{
YAP_LeaveGoal(result, &q);
// PyEval_RestoreThread(_save);
RECOVER_MACHINE_REGS();
return result;
return ot;
}
}
@ -969,7 +977,7 @@ PredEntry *YAPPredicate::getPred(Term &t, Term &m, CELL *&out) {
} else {
ap = RepPredProp(PredPropByFunc(f, m));
if (out)
memmove(out, RepAppl(t) + 1, ap->ArityOfPE * sizeof(CELL));
memmove(out, (const CELL *)RepAppl(t) + 1, ap->ArityOfPE * sizeof(CELL));
else
out = RepAppl(t) + 1;
}

32
CXX/yapi.hh Normal file → Executable file
View File

@ -8,11 +8,20 @@
#define YAP_CPP_INTERFACE 1
#include <gmpxx.h>
#include <iostream>
#include <string>
#include <vector>
extern "C" {
#include "YapConfig.h"
}
#if HAVE_GMPXX_H
#include <gmpxx.h>
#elif HAVE_GMP_H
#include <gmp.h>
#endif
/*!
*
* @ingroup fli_c_cxx
@ -32,17 +41,14 @@
extern "C" {
#include <stdlib.h>
// Bad export from Python
#include <config.h>
#include <YapConfig.h>
#include <stddef.h>
#if YAP_PYTHON
#include <Python.h>
@ -93,22 +99,19 @@ X_API extern void YAP_UserCPredicate(const char *, YAP_UserCPred,
X_API extern void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred,
YAP_Arity, YAP_Term);
X_API extern void YAP_UserBackCPredicate(const char *name,
YAP_UserCPred init,
YAP_UserCPred cont,
YAP_Arity arity, YAP_Arity extra);
X_API extern void YAP_UserBackCPredicate(const char *name, YAP_UserCPred init,
YAP_UserCPred cont, YAP_Arity arity,
YAP_Arity extra);
X_API extern void YAP_UserBackCutCPredicate(const char *name,
YAP_UserCPred init,
YAP_UserCPred init,
YAP_UserCPred cont,
YAP_UserCPred cut,
YAP_Arity arity, YAP_Arity extra);
YAP_UserCPred cut, YAP_Arity arity,
YAP_Arity extra);
X_API extern YAP_Term YAP_ReadBuffer(const char *s, YAP_Term *tp);
extern YAP_Term YAP_MkcharPTerm(char *s);
}
class YAPEngine;
@ -121,7 +124,6 @@ class YAPModule;
class YAPError;
class YAPPredicate;
#include "yapa.hh"
#include "yapie.hh"

2
CXX/yapq.hh
View File

@ -367,7 +367,7 @@ public:
//> output.
YAPTerm funCall(YAPTerm t) { return YAPTerm(fun(t.term())); };
Term fun(Term t);
Term fun(YAPTerm t) { return fun(t.term()); };
//Term fun(YAPTerm t) { return fun(t.term()); };
//> set a StringFlag, usually a path
//>
bool setStringFlag(std::string arg, std::string path) {

3
CXX/yapt.hh
View File

@ -525,8 +525,9 @@ public:
mk(t);
}
}
/// type check for unbound
bool unbound() { return IsUnboundVar(VarOfTerm(gt())); }
inline bool isVar() { return true; } /// type check for unbound
inline bool isVar() { return true; }
inline bool isAtom() { return false; } /// type check for atom
inline bool isInteger() { return false; } /// type check for integer
inline bool isFloat() { return false; } /// type check for floating-point

5
H/ATOMS
View File

@ -7,6 +7,7 @@
// This is supported by YAP directly
// A Dot N "."
//
A AtSymbol N "@"
A 3Dots N "..."
A Abol F "$abol"
A Access N "access"
@ -187,6 +188,7 @@ A GlobalSp N "global_sp"
A GlobalTrie N "global_trie"
A GoalExpansion N "goal_expansion"
A Hat N "^"
A DoubleHat N "^^"
A HERE N "\n <====HERE====> \n"
A HandleThrow F "$handle_throw"
A Heap N "heap"
@ -462,6 +464,8 @@ F DoubleArrow DoubleArrow 2
F As As 2
F Assert1 Assert 1
F Assert Assert 2
F At At 2
F AtSymbol AtSymbol 2
F AtFoundOne FoundVar 2
F Atom Atom 1
F Att1 Att1 3
@ -535,6 +539,7 @@ F GoalExpansion2 GoalExpansion 2
F GoalExpansion GoalExpansion 3
F HandleThrow HandleThrow 3
F Hat Hat 2
F DoubleHat DoubleHat 1
F I I 2
F Id Id 1
F Info1 Info 1

26
H/TermExt.h
View File

@ -388,26 +388,6 @@ INLINE_ONLY bool IsStringTerm(Term t) {
#include <stdio.h>
#if !defined(__cplusplus)
#include <gmp.h>
#endif
#else
typedef UInt mp_limb_t;
typedef struct {
Int _mp_size, _mp_alloc;
mp_limb_t *_mp_d;
} MP_INT;
typedef struct {
MP_INT _mp_num;
MP_INT _mp_den;
} MP_RAT;
#endif
INLINE_ONLY bool IsBigIntTerm(Term);
INLINE_ONLY bool IsBigIntTerm(Term t) {
@ -415,7 +395,11 @@ INLINE_ONLY bool IsBigIntTerm(Term t) {
FunctorOfTerm(t) == FunctorBigInt;
}
#ifdef USE_GMP
#if !defined(__cplusplus)
#include <gmp.h>
#endif
Term Yap_MkBigIntTerm(MP_INT *);
MP_INT *Yap_BigIntOfTerm(Term);

24
H/Yap.h
View File

@ -50,7 +50,7 @@
#endif /* THREADS && (YAPOR_COW || YAPOR_SBA || YAPOR_COPY) */
// Bad export from Python
#include "config.h"
#include "YapConfig.h"
#ifndef COROUTINING
#define COROUTINING 1
@ -74,6 +74,28 @@
#include <stdint.h>
#endif
typedef YAP_Int Int;
typedef YAP_UInt UInt;
typedef YAP_Short Short;
typedef YAP_UShort UShort;
typedef uint16_t BITS16;
typedef int16_t SBITS16;
typedef uint32_t BITS32;
typedef YAP_CELL CELL;
typedef YAP_Term Term;
#define WordSize sizeof(BITS16)
#define CellSize sizeof(CELL)
#define SmallSize sizeof(SMALLUNSGN)
typedef YAP_Int Int;
typedef YAP_Float Float;
typedef YAP_handle_t yhandle_t;
#define TermZERO ((Term)0)
/*
#define RATIONAL_TREES 1

5
H/YapEval.h Normal file → Executable file
View File

@ -205,7 +205,6 @@ typedef enum {
op_heapused,
op_localsp,
op_globalsp,
op_b,
op_env,
op_tr,
op_stackfree
@ -632,13 +631,13 @@ __Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS) {
}
inline static Term add_int(Int i, Int j USES_REGS) {
#if defined(__clang__) || defined(__GNUC__)
#if defined(__clang__) || (defined(__GNUC__) && __GNUC__ > 4)
Int w;
if (!__builtin_add_overflow(i, j, &w))
RINT(w);
return Yap_gmp_add_ints(i, j);
;
#elif defined(__GNUC__)
#elif defined(__GNUC__) && __GNUC__ > 4
Int w;
if (!__builtin_add_overflow_p(i, j, w))
RINT(w);

19
H/YapFlags.h
View File

@ -187,6 +187,18 @@ static inline Term isatom(Term inp) {
return TermZERO;
}
static inline Term isadress(Term inp) {
if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag %s",
"value must be bound");
return TermZERO;
}
if (IsAddressTerm(inp))
return inp;
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return TermZERO;
}
static inline Term options(Term inp) {
return Yap_IsGroundTerm(inp) ? inp : TermZERO;
}
@ -342,8 +354,11 @@ static inline bool verboseMode(void) {
return GLOBAL_Flags[VERBOSE_FLAG].at != TermSilent;
}
static inline void setVerbosity(Term val) {
GLOBAL_Flags[VERBOSE_FLAG].at = val;
if (val == TermSilent)
GLOBAL_Flags[VERBOSE_LOAD_FLAG].at = TermFalse;
}
static inline bool setSyntaxErrorsFlag(Term val) {
@ -405,12 +420,12 @@ extern xarg *Yap_ArgListToVector__(const char *file, const char *function, int
#define Yap_ArgListToVector(l, def, n, e) \
Yap_ArgListToVector__(__FILE__, __FUNCTION__, __LINE__, l, def, n, e)
extern xarg *Yap_ArgList2ToVector__(const char *file, const char *function, int lineno, Term listl, const param2_t *def, int n, yap_error_number e);
#define Yap_ArgList2ToVector(l, def, n, e) \
Yap_ArgList2ToVector__(__FILE__, __FUNCTION__, __LINE__, l, def, n, e)
#endif // YAP_FLAGS_H
/// @}

411
H/YapGFlagInfo.h
View File

@ -24,28 +24,29 @@
START_GLOBAL_FLAGS
YAP_FLAG(ADDRESS_BITS_FLAG, "address_bits", false, nat, BITNESS, NULL), /**<
/**<
Number of address bits in the machine, either 64 or 32 bits.
*/
YAP_FLAG(ADDRESS_BITS_FLAG, "address_bits", false, nat, BITNESS, NULL),
YAP_FLAG(AGC_MARGIN_FLAG, "agc_margin", true, nat, "10000",
agc_threshold), /**<
/**<
An integer: if this amount of atoms has been created since the last
atom-garbage collection, perform atom garbage collection at the first
opportunity. Initial value is 10,000. May be changed. A value of 0
(zero) disables atom garbage collection.
*/
YAP_FLAG(AGC_MARGIN_FLAG, "agc_margin", true, nat, "10000",
agc_threshold),
YAP_FLAG(ALLOW_ASSERT_FOR_STATIC_PREDICATES,
/**<
boolean: allow asserting and retracting clauses of static
predicates. */
YAP_FLAG(ALLOW_ASSERT_FOR_STATIC_PREDICATES,
"allow_assert_for_static_predicates", true, booleanFlag, "true",
NULL), /**<
boolean: allow asserting and retracting clauses of static
predicates. */
NULL),
YAP_FLAG(ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG,
"allow_variable_name_as_functor", false, booleanFlag, "false",
NULL), /**<
/**<
boolean flag allows syntax such
as
@ -55,27 +56,36 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
Tree(R).
~~~
*/
YAP_FLAG(ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG,
"allow_variable_name_as_functor", false, booleanFlag, "false",
NULL),
YAP_FLAG(ANSWER_FORMAT_FLAG, "answer_format", true, isatom, "~p", NULL),
/**< how to present answers, default is `~p`. */
YAP_FLAG(ANSWER_FORMAT_FLAG, "answer_format", true, isatom, "~p", NULL),
#if __ANDROID__
YAP_FLAG(ANDROID_FLAG, "android", false, booleanFlag, "true", NULL), /**<
/**<
read-only boolean, a machine running an Google's Android version of the
Linux Operating System */
YAP_FLAG(ANDROID_FLAG, "android", false, booleanFlag, "true", NULL),
#else
YAP_FLAG(ANDROID_FLAG, "android", false, booleanFlag, "false", NULL),
#endif
#if __APPLE__
YAP_FLAG(APPLE_FLAG, "apple", false, booleanFlag, "true", NULL), /**<
/**<
read-only boolean, a machine running an Apple Operating System */
YAP_FLAG(APPLE_FLAG, "apple", false, booleanFlag, "true", NULL),
#else
YAP_FLAG(APPLE_FLAG, "apple", false, booleanFlag, "false", NULL),
#endif
YAP_FLAG(ARCH_FLAG, "arch", false, isatom, YAP_ARCH, NULL), /**<
/**<
read-only atom, it describes the ISA used in this version of YAP.
Available from YAP_ARCH.
*/
YAP_FLAG(ARCH_FLAG, "arch", false, isatom, YAP_ARCH, NULL),
YAP_FLAG(ARGV_FLAG, "argv", false, argv, "@boot", NULL),
YAP_FLAG(ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true,
booleanFlag, "true", NULL),
/**<
/**<
Read-write flag telling whether arithmetic exceptions generate
Prolog exceptions. If enabled:
@ -95,86 +105,96 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
It is `true` by default, but it is disabled by packages like CLP(BN) and
ProbLog.
*/
YAP_FLAG(BACK_QUOTES_FLAG, "back_quotes", true, isatom, "true", bqs),
/**<
YAP_FLAG(ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true,
booleanFlag, "true", NULL),
/**<
If _Value_ is unbound, tell whether a back quoted list of characters
token is converted to a list of atoms, `chars`, to a list of integers,
`codes`, or to a single atom, `atom`. If _Value_ is bound, set to
the corresponding behavior. The default value is `string`
*/
YAP_FLAG(BOUNDED_FLAG, "bounded", false, booleanFlag, "false", NULL),
/**< `bounded` is iso
YAP_FLAG(BACK_QUOTES_FLAG, "back_quotes", true, isatom, "true", bqs),
/**<
Read-only flag telling whether integers are bounded. The value depends
on whether YAP uses the GMP library or not.
*/
YAP_FLAG(BOUNDED_FLAG, "bounded", false, booleanFlag, "false", NULL),
YAP_FLAG(C_CC_FLAG, "c_cc", false, isatom, C_CC, NULL),
YAP_FLAG(C_CFLAGS_FLAG, "c_cflags", false, isatom, C_CFLAGS, 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_LIBS_FLAG, "c_libs", false, isatom, C_LIBS, NULL),
YAP_FLAG(CHAR_CONVERSION_FLAG, "char_conversion", true, booleanFlag,
"false", NULL),
/**< `char_conversion is iso`
/**< `char_conversion is iso`
Writable flag telling whether a character conversion table is used when
reading terms. The default value for this flag is `off` except in
`sicstus` and `iso` language modes, where it is `on`.
*/
YAP_FLAG(CHARACTER_ESCAPES_FLAG, "character_escapes", true, booleanFlag,
"true", NULL),
/**< `
YAP_FLAG(CHAR_CONVERSION_FLAG, "char_conversion", true, booleanFlag,
"false", NULL),
/**< `
Writable flag telling whether a character escapes are enabled,
`true`, or disabled, `false`. The default value for this flag is
`true`. */
YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context",
true, booleanFlag, "true", NULL),
/**< `compiled_at `
YAP_FLAG(CHARACTER_ESCAPES_FLAG, "character_escapes", true, booleanFlag,
"true", NULL),
/**< `compiled_at `
Read-only flag that gives the time when the main YAP binary was compiled.
It is obtained staight from the __TIME__ macro, as defined in the C99.
*/
YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context",
true, booleanFlag, "true", NULL),
YAP_FLAG(COMPILED_AT_FLAG, "compiled_at", false, isatom, YAP_COMPILED_AT,
NULL),
YAP_FLAG(DEBUG_FLAG, "debug", true, booleanFlag, "false", NULL),
/**<
/**<
If _Value_ is unbound, tell whether debugging is `true` or
`false`. If _Value_ is bound to `true` enable debugging, and if
it is bound to `false` disable debugging.
*/
YAP_FLAG(DEBUG_FLAG, "debug", true, booleanFlag, "false", NULL),
YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, booleanFlag, "true", NULL),
YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, booleanFlag, "true",
NULL),
/**<
/**<
If bound, set the argument to the `write_term/3` options the
debugger uses to write terms. If unbound, show the current options.
*/
YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, booleanFlag, "true",
NULL),
YAP_FLAG(DEBUGGER_PRINT_OPTIONS_FLAG, "debugger_print_options", true,
list_option,
"[quoted(true),numbervars(true),portrayed(true),max_depth(10)]",
NULL),
YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true,
booleanFlag, "false", NULL),
YAP_FLAG(DEFAULT_PARENT_MODULE_FLAG, "default_parent_module", true, isatom,
"user", NULL),
/**<
/**<
* A module to be inherited by all other modules. Default is user that
* reexports prolog.
*
* Set it to `prolog` for SICStus Prolog like resolution, to `user` for
* SWI-like.
*/
YAP_FLAG(DIALECT_FLAG, "dialect", false, ro, "yap", NULL),
/**<
YAP_FLAG(DEFAULT_PARENT_MODULE_FLAG, "default_parent_module", true, isatom,
"user", NULL),
/**<
Read-only flag that always returns `yap`.
*/
YAP_FLAG(DISCONTIGUOUS_WARNINGS_FLAG, "discontiguous_warnings", true,
booleanFlag, "true", NULL),
/**<
YAP_FLAG(DIALECT_FLAG, "dialect", false, ro, "yap", NULL),
/**<
If `true` (default `true`) YAP checks for definitions of the same predicate
that are separated by clauses for other predicates. This may indicate that
@ -184,36 +204,42 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
predicates.
*/
YAP_FLAG(DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true,
booleanFlag, "false", NULL),
/**<
YAP_FLAG(DISCONTIGUOUS_WARNINGS_FLAG, "discontiguous_warnings", true,
booleanFlag, "true", NULL),
/**<
If `off` (default) consider the character `$` a control character, if
vxu `on` consider `$` a lower case character.
*/
YAP_FLAG(DOUBLE_QUOTES_FLAG, "double_quotes", true, isatom, "codes", dqs),
/**< iso
YAP_FLAG(DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true,
booleanFlag, "false", NULL),
/**< iso
If _Value_ is unbound, tell whether a double quoted list of characters
token is converted to a list of atoms, `chars`, to a list of integers,
`codes`, or to a single atom, `atom`. If _Value_ is bound, set to
the corresponding behavior. The default value is `codes`. */
YAP_FLAG(DOUBLE_QUOTES_FLAG, "double_quotes", true, isatom, "codes", dqs),
YAP_FLAG(EDITOR_FLAG, "editor", true, isatom, "$EDITOR", NULL),
YAP_FLAG(EXECUTABLE_FLAG, "executable", false, executable, "@boot", NULL),
/**<
/**<
Read-only flag. It unifies with an atom that gives the
original program path.
*/
YAP_FLAG(FAST_FLAG, "fast", true, booleanFlag, "false", NULL),
/**<
YAP_FLAG(EXECUTABLE_FLAG, "executable", false, executable, "@boot", NULL),
/**<
If `on` allow fast machine code, if `off` (default) disable it. Only
available in experimental implementations.
*/
YAP_FLAG(FAST_FLAG, "fast", true, booleanFlag, "false", NULL),
YAP_FLAG(FILE_NAME_VARIABLES_FLAG, "file_name_variables", true, booleanFlag,
"true", NULL),
YAP_FLAG(FLOAT_FORMAT_FLAG, "float_format", true, isatom, "%.16f", NULL),
/**<
/**<
C-library `printf()` format specification used by write/1 and
friends to determine how floating point numbers are printed. The
@ -222,20 +248,23 @@ vxu `on` consider `$` a lower case character.
printed, `%g` will print all floats using 6 digits instead of the
default 15.
*/
YAP_FLAG(GC_FLAG, "gc", true, booleanFlag, "on", NULL),
/**< `gc`
YAP_FLAG(FLOAT_FORMAT_FLAG, "float_format", true, isatom, "%.16f", NULL),
/**< `gc`
If `on` allow garbage collection (default), if `off` disable it.
*/
YAP_FLAG(GC_MARGIN_FLAG, "gc_margin", true, nat, "0", gc_margin),
/**< `gc_margin `
YAP_FLAG(GC_FLAG, "gc", true, booleanFlag, "on", NULL),
/**< `gc_margin `
Set or show the minimum free stack before starting garbage
collection. The default depends on total stack size.
*/
YAP_FLAG(GC_TRACE_FLAG, "gc_trace", true, isatom, "off", NULL),
/**<
YAP_FLAG(GC_MARGIN_FLAG, "gc_margin", true, nat, "0", gc_margin),
/**<
*
If `off` (default) do not show information on garbage collection
and stack shifts, if `on` inform when a garbage collection or stack
@ -244,9 +273,9 @@ vxu `on` consider `$` a lower case character.
information on data-structures found during the garbage collection
process, namely, on choice-points.
*/
YAP_FLAG(GENERATE_DEBUGGING_INFO_FLAG, "generate_debug_info", true,
booleanFlag, "true", NULL),
/**< `
YAP_FLAG(GC_TRACE_FLAG, "gc_trace", true, isatom, "off", NULL),
/**< `
If `true` (default) generate debugging information for
procedures, including source mode. If `false` predicates no
@ -254,55 +283,64 @@ vxu `on` consider `$` a lower case character.
source mode is disabled.
*/
YAP_FLAG(GENERATE_DEBUGGING_INFO_FLAG, "generate_debug_info", true,
booleanFlag, "true", NULL),
YAP_FLAG(GMP_VERSION_FLAG, "gmp_version", false, isatom, "4.8.12", NULL),
YAP_FLAG(HALT_AFTER_CONSULT_FLAG, "halt_after_consult", false, booleanFlag,
"false", NULL),
YAP_FLAG(HOME_FLAG, "home", false, isatom, YAP_ROOTDIR, NULL),
/**< home `
/**< home `
the root of the YAP installation, by default `/usr/local` in Unix or
`c:\Yap` in Windows system. Can only be set at configure time
*/
YAP_FLAG(HOST_TYPE_FLAG, "host_type", false, isatom, HOST_ALIAS, NULL),
/**< host_type `
YAP_FLAG(HOME_FLAG, "home", false, isatom, YAP_ROOTDIR, NULL),
/**< host_type `
Return `configure` system information, including the machine-id
for which YAP was compiled and Operating System information.
*/
YAP_FLAG(INDEX_FLAG, "index", true, indexer, "multi", NULL),
/**< `index `
YAP_FLAG(HOST_TYPE_FLAG, "host_type", false, isatom, HOST_ALIAS, NULL),
/**< `index `
If `on` allow indexing (default), if `off` disable it, if
`single` allow on first argument only.
*/
YAP_FLAG(INDEX_SUB_TERM_SEARCH_DEPTH_FLAG, "index_sub_term_search_depth",
true, nat, "0", NULL),
/**< `Index_sub_term_search_depth `
YAP_FLAG(INDEX_FLAG, "index", true, indexer, "multi", NULL),
/**< `Index_sub_term_search_depth `
Maximum bound on searching sub-terms for indexing, if `0` (default) no
bound.
*/
YAP_FLAG(INFORMATIONAL_MESSAGES_FLAG, "informational_messages", true,
isatom, "normal", NULL),
/**< `informational_messages `
YAP_FLAG(INDEX_SUB_TERM_SEARCH_DEPTH_FLAG, "index_sub_term_search_depth",
true, nat, "0", NULL),
/**< `informational_messages `
If `on` allow printing of informational messages, such as the ones
that are printed when consulting. If `off` disable printing
these messages. It is `on` by default except if YAP is booted with
the `-L` flag.
*/
YAP_FLAG(INTEGER_ROUNDING_FUNCTION_FLAG, "integer_rounding_function", true,
isatom, "toward_zero", NULL),
/**< `integer_rounding_function is iso `
YAP_FLAG(INFORMATIONAL_MESSAGES_FLAG, "informational_messages", true,
isatom, "normal", NULL),
/**< `integer_rounding_function is iso `
Read-only flag telling the rounding function used for integers. Takes the
value `toward_zero` for the current version of YAP.
*/
YAP_FLAG(INTEGER_ROUNDING_FUNCTION_FLAG, "integer_rounding_function", true,
isatom, "toward_zero", NULL),
YAP_FLAG(ISO_FLAG, "iso", true, booleanFlag, "false", NULL),
YAP_FLAG(JUPYTER_FLAG, "jupyter", false, booleanFlag, "true", NULL), /**<
/**<
read-only boolean, a machine running Jupyter */
YAP_FLAG(LANGUAGE_FLAG, "language", true, isatom, "yap", NULL),
/**< `language `
YAP_FLAG(JUPYTER_FLAG, "jupyter", false, booleanFlag, "true", NULL),
/**< `language `
Choose whether YAP follows native, closer to C-Prolog, `yap`, iso-prolog,
`iso` or SICStus Prolog, `sicstus`. The current default is
@ -311,21 +349,26 @@ vxu `on` consider `$` a lower case character.
are interpreted, when to use dynamic, character escapes, and how files
are consulted. Also check the `dialect` option.
*/
YAP_FLAG(PROLOG_LIBRARY_DIRECTORY_FLAG, "prolog_library_directory", true,
isatom, "", NULL),
/**< if defined, first location where YAP expects to find the YAP Prolog
YAP_FLAG(LANGUAGE_FLAG, "language", true, isatom, "yap", NULL),
/**< if defined, first location where YAP expects to find the YAP Prolog
library. Takes precedence over library_directory */
YAP_FLAG(PROLOG_FOREIGN_DIRECTORY_FLAG, "prolog_foreign_directory", true,
YAP_FLAG(PROLOG_LIBRARY_DIRECTORY_FLAG, "prolog_library_directory", true,
isatom, "", NULL),
/**< if defined, first location where YAP expects to find the YAP Prolog
/**< if defined, first location where YAP expects to find the YAP Prolog
shared libraries (DLLS). Takes precedence over executable_directory/2. */
/**< `max_arity is iso `
/**< `max_arity is iso `
YAP_FLAG(MAX_ARITY_FLAG, "max_arity", false, isatom, "unbounded", NULL),
Read-only flag telling the maximum arity of a functor. Takes the value
`unbounded` for the current version of YAP.
*/
YAP_FLAG(PROLOG_FOREIGN_DIRECTORY_FLAG, "prolog_foreign_directory", true,
isatom, "", NULL),
YAP_FLAG(MAX_TAGGED_INTEGER_FLAG, "max_tagged_integer", false, at2n,
"INT_MAX", NULL),
YAP_FLAG(MAX_THREADS_FLAG, "max_threads", false, at2n, "MAX_THREADS", NULL),
@ -336,28 +379,31 @@ vxu `on` consider `$` a lower case character.
"256", NULL),
YAP_FLAG(OCCURS_CHECK_FLAG, "occurs_check", true, booleanFlag, "false",
NULL),
YAP_FLAG(OPEN_EXPANDS_FILENAME_FLAG, "open_expands_filename", true,
booleanFlag, "false", NULL),
/**< `open_expands_filename `
/**< `open_expands_filename `
If `true` the open/3 builtin performs filename-expansion
before opening a file (SICStus Prolog like). If `false` it does not
(SWI-Prolog like).
*/
YAP_FLAG(OPEN_SHARED_OBJECT_FLAG, "open_shared_object", true, booleanFlag,
"true", NULL),
/**< `open_shared_object `
YAP_FLAG(OPEN_EXPANDS_FILENAME_FLAG, "open_expands_filename", true,
booleanFlag, "false", NULL),
/**< `open_shared_object `
If true, `open_shared_object/2` and friends are implemented,
providing access to shared libraries (`.so` files) or to dynamic link
libraries (`.DLL` files).
*/
/**< `module_independent_operators `
/**< `module_independent_operators `
If `true` an operator declaration will be valid for every module in the
program. This is for compatibility with old software that
might expect module-independent operators.
*/
YAP_FLAG(OPEN_SHARED_OBJECT_FLAG, "open_shared_object", true, booleanFlag,
"true", NULL),
YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, "module_independent_operators",
true, booleanFlag, "false", NULL),
@ -365,17 +411,16 @@ vxu `on` consider `$` a lower case character.
YAP_FLAG(OS_ARGV_FLAG, "os_argv", false, os_argv, "@boot", NULL),
YAP_FLAG(PID_FLAG, "pid", false, sys_pid, "@boot", NULL),
YAP_FLAG(PIPE_FLAG, "pipe", true, booleanFlag, "true", NULL),
YAP_FLAG(PROFILING_FLAG, "profiling", true, booleanFlag, "false", NULL),
/**< `profiling `
/**< `profiling `
If `off` (default) do not compile call counting information for
procedures. If `on` compile predicates so that they calls and
retries to the predicate may be counted. Profiling data can be read through
the call_count_data/3 built-in.
*/
YAP_FLAG(PROMPT_ALTERNATIVES_ON_FLAG, "prompt_alternatives_on", true,
isatom, "determinism", NULL),
/**< `prompt_alternatives_on(atom,
YAP_FLAG(PROFILING_FLAG, "profiling", true, booleanFlag, "false", NULL),
/**< `prompt_alternatives_on(atom,
changeable) `
SWI-Compatible option, determines prompting for alternatives in the Prolog
@ -383,17 +428,20 @@ vxu `on` consider `$` a lower case character.
and only if the query contains variables. The alternative, default in
SWI-Prolog is <tt>determinism</tt> which implies the system prompts for
alternatives if the goal succeeded while leaving choicepoints. */
YAP_FLAG(PROMPT_ALTERNATIVES_ON_FLAG, "prompt_alternatives_on", true,
isatom, "determinism", NULL),
YAP_FLAG(QUASI_QUOTATIONS_FLAG, "quasi_quotations", true, booleanFlag,
"true", NULL),
YAP_FLAG(READLINE_FLAG, "readline", true, booleanFlag, "false",
Yap_InitReadline),
/**< `readline(boolean, changeable)`
/**< `readline(boolean, changeable)`
}
enable the use of the readline library for console interactions, true by
default if readline was found. */
YAP_FLAG(REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, booleanFlag,
"true", NULL), /**<
YAP_FLAG(READLINE_FLAG, "readline", true, booleanFlag, "false",
Yap_InitReadline),
/**<
If _Value_ is unbound, tell whether warnings for procedures defined
in several different files are `on` or
@ -401,43 +449,50 @@ in several different files are `on` or
and if it is bound to `off` disable them. The default for YAP is
`off`, unless we are in `sicstus` or `iso` mode.
*/
YAP_FLAG(REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, booleanFlag,
"true", NULL),
YAP_FLAG(REPORT_ERROR_FLAG, "report_error", true, booleanFlag, "true",
NULL),
YAP_FLAG(RESOURCE_DATABASE_FLAG, "resource_database", false, isatom,
YAP_BOOTSTRAP, NULL),
/**<`resource_database`
/**<`resource_database`
Name of the resource file (saved-state or Prolog file) used to construct
the YAP
run-time environment.
*/
YAP_FLAG(SAVED_PROGRAM_FLAG, "saved_program", false, booleanFlag, "false",
NULL),
/**<`saved_program`
YAP_FLAG(RESOURCE_DATABASE_FLAG, "resource_database", false, isatom,
YAP_BOOTSTRAP, NULL),
/**<`saved_program`
if `true` YAP booted from a `yss` file, usually `startup.yss'. If
`false`, YAP booted from a Prolog file, by default `boot.yap`.
*/
YAP_FLAG(SHARED_OBJECT_EXTENSION_FLAG, "shared_object_extension", false,
isatom, SO_EXT, NULL),
/**< `shared_object_extension `
YAP_FLAG(SAVED_PROGRAM_FLAG, "saved_program", false, booleanFlag, "false",
NULL),
/**< `shared_object_extension `
Suffix associated with loadable code.
*/
YAP_FLAG(SHARED_OBJECT_SEARCH_PATH_FLAG, "shared_object_search_path", true,
isatom, SO_PATH, NULL),
/**< `shared_object_search_path `
YAP_FLAG(SHARED_OBJECT_EXTENSION_FLAG, "shared_object_extension", false,
isatom, SO_EXT, NULL),
/**<
Name of the environment variable used by the system to search for shared
objects.
*/
YAP_FLAG(SINGLE_QUOTES_FLAG, "single_quotes", true, isatom, "atom", sqf),
/**< `single_quoted text is usuallly interpreted as atoms. This flagTerm
allows other inerpretations such as strings_contains_strings */
YAP_FLAG(SHARED_OBJECT_SEARCH_PATH_FLAG, "shared_object_search_path", true,
isatom, SO_PATH, NULL),
/**< single_quoted text is usuallly interpreted as atoms. This flag
allows other interpretations such as strings */
YAP_FLAG(SINGLE_QUOTES_FLAG, "single_quotes", true, isatom, "atom", sqf),
YAP_FLAG(SINGLE_VAR_WARNINGS_FLAG, "single_var_warnings", true, booleanFlag,
"true", NULL), /**<
/**<
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
@ -445,22 +500,25 @@ and if it is bound to `off` disable them. The default for YAP is
starts with underscore are never considered singleton.
*/
YAP_FLAG(SIGNALS_FLAG, "signals", true, booleanFlag, "true", NULL),
/**< `signals`
YAP_FLAG(SINGLE_VAR_WARNINGS_FLAG, "single_var_warnings", true, booleanFlag,
"true", NULL),
/**<
If `true` (default) YAP handles Signals such as `^C`
(`SIGINT`).
*/
YAP_FLAG(SOURCE_FLAG, "source", true, booleanFlag, "true", NULL),
/**< `source`
YAP_FLAG(SIGNALS_FLAG, "signals", true, booleanFlag, "true", NULL),
/**<
If `true` maintain the source for all clauses. Notice that this is trivially
supported for facts, and always supported for dynamic code.
*/
YAP_FLAG(STRICT_ISO_FLAG, "strict_iso", true, booleanFlag, "false", NULL),
/**< `strict_iso `
YAP_FLAG(SOURCE_FLAG, "source", true, booleanFlag, "true", NULL),
/**< `strict_iso `
If _Value_ is unbound, tell whether strict ISO compatibility mode
is `on` or `off`. If _Value_ is bound to `on` set
@ -482,9 +540,9 @@ and if it is bound to `off` disable them. The default for YAP is
depends on a Prolog's platform specific features.
*/
YAP_FLAG(SYSTEM_OPTIONS_FLAG, "system_options", false, options,
SYSTEM_OPTIONS, NULL),
/**< `system_options `
YAP_FLAG(STRICT_ISO_FLAG, "strict_iso", true, booleanFlag, "false", NULL),
/**< `system_options `
This read only flag tells which options were used to compile
YAP. Currently it informs whether the system supports `big_numbers`,
@ -492,20 +550,22 @@ and if it is bound to `off` disable them. The default for YAP is
`or-parallelism`, `rational_trees`, `readline`, `tabling`,
`threads`, or the `wam_profiler`.
*/
YAP_FLAG(SYSTEM_OPTIONS_FLAG, "system_options", false, options,
SYSTEM_OPTIONS, NULL),
YAP_FLAG(SYSTEM_THREAD_ID_FLAG, "system_thread_id", false, sys_thread_id,
"@boot", NULL),
YAP_FLAG(TABLING_MODE_FLAG, "tabling_mode", true, isatom, "[]", NULL),
/**< `tabling_mode`
/**< `tabling_mode`
Sets or reads the tabling mode for all tabled predicates. Please
(see Tabling) for the list of options.
*/
YAP_FLAG(TABLING_MODE_FLAG, "tabling_mode", true, isatom, "[]", NULL),
YAP_FLAG(THREADS_FLAG, "threads", false, ro, "MAX_THREADS", NULL),
YAP_FLAG(TIMEZONE_FLAG, "timezone", false, ro, "18000", NULL),
YAP_FLAG(TOPLEVEL_HOOK_FLAG, "toplevel_hook", true, booleanFlag, "true",
NULL),
/**< `toplevel_hook `
/**< `toplevel_hook `
If bound, set the argument to a goal to be executed before entering the
top-level. If unbound show the current goal or `true` if none is
@ -513,6 +573,9 @@ and if it is bound to `off` disable them. The default for YAP is
backtracked into.
*/
YAP_FLAG(TOPLEVEL_HOOK_FLAG, "toplevel_hook", true, booleanFlag, "true",
NULL),
YAP_FLAG(TOPLEVEL_PRINT_ANON_FLAG, "toplevel_print_anon", true, booleanFlag,
"true", NULL),
YAP_FLAG(TOPLEVEL_PRINT_OPTIONS_FLAG, "toplevel_print_options", true,
@ -521,14 +584,13 @@ and if it is bound to `off` disable them. The default for YAP is
YAP_FLAG(TOPLEVEL_PROMPT_FLAG, "toplevel_prompt", true, isatom, "?- ",
mkprompt),
YAP_FLAG(TTY_CONTROL_FLAG, "tty_control", true, booleanFlag, "true", NULL),
YAP_FLAG(UNIX_FLAG, "unix", false, ro, "true", NULL),
/**< `unix`
/**< `unix`
Read-only BooleanFlag flag that unifies with `true` if YAP is
running on an Unix system. Defined if the C-compiler used to compile
this version of YAP either defines `__unix__` or `unix`.
*/
/**< `update_semantics `
/**< `update_semantics `
Define whether YAP should follow `immediate` update
semantics, as in C-Prolog (default), `logical` update semantics,
@ -537,10 +599,12 @@ and if it is bound to `off` disable them. The default for YAP is
procedures follow logical semantics but the internal data base still
follows immediate semantics.
*/
YAP_FLAG(UNIX_FLAG, "unix", false, ro, "true", NULL),
YAP_FLAG(UPDATE_SEMANTICS_FLAG, "update_semantics", true, isatom, "logical",
NULL),
YAP_FLAG(USER_FLAGS_FLAG, "user_flags", true, isatom, "error", NULL),
/**<
/**<
`user_flags `
Define the behaviour of set_prolog_flag/2 if the flag is not known. Values
@ -551,18 +615,20 @@ and if it is bound to `off` disable them. The default for YAP is
developers are encouraged to use `create_prolog_flag/3` to create flags for
their library.
*/
YAP_FLAG(UNKNOWN_FLAG, "unknown", true, isatom, "error", Yap_unknown),
/**< `unknown is iso`
YAP_FLAG(USER_FLAGS_FLAG, "user_flags", true, isatom, "error", NULL),
/**< `unknown is iso`
Corresponds to calling the unknown/2 built-in. Possible ISO values
are `error`, `fail`, and `warning`. Yap includes the following extensions:
`fast_fail` does not invoke any handler.
*/
YAP_FLAG(UNKNOWN_FLAG, "unknown", true, isatom, "error", Yap_unknown),
YAP_FLAG(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG,
"variable_names_may_end_with_quotes", true, booleanFlag, "false",
NULL),
YAP_FLAG(VERBOSE_FLAG, "verbose", true, isatom, "normal", NULL),
/**< `verbose `
/**<
If `normal` allow printing of informational and banner messages,
such as the ones that are printed when consulting. If `silent`
@ -570,66 +636,75 @@ and if it is bound to `off` disable them. The default for YAP is
YAP is booted with the `-q` or `-L` flag.
*/
YAP_FLAG(VERBOSE_FILE_SEARCH_FLAG, "verbose_file_search", true, booleanFlag,
"false", NULL),
/**< `verbose_file_search `
YAP_FLAG(VERBOSE_FLAG, "verbose", true, isatom, "normal", NULL),
/**<
If `true` allow printing of informational messages when
searching for file names. If `false` disable printing these messages. It
is `false` by default except if YAP is booted with the `-L`
flag.
*/
YAP_FLAG(VERBOSE_LOAD_FLAG, "verbose_load", true, isatom, "normal", NULL),
/**< `verbose_load `
YAP_FLAG(VERBOSE_FILE_SEARCH_FLAG, "verbose_file_search", true, booleanFlag,
"false", NULL),
/**<
If `true` allow printing of informational messages when
consulting files. If `false` disable printing these messages. It
is `normal` by default except if YAP is booted with the `-L`
is `true` by default except if YAP is booted with the `-L`
flag.
*/
YAP_FLAG(VERSION_FLAG, "version", false, nat, YAP_NUMERIC_VERSION, NULL),
/**<
`version ` Read-only flag that returns a compound term with the
YAP_FLAG(VERBOSE_LOAD_FLAG, "verbose_load", true, booleanFlag, "true", NULL),
/**<
Read-only flag that returns a compound term with the
current version of YAP. The term will have the name `yap` and arity 4, the
first argument will be the major version, the second the minor version, the
third the patch number, and the last one is reserved.
*/
YAP_FLAG(VERSION_DATA_FLAG, "version_data", false, ro, YAP_TVERSION, NULL),
/**< `version_data `
YAP_FLAG(VERSION_FLAG, "version", false, nat, YAP_NUMERIC_VERSION, NULL),
/**<
Read-only flag that unifies with a number of the form
`_Major_ * 100000 + _Minor_ *100 + _Patch_`, where
_Major_ is the major version, _Minor_ is the minor version,
and _Patch_ is the patch number.
*/
YAP_FLAG(VERSION_GIT_FLAG, "version_git", false, isatom, YAP_GIT_HEAD,
NULL),
/**< `version_git `
YAP_FLAG(VERSION_DATA_FLAG, "version_data", false, ro, YAP_TVERSION, NULL),
/**<
`
this is the unique identifier for the last commit of the current GIT HEAD,
it xan be used to identify versions that differ on small (or large) updates.
*/
YAP_FLAG(WRITE_ATTRIBUTES_FLAG, "write_attributes", true, isatom, "ignore",
YAP_FLAG(VERSION_GIT_FLAG, "version_git", false, isatom, YAP_GIT_HEAD,
NULL),
#if __WINDOWS__
/**< `windows`
/**<
Read-only booleanFlag flag that unifies with `true` if YAP is
running on an Windows machine.
*/
YAP_FLAG(WRITE_ATTRIBUTES_FLAG, "write_attributes", true, isatom, "ignore",
NULL),
#if __WINDOWS__
YAP_FLAG(WINDOWS_FLAG, "windows", false, ro, "true", NULL),
#endif
YAP_FLAG(WRITE_STRINGS_FLAG, "write_strings", true, booleanFlag, "false",
NULL),
/**< `write_strings `
/**<
Writable flag telling whether the system should write lists of
integers that are writable character codes using the list notation. It
is `on` if enables or `off` if disabled. The default value for
this flag is `off`.
*/
YAP_FLAG(WRITE_STRINGS_FLAG, "write_strings", true, booleanFlag, "false",
NULL),
END_GLOBAL_FLAGS
//! @}

4
H/YapHandles.h
View File

@ -218,9 +218,9 @@ INLINE_ONLY yhandle_t Yap_InitHandle__(Term t USES_REGS) {
ensure_slots(1 PASS_REGS);
if (t==0) {
t = MkVarTerm();
} else if (IsVarTerm(t) ) {
} else if (IsVarTerm(t) && VarOfTerm(t) > HR ) {
Term tg = MkVarTerm();
Bind_Global( VarOfTerm(t), tg);
Bind_Local(VarOfTerm(t), tg);
}
LOCAL_HandleBase[old_slots] = t;
LOCAL_CurHandle++;

93
H/YapLFlagInfo.h
View File

@ -1,5 +1,3 @@
/*************************************************************************
* *
* YAP Prolog *
@ -28,13 +26,13 @@
START_LOCAL_FLAGS
/** + `autoload`: set the system to look for undefined procedures */
/**< set the system to look for undefined procedures */
YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL),
/** + `read-only flag, that tells if Prolog is in an inner top-level */
YAP_FLAG(BREAK_LEVEL_FLAG, "break_level", true, nat, "0", NULL),
YAP_FLAG(CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true",
NULL), /** + `call_counting`
/**<`read-only flag, that tells if Prolog is in an inner top-level */
YAP_FLAG(BREAK_LEVEL_FLAG, "break_level", true, nat, "0", NULL),
/**<
Predicates compiled with this flag set maintain a counter
on the numbers of proceduree calls and of retries. These counters
are decreasing counters, and they can be used as timers. Three
@ -51,28 +49,36 @@ YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL),
If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled.
*/
YAP_FLAG(ENCODING_FLAG, "encoding", true, isatom, "utf-8", getenc),
YAP_FLAG(FILEERRORS_FLAG, "fileerrors", true, booleanFlag, "true",
NULL), /** + `fileerrors`
If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled.
*/
YAP_FLAG(LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap",
NULL), /** + `language_mode`
wweter native mode or trying to emulate a different Prolog.
*/
YAP_FLAG(STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, booleanFlag,
"true", NULL), /** + `stack_dump_on_error `
If `true` show a stack dump when YAP finds an error. The default is
`off`.
*/
YAP_FLAG(STREAM_TYPE_CHECK_FLAG, "stream_type_check", true, isatom, "loose",
YAP_FLAG(CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true",
NULL),
YAP_FLAG(SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error",
NULL), /** + `syntax_errors`
/**< support for coding systens, YAP relies on UTF-8 internally.
*/
YAP_FLAG(ENCODING_FLAG, "encoding", true, isatom, "utf-8", getenc),
/** + what to do if opening a file fails.
*/
YAP_FLAG(FILEERRORS_FLAG, "fileerrors", true, booleanFlag, "true",
NULL),
/**<
whether native mode or trying to emulate a different
Prolog.
*/
YAP_FLAG(LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap",
NULL),
YAP_FLAG(STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, booleanFlag,
"true", NULL),
/**<`
If `true` show a stack dump when YAP finds an error. The default is
`off`.
*/
YAP_FLAG(STREAM_TYPE_CHECK_FLAG, "stream_type_check", true, isatom, "loose",
NULL),
/** + `syntax_errors`
Control action to be taken after syntax errors while executing read/1,
`read/2`, or `read_term/3`:
@ -85,16 +91,17 @@ Report the syntax error and generate an error (default).
+ `quiet`
Just fail
*/
YAP_FLAG(TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user",
typein), /** + `typein_module `
YAP_FLAG(SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error",
NULL),
/**<
If bound, set the current working or type-in module to the argument,
which must be an atom. If unbound, unify the argument with the current
working module.
If bound, set the current working or type-in module to the argument,
which must be an atom. If unbound, unify the argument with the current
working module.
*/
YAP_FLAG(USER_ERROR_FLAG, "user_error", true, stream, "user_error",
set_error_stream), /** + `user_error1`
*/
YAP_FLAG(TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user",
typein),
/**<
If the second argument is bound to a stream, set user_error to
this stream. If the second argument is unbound, unify the argument with
@ -125,11 +132,13 @@ prompts from the system were redirected to the stream
automatically redirects the user_error alias to the original
`stderr`.
*/
YAP_FLAG(USER_INPUT_FLAG, "user_input", true, stream, "user_input",
set_input_stream),
YAP_FLAG(USER_OUTPUT_FLAG, "user_output", true, stream, "user_output",
set_output_stream),
YAP_FLAG(USER_ERROR_FLAG, "user_error", true, stream, "user_error",
set_error_stream),
YAP_FLAG(USER_INPUT_FLAG, "user_input", true, stream, "user_input",
set_input_stream),
YAP_FLAG(USER_OUTPUT_FLAG, "user_output", true, stream, "user_output",
set_output_stream),
END_LOCAL_FLAGS
/// @}

116
H/YapTerm.h
View File

@ -1,116 +0,0 @@
/*************************************************************************
* *
* YAP Prolog %W% %G% *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: Yap.h *
* mods: *
* comments: abstract type definitions for YAP *
* version: $Id: Yap.h,v 1.38 2008-06-18 10:02:27 vsc Exp $ *
*************************************************************************/
#ifndef YAP_H
#include "YapTermConfig.h"
#include "config.h"
typedef void *Functor;
typedef void *Atom;
#endif
#if HAVE_STDINT_H
#include <stdint.h>
#endif
#if HAVE_INTTYPES_H
#include <inttypes.h>
#endif
#define ALIGN_BY_TYPE(X, TYPE) \
(((CELL)(X) + (sizeof(TYPE) - 1)) & ~(sizeof(TYPE) - 1))
#ifndef EXTERN
#ifdef MSC_VER
#define EXTERN
#else
#define EXTERN extern
#endif
#endif
/* defines integer types Int and UInt (unsigned) with the same size as a ptr
** and integer types Short and UShort with half the size of a ptr */
#if defined(PRIdPTR)
typedef intptr_t Int;
typedef uintptr_t UInt;
#elif defined(_WIN64)
typedef int64_t Int;
typedef uint64_t UInt;
#elif defined(_WIN32)
typedef int32_t Int;
typedef uint32_t UInt;
#elif SIZEOF_LONG_INT == SIZEOF_INT_P
typedef long int Int;
typedef unsigned long int UInt;
#elif SIZEOF_INT == SIZEOF_INT_P
typedef int Int;
typedef unsigned int UInt;
#else
#error Yap require integer types of the same size as a pointer
#endif
/* */ typedef short int Short;
/* */ typedef unsigned short int UShort;
typedef UInt CELL;
typedef uint16_t BITS16;
typedef int16_t SBITS16;
typedef uint32_t BITS32;
#define WordSize sizeof(BITS16)
#define CellSize sizeof(CELL)
#define SmallSize sizeof(SMALLUNSGN)
#include "YapFormat.h"
/*************************************************************************************************
type casting macros
*************************************************************************************************/
typedef UInt Term;
typedef Int yhandle_t;
typedef double Float;
#if SIZEOF_INT < SIZEOF_INT_P
#define SHORT_INTS 1
#else
#define SHORT_INTS 0
#endif
#ifdef __GNUC__
typedef long long int YAP_LONG_LONG;
typedef unsigned long long int YAP_ULONG_LONG;
#else
typedef long int YAP_LONG_LONG;
typedef unsigned long int YAP_ULONG_LONG;
#endif
#define Unsigned(V) ((CELL)(V))
#define Signed(V) ((Int)(V))

5
H/YapText.h
View File

@ -175,7 +175,10 @@ INLINE_ONLY char_kind_t chtype(Int ch) {
#endif
extern const char *Yap_tokText(void *tokptr);
extern Term Yap_tokRep(void *tokptr);
/// represent token *_tokptr_ in string s, maxlength is sz-1
///
/// conversion is based on token type.
extern Term Yap_tokRep(void *tokptrXS);
// standard strings

9
H/Yapproto.h
View File

@ -128,6 +128,7 @@ extern X_API Int YAP_RunGoalOnce(Term);
/* cdmgr.c */
extern Term Yap_all_calls(void);
extern Atom Yap_ConsultingFile(USES_REGS1);
extern bool Yap_Consulting(USES_REGS1);
extern struct pred_entry *Yap_PredForChoicePt(choiceptr bptr, op_numbers *op);
extern void Yap_InitCdMgr(void);
extern struct pred_entry *Yap_PredFromClause(Term t USES_REGS);
@ -390,8 +391,7 @@ extern void Yap_InitSortPreds(void);
/* stack.c */
extern void Yap_InitStInfo(void);
extern void Yap_dump_stack(void);
extern void Yap_detect_bug_location(yamop *yap_pc, int where_from, int psize);
extern char *Yap_output_bug_location(yamop *yap_pc, int where_from, int psize);
#if !defined(YAPOR) && !defined(THREADS)
extern bool Yap_search_for_static_predicate_in_use(struct pred_entry *, bool);
@ -493,7 +493,10 @@ extern Int Yap_TermHash(Term, Int, Int, int);
extern Int Yap_NumberVars(Term, Int, bool);
extern Term Yap_TermVariables(Term t, UInt arity USES_REGS);
extern Term Yap_UnNumberTerm(Term, int);
extern Int Yap_SkipList(Term *, Term **);
extern Int Yap_SkipList(Term *, Term **);
extern Term Yap_BreakRational(Term inp, UInt arity, Term *of, Term oi USES_REGS);
extern Term Yap_BreakTerml(Term inp, UInt arity, Term *of, Term oi USES_REGS);
/* yap.c */
/* write.c */

5
H/Yatom.h
View File

@ -1529,6 +1529,11 @@ extern bool Yap_HasException(void);
extern yap_error_descriptor_t *Yap_GetException();
extern void Yap_PrintException(yap_error_descriptor_t *i);
INLINE_ONLY bool Yap_HasException(void) {
extern yap_error_number Yap_MathException__(USES_REGS1);
yap_error_number me;
if ((me = Yap_MathException__(PASS_REGS1)) && LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
LOCAL_ActiveError->errorNo = me;
}
return LOCAL_ActiveError->errorNo != YAP_NO_ERROR;
}

19
H/alloc.h
View File

@ -96,10 +96,11 @@ typedef struct FREEB {
/* Operating system and architecture dependent page size */
extern size_t Yap_page_size;
void Yap_InitHeap(void *);
UInt Yap_ExtendWorkSpaceThroughHole(UInt);
void Yap_AllocHole(UInt, UInt);
extern void Yap_InitHeap(void *);
extern UInt Yap_ExtendWorkSpaceThroughHole(UInt);
extern void Yap_AllocHole(UInt, UInt);
extern size_t Yap_HeapUsed(void);
;
#if USE_SYSTEM_MMAP && ! defined(__CYGWIN__)
#include <sys/types.h>
@ -107,7 +108,7 @@ void Yap_AllocHole(UInt, UInt);
#elif USE_SYSTEM_SHM
#elif USE_SBRK
@ -120,10 +121,10 @@ void *sbrk(caddr_t);
typedef unsigned size_t;
MALLOC_T malloc(size_t);
void free(MALLOC_T);
MALLOC_T realloc(MALLOC_T,size_t);
MALLOC_T calloc(size_t,size_t);
extern MALLOC_T malloc(size_t);
extern void free(MALLOC_T);
extern MALLOC_T realloc(MALLOC_T,size_t);
extern MALLOC_T calloc(size_t,size_t);
#endif

6
H/arith2.h
View File

@ -24,13 +24,13 @@ inline static int sub_overflow(Int x, Int i, Int j) {
}
inline static Term sub_int(Int i, Int j USES_REGS) {
#if defined(__clang__ ) || defined(__GNUC__)
#if defined(__clang__ ) || (defined(__GNUC__) && __GNUC__ > 4)
Int k;
if (__builtin_sub_overflow(i,j,&k)) {
return Yap_gmp_sub_ints(i, j);
}
RINT(k);
#elif defined(__GNUC__)
#elif defined(__GNUC__) && __GNUC__ >4
Int w;
if (!__builtin_sub_overflow_p(i,j,w))
RINT(w);
@ -64,7 +64,7 @@ inline static int mul_overflow(Int z, Int i1, Int i2) {
return (i2 && z / i2 != i1);
}
#if defined(__clang__) || defined(__GNUC__)
#if defined(__clang__) || (defined(__GNUC__) && __GNUC__ > 4)
#define DO_MULTI() \
if (__builtin_mul_overflow(i1, i2, &z)) { \
goto overflow; \

5
H/generated/iatoms.h
View File

@ -2,6 +2,7 @@
/* This file, iatoms.h, was generated automatically by "yap -L misc/buildatoms"
{lease do not update, update misc/ATOMS instead */
AtomAtSymbol = Yap_LookupAtom("@"); TermAtSymbol = MkAtomTerm(AtomAtSymbol);
Atom3Dots = Yap_LookupAtom("...");
AtomAbol = Yap_FullLookupAtom("$abol"); TermAbol = MkAtomTerm(AtomAbol);
AtomAccess = Yap_LookupAtom("access"); TermAccess = MkAtomTerm(AtomAccess);
@ -182,6 +183,7 @@
AtomGlobalTrie = Yap_LookupAtom("global_trie"); TermGlobalTrie = MkAtomTerm(AtomGlobalTrie);
AtomGoalExpansion = Yap_LookupAtom("goal_expansion"); TermGoalExpansion = MkAtomTerm(AtomGoalExpansion);
AtomHat = Yap_LookupAtom("^"); TermHat = MkAtomTerm(AtomHat);
AtomDoubleHat = Yap_LookupAtom("^^"); TermDoubleHat = MkAtomTerm(AtomDoubleHat);
AtomHERE = Yap_LookupAtom("\n <====HERE====> \n"); TermHERE = MkAtomTerm(AtomHERE);
AtomHandleThrow = Yap_FullLookupAtom("$handle_throw"); TermHandleThrow = MkAtomTerm(AtomHandleThrow);
AtomHeap = Yap_LookupAtom("heap"); TermHeap = MkAtomTerm(AtomHeap);
@ -457,6 +459,8 @@
FunctorAs = Yap_MkFunctor(AtomAs,2);
FunctorAssert1 = Yap_MkFunctor(AtomAssert,1);
FunctorAssert = Yap_MkFunctor(AtomAssert,2);
FunctorAt = Yap_MkFunctor(AtomAt,2);
FunctorAtSymbol = Yap_MkFunctor(AtomAtSymbol,2);
FunctorAtFoundOne = Yap_MkFunctor(AtomFoundVar,2);
FunctorAtom = Yap_MkFunctor(AtomAtom,1);
FunctorAtt1 = Yap_MkFunctor(AtomAtt1,3);
@ -530,6 +534,7 @@
FunctorGoalExpansion = Yap_MkFunctor(AtomGoalExpansion,3);
FunctorHandleThrow = Yap_MkFunctor(AtomHandleThrow,3);
FunctorHat = Yap_MkFunctor(AtomHat,2);
FunctorDoubleHat = Yap_MkFunctor(AtomDoubleHat,1);
FunctorI = Yap_MkFunctor(AtomI,2);
FunctorId = Yap_MkFunctor(AtomId,1);
FunctorInfo1 = Yap_MkFunctor(AtomInfo,1);

5
H/generated/ratoms.h
View File

@ -2,6 +2,7 @@
/* This file, ratoms.h, was generated automatically by "yap -L misc/buildatoms"
{lease do not update, update misc/ATOMS instead */
AtomAtSymbol = AtomAdjust(AtomAtSymbol); TermAtSymbol = MkAtomTerm(AtomAtSymbol);
Atom3Dots = AtomAdjust(Atom3Dots);
AtomAbol = AtomAdjust(AtomAbol); TermAbol = MkAtomTerm(AtomAbol);
AtomAccess = AtomAdjust(AtomAccess); TermAccess = MkAtomTerm(AtomAccess);
@ -182,6 +183,7 @@
AtomGlobalTrie = AtomAdjust(AtomGlobalTrie); TermGlobalTrie = MkAtomTerm(AtomGlobalTrie);
AtomGoalExpansion = AtomAdjust(AtomGoalExpansion); TermGoalExpansion = MkAtomTerm(AtomGoalExpansion);
AtomHat = AtomAdjust(AtomHat); TermHat = MkAtomTerm(AtomHat);
AtomDoubleHat = AtomAdjust(AtomDoubleHat); TermDoubleHat = MkAtomTerm(AtomDoubleHat);
AtomHERE = AtomAdjust(AtomHERE); TermHERE = MkAtomTerm(AtomHERE);
AtomHandleThrow = AtomAdjust(AtomHandleThrow); TermHandleThrow = MkAtomTerm(AtomHandleThrow);
AtomHeap = AtomAdjust(AtomHeap); TermHeap = MkAtomTerm(AtomHeap);
@ -457,6 +459,8 @@
FunctorAs = FuncAdjust(FunctorAs);
FunctorAssert1 = FuncAdjust(FunctorAssert1);
FunctorAssert = FuncAdjust(FunctorAssert);
FunctorAt = FuncAdjust(FunctorAt);
FunctorAtSymbol = FuncAdjust(FunctorAtSymbol);
FunctorAtFoundOne = FuncAdjust(FunctorAtFoundOne);
FunctorAtom = FuncAdjust(FunctorAtom);
FunctorAtt1 = FuncAdjust(FunctorAtt1);
@ -530,6 +534,7 @@
FunctorGoalExpansion = FuncAdjust(FunctorGoalExpansion);
FunctorHandleThrow = FuncAdjust(FunctorHandleThrow);
FunctorHat = FuncAdjust(FunctorHat);
FunctorDoubleHat = FuncAdjust(FunctorDoubleHat);
FunctorI = FuncAdjust(FunctorI);
FunctorId = FuncAdjust(FunctorId);
FunctorInfo1 = FuncAdjust(FunctorInfo1);

8
H/generated/tatoms.h
View File

@ -2,6 +2,7 @@
/* This file, tatoms.h, was generated automatically by "yap -L misc/buildatoms"
{lease do not update, update misc/ATOMS instead */
X_API EXTERNAL Atom AtomAtSymbol; X_API EXTERNAL Term TermAtSymbol;
X_API EXTERNAL Atom Atom3Dots;
X_API EXTERNAL Atom AtomAbol; X_API EXTERNAL Term TermAbol;
X_API EXTERNAL Atom AtomAccess; X_API EXTERNAL Term TermAccess;
@ -182,6 +183,7 @@ X_API EXTERNAL Atom AtomGlobalSp; X_API EXTERNAL Term TermGlobalSp;
X_API EXTERNAL Atom AtomGlobalTrie; X_API EXTERNAL Term TermGlobalTrie;
X_API EXTERNAL Atom AtomGoalExpansion; X_API EXTERNAL Term TermGoalExpansion;
X_API EXTERNAL Atom AtomHat; X_API EXTERNAL Term TermHat;
X_API EXTERNAL Atom AtomDoubleHat; X_API EXTERNAL Term TermDoubleHat;
X_API EXTERNAL Atom AtomHERE; X_API EXTERNAL Term TermHERE;
X_API EXTERNAL Atom AtomHandleThrow; X_API EXTERNAL Term TermHandleThrow;
X_API EXTERNAL Atom AtomHeap; X_API EXTERNAL Term TermHeap;
@ -468,6 +470,10 @@ X_API EXTERNAL Functor FunctorAssert1;
X_API EXTERNAL Functor FunctorAssert;
X_API EXTERNAL Functor FunctorAt;
X_API EXTERNAL Functor FunctorAtSymbol;
X_API EXTERNAL Functor FunctorAtFoundOne;
X_API EXTERNAL Functor FunctorAtom;
@ -614,6 +620,8 @@ X_API EXTERNAL Functor FunctorHandleThrow;
X_API EXTERNAL Functor FunctorHat;
X_API EXTERNAL Functor FunctorDoubleHat;
X_API EXTERNAL Functor FunctorI;
X_API EXTERNAL Functor FunctorId;

48
H/udi_private.h
View File

@ -1,41 +1,40 @@
#include "config.h"
#include "YapConfig.h"
#include "udi.h"
#include "utarray.h"
#include "uthash.h"
/* Argument Indexing */
struct udi_p_args {
int arg; //indexed arg
void *idxstr; //user indexing structure
UdiControlBlock control; //user indexing structure functions
int arg; // indexed arg
void *idxstr; // user indexing structure
UdiControlBlock control; // user indexing structure functions
};
typedef struct udi_p_args *UdiPArg;
UT_icd arg_icd = {sizeof(struct udi_p_args), NULL, NULL, NULL };
UT_icd arg_icd = {sizeof(struct udi_p_args), NULL, NULL, NULL};
/* clauselist */
UT_icd cl_icd = {sizeof(yamop *), NULL, NULL, NULL };
UT_icd cl_icd = {sizeof(yamop *), NULL, NULL, NULL};
/*
* All the info we need to enter user indexed code
* stored in a uthash
*/
struct udi_info
{
PredEntry *p; //predicate (need to identify asserts)
UT_array *clauselist; //clause list used on returns
UT_array *args; //indexed args
UT_hash_handle hh; //uthash handle
struct udi_info {
PredEntry *p; // predicate (need to identify asserts)
UT_array *clauselist; // clause list used on returns
UT_array *args; // indexed args
UT_hash_handle hh; // uthash handle
};
typedef struct udi_info *UdiInfo;
/* to ease code for a UdiInfo hash table*/
#define HASH_FIND_UdiInfo(head,find,out) \
HASH_FIND(hh,head,find,sizeof(PredEntry),out)
#define HASH_ADD_UdiInfo(head,p,add) \
HASH_ADD_KEYPTR(hh,head,p,sizeof(PredEntry *),add)
#define HASH_FIND_UdiInfo(head, find, out) \
HASH_FIND(hh, head, find, sizeof(PredEntry), out)
#define HASH_ADD_UdiInfo(head, p, add) \
HASH_ADD_KEYPTR(hh, head, p, sizeof(PredEntry *), add)
/* used during init */
static YAP_Int p_new_udi( USES_REGS1 );
static YAP_Int p_new_udi(USES_REGS1);
static YAP_Int p_udi_args_init(Term spec, int arity, UdiInfo blk);
/*
@ -44,18 +43,15 @@ static YAP_Int p_udi_args_init(Term spec, int arity, UdiInfo blk);
/* single indexing helpers (no intersection needed just create clauselist) */
#include "clause_list.h"
struct si_callback_h
{
struct si_callback_h {
clause_list_t cl;
UT_array *clauselist;
void * pred;
void *pred;
};
typedef struct si_callback_h * si_callback_h_t;
typedef struct si_callback_h *si_callback_h_t;
static inline int si_callback(void *key, void *data, void *arg)
{
si_callback_h_t c = (si_callback_h_t) arg;
yamop **cl = (yamop **) utarray_eltptr(c->clauselist, ((YAP_Int) data) - 1);
static inline int si_callback(void *key, void *data, void *arg) {
si_callback_h_t c = (si_callback_h_t)arg;
yamop **cl = (yamop **)utarray_eltptr(c->clauselist, ((YAP_Int)data) - 1);
return Yap_ClauseListExtend(c->cl, *cl, c->pred);
}

51
JIT/CMakeLists.txt
View File

@ -2,29 +2,29 @@ set(LIBJIT_MAJOR_VERSION 0)
set(LIBJIT_MINOR_VERSION 1)
set(LIBJIT_PATCH_VERSION 0)
set(LIBJIT_FULL_VERSION
${LIBJIT_MAJOR_VERSION}.${LIBJIT_MINOR_VERSION}.${LIBJIT_PATCH_VERSION})
${LIBJIT_MAJOR_VERSION}.${LIBJIT_MINOR_VERSION}.${LIBJIT_PATCH_VERSION})
set(LIBJIT_SOURCES
jit_analysispreds.c
jit_configpreds.c
jit_statisticpreds.c
jit_codegenpreds.c
jit_debugpreds.c
jit_traced.c
jit_transformpreds.c
JIT_Compiler.cpp
JIT_Init.cpp
)
set(LIBJIT_SOURCES
jit_analysispreds.c
jit_configpreds.c
jit_statisticpreds.c
jit_codegenpreds.c
jit_debugpreds.c
jit_traced.c
jit_transformpreds.c
JIT_Compiler.cpp
JIT_Init.cpp
)
set(LIBJIT_HEADERS
HPP/JIT.hpp
HPP/JIT_Compiler.hpp
HPP/jit_predicates.hpp
../OPTYap/traced_or.insts.h
../OPTYap/traced_tab.insts.h
../OPTYap/traced_tab.tries.insts.h
../C/traced_absmi_insts.h
)
set(LIBJIT_HEADERS
HPP/JIT.hpp
HPP/JIT_Compiler.hpp
HPP/jit_predicates.hpp
../OPTYap/traced_or.insts.h
../OPTYap/traced_tab.insts.h
../OPTYap/traced_tab.tries.insts.h
../C/traced_absmi_insts.h
)
# The following variables are defined:
# LLVM_FOUND - true if LLVM was found
@ -59,18 +59,17 @@ set (POSITION_INDEPENDENT_CODE TRUE)
set(CMAKE_CXX_FLAGS ${CMAKE_CXX_FLAGS} ${LLVM_CXXFLAGS})
add_lib (libyapjit
${LIBJIT_SOURCES}
${LIBJIT_HEADERS}
${LIBJIT_SOURCES}
${LIBJIT_HEADERS}
)
set_target_properties(libyapjit
PROPERTIES
# RPATH ${libdir} VERSION ${LIBJIT_FULL_VERSION}
SOVERSION ${LIBJIT_MAJOR_VERSION}.${LIBJIT_MINOR_VERSION}
POSITION_INDEPENDENT_CODE TRUE
OUTPUT_NAME YapJIT
)
)
target_link_libraries(libyapjit libYap ${LLVM_LIBRARIES} z)
target_link_libraries(libyapjit libYap ${LLVM_LIBRARIES})
set ( YAP_YAPJITLIB $<TARGET_FILE_NAME:libyapjit> )

2
OPTYap/CMakeLists.txt
View File

@ -71,7 +71,7 @@ add_component (libOPTYap
My_set_target_properties(libOPTYap
PROPERTIES
# RPATH ${libdir} VERSION ${LIBYAPTAI_FULL_VERSION}
# RPATH ${CMAKE_INSTALL_LIBDIR} VERSION ${LIBYAPTAI_FULL_VERSION}
# SOVERSION ${LIBYAPTAI_MAJOR_VERSION}.${LIBYAPTAI_MINOR_VERSION}
POSITION_INDEPENDENT_CODE TRUE
OUTPUT_NAME OPTYap

4
Packages.cmake
View File

@ -159,8 +159,8 @@ target_link_libraries(yap-bin libYap )
install(TARGETS libYap yap-bin
RUNTIME DESTINATION ${bindir}
LIBRARY DESTINATION ${libdir}
ARCHIVE DESTINATION ${libdir}
LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}
ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR}
)

185
README.md
View File

@ -1,93 +1,92 @@
``
<center>
![The YAP Logo](docs/icons/yap_128x128x32.png)
</center>
NOTE: this version of YAP is still experimental, documentation may be out of date.
## Introduction
This document provides User information on version 6.3.4 of
YAP (<em>Yet Another Prolog</em>). The YAP Prolog System is a
high-performance Prolog compiler developed at Universidade do
Porto. YAP supports stream Input/Output, sockets, modules,
exceptions, Prolog debugger, C-interface, dynamic code, internal
database, DCGs, saved states, co-routining, arrays, threads.
We explicitly allow both commercial and non-commercial use of YAP.
YAP is based on the David H. D. Warren's WAM (Warren Abstract Machine),
with several optimizations for better performance. YAP follows the
Edinburgh tradition, and was originally designed to be largely
compatible with DEC-10 Prolog, Quintus Prolog, and especially with
C-Prolog. More recently, we have worked on being compatible with SICStus Prolog and with SWI-Prolog.
YAP implements most of the ISO-Prolog standard. We are striving at
full compatibility, and the manual describes what is still
missing.
The document is intended neither as an introduction to Prolog nor to the
implementation aspects of the compiler. A good introduction to
programming in Prolog is the book @cite TheArtOfProlog , by
L. Sterling and E. Shapiro, published by "The MIT Press, Cambridge
MA". Other references should include the classical @cite ProgrammingInProlog , by W.F. Clocksin and C.S. Mellish, published by
Springer-Verlag.
YAP 6.3.4 has been built with the gcc and clang compilers on Linux and OSX machines. We expect to recover support for WIN32 machines and
Android next.
We are happy to include in YAP several excellent packages developed
under separate licenses. Our thanks to the authors for their kind
authorization to include these packages.
The overall copyright and permission notice for YAP4.3 can be found in
the Artistic file in this directory. YAP follows the Perl Artistic
license, and it is thus non-copylefted freeware. Some components of YAP have been obtained from SWI Prolog and ciao, and have
different licenses.
If you have a question about this software, desire to add code, found a
bug, want to request a feature, or wonder how to get further assistance,
please send e-mail to <yap-users AT lists.sourceforge.net>. To
subscribe to the mailing list, visit the page
<https://lists.sourceforge.net/lists/listinfo/yap-users>.
On-line documentation is available for [YAP](http://www.dcc.fp.pt/~vsc/yap/)
The packages are, in alphabetical order:
+ The CHR package developed by Tom Schrijvers,
Christian Holzbaur, and Jan Wielemaker.
+ The CLP(BN) package and Horus toolkit developed by Tiago Gomes, and Vítor Santos Costa.
+ The CLP(R) package developed by Leslie De Koninck, Bart Demoen, Tom
Schrijvers, and Jan Wielemaker, based on the CLP(Q,R) implementation
by Christian Holzbaur.
+ The CPLint package developed by Fabrizio Riguzzi's research
laboratory at the [University of Ferrara](http://www.ing.unife.it/Docenti/FabrizioRiguzzi/)
+ The CUDA interface package developed by Carlos Martínez, Jorge
Buenabad, Inês Dutra and Vítor Santos Costa.
+ The [GECODE](http://www.gecode.org) interface package developed by Denys Duchier and Vítor Santos Costa.
+ The [JPL](http://www.swi-prolog.org/packages/jpl/) (Java-Prolog Library) package developed by .
The minisat SAT solver interface developed by Michael Codish,
Vitaly Lagoon, and Peter J. Stuckey.
+ The MYDDAS relational data-base interface developed at the
Universidade do Porto by Tiago Soares, Michel Ferreira, and Ricardo Rocha.
+ The [PRISM](http://rjida.meijo-u.ac.jp/prism/) logic-based
programming system for statistical modeling developed at the Sato
Research Laboratory, TITECH, Japan.
+ The ProbLog 1 system developed by the [ProbLog](https://dtai.cs.kuleuven.be/problog) team in the
DTAI group of KULeuven.
+ The [R](http://stoics.org.uk/~nicos/sware/packs/real/) interface package developed by Nicos Angelopoulos,
Vítor Santos Costa, João Azevedo, Jan Wielemaker, and Rui Camacho.
<p align="center">
<img src="./docs/icons/yap_128x128x32.png" alt="The YAP Logo"/>
</p>
NOTE: this version of YAP is still experimental, documentation may be out of date.
## Introduction
This document provides User information on version 6.3.4 of
YAP (<em>Yet Another Prolog</em>). The YAP Prolog System is a
high-performance Prolog compiler developed at Universidade do
Porto. YAP supports stream Input/Output, sockets, modules,
exceptions, Prolog debugger, C-interface, dynamic code, internal
database, DCGs, saved states, co-routining, arrays, threads.
We explicitly allow both commercial and non-commercial use of YAP.
YAP is based on the David H. D. Warren's WAM (Warren Abstract Machine),
with several optimizations for better performance. YAP follows the
Edinburgh tradition, and was originally designed to be largely
compatible with DEC-10 Prolog, Quintus Prolog, and especially with
C-Prolog. More recently, we have worked on being compatible with SICStus Prolog and with SWI-Prolog.
YAP implements most of the ISO-Prolog standard. We are striving at
full compatibility, and the manual describes what is still
missing.
The document is intended neither as an introduction to Prolog nor to the
implementation aspects of the compiler. A good introduction to
programming in Prolog is the book @cite TheArtOfProlog , by
L. Sterling and E. Shapiro, published by "The MIT Press, Cambridge
MA". Other references should include the classical @cite ProgrammingInProlog , by W.F. Clocksin and C.S. Mellish, published by
Springer-Verlag.
YAP 6.3.4 has been built with the gcc and clang compilers on Linux and OSX machines. We expect to recover support for WIN32 machines and
Android next.
We are happy to include in YAP several excellent packages developed
under separate licenses. Our thanks to the authors for their kind
authorization to include these packages.
The overall copyright and permission notice for YAP4.3 can be found in
the Artistic file in this directory. YAP follows the Perl Artistic
license, and it is thus non-copylefted freeware. Some components of YAP have been obtained from SWI Prolog and ciao, and have
different licenses.
If you have a question about this software, desire to add code, found a
bug, want to request a feature, or wonder how to get further assistance,
please send e-mail to <yap-users AT lists.sourceforge.net>. To
subscribe to the mailing list, visit the page
<https://lists.sourceforge.net/lists/listinfo/yap-users>.
On-line documentation is available for [YAP](http://www.dcc.fp.pt/~vsc/yap/)
The packages are, in alphabetical order:
+ The CHR package developed by Tom Schrijvers,
Christian Holzbaur, and Jan Wielemaker.
+ The CLP(BN) package and Horus toolkit developed by Tiago Gomes, and Vítor Santos Costa.
+ The CLP(R) package developed by Leslie De Koninck, Bart Demoen, Tom
Schrijvers, and Jan Wielemaker, based on the CLP(Q,R) implementation
by Christian Holzbaur.
+ The CPLint package developed by Fabrizio Riguzzi's research
laboratory at the [University of Ferrara](http://www.ing.unife.it/Docenti/FabrizioRiguzzi/)
+ The CUDA interface package developed by Carlos Martínez, Jorge
Buenabad, Inês Dutra and Vítor Santos Costa.
+ The [GECODE](http://www.gecode.org) interface package developed by Denys Duchier and Vítor Santos Costa.
+ The [JPL](http://www.swi-prolog.org/packages/jpl/) (Java-Prolog Library) package developed by .
The minisat SAT solver interface developed by Michael Codish,
Vitaly Lagoon, and Peter J. Stuckey.
+ The MYDDAS relational data-base interface developed at the
Universidade do Porto by Tiago Soares, Michel Ferreira, and Ricardo Rocha.
+ The [PRISM](http://rjida.meijo-u.ac.jp/prism/) logic-based
programming system for statistical modeling developed at the Sato
Research Laboratory, TITECH, Japan.
+ The ProbLog 1 system developed by the [ProbLog](https://dtai.cs.kuleuven.be/problog) team in the
DTAI group of KULeuven.
+ The [R](http://stoics.org.uk/~nicos/sware/packs/real/) interface package developed by Nicos Angelopoulos,
Vítor Santos Costa, João Azevedo, Jan Wielemaker, and Rui Camacho.

2
YapTermConfig.h.cmake
View File

@ -55,4 +55,6 @@
#endif
#include "YapTerm.h"
#endif

8
cmake/Prelims.cmake
View File

@ -137,10 +137,8 @@ endif()
set ( libpl ${datarootdir}/Yap)
set ( includedir "${prefix}/include")
set ( exec_prefix "${prefix}")
set ( libdir "${exec_prefix}/lib")
set ( datadir "${datarootdir}")
set ( mandir "${datarootdir}/man")
set ( bindir "${exec_prefix}/bin")
set ( docdir "${datarootdir}/doc/Yap")
set ( dlls "${exec_prefix}/lib/Yap")
@ -149,10 +147,10 @@ set(YAP_ROOTDIR ${prefix})
# erootdir -> rootdir
# bindir defined above
# libdir defined above
set(YAP_LIBDIR "${dlls}")
set(YAP_LIBDIR "${YAP_INSTALL_LIBDIR}")
set(YAP_SHAREDIR "${datarootdir}")
set(YAP_BINDIR "${bindir}")
set(YAP_INCLUDEDIR "${includedir}")
set(YAP_BINDIR "${CMAKE_INSTALL_BINDIR}")
set(YAP_INCLUDEDIR "${CMAKE_INSTALL_INCLUDEDIR}")
set(YAP_ROOTDIR "${prefix}")
#

2
config.h.cmake
View File

@ -2115,4 +2115,6 @@ calls it, or to nothing if 'inline' is not supported under any name. */
#endif
#endif
#include "YapTermConfig.h"
#endif

12
configure vendored
View File

@ -165,7 +165,7 @@ print_help() {
--mandir=DIR man documentation [DATAROOTDIR/man]
--docdir=DIR documentation root [DATAROOTDIR/doc/PROJECT_NAME]
--generator=Generator Specify the tool used to send callss
--generator=GENERATOR Specify the tool used to send callss
EOF
first=y
@ -220,6 +220,8 @@ EOF
exit 0
}
while [ $# != 0 ]; do
case "$1" in
"--cmake="*)
@ -291,10 +293,10 @@ while [ $# != 0 ]; do
"--docdir")
CMAKE_ARGS="$CMAKE_ARGS -DCMAKE_INSTALL_DOCDIR=$(quote "$2")"; shift;;
"-G="|"--generator="*)
CMAKE_ARGS+="-G"${1#*=};;
"-G"|"--generator")
CMAKE_ARGS+="-G$"$2; shift;;
"--generator="*)
CMAKE_ARGS="$CMAKE_ARGS -G ${1#*=}";;
"-G")
CMAKE_ARGS="$CMAKE_ARGS -G $2"; shift;;
"CC="*)
CMAKE_ARGS="$CMAKE_ARGS -DCMAKE_C_COMPILER=$(quote "${1#*=}")";;

39
console/yap.c
View File

@ -1,23 +1,21 @@
/*************************************************************************
* *
* Yap Prolog *
* *
* Yap Prolog Was Developed At Nccup - Universidade Do Porto *
* *
* Copyright L.Damas, V.S.Costa And Universidade Do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: Yap.C *
* Last Rev: *
* Mods: *
* Comments: Yap's Main File *
* *
*************************************************************************/
* *
* Yap Prolog *
* *
* Yap Prolog Was Developed At Nccup - Universidade Do Porto *
* *
* Copyright L.Damas, V.S.Costa And Universidade Do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: Yap.C * Last Rev:
** Mods: * Comments: Yap's Main File *
* *
*************************************************************************/
/* static char SccsId[] = "X 4.3.3"; */
#include "YapConfig.h"
#include "YapInterface.h"
#include "config.h"
#include "cut_c.h"
@ -112,14 +110,13 @@ static bool exec_top_level(int BootMode, YAP_init_args *iap) {
livegoal = YAP_FullLookupAtom("live");
}
return true;
//YAP_Exit(EXIT_SUCCESS);
}
// YAP_Exit(EXIT_SUCCESS);
}
// FILE *debugf;
#ifdef LIGHT
int _main(int argc, char **argv)
#else
int main(int argc, char **argv)
@ -129,7 +126,7 @@ int main(int argc, char **argv)
int i;
YAP_init_args init_args;
BootMode = init_standard_system(argc, argv, &init_args);
if (BootMode == YAP_BOOT_ERROR) {
fprintf(stderr, "[ FATAL ERROR: could not find saved state ]\n");
exit(1);

3
dlocals.h
View File

@ -264,6 +264,9 @@
#define REMOTE_OpenArray(wid) (REMOTE(wid)->OpenArray)
/* in a single gc */
#define LOCAL_MallocDepth (Yap_local.MallocDepth)
#define REMOTE_MallocDepth(wid) (REMOTE(wid)->MallocDepth)
#define LOCAL_total_marked (Yap_local.total_marked)
#define REMOTE_total_marked(wid) (REMOTE(wid)->total_marked)

9
docs/CMakeLists.txt
View File

@ -26,8 +26,7 @@ SET( EXT
${DOCS_SOURCE_DIR}/custom/theme.css
${DOCS_SOURCE_DIR}/custom/yap.css
)
foreach(i ${CMAKE_HTML_EXTRA_})
string(APPEND CMAKE_HTML_EXTRA ${i} " ")
endforeach(i ${CMAKE_HTML_EXTRA_})
@ -88,15 +87,11 @@ endforeach(i ${DOCS_EXCLUDE_})
set(doxyfile_in ${CMAKE_SOURCE_DIR}/docs/Doxyfile.in)
add_subdirectory(../packages/raptor/doc ${CMAKE_BINARY_DIR}/packages/raptor/doc)
SET(DOC_INPUT_FILES_
${CMAKE_SOURCE_DIR}/pl
${CMAKE_SOURCE_DIR}/docs/md
${CMAKE_SOURCE_DIR}/pl
${CMAKE_SOURCE_DIR}/CXX
${CMAKE_SOURCE_DIR}/OPTYap
${CMAKE_SOURCE_DIR}/C

34
docs/custom/DoxygenLayout.xml
View File

@ -140,26 +140,12 @@
<briefdescription visible="yes"/>
<detaileddescription title=""/>
<groupgraph visible="$GROUP_GRAPHS"/>
<memberdecl>
<memberdecl>
<nestedgroups visible="yes" title=""/>
<dirs visible="yes" title=""/>
<files visible="yes" title=""/>
<namespaces visible="yes" title=""/>
<classes visible="no" title=""/>
<defines title=""/>
<typedefs title=""/>
<enums title=""/>
<enumvalues title=""/>
<functions title=""/>
<variables title=""/>
<signals title=""/>
<publicslots title=""/>
<protectedslots title=""/>
<privateslots title=""/>
<events title=""/>
<properties title=""/>
<friends title=""/>
<membergroups visible="yes"/>
</memberdecl>
<memberdef>
<pagedocs/>
@ -177,8 +163,24 @@
<events title=""/>
<properties title=""/>
<friends title=""/>
<membergroups visible="yes"/>
</memberdef>
<authorsection visible="yes"/>
<memberdecl>
<defines title=""/>
<typedefs title=""/>
<enums title=""/>
<enumvalues title=""/>
<functions title=""/>
<variables title=""/>
<signals title=""/>
<publicslots title=""/>
<protectedslots title=""/>
<privateslots title=""/>
<events title=""/>
<properties title=""/>
<friends title=""/>
</memberdecl>
<authorsection visible="yes"/>
</group>
<!-- Layout definition for a directory page -->

4
docs/md/builtins.md
View File

@ -20,4 +20,6 @@ notation will be used:
+ an argument with no preceding symbol can be used in both ways.
@{
[TOC]
@}

34
docs/md/fli.md
View File

@ -13,11 +13,11 @@ 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.
This gives portability with a number of SWI-Prolog packages and avoids garnage collection by using @ref slotInterface. Last, a new C++ based interface is
being designed to work with the swig (www.swig.orgv) interface compiler.
@}
@defgroup ChYInterface YAP original C-interface
@{
@ingroup fli_c_cxx
@{
Before describing in full detail how to interface to C code, we will examine
a brief example.
@ -50,8 +50,8 @@ system.
@}
@defgroup CallYAP Using the compiler:
@{
@ingroup ChYInterface
@{
Under Linux you should use:
@ -127,8 +127,8 @@ The rest of this appendix describes exhaustively how to interface C to YAP.
@}
@defgroup Manipulating_Terms Terms
@{
@ingroup ChYInterface
@{
This section provides information about the primitives available to the C
programmer for manipulating Prolog terms.
@ -504,8 +504,8 @@ code. Slots can also be used if there is small state.
@}
@defgroup Unifying_Terms Unification
@{
@ingroup ChYInterface
@{
YAP provides a single routine to attempt the unification of two Prolog
terms. The routine may succeed or fail:
@ -522,8 +522,8 @@ otherwise.
@}
@defgroup CallYAP Using the compiler:
@{
@ingroup Manipulating_Strings Strings
@{
The YAP C-interface now includes an utility routine to copy a string
@ -608,8 +608,8 @@ and <tt>-1</tt> on error.
@}
@defgroup Memory_Allocation Memory Allocation
@{
@ingroup ChYInterface
@{
The next routine can be used to ask space from the Prolog data-base:
@ -638,8 +638,8 @@ area.
@}
@defgroup Controlling_Streams Controlling YAP Streams from `C`
@{
@ingroup ChYInterface
@{
The C-Interface also provides the C-application with a measure of
control over the YAP Input/Output system. The first routine allows one
@ -698,8 +698,8 @@ the name by which YAP should know the new stream.
@}
@defgroup Utility_Functions Utility Functions in `C
@{
@ingroup ChYInterface
@{
The C-Interface provides the C-application with a a number of utility
functions that are useful.
@ -794,9 +794,8 @@ ignore the variable.
@}
@defgroup Calling_YAP_From_C From `C` back to Prolog
@{
@ingroup ChYInterface
### From `C` back to Prolog {#Calling_YAP_From_C}
@{
There are several ways to call Prolog code from C-code. By default, the
`YAP_RunGoal()` should be used for this task. It assumes the engine
@ -967,8 +966,8 @@ have moved the terms
@}
@defgroup CallYAP Using the compiler:
@{
@ingroup Module_Manipulation_in_C Module Manipulation in C
@{
YAP allows one to create a new module from C-code. To create the new
code it is sufficient to call:
@ -998,8 +997,8 @@ Notice that this function returns a term, and not an atom. You can
@}
@defgroup Miscellaneous_ChYFunctions Miscellaneous C Functions
@{
@ingroup ChYInterface
@{
<ul>
<li>`void` YAP_Throw(`YAP_Term exception`)
@ -1064,9 +1063,8 @@ of such arguments.
@}
@defgroup Writing_C Writing predicates in C
@{
@ingroup ChYInterface
### Writing predicates in C {#Writing_C}
@{
We will distinguish two kinds of predicates:
@ -1321,8 +1319,8 @@ in this case no code is executed at cut time.
@}
@defgroup YAP4_Notes Changes to the C-Interface in YAP4
@{
@ingroup ChYInterface
@{
YAP4 includes several changes over the previous `load_foreign_files/3`
interface. These changes were required to support the new binary code
@ -1361,8 +1359,8 @@ arguments to the backtrackable procedure.
@}
@defgroup YAPAsLibrary Using YAP as a Library
@{
@ingroup ChYInterface
@{
YAP can be used as a library to be called from other
programs. To do so, you must first create the YAP library:
@ -1588,4 +1586,4 @@ the future we plan to split this library into several smaller libraries
@}
@}
@}

2
docs/md/library.md
View File

@ -6,4 +6,6 @@
`LIBDIR` variable in the Makefile for YAP). Several files in the
library are originally from the public-domain Edinburgh Prolog library.
[TOC]
@}

2
docs/md/programming.md
View File

@ -141,7 +141,7 @@ We present the main predicates and directives available to load
their public predicates into the current type-in module. It is
implemented as if by:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.yap}
use_module(F) :-
load_files(F, [if(not_loaded),must_be_module(true)]).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

8
docs/yap.yap
View File

@ -1,3 +1,9 @@
2:- use_module( library(lineutils) ).
3
4main :-
5 unix(argv[Dir,Out]),
6 open(Out,write,O),
:- module( prolog, [] ).
7 go(Dir,O).
9go(Dir,O) :-

4
include/SWI-Prolog.h
View File

@ -19,7 +19,7 @@ extern "C" {
//=== includes ===============================================================
#ifdef YAP_KERNEL
#include "config.h"
#include "YapConfig.h"
#ifdef __cplusplus
}
@ -40,8 +40,8 @@ extern "C" {
#include "YapInterface.h"
#else
#if _YAP_NOT_INSTALLED_
#include <YapConfig.h>
#include <YapInterface.h>
#include <config.h>
#else
#include <Yap/YapInterface.h>
#endif

2
include/VFS.h
View File

@ -85,9 +85,11 @@ typedef struct vfs {
/// in this space, usual w,r,a,b flags plus B (store in a buffer)
bool (*close)(int sno); /// close the object
int (*get_char)(int sno); /// get an octet from the stream
int (*get_wchar)(int sno); /// get an octet from the stream
int (*peek_char)(int sno); /// unget an octet from the stream
int (*peek_wchar)(int sno); /// unget an octet from the stream
int (*put_char)(int sno, int ch); /// output an octet to the stream
int (*put_wchar)(int sno, int ch); /// output a character to the stream
void (*flush)(int sno); /// flush a stream
int64_t (*seek)(int sno, int64_t offset,
int whence); /// jump around the stream

158
include/YapDefs.h
View File

@ -50,35 +50,6 @@
#include <stdio.h>
#include <stdlib.h>
/* The YAP main types */
#include "YapTerm.h"
#if HAVE_STDINT_H
#include <stdint.h>
#endif
#if HAVE_INTTYPES_H
#include <inttypes.h>
#endif
/**
FALSE and TRUE are the pre-standard versions,
still widely used.
*/
#ifndef TRUE
#define TRUE true
#endif
#ifndef FALSE
#define FALSE false
#endif
#ifndef YAP_Bool
typedef bool YAP_Bool;
#endif
/**
This term can never be constructed as a valid term, so it is
used as a "BAD" term
*/
#define TermZERO ((Term)0)
#include "YapConfig.h"
@ -152,10 +123,6 @@ typedef enum {
YAP_TAG_ARRAY = 0x4000
} YAP_tag_t;
#define YAP_BOOT_FROM_SAVED_CODE 1
#define YAP_BOOT_FROM_SAVED_STACKS 2
#define YAP_BOOT_ERROR -1
#define YAP_WRITE_QUOTED 1
#define YAP_WRITE_IGNORE_OPS 2
#define YAP_WRITE_HANDLE_VARS 4
@ -167,130 +134,7 @@ typedef enum {
#define YAP_WRITE_ATTVAR_PORTRAY 0x400
#define YAP_WRITE_BLOB_PORTRAY 0x800
#define YAP_CONSULT_MODE 0
#define YAP_RECONSULT_MODE 1
#define YAP_BOOT_MODE 2
X_API YAP_file_type_t Yap_InitDefaults(void *init_args, char saved_state[],
int Argc, char *Argv[]);
typedef struct yap_boot_params {
//> boot type as suggested by the user
YAP_file_type_t boot_file_type;
//> how files are organised: NULL is GNU/Linux way
// const char *directory_structure;
//> if NON-NULL, set value for Yap_ROOTDIR
const char *ROOTDIR;
//> if NON-NULL, location of yaap, sets Yap_BINDIR
const char *BINDIR;
//> if NON-NULL, location of libYap, sets Yap_LIBDIR
const char *LIBDIR;
//> if NON-NULL, architecture independent files, sets Yap_SHAREDIR
const char *SHAREDIR;
//> if NON-NULL, include files, sets Yap_INCLUDEDIR
const char *INCLUDEDIR;
//> if NON-NULL, Prolog DLL location, sets Yap_DLLDIR
const char *DLLDIR;
//> if NON-NULL, Prolog library, sets Yap_DLLDIR
const char *PLDIR;
//> if NON-NULL, Prolog library, sets Yap_COMMONSDIR
const char *COMMONSDIR;
//> if NON-NULL, name for a Prolog file to use when booting at run-time
const char *BOOTFILE;
//> if NON-NULL, name for a Prolog file to use when booting at compile-time
const char *BOOTSTRAP;
//> if NON-NULL, path where we can find the saved state
const char *INPUT_STARTUP;
//> bootstrapping mode: YAP is not properly installed
bool install;
//> jupyter mode: YAP is in space
bool jupyter;
//> generats a saved space at this path
const char *OUTPUT_STARTUP;
//> if NON-0, minimal size for Heap or Code Area
size_t HeapSize;
//> if NON-0, maximal size for Heap or Code Area
size_t MaxHeapSize;
//> if NON-0, minimal size for Local+Global Stack
size_t StackSize;
//> if NON-0, maximal size for Local+Global Stack
size_t MaxStackSize;
//*> deprecated
size_t MaxGlobalSize;
//> if NON-0, minimal size for Trail
size_t TrailSize;
//> if NON-0, maximal size for Trail
size_t MaxTrailSize;
//> if NON-0, minimal size for AttributeVarStack
size_t AttsSize;
//> if NON-0, maximal size for AttributeVarStack
size_t MaxAttsSize;
//> if NON-NULL, name for a Prolog file to use when initializing
const char *YapPrologInitGoal;
//> if NON-NULL, name for a Prolog file to consult before entering top-level
const char *PrologRCFile;
//> if NON-NULL, a goal to run before top-level
const char *PrologGoal;
//> if NON-NULL, a goal to run as top-level
const char *PrologTopLevelGoal;
//> if NON-NULL, a path to extend file-search-path
const char *PrologAddPath;
//> if previous NON-NULL and TRUE, halt after consulting that file
bool HaltAfterBoot;
//> ignore .yaprc, .prolog.ini, etc. files.
bool FastBoot;
//> the next field only interest YAPTAB
//> if NON-0, maximum size for Table Space
size_t MaxTableSpaceSize;
/* the next three fields only interest YAPOR, but we keep them so that
users don't need to recompile DLL in order to use YAPOR */
//> if NON-0, number of workers we want to have (default=1)
unsigned long int NumberWorkers;
//> if NON-0, manage the inner scheduler loop (default = 10)
unsigned long int SchedulerLoop;
//> if NON-0, say how long to keep nodes (default = 3)
unsigned long int DelayedReleaseLoad;
//> end of YAPOR fields
/* whether Prolog should handle interrupts. Note that
interrupts will always be disabled in embedded mode. */
bool PrologCannotHandleInterrupts;
//> flag for JIT mode
int ExecutionMode;
//> number of arguments that Prolog will see
int Argc;
//> array of arguments as seen by Prolog
char **Argv;
//> embedded in some other system: no signals, readline, etc
bool Embedded;
//> QuietMode
int QuietMode;
//> 0, maintain default, > 0 use fd-1, < 0 close
int inp, out, err;
#if __ANDROID__
//> android asset support
AAssetManager *assetManager;
#endif
/* support nf's ypp preprocessor code */
#define YAP_MAX_YPP_DEFS 100
char *def_var[YAP_MAX_YPP_DEFS];
char *def_value[YAP_MAX_YPP_DEFS];
int def_c;
/* End preprocessor code */
#ifdef MYDDAS_MYSQL
//> If any myddas option was given
short myddas;
//> MYDDAS Fields
char *myddas_user;
char *myddas_pass;
char *myddas_db;
char *myddas_host;
#endif
/* errornumber */
int ErrorNo;
//> errorstring
char *ErrorCause;
} YAP_init_args;
#include "YapInit.h"
/* this should be opaque to the user */
typedef struct {

45
include/YapError.h
View File

@ -200,33 +200,53 @@ INLINE_ONLY Term Yap_ensure_atom__(const char *fu, const char *fi, int line,
/// all we need to know about an error/throw
typedef struct s_yap_error_descriptor {
/// error identifier
yap_error_number errorNo;
/// kind of error: derived from errorNo;
yap_error_class_number errorClass;
/// if non-NULL: goal who caused error;
const char *errorGoal;
/// errorNo as text
const char *errorAsText;
/// errorClass as text
const char *classAsText;
/// c-code that generated the error
/// C-line
intptr_t errorLine;
/// C-function
const char *errorFunction;
/// C-file
const char *errorFile;
// struct error_prolog_source *errorSource;
intptr_t prologPredCl;
uintptr_t prologPredLine;
uintptr_t prologPredFirstLine;
uintptr_t prologPredLastLine;
/// Prolog predicate that caused the error: name
const char *prologPredName;
/// Prolog predicate that caused the error:arity
uintptr_t prologPredArity;
/// Prolog predicate that caused the error:module
const char *prologPredModule;
/// Prolog predicate that caused the error:line
const char *prologPredFile;
uintptr_t prologParserPos;
uintptr_t prologParserLine;
uintptr_t prologParserFirstLine;
uintptr_t prologParserLastLine;
const char *prologParserText;
const char *prologParserFile;
/// line where error clause defined
uintptr_t prologPredLine;
/// syntax and other parsing errors
uintptr_t parserPos;
uintptr_t parserFirstPos;
uintptr_t parserLastPos;
uintptr_t parserLine;
uintptr_t parserFirstLine;
uintptr_t parserLastLine;
const char *parserTextA;
const char *parserTextB;
const char *parserFile;
/// reading a clause, or called from read?
bool parserReadingCode;
/// whether we are consulting
bool prologConsulting;
const char *culprit;
/// Prolog stack at the time
const char *prologStack;
YAP_Term errorRawTerm, rawExtraErrorTerm;
char *errorMsg;
char *errorMsg;
size_t errorMsgLen;
struct s_yap_error_descriptor *top_error;
} yap_error_descriptor_t;
@ -242,6 +262,7 @@ INLINE_ONLY Term Yap_ensure_atom__(const char *fu, const char *fi, int line,
extern void Yap_CatchError(void);
extern void Yap_ThrowExistingError(void);
extern YAP_Term Yap_MkFullError(void);
extern bool Yap_MkErrorRecord(
yap_error_descriptor_t * r, const char *file, const char *function,
int lineno, yap_error_number type, YAP_Term where, const char *msg);
@ -252,6 +273,8 @@ INLINE_ONLY Term Yap_ensure_atom__(const char *fu, const char *fi, int line,
yap_error_descriptor_t * t, void *cp0, void *b_ptr0, void *env0,
YAP_Int ignore_first);
extern const char *Yap_dump_stack(void);
extern yap_error_descriptor_t *Yap_prolog_add_culprit(yap_error_descriptor_t *
t);
extern yap_error_class_number Yap_errorClass(yap_error_number e);

19
include/YapErrors.h
View File

@ -27,13 +27,15 @@ ECLASS(RESOURCE_ERROR, "resource_error", 2)
/// bad text
ECLASS(SYNTAX_ERROR_CLASS, "syntax_error", 1)
/// OS or internal
ECLASS(SYSTEM_ERROR_CLASS, "system_error", 2)
ECLASS(SYSTEM_ERROR_CLASS, "system_error", 1)
/// bad typing
ECLASS(TYPE_ERROR, "type_error", 2)
/// should be unbound
ECLASS(UNINSTANTIATION_ERROR_CLASS, "uninstantiation_error", 1)
/// escape hatch
ECLASS(EVENT, "event", 2)
/// not quite an error, but almost
ECLASS(WARNING, "warning", 1)
/// user defined escape hatch
ECLASS(EVENT, "event", 1)
END_ERROR_CLASSES();
@ -48,12 +50,12 @@ E(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, DOMAIN_ERROR,
E(DOMAIN_ERROR_ARRAY_OVERFLOW, DOMAIN_ERROR, "array_overflow")
E(DOMAIN_ERROR_ARRAY_TYPE, DOMAIN_ERROR, "array_type")
E(DOMAIN_ERROR_CLOSE_OPTION, DOMAIN_ERROR, "close_option")
E(DOMAIN_ERROR_CREATE_ARRAY_OPTION, DOMAIN_ERROR, "create_array_option")
E(DOMAIN_ERROR_ENCODING, DOMAIN_ERROR, "encoding")
E(DOMAIN_ERROR_EXPAND_FILENAME_OPTION, DOMAIN_ERROR, "expand_filename")
E(DOMAIN_ERROR_FILE_ERRORS, DOMAIN_ERROR, "file_errors")
E(DOMAIN_ERROR_FILE_TYPE, DOMAIN_ERROR, "file_type")
E(DOMAIN_ERROR_FORMAT_CONTROL_SEQUENCE, DOMAIN_ERROR, "format argument "
"domain")
E(DOMAIN_ERROR_FORMAT_CONTROL_SEQUENCE, DOMAIN_ERROR, "format argument")
E(DOMAIN_ERROR_FORMAT_OUTPUT, DOMAIN_ERROR, "format output")
E(DOMAIN_ERROR_GENERIC_ARGUMENT, DOMAIN_ERROR, "generic_argument")
E(DOMAIN_ERROR_IO_MODE, DOMAIN_ERROR, "io_mode")
@ -88,6 +90,7 @@ E(DOMAIN_ERROR_WRITE_OPTION, DOMAIN_ERROR, "write_option")
E(EVALUATION_ERROR_FLOAT_OVERFLOW, EVALUATION_ERROR, "float_overflow")
E(EVALUATION_ERROR_FLOAT_UNDERFLOW, EVALUATION_ERROR, "float_underflow")
E(EVALUATION_ERROR_INT_OVERFLOW, EVALUATION_ERROR, "int_overflow")
E(EVALUATION_ERROR_READ_STREAM, EVALUATION_ERROR, "read_from_stream")
E(EVALUATION_ERROR_UNDEFINED, EVALUATION_ERROR, "undefined")
E(EVALUATION_ERROR_UNDERFLOW, EVALUATION_ERROR, "underflow")
E(EVALUATION_ERROR_ZERO_DIVISOR, EVALUATION_ERROR, "zero_divisor")
@ -196,7 +199,11 @@ E(TYPE_ERROR_REFERENCE, TYPE_ERROR, "reference")
E(TYPE_ERROR_STRING, TYPE_ERROR, "string")
E(TYPE_ERROR_TEXT, TYPE_ERROR, "text")
E(TYPE_ERROR_UBYTE, TYPE_ERROR, "ubyte")
E(TYPE_ERROR_UCHAR, TYPE_ERROR, "uchar")
E(TYPE_ERROR_UCHAR, TYPE_ERROR, "unsigned char")
E(WARNING_DISCONTIGUOUS, WARNING, "discontiguous")
E(WARNING_SINGLETONS, WARNING, "singletons")
E(WARNING_SYNTAX_ERROR, WARNING, "syntax_error")
E1(UNINSTANTIATION_ERROR, UNINSTANTIATION_ERROR_CLASS, "uninstantiation_error")

140
include/YapInit.h Normal file
View File

@ -0,0 +1,140 @@
/**
*
* @file YapInit.h
*
* * Utilities for Booting YAP
*/
#ifndef YAPINIT_H
#define YAPINIT_H
#define YAP_BOOT_FROM_SAVED_CODE 1
#define YAP_BOOT_FROM_SAVED_STACKS 2
#define YAP_BOOT_ERROR -1
#define YAP_CONSULT_MODE 0
#define YAP_RECONSULT_MODE 1
#define YAP_BOOT_MODE 2
X_API YAP_file_type_t Yap_InitDefaults(void *init_args, char saved_state[],
int Argc, char *Argv[]);
typedef struct yap_boot_params {
//> boot type as suggested by the user
YAP_file_type_t boot_file_type;
//> how files are organised: NULL is GNU/Linux way
// const char *directory_structure;
//> if NON-NULL, set value for Yap_ROOTDIR
const char *ROOTDIR;
//> if NON-NULL, location of yaap, sets Yap_BINDIR
const char *BINDIR;
//> if NON-NULL, location of libYap, sets Yap_LIBDIR
const char *LIBDIR;
//> if NON-NULL, architecture independent files, sets Yap_SHAREDIR
const char *SHAREDIR;
//> if NON-NULL, include files, sets Yap_INCLUDEDIR
const char *INCLUDEDIR;
//> if NON-NULL, Prolog DLL location, sets Yap_DLLDIR
const char *DLLDIR;
//> if NON-NULL, Prolog library, sets Yap_DLLDIR
const char *PLDIR;
//> if NON-NULL, Prolog library, sets Yap_COMMONSDIR
const char *COMMONSDIR;
//> if NON-NULL, name for a Prolog file to use when booting at run-time
const char *BOOTFILE;
//> if NON-NULL, name for a Prolog file to use when booting at compile-time
const char *BOOTSTRAP;
//> if NON-NULL, path where we can find the saved state
const char *INPUT_STARTUP;
//> bootstrapping mode: YAP is not properly installed
bool install;
//> jupyter mode: YAP is in space
bool jupyter;
//> generats a saved space at this path
const char *OUTPUT_STARTUP;
//> if NON-0, minimal size for Heap or Code Area
size_t HeapSize;
//> if NON-0, maximal size for Heap or Code Area
size_t MaxHeapSize;
//> if NON-0, minimal size for Local+Global Stack
size_t StackSize;
//> if NON-0, maximal size for Local+Global Stack
size_t MaxStackSize;
//*> deprecated
size_t MaxGlobalSize;
//> if NON-0, minimal size for Trail
size_t TrailSize;
//> if NON-0, maximal size for Trail
size_t MaxTrailSize;
//> if NON-0, minimal size for AttributeVarStack
size_t AttsSize;
//> if NON-0, maximal size for AttributeVarStack
size_t MaxAttsSize;
//> if NON-NULL, name for a Prolog file to use when initializing
const char *YapPrologInitGoal;
//> if NON-NULL, name for a Prolog file to consult before entering top-level
const char *PrologRCFile;
//> if NON-NULL, a goal to run before top-level
const char *PrologGoal;
//> if NON-NULL, a goal to run as top-level
const char *PrologTopLevelGoal;
//> if NON-NULL, a path to extend file-search-path
const char *PrologAddPath;
//> if previous NON-NULL and TRUE, halt after consulting that file
bool HaltAfterBoot;
//> ignore .yaprc, .prolog.ini, etc. files.
bool FastBoot;
//> the next field only interest YAPTAB
//> if NON-0, maximum size for Table Space
size_t MaxTableSpaceSize;
/* the next three fields only interest YAPOR, but we keep them so that
users don't need to recompile DLL in order to use YAPOR */
//> if NON-0, number of workers we want to have (default=1)
unsigned long int NumberWorkers;
//> if NON-0, manage the inner scheduler loop (default = 10)
unsigned long int SchedulerLoop;
//> if NON-0, say how long to keep nodes (default = 3)
unsigned long int DelayedReleaseLoad;
//> end of YAPOR fields
/* whether Prolog should handle interrupts. Note that
interrupts will always be disabled in embedded mode. */
bool PrologCannotHandleInterrupts;
//> flag for JIT mode
int ExecutionMode;
//> number of arguments that Prolog will see
int Argc;
//> array of arguments as seen by Prolog
char **Argv;
//> embedded in some other system: no signals, readline, etc
bool Embedded;
//> QuietMode
int QuietMode;
//> 0, maintain default, > 0 use fd-1, < 0 close
int inp, out, err;
#if __ANDROID__
//> android asset support
AAssetManager *assetManager;
#endif
/* support nf's ypp preprocessor code */
#define YAP_MAX_YPP_DEFS 100
char *def_var[YAP_MAX_YPP_DEFS];
char *def_value[YAP_MAX_YPP_DEFS];
int def_c;
/* End preprocessor code */
#ifdef MYDDAS_MYSQL
//> If any myddas option was given
short myddas;
//> MYDDAS Fields
char *myddas_user;
char *myddas_pass;
char *myddas_db;
char *myddas_host;
#endif
/* errornumber */
int ErrorNo;
//> errorstring
char *ErrorCause;
} YAP_init_args;
#endif

21
include/YapInterface.h
View File

@ -31,10 +31,12 @@ The following routines export the YAP internals and architecture.
#define _yap_c_interface_h 1
#include "YapConfig.h"
#define __YAP_PROLOG__ 1
#ifndef YAPVERSION
#define YAPVERSION 60000
#define YAPVERSION YAP_NUMERIC_VERSION
#endif
#include "YapDefs.h"
@ -102,6 +104,9 @@ extern YAP_Term YAP_A(int);
#define YAP_ARG15 YAP_A(15)
#define YAP_ARG16 YAP_A(16)
X_API
extern YAP_Term YAP_SetA(int, YAP_Term);
/* YAP_Bool IsVarTerm(YAP_Term) */
extern X_API YAP_Bool YAP_IsVarTerm(YAP_Term);
@ -268,7 +273,6 @@ extern X_API void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred,
extern X_API void YAP_UserBackCPredicate(const char *, YAP_UserCPred,
YAP_UserCPred, YAP_Arity, YAP_Arity);
/* void UserBackCPredicate(char *name, int *init(), int *cont(), int *cut(),
int
arity, int extra) */
@ -371,7 +375,7 @@ extern X_API YAP_Term YAP_CopyTerm(YAP_Term t);
/* bool YAP_CompileClause(YAP_Term)
@short compile the clause _Cl_; on failure it may call the exception handler. */
@short compile the clause _Cl_; on failure it may call the exception handler. */
extern X_API bool YAP_CompileClause(YAP_Term Cl);
extern X_API int YAP_NewExo(YAP_PredEntryPtr ap, size_t data, void *user_di);
@ -383,8 +387,7 @@ extern X_API int YAP_AssertTuples(YAP_PredEntryPtr pred, const YAP_Term *ts,
extern X_API void YAP_Init(YAP_init_args *);
/* int YAP_FastInit(const char *) */
extern X_API void YAP_FastInit(char saved_state[], int argc,
char *argv[]);
extern X_API void YAP_FastInit(char saved_state[], int argc, char *argv[]);
#ifndef _PL_STREAM_H
// if we don't know what a stream is, just don't assume nothing about the
@ -402,7 +405,8 @@ extern X_API YAP_Term YAP_ReadFromStream(int s);
/// read a Prolog clause from a Prolog opened stream $s$. Similar to
/// YAP_ReadFromStream() but takes /// default options from read_clause/3.
extern X_API YAP_Term YAP_ReadClauseFromStream(int s, YAP_Term varNames, YAP_Term);
extern X_API YAP_Term YAP_ReadClauseFromStream(int s, YAP_Term varNames,
YAP_Term);
extern X_API void YAP_Write(YAP_Term t, FILE *s, int);
@ -411,7 +415,8 @@ extern X_API FILE *YAP_TermToStream(YAP_Term t);
extern X_API int YAP_InitConsult(int mode, const char *filename, char **buf,
int *previous_sno);
extern X_API void YAP_EndConsult(int s, int *previous_sno, const char *previous_cwd);
extern X_API void YAP_EndConsult(int s, int *previous_sno,
const char *previous_cwd);
extern X_API void YAP_Exit(int);
@ -477,7 +482,6 @@ extern X_API void YAP_SetOutputMessage(void);
extern X_API int YAP_StreamToFileNo(YAP_Term);
/**
* Utility routine to Obtain a pointer to the YAP representation of a stream.
*
@ -486,7 +490,6 @@ extern X_API int YAP_StreamToFileNo(YAP_Term);
*/
extern X_API void *YAP_RepStreamFromId(int sno);
extern X_API void YAP_CloseAllOpenStreams(void);
extern X_API void YAP_FlushAllStreams(void);

2
include/YapStreams.h
View File

@ -194,7 +194,7 @@ typedef enum { /* we accept two domains for the moment, IPV6 may follow */
#define Handle_vars_f 0x04
#define Use_portray_f 0x08
#define To_heap_f 0x10
#define Unfold_cyclics_f 0x20
#define Ignore_cyclics_f 0x20
#define Use_SWI_Stream_f 0x40
#define BackQuote_String_f 0x80
#define AttVar_None_f 0x100

46
include/YapTerm.h
View File

@ -13,17 +13,11 @@
* version: $Id: Yap.h,v 1.38 2008-06-18 10:02:27 vsc Exp $ *
*************************************************************************/
#ifndef YAP_H
#include "YapTermConfig.h"
#include "config.h"
#include <stddef.h>
#endif
#if HAVE_STDINT_H
#include <stdint.h>
#endif
#if HAVE_INTTYPES_H
#include <inttypes.h>
#if HAVE_STDTYPES_H
#include <stdtypes.h>
#endif
/* truth-values */
@ -41,6 +35,13 @@ typedef int _Bool;
#endif
#endif /* HAVE_STDBOOL_H */
#if HAVE_STDINT_H
#include <stdint.h>
#endif
#if HAVE_INTTYPES_H
#include <inttypes.h>
#endif
#define ALIGN_BY_TYPE(X, TYPE) \
(((CELL)(X) + (sizeof(TYPE) - 1)) & ~(sizeof(TYPE) - 1))
@ -99,10 +100,10 @@ typedef YAP_UInt YAP_Term;
#define TRUE true
#endif
#ifndef FALSE
#define FALSE false
#endif
typedef bool YAP_Bool;
#define FALSE false
typedef YAP_Int YAP_handle_t;
@ -113,31 +114,6 @@ typedef void *YAP_Atom;
typedef void *YAP_Functor;
#ifdef YAP_H
typedef YAP_Int Int;
typedef YAP_UInt UInt;
typedef YAP_Short Short;
typedef YAP_UShort UShort;
typedef uint16_t BITS16;
typedef int16_t SBITS16;
typedef uint32_t BITS32;
typedef YAP_CELL CELL;
typedef YAP_Term Term;
#define WordSize sizeof(BITS16)
#define CellSize sizeof(CELL)
#define SmallSize sizeof(SMALLUNSGN)
typedef YAP_Int Int;
typedef YAP_Float Float;
typedef YAP_handle_t yhandle_t;
#endif
#include "YapError.h"
#include "../os/encoding.h"

6
libYap.cmake
View File

@ -28,7 +28,7 @@ SET(CMAKE_SKIP_BUILD_RPATH FALSE)
# (but later on when installing)
SET(CMAKE_BUILD_WITH_INSTALL_RPATH FALSE)
SET(CMAKE_INSTALL_RPATH "${libdir};${dlls}:")
SET(CMAKE_INSTALL_RPATH "${CMAKE_INSTALL_LIBDIR};${YAP_INSTALL_LIBDIR}:")
# add the automatically determined parts of the RPATH
# which point to directories outside the build tree to the install RPATH
@ -47,9 +47,9 @@ set_target_properties(libYap
endif()
# the RPATH to be used when installing, but only if it's not a system directory
LIST(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES "${libdir};${dlls}" isSystemDir)
LIST(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES "${CMAKE_INSTALL_LIBDIR};${YAP_INSTALL_LIBDIR}" isSystemDir)
IF("${isSystemDir}" STREQUAL "-1")
SET(CMAKE_INSTALL_RPATH "${libdir};${dlls}")
SET(CMAKE_INSTALL_RPATH "${CMAKE_INSTALL_LIBDIR};${YAP_INSTALL_LIBDIR}")
ENDIF("${isSystemDir}" STREQUAL "-1")

4
library/CMakeLists.txt
View File

@ -76,10 +76,10 @@ MY_add_subdirectory(ytest)
add_to_group( LIBRARY_PL pl_library)
install(FILES ${LIBRARY_PL} DESTINATION ${libpl})
install(FILES ${LIBRARY_PL} DESTINATION ${YAP_INSTALL_DATADIR})
if (ANDROID)
file( INSTALL ${LIBRARY_PL} DESTINATION ${libpl} )
file( INSTALL ${LIBRARY_PL} DESTINATION ${YAP_INSTALL_DATADIR} )
endif()
include_directories("dialect/swi")

50
library/arg.yap
View File

@ -22,30 +22,32 @@
/**
*
@defgroup args Term Argument Manipulation.
@ingroup @library
@{
Extends arg/3 by including backtracking through arguments and access
to sub-arguments,
- arg0/3
- args/3
- args0/3
- genarg/3
- genarg0/3
- path_arg/3
It is based on the Quintus Prolog arg library. Except for project, all
predicates use the arg/3 argument pattern.
This file has been included in the YAP library by Vitor Santos Costa, 2008. No error checking is actuallly performed within the package: this left to the C-code thaat implements arg``/3 and
genarg/3.
*/
*
*
* @defgroup args Term Argument Manipulation.
*
* @ingroup @library
*
* @{
*
*This library extends arg/3 by supporting backtracking through
*arguments and access to sub-arguments,
*
* - arg0/3
* - args/3
* - args0/3
* - genarg/3
* - genarg0/3
* - path_arg/3
*
*
*It is based on the Quintus Prolog public domain library. Except for
*project, all predicates use the arg/3 argument pattern. This file has
*been included in the YAP library by Vitor Santos Costa, 2008.
*
* No error checking is actuallly performed within the package: this
*left to the C-code that implements arg/3 and genarg/3.
*/
/**
* @pred arg0( +_Index_, +_Term_ , -_Arg_ )

2
library/clp/CMakeList.txt
View File

@ -5,7 +5,7 @@ set (LIBRARY_PL_VLP
)
install(FILES ${LIBRARY_PL_CLP}
DESTINATION ${libpl}
DESTINATION ${YAP_INSTALL_DATADIR}
)

2
library/clp/CMakeLists.txt
View File

@ -7,7 +7,7 @@ set (LIBRARY_PL_CLP
add_to_group( LIBRARY_PL_CLP pl_library )
install(FILES ${LIBRARY_PL_CLP}
DESTINATION ${libpl}
DESTINATION ${YAP_INSTALL_DATADIR}
)

2
library/dialect/CMakeLists.txt
View File

@ -14,5 +14,5 @@ COMMAND ${CMAKE_COMMAND} -E touch visited
DEPENDS ${DIALECTS_PL} ) # WORKING_DIRECTORY ${CMAKE_BINARY_DIR} )
install(FILES ${DIALECTS_PL}
DESTINATION ${libpl}/dialect
DESTINATION ${YAP_INSTALL_DATADIR}/dialect
)

2
library/dialect/swi/CMakeLists.txt
View File

@ -7,5 +7,5 @@ set (SDIALECTS_PL
add_SubDirectory( fli )
install(FILES ${SDIALECTS_PL}
DESTINATION ${libpl}/dialect/swi
DESTINATION ${YAP_INSTALL_DATADIR}/dialect/swi
)

2
library/dialect/swi/fli/CMakeLists.txt
View File

@ -8,7 +8,7 @@ add_component (libswi
MY_set_target_properties(libswi
PROPERTIES
# RPATH ${libdir} VERSION ${LIBYAPTAI_FULL_VERSION}
# RPATH ${CMAKE_INSTALL_LIBDIR} VERSION ${LIBYAPTAI_FULL_VERSION}
# SOVERSION ${LIBYAPTAI_MAJOR_VERSION}.${LIBYAPTAI_MINOR_VERSION}
POSITION_INDEPENDENT_CODE ON
)

2
library/dialect/swi/os/CMakeLists.txt
View File

@ -58,7 +58,7 @@ add_component (libswi_os
set_target_properties(libswi_os
PROPERTIES
# RPATH ${libdir} VERSION ${LIBSWI_OS_FULL_VERSION}
# RPATH ${CMAKE_INSTALL_LIBDIR} VERSION ${LIBSWI_OS_FULL_VERSION}
# SOVERSION ${LIBSWI_OS_MAJOR_VERSION}.${LIBSWI_OS_MINOR_VERSION}
POSITION_INDEPENDENT_CODE TRUE
OUTPUT_NAME swi_os

2
library/dialect/swi/os/libtai/CMakeLists.txt
View File

@ -45,7 +45,7 @@ add_library (libyaptai OBJECT
set_target_properties(libyaptai
PROPERTIES
# RPATH ${libdir} VERSION ${LIBYAPTAI_FULL_VERSION}
# RPATH ${CMAKE_INSTALL_LIBDIR} VERSION ${LIBYAPTAI_FULL_VERSION}
# SOVERSION ${LIBYAPTAI_MAJOR_VERSION}.${LIBYAPTAI_MINOR_VERSION}
POSITION_INDEPENDENT_CODE TRUE
OUTPUT_NAME yaptai

25
library/gensym.yap
View File

@ -2,10 +2,10 @@
* @file gensym.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 18:37:13 2015
*
*
* @brief Generate a new atom.
*
*
*
*
*/
:- module(gensym, [
init_gensym/1,
@ -20,7 +20,7 @@
*
* Predicates to create new atoms based on the prefix _Atom_.
* They use a counter, stored as a
* dynamic predicate, to construct the atom's suffix.
* dynamic predicate, to construct the atom's suffix.
*
*/
@ -28,21 +28,20 @@
:- dynamic gensym_key/2.
init_gensym(Key) :-
assert(gensym_key(Atom,0) ).
retractall(gensym_key(Key,_)),
assert(gensym_key(Key,0) ).
gensym(Atom, New) :-
retract(gensym_key(Atom,Id)), !,
atomic_concat(Atom,Id,New),
gensym(Key, New) :-
retract(gensym_key(Key,Id)), !,
atomic_concat(Key,Id,New),
NId is Id+1,
assert(gensym_key(Atom,NId)).
assert(gensym_key(Key,NId)).
gensym(Atom, New) :-
atomic_concat(Atom,1,New),
assert(gensym_key(Atom,2)).
atomic_concat(Atom,0,New),
assert(gensym_key(Atom,1)).
reset_gensym(Atom) :-
retract(gensym_key(Atom,_)).
reset_gensym :-
retractall(gensym_key(_,_)).

6
library/lammpi/CMakeLists.txt
View File

@ -78,9 +78,9 @@ set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS HAVE_MPI_H=1)
PUBLIC ${MPI_C_COMPILE_FLAGS})
install(TARGETS yap_mpi
RUNTIME DESTINATION ${bindir}
LIBRARY DESTINATION ${YAP_INSTALL_DLLDIR}
ARCHIVE DESTINATION ${YAP_INSTALL_DLLDIR}
RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR}
LIBRARY DESTINATION ${YAP_INSTALL_LIBDIR}
ARCHIVE DESTINATION ${YAP_INSTALL_LIBDIR}
)
endif (MPI_C_FOUND)

23
library/listing.yap
View File

@ -19,10 +19,10 @@
* @file library/listing.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 22:03:59 2015
*
*
* @brief Emulate SWI Prolog's listing.
*
*
*
*
*/
:- module(swi_listing,
[ listing/0,
@ -31,20 +31,3 @@
portray_clause/2, % +Stream, +Clause
portray_clause/3 % +Stream, +Clause, +Options
]).
/*
* @defgroup swi_listing SWI Prolog listing emulation
* @ingroup library
emulates listing.pl, but just the interface for now.
*/
:- meta_predicate portray_clause( +, + , : ).
portray_clause(Stream, Term, M:Options) :-
portray_clause( Stream, Term ).

24
library/lists.yap
View File

@ -57,7 +57,7 @@
with the `use_module(library(lists))` command.
*/
:- include(pl/bootlists).
%:- include(pl/bootlists).
/** @pred list_concat(+ _Lists_,? _List_)
@ -205,6 +205,17 @@ append_([L1,L2|[L3|LL]], L) :-
append(L1,L2,LI),
append_([LI|[L3|LL]],L).
% reverse(List, Reversed)
% is true when List and Reversed are lists with the same elements
% but in opposite orders. rev/2 is a synonym for reverse/2.
reverse(List, Reversed) :-
reverse(List, [], Reversed).
reverse([], Reversed, Reversed).
reverse([Head|Tail], Sofar, Reversed) :-
reverse(Tail, [Head|Sofar], Reversed).
/** @pred last(+ _List_,? _Last_)
@ -358,17 +369,6 @@ remove_duplicates([Elem|L], [Elem|NL]) :-
delete(L, Elem, Temp),
remove_duplicates(Temp, NL).
% reverse(List, Reversed)
% is true when List and Reversed are lists with the same elements
% but in opposite orders. rev/2 is a synonym for reverse/2.
reverse(List, Reversed) :-
reverse(List, [], Reversed).
reverse([], Reversed, Reversed).
reverse([Head|Tail], Sofar, Reversed) :-
reverse(Tail, [Head|Sofar], Reversed).
% same_length(?List1, ?List2)
% is true when List1 and List2 are both lists and have the same number

40
library/maplist.yap
View File

@ -15,6 +15,7 @@
maplist/3,
maplist/4,
maplist/5,
maplist/6,
checklist/2,
checknodes/2,
convlist/3,
@ -52,6 +53,7 @@
maplist(2,+,-),
maplist(3,+,+,-),
maplist(4,+,+,+,-),
maplist(5,+,+,+,+,-),
convlist(2,+,-),
convlist(3,?,?,?),
mapnodes(2,+,-),
@ -63,7 +65,7 @@
sumnodes_body(3,+,+,-,+,+),
include(1,+,-),
exclude(1,+,-),
partition(2,+,-,-),
partition(1,+,-,-),
partition(2,+,-,-,-),
foldl(3, +, +, -),
foldl2(5, +, +, -, +, -),
@ -287,7 +289,8 @@ checklist(Pred, [In|ListIn]) :-
checklist(Pred, ListIn).
/**
@pred maplist(: Pred, ? ListIn)
@pred
ist(: Pred, ? ListIn)
Applies predicate _Pred_( _El_ ) to all
elements _El_ of _ListIn_.
@ -339,6 +342,18 @@ maplist(Pred, [A1|L1], [A2|L2], [A3|L3], [A4|L4]) :-
call(Pred, A1, A2, A3, A4),
maplist(Pred, L1, L2, L3, L4).
/**
@pred maplist(: Pred, ? L1, ? L2, ? L3, ? L4, ? L5)
_L1_, _L2_, _L3_, _L4_ and _L5_ are such that
`call( _Pred_, _A1_, _A2_, _A3_, _A4_,_A5_)` holds
for every corresponding element in lists _L1_, _L2_, _L3_, _L4_ and _L5_.
*/
maplist(_, [], [], [], [], []).
maplist(Pred, [A1|L1], [A2|L2], [A3|L3], [A4|L4], [A5|L5]) :-
call(Pred, A1, A2, A3, A4, A5),
maplist(Pred, L1, L2, L3, L4, L5).
/**
@pred convlist(: Pred, + ListIn, ? ListOut)
@ -793,6 +808,27 @@ goal_expansion(maplist(Meta, L1, L2, L3, L4), Mod:Goal) :-
(RecursionHead :- Apply, RecursiveCall)
], Mod).
goal_expansion(maplist(Meta, L1, L2, L3, L4, L5), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
% the new goal
pred_name(maplist, 6, Proto, GoalName),
append(MetaVars, [L1, L2, L3, L4, L5], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
append_args(HeadPrefix, [[], [], [], [], []], Base),
append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s], [A4|A4s], [A5|A5s]], RecursionHead),
append_args(Pred, [A1, A2, A3, A4, A5], Apply),
append_args(HeadPrefix, [A1s, A2s, A3s, A4s, A5s], RecursiveCall),
compile_aux([
Base,
(RecursionHead :- Apply, RecursiveCall)
], Mod).
goal_expansion(selectlist(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),

9
library/maputils.yap
View File

@ -77,17 +77,16 @@ aux_args([Arg|Args], MVars, [Arg|PArgs], PVars, [Arg|ProtoArgs]) :-
aux_args([Arg|Args], [Arg|MVars], [PVar|PArgs], [PVar|PVars], ['_'|ProtoArgs]) :-
aux_args(Args, MVars, PArgs, PVars, ProtoArgs).
pred_name(Macro, Arity, _ , Name) :-
pred_name(Macro, Arity, P , Name) :-
prolog_load_context(file, FullFileName),
file_base_name( FullFileName, File ),
prolog_load_context(term_position, Pos),
stream_position_data( line_count, Pos, Line ), !,
transformation_id(Id),
atomic_concat(['$$$ for ',Macro,'/',Arity,', line ',Line,' in ',File,' ',Id], Name).
pred_name(Macro, Arity, _ , Name) :-
atomic_concat(['$$$ for ',Macro,'/',Arity,', line ',Line,' in ',File,'(',P,') #',Id], Name).
pred_name(Macro, Arity, P , Name) :-
transformation_id(Id),
stop_low_level_trace,
atomic_concat(['$$$__expansion__ for ',Macro,'/',Arity,' ',Id], Name).
atomic_concat(['$$$__expansion__ for ',Macro,'/',Arity,'(',P,') #',Id], Name).
transformation_id(Id) :-
retract(number_of_expansions(Id)),

4
library/matlab/CMakeLists.txt
View File

@ -15,8 +15,8 @@ if (MATLAB_FOUND)
target_link_libraries(matlab libYap $(MATLAB_LIBRARIES) )
install(TARGETS matlab
RUNTIME DESTINATION ${YAP_INSTALL_DLLDIR}
ARCHIVE DESTINATION ${YAP_INSTALL_DLLDIR} )
RUNTIME DESTINATION ${YAP_INSTALL_LIBDIR}
ARCHIVE DESTINATION ${YAP_INSTALL_LIBDIR} )
endif (MATLAB_FOUND)

13
library/matrix.yap
View File

@ -745,6 +745,11 @@ rhs(list(RHS), List) :- !,
rhs(lists(RHS), List) :- !,
rhs(RHS, X1),
matrix_to_lists( X1, List ).
rhs('[]'([Args], floats(RHS)), Val) :-
integer(RHS),
integer(Args),
!,
get_float_from_address(RHS,Args,Val).
rhs('[]'(Args, RHS), Val) :-
!,
rhs(RHS, X1),
@ -770,6 +775,9 @@ rhs(log(RHS), Logs ) :- !,
rhs(exp(RHS), Logs ) :- !,
rhs(RHS, X1),
matrix_to_exps( X1, Logs ).
rhs(sum(RHS), Logs ) :- !,
rhs(RHS, X1),
matrix_sum( X1, Logs ).
rhs(S, NS) :-
rhs_opaque( S ), !,
S = NS.
@ -788,6 +796,11 @@ rhs(S, NS) :-
set_lhs(V, R) :- var(V), !, V = R.
set_lhs(V, R) :- number(V), !, V = R.
set_lhs('[]'([Args], floats(RHS)), Val) :-
!,
integer(RHS),
integer(Args),
set_float_from_address(RHS,Args,Val).
set_lhs('[]'(Args, M), Val) :-
matrix_dims( M, Dims, Bases),
maplist( index(Range), Args, Dims, Bases, NArgs),

6
library/matrix/CMakeLists.txt
View File

@ -6,8 +6,8 @@ target_link_libraries(matrix libYap)
set_target_properties (matrix PROPERTIES PREFIX "")
install(TARGETS matrix
RUNTIME DESTINATION ${YAP_INSTALL_DLLDIR}
ARCHIVE DESTINATION ${YAP_INSTALL_DLLDIR}
LIBRARY DESTINATION ${YAP_INSTALL_DLLDIR}
RUNTIME DESTINATION ${YAP_INSTALL_LIBDIR}
ARCHIVE DESTINATION ${YAP_INSTALL_LIBDIR}
LIBRARY DESTINATION ${YAP_INSTALL_LIBDIR}
)

1932
library/matrix/matrix.c
View File

File diff suppressed because it is too large Load Diff

4
library/random/CMakeLists.txt
View File

@ -10,5 +10,5 @@ set_target_properties (yap_random PROPERTIES PREFIX "")
endif()
MY_install(TARGETS yap_random
LIBRARY DESTINATION ${YAP_INSTALL_DLLDIR}
ARCHIVE DESTINATION ${YAP_INSTALL_DLLDIR} )
LIBRARY DESTINATION ${YAP_INSTALL_LIBDIR}
ARCHIVE DESTINATION ${YAP_INSTALL_LIBDIR} )

83
library/random/yap_random.c
View File

@ -1,67 +1,56 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: random.c *
* Last rev: *
* mods: *
* comments: regular expression interpreter *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: random.c * Last rev:
** mods: * comments: regular expression interpreter *
* *
*************************************************************************/
#include "config.h"
#include "YapInterface.h"
#include <math.h>
#if defined(__MINGW32__) || _MSC_VER
#include <windows.h>
#endif
X_API void init_random( void );
X_API void init_random(void);
static short a1 = 27314, b1 = 9213, c1 = 17773;
static YAP_Bool
p_random(void)
{
static YAP_Bool p_random(void) {
double fli;
long int t1, t2, t3;
t1 = (a1 * 171) % 30269;
t2 = (b1 * 172) % 30307;
t3 = (c1 * 170) % 30323;
fli = (t1/30269.0) + (t2/30307.0) + (t3/30323.0);
fli = (t1 / 30269.0) + (t2 / 30307.0) + (t3 / 30323.0);
a1 = t1;
b1 = t2;
c1 = t3;
return(YAP_Unify(YAP_ARG1, YAP_MkFloatTerm(fli-(int)(fli))));
return (YAP_Unify(YAP_ARG1, YAP_MkFloatTerm(fli - (int)(fli))));
}
static YAP_Bool
p_setrand(void)
{
static YAP_Bool p_setrand(void) {
a1 = YAP_IntOfTerm(YAP_ARG1);
b1 = YAP_IntOfTerm(YAP_ARG2);
c1 = YAP_IntOfTerm(YAP_ARG3);
return(TRUE);
return (TRUE);
}
static YAP_Bool
p_getrand(void)
{
return(YAP_Unify(YAP_ARG1,YAP_MkIntTerm(a1)) &&
YAP_Unify(YAP_ARG2,YAP_MkIntTerm(b1)) &&
YAP_Unify(YAP_ARG3,YAP_MkIntTerm(c1)));
static YAP_Bool p_getrand(void) {
return (YAP_Unify(YAP_ARG1, YAP_MkIntTerm(a1)) &&
YAP_Unify(YAP_ARG2, YAP_MkIntTerm(b1)) &&
YAP_Unify(YAP_ARG3, YAP_MkIntTerm(c1)));
}
X_API void
init_random(void)
{
X_API void init_random(void) {
YAP_UserCPredicate("random", p_random, 1);
YAP_UserCPredicate("setrand", p_setrand, 3);
YAP_UserCPredicate("getrand", p_getrand, 3);
@ -71,19 +60,17 @@ init_random(void)
int WINAPI win_random(HANDLE, DWORD, LPVOID);
int WINAPI win_random(HANDLE hinst, DWORD reason, LPVOID reserved)
{
switch (reason)
{
case DLL_PROCESS_ATTACH:
break;
case DLL_PROCESS_DETACH:
break;
case DLL_THREAD_ATTACH:
break;
case DLL_THREAD_DETACH:
break;
}
int WINAPI win_random(HANDLE hinst, DWORD reason, LPVOID reserved) {
switch (reason) {
case DLL_PROCESS_ATTACH:
break;
case DLL_PROCESS_DETACH:
break;
case DLL_THREAD_ATTACH:
break;
case DLL_THREAD_DETACH:
break;
}
return 1;
}
#endif

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