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

Merge branch 'master' into master

This commit is contained in:
vscosta 2018-10-23 16:01:30 +01:00 committed by GitHub
parent 84e90d764f 37212efc55
commit da6bd115d8
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1160 changed files with 204832 additions and 112518 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
.configure-custom.sh
View File

@ -1,7 +1,9 @@
ENABLE_VARS="clpbn|yes|WITH_CLPBN \
ENABLE_VARS="brew|yes|WITH_BREW\
clpbn|yes|WITH_CLPBN \
cplint|yes|WITH_CPLINT \
horus|yes|WITH_HORUS \
clpr|yes|WITH_CLPR \
macports|yes|WITH_MACPORTS\
problog|yes|WITH_PROBLOG \
jit|no|WITH_JIT \
chr|no|WITH_CHR \
@ -10,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 "
gmp|yes|WITH_GMP"

19
.gitignore vendored
View File

@ -12,6 +12,7 @@
*.dll
docs/yap.info*
.build
build
tags
TGSautom4te.cache
cscope.*
@ -24,7 +25,6 @@ tmtags*
.Rhistory
.zedstate
config.h
Yap.h
YapConfig.h
YapTermConfig.h
.graffiti
@ -42,7 +42,6 @@ groups
.cproject
.dir-locals.el
.DS_store
.kateproject
.project
.pydevproject
.Rhistory
@ -150,7 +149,7 @@ yap-6.3.workspace
yap-6.3.geany
YAP.project
CBlocks
yPQ
yPQ
*.tmp
YAP.sublime*
yap32
@ -203,4 +202,16 @@ mxe
build
library/system/#CMakeLists.txt#
*.txt#
*.txt#
cmake/CMakeCache.txt
C/compiling_error.txt
cmake/compile_commands.json
cmake/cudd_config.h
cmake/docs/Doxyfile
*.stackdump
*.gz

120
C/absmi.c
View File

@ -22,25 +22,49 @@
@file absmi.c
@defgroup Efficiency Efficiency Considerations
@ingroup YAPProgramming
@{
We next discuss several issues on trying to make Prolog programs run
fast in YAP. We assume two different programming styles:
+ Execution of <em>deterministic</em> programs ofte
n
+ Execution of <em>deterministic</em> programs often
boils down to a recursive loop of the form:
~~~~~
loop(Done).
loop(Env) :-
do_something(Env,NewEnv),
loop(NewEnv).
~~~~~
or to the repeat-fail loop:
~~~~~
loop(Inp) :-
do_something(Inp,Out),
out_and_fail(Out).
~~~~~
@}
@defgroup Implementation Implementation Considerations
@ingroup YAPProgramming
This section is about the YAP implementation, and is mostly of
interest to hackers.
@{
@defgroup Emulator The Abstract Machine Emulator
@ingroup Implementation
*/
/// code belongs to the emulator
#define IN_ABSMI_C 1
#define _INATIVE 1
/// use tmp variables that are placed in registers
#define HAS_CACHE_REGS 1
#include "absmi.h"
@ -195,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;
@ -215,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();
@ -502,8 +526,8 @@ static int interrupt_execute(USES_REGS1) {
}
if (PP)
UNLOCKPE(1, PP);
PP = P->y_u.pp.p0;
if ((P->y_u.pp.p->PredFlags & (NoTracePredFlag | HiddenPredFlag)) &&
PP = P->y_u.Osbpp.p0;
if ((P->y_u.Osbpp.p->PredFlags & (NoTracePredFlag | HiddenPredFlag)) &&
Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
return 2;
}
@ -511,11 +535,11 @@ static int interrupt_execute(USES_REGS1) {
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v;
}
if ((v = stack_overflow(P->y_u.pp.p, ENV, CP,
P->y_u.pp.p->ArityOfPE PASS_REGS)) >= 0) {
if ((v = stack_overflow(P->y_u.Osbpp.p, ENV, CP,
P->y_u.Osbpp.p->ArityOfPE PASS_REGS)) >= 0) {
return v;
}
return interrupt_handler(P->y_u.pp.p PASS_REGS);
return interrupt_handler(P->y_u.Osbpp.p PASS_REGS);
}
static int interrupt_call(USES_REGS1) {
@ -665,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);
@ -840,8 +864,8 @@ static int interrupt_dexecute(USES_REGS1) {
#endif
if (PP)
UNLOCKPE(1, PP);
PP = P->y_u.pp.p0;
pe = P->y_u.pp.p;
PP = P->y_u.Osbpp.p0;
pe = P->y_u.Osbpp.p;
if ((pe->PredFlags & (NoTracePredFlag | HiddenPredFlag)) &&
Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
return 2;
@ -853,8 +877,8 @@ static int interrupt_dexecute(USES_REGS1) {
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v;
}
if ((v = stack_overflow(P->y_u.pp.p, (CELL *)YENV[E_E], (yamop *)YENV[E_CP],
P->y_u.pp.p->ArityOfPE PASS_REGS)) >= 0) {
if ((v = stack_overflow(P->y_u.Osbpp.p, (CELL *)YENV[E_E], (yamop *)YENV[E_CP],
P->y_u.Osbpp.p->ArityOfPE PASS_REGS)) >= 0) {
return v;
}
/* first, deallocate */
@ -892,7 +916,6 @@ static int interrupt_dexecute(USES_REGS1) {
static void undef_goal(USES_REGS1) {
PredEntry *pe = PredFromDefCode(P);
BEGD(d0);
/* avoid trouble with undefined dynamic procedures */
/* I assume they were not locked beforehand */
@ -902,12 +925,26 @@ static void undef_goal(USES_REGS1) {
PP = pe;
}
#endif
if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag) ||
pe == UndefCode) {
if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag) ) {
#if defined(YAPOR) || defined(THREADS)
UNLOCKPE(19, PP);
PP = NULL;
#endif
CalculateStackGap(PASS_REGS1);
P = FAILCODE;
return;
}
if (UndefCode == NULL || UndefCode->OpcodeOfPred == UNDEF_OPCODE) {
fprintf(stderr,"call to undefined Predicates %s ->", IndicatorOfPred(pe));
Yap_DebugPlWriteln(ARG1);
fputc(':', stderr);
Yap_DebugPlWriteln(ARG2);
fprintf(stderr," error handler not available, failing\n");
#if defined(YAPOR) || defined(THREADS)
UNLOCKPE(19, PP);
PP = NULL;
#endif
CalculateStackGap(PASS_REGS1);
P = FAILCODE;
return;
}
@ -915,16 +952,16 @@ static void undef_goal(USES_REGS1) {
UNLOCKPE(19, PP);
PP = NULL;
#endif
d0 = pe->ArityOfPE;
if (d0 == 0) {
HR[1] = MkAtomTerm((Atom)(pe->FunctorOfPred));
if (pe->ArityOfPE == 0) {
d0 = MkAtomTerm((Atom)(pe->FunctorOfPred));
} else {
HR[d0 + 2] = AbsAppl(HR);
*HR = (CELL)pe->FunctorOfPred;
HR++;
d0 = AbsAppl(HR);
*HR++ = (CELL)pe->FunctorOfPred;
CELL *ip=HR, *imax = HR+pe->ArityOfPE;
HR = imax;
BEGP(pt1);
pt1 = XREGS + 1;
for (; d0 > 0; --d0) {
for (; ip < imax; ip++) {
BEGD(d1);
BEGP(pt0);
pt0 = pt1++;
@ -932,18 +969,17 @@ static void undef_goal(USES_REGS1) {
deref_head(d1, undef_unk);
undef_nonvar:
/* just copy it to the heap */
*HR++ = d1;
*ip = d1;
continue;
derefa_body(d1, pt0, undef_unk, undef_nonvar);
if (pt0 <= HR) {
/* variable is safe */
*HR++ = (CELL)pt0;
*ip = (CELL)pt0;
} else {
/* bind it, in case it is a local variable */
d1 = Unsigned(HR);
RESET_VARIABLE(HR);
HR += 1;
d1 = Unsigned(ip);
RESET_VARIABLE(ip);
Bind_Local(pt0, d1);
}
ENDP(pt0);
@ -951,11 +987,20 @@ static void undef_goal(USES_REGS1) {
}
ENDP(pt1);
}
ENDD(d0);
HR[0] = Yap_Module_Name(pe);
ARG1 = (Term)AbsPair(HR);
ARG1 = AbsPair(HR);
HR[1] = d0;
ENDD(d0);
if (pe->ModuleOfPred == PROLOG_MODULE) {
if (CurrentModule == PROLOG_MODULE)
HR[0] = TermProlog;
else
HR[0] = CurrentModule;
} else {
HR[0] = Yap_Module_Name(pe);
}
ARG2 = Yap_getUnknownModule(Yap_GetModuleEntry(HR[0]));
HR += 2;
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred, UndefCode, XREGS + 1);
@ -1146,7 +1191,6 @@ Int Yap_absmi(int inp) {
#ifdef SHADOW_S
register CELL *SREG = Yap_REGS.S_;
#else
#define SREG S
#endif /* SHADOW_S */
/* The indexing register so that we will not destroy ARG1 without
@ -1420,3 +1464,7 @@ default:
/* dummy function that is needed for profiler */
int Yap_absmiEND(void) { return 1; }
/// @}
/// @}

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 {

2035
C/adtdefs.c
View File

File diff suppressed because it is too large Load Diff

1268
C/adtdefs.c.new Executable file
View File

File diff suppressed because it is too large Load Diff

4
C/agc.c
View File

@ -340,8 +340,8 @@ mark_global_cell(CELL *pt)
Int sz = 3 +
(sizeof(MP_INT)+
(((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL);
Opaque_CallOnGCMark f;
Opaque_CallOnGCRelocate f2;
YAP_Opaque_CallOnGCMark f;
YAP_Opaque_CallOnGCRelocate f2;
Term t = AbsAppl(pt);
if ( (f = Yap_blob_gc_mark_handler(t)) ) {

93
C/alloc.c
View File

@ -1,19 +1,18 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: alloc.c *
* Last rev: *
* mods: *
* comments: allocating space *
* version:$Id: alloc.c,v 1.95 2008-05-10 23:24:11 vsc Exp $ *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: alloc.c * Last
*rev: * mods:
** comments: allocating space *
* version:$Id: alloc.c,v 1.95 2008-05-10 23:24:11 vsc Exp $ *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
@ -43,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
@ -77,11 +82,13 @@ void *my_malloc(size_t sz) {
p = malloc(sz);
// Yap_DebugPuts(stderr,"gof\n");
if (Yap_do_low_level_trace)
fprintf(stderr, "+ %p: %" Sizet_F "\n", p, sz);
if (sz > 500 && write_malloc++ > 0)
__android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "+ %d %p", write_malloc,
p);
if (Yap_do_low_level_trace) {
#if __ANDROID__
// __android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "+ %d %p", write_malloc,p);
#else
fprintf(stderr, "+s %p\n @%p %ld\n", p, TR, LCL0 - (CELL *)LCL0);
#endif
}
return p;
}
@ -89,22 +96,22 @@ void *my_realloc(void *ptr, size_t sz) {
void *p;
p = realloc(ptr, sz);
if (Yap_do_low_level_trace)
//if (Yap_do_low_level_trace)
// fprintf(stderr, "+ %p -> %p : " Sizet_F "\n", ptr, p, sz);
// Yap_DebugPuts(stderr,"gof\n");
if (sz > 500 && write_malloc++ > 0)
__android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "* %d %p", write_malloc,
p);
// Yap_DebugPuts(stderr,"gof\n");
// if (sz > 500 && write_malloc++ > 0)
// __android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "* %d %p",
// write_malloc, p);
return p;
}
void my_free(void *p) {
// printf("f %p\n",p);
if (Yap_do_low_level_trace)
fprintf(stderr, "+ %p\n", p);
if (write_malloc && write_malloc++ > 0)
__android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "- %d %p", write_malloc,
p);
fprintf(stderr, "- %p\n @%p %ld\n", p, TR, (long int)(LCL0 - (CELL *)B) );
//if (write_malloc && write_malloc++ > 0)
// __android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "- %d %p", write_malloc,
// p);
free(p);
// Yap_DebugPuts(stderr,"gof\n");
@ -296,7 +303,7 @@ ADDR Yap_InitPreAllocCodeSpace(int wid) {
#else
my_malloc(sz)
#endif
)) {
)) {
REMOTE_PrologMode(wid) &= ~MallocMode;
#if USE_DL_MALLOC
UNLOCK(DLMallocLock);
@ -382,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;
@ -393,7 +411,7 @@ static void InitExStacks(int wid, int Trail, int Stack) {
Stack = MinStackSpace;
pm = (Trail + Stack) * K; /* memory to be
* requested */
sa = Stack * K; /* stack area size */
sa = Stack * K; /* stack area size */
#ifdef THREADS
if (wid)
@ -671,7 +689,7 @@ static char *AllocHeap(size_t size) {
LOCK(FreeBlocksLock);
if ((b = GetBlock(size))) {
if (b->b_size >= size + 24 + 1) {
n = (BlockHeader *)(((YAP_SEG_SIZE *)b) + size + 1)v;
n = (BlockHeader *)(((YAP_SEG_SIZE *)b) + size + 1) v;
n->b_size = b->b_size - size - 1;
b->b_size = size;
AddToFreeList(n);
@ -1328,7 +1346,7 @@ XX realloc(MALLOC_T ptr, size_t size) {
MALLOC_T new = malloc(size);
if (ptr)
memcpy(new, ptr, size);
memmove(new, ptr, size);
free(ptr);
return (new);
}
@ -1455,7 +1473,7 @@ void Yap_InitMemory(UInt Trail, UInt Heap, UInt Stack) {
#endif
pm = (Trail + Heap + Stack); /* memory to be
* requested */
sa = Stack; /* stack area size */
sa = Stack; /* stack area size */
ta = Trail; /* trail area size */
#if RANDOMIZE_START_ADDRESS
@ -1477,7 +1495,7 @@ void Yap_InitMemory(UInt Trail, UInt Heap, UInt Stack) {
LOCAL_GlobalBase = LOCAL_LocalBase - sa;
HeapLim = LOCAL_GlobalBase; /* avoid confusions while
* * restoring */
* * restoring */
#if !USE_DL_MALLOC
AuxTop = (ADDR)(AuxSp = (CELL *)LOCAL_GlobalBase);
#endif
@ -1496,8 +1514,9 @@ void Yap_InitMemory(UInt Trail, UInt Heap, UInt Stack) {
(UInt)LOCAL_TrailTop);
#endif
fprintf(stderr, "Heap+Aux: " UInt_FORMAT "\tLocal+Global: " UInt_FORMAT
"\tTrail: " UInt_FORMAT "\n",
fprintf(stderr,
"Heap+Aux: " UInt_FORMAT "\tLocal+Global: " UInt_FORMAT
"\tTrail: " UInt_FORMAT "\n",
pm - sa - ta, sa, ta);
}
#endif /* DEBUG */

16
C/amasm.c
View File

@ -1434,10 +1434,12 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no,
if (Flags & CPredFlag) {
code_p->opc = emit_op(_execute_cpred);
}
code_p->y_u.pp.p = RepPredProp(fe);
code_p->y_u.pp.p0 = clinfo->CurrentPred;
code_p->y_u.Osbpp.p = RepPredProp(fe);
code_p->y_u.Osbpp.p0 = clinfo->CurrentPred;
code_p->y_u.Osbpp.s = 0;
code_p->y_u.Osbpp.bmap = NULL;
}
GONEXT(pp);
GONEXT(Osbpp);
} else {
if (pass_no)
code_p->y_u.p.p = RepPredProp(fe);
@ -3901,7 +3903,7 @@ yamop *Yap_InitCommaContinuation(PredEntry *pe) {
GONEXT(Osbmp);
for (i = 0; i < arity; i++)
GONEXT(yx);
GONEXT(pp);
GONEXT(Osbmp);
pe->MetaEntryOfPred = code_p =
Yap_AllocCodeSpace((size_t)code_p);
code_p->opc = opcode(_call);
@ -3917,8 +3919,8 @@ Yap_AllocCodeSpace((size_t)code_p);
GONEXT(yx);
}
code_p->opc = opcode(_dexecute);
code_p->y_u.pp.p0 = PredMetaCall;
code_p->y_u.pp.p = pe;
GONEXT(pp);
code_p->y_u.Osbpp.p0 = PredMetaCall;
code_p->y_u.Osbpp.p = pe;
GONEXT(Osbpp);
return pe->MetaEntryOfPred;
}

102
C/args.c
View File

@ -38,92 +38,90 @@ int Yap_ArgKey(Atom key, const param_t *def, int n) {
return -1;
}
#define failed(e, t, a) failed__(e, t, a PASS_REGS)
#define YAP_XARGINFO(Error, Message)
static xarg *failed__(yap_error_number e, Term t, xarg *a USES_REGS) {
free(a);
return NULL;
}
xarg *Yap_ArgListToVector(Term listl, const param_t *def, int n) {
xarg *Yap_ArgListToVector__(const char *file, const char *function, int lineno,
Term listl, const param_t *def, int n,
yap_error_number err) {
CACHE_REGS
listl = Deref(listl);
xarg *a = calloc(n, sizeof(xarg));
if (IsApplTerm(listl) && FunctorOfTerm(listl) == FunctorModule)
listl = ArgOfTerm(2, listl);
xarg *a;
listl = Deref(listl);
if (IsVarTerm(listl)) {
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl,
"while opening listl = ArgOfTerm(2, listl ,k)");
}
a = calloc(n, sizeof(xarg));
if (!IsPairTerm(listl) && listl != TermNil) {
if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a);
}
if (IsAtomTerm(listl)) {
xarg *na = matchKey(AtomOfTerm(listl), a, n, def);
if (!na) {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "match key");
}
} else if (IsApplTerm(listl)) {
Functor f = FunctorOfTerm(listl);
if (IsExtensionFunctor(f)) {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "callable");
}
arity_t arity = ArityOfFunctor(f);
if (arity != 1) {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "bad arity");
}
xarg *na = matchKey(NameOfFunctor(f), a, n, def);
if (!na) {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, err, listl, "no match");
}
na->used = true;
na->tvalue = ArgOfTerm(1, listl);
return a;
} else {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_ATOM, listl, "not atom");
}
listl = MkPairTerm(listl, TermNil);
}
while (IsPairTerm(listl)) {
Term hd = HeadOfTerm(listl);
listl = TailOfTerm(listl);
if (IsVarTerm(hd) || IsVarTerm(listl)) {
if (IsVarTerm(hd)) {
return failed(INSTANTIATION_ERROR, hd, a);
} else {
return failed(INSTANTIATION_ERROR, listl, a);
}
if (IsVarTerm(hd)) {
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, hd, "sub-element");
}
if (IsVarTerm(listl)) {
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "sub-list");
}
if (IsAtomTerm(hd)) {
xarg *na = matchKey(AtomOfTerm(hd), a, n, def);
if (!na)
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
Yap_ThrowError__(file, function, lineno, err, hd, "bad match in list");
na->used = true;
na->tvalue = TermNil;
continue;
} else if (IsApplTerm(hd)) {
Functor f = FunctorOfTerm(hd);
if (IsExtensionFunctor(f)) {
return failed(TYPE_ERROR_PARAMETER, hd, a);
Yap_ThrowError__(file, function, lineno, err, hd, "bad compound");
}
arity_t arity = ArityOfFunctor(f);
if (arity != 1) {
return failed(DOMAIN_ERROR_OUT_OF_RANGE, hd, a);
Yap_ThrowError__(file, function, lineno, DOMAIN_ERROR_OUT_OF_RANGE, hd,
"high arity");
}
xarg *na = matchKey(NameOfFunctor(f), a, n, def);
if (!na) {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
Yap_ThrowError__(file, function, lineno, err, hd, "no match");
}
na->used = true;
na->tvalue = ArgOfTerm(1, hd);
} else {
return failed(TYPE_ERROR_PARAMETER, hd, a);
Yap_ThrowError__(file, function, lineno, err, hd, "bad type");
}
}
if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a);
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "unbound");
} else if (listl != TermNil) {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "bad list");
}
return a;
}
}
static xarg *matchKey2(Atom key, xarg *e0, int n, const param2_t *def) {
int i;
@ -136,50 +134,53 @@ static xarg *matchKey2(Atom key, xarg *e0, int n, const param2_t *def) {
}
return NULL;
}
/// Yap_ArgList2ToVector is much the same as before,
/// but assumes parameters also have something called a
/// scope
xarg *Yap_ArgList2ToVector(Term listl, const param2_t *def, int n) {
xarg *Yap_ArgList2ToVector__(const char *file, const char *function, int lineno,Term listl, const param2_t *def, int n, yap_error_number err) {
CACHE_REGS
xarg *a = calloc(n, sizeof(xarg));
if (!IsPairTerm(listl) && listl != TermNil) {
if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a);
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "unbound");
}
if (IsAtomTerm(listl)) {
xarg *na = matchKey2(AtomOfTerm(listl), a, n, def);
if (!na) {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a);
Yap_ThrowError__(file, function, lineno, err,
listl, "bad match");
}
}
if (IsApplTerm(listl)) {
Functor f = FunctorOfTerm(listl);
if (IsExtensionFunctor(f)) {
return failed(TYPE_ERROR_PARAMETER, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_PARAMETER, listl,
"bad compound");
}
arity_t arity = ArityOfFunctor(f);
if (arity != 1) {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "bad arity");
}
xarg *na = matchKey2(NameOfFunctor(f), a, n, def);
if (!na) {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a);
Yap_ThrowError__(file, function, lineno, DOMAIN_ERROR_GENERIC_ARGUMENT,
listl, "bad match");
}
} else {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "");
}
listl = MkPairTerm(listl, TermNil);
}
while (IsPairTerm(listl)) {
Term hd = HeadOfTerm(listl);
if (IsVarTerm(hd)) {
return failed(INSTANTIATION_ERROR, hd, a);
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, hd, "");
}
if (IsAtomTerm(hd)) {
xarg *na = matchKey2(AtomOfTerm(hd), a, n, def);
if (!na) {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
Yap_ThrowError__(file, function, lineno, DOMAIN_ERROR_GENERIC_ARGUMENT,
hd, "bad match");
}
na->used = true;
na->tvalue = TermNil;
@ -187,29 +188,32 @@ xarg *Yap_ArgList2ToVector(Term listl, const param2_t *def, int n) {
} else if (IsApplTerm(hd)) {
Functor f = FunctorOfTerm(hd);
if (IsExtensionFunctor(f)) {
return failed(TYPE_ERROR_PARAMETER, hd, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_PARAMETER, hd, "bad compound");
}
arity_t arity = ArityOfFunctor(f);
if (arity != 1) {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
Yap_ThrowError__(file, function, lineno, DOMAIN_ERROR_GENERIC_ARGUMENT,
hd, "bad arity");
}
xarg *na = matchKey2(NameOfFunctor(f), a, n, def);
if (na) {
na->used = 1;
na->tvalue = ArgOfTerm(1, hd);
} else {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
Yap_ThrowError__(file, function, lineno, err,
hd, "bad key");
}
return a;
} else {
return failed(INSTANTIATION_ERROR, hd, a);
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, hd, "unbound");
}
listl = TailOfTerm(listl);
}
if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a);
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "");
}
if (TermNil != listl) {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "");
}
return a;
}

11
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
@ -191,7 +194,10 @@ eval0(Int fi) {
#if YAPOR_SBA
RINT((Int)B);
#else
if (B)
RINT(LCL0 - (CELL *)B);
else
RINT(0);
#endif
case op_env:
/// - $env
@ -284,6 +290,7 @@ Yap_InitConstExps(void)
}
}
/* This routine is called from Restore to make sure we have the same arithmetic operators */
int
Yap_ReInitConstExps(void)

879
C/arith1.c
View File

File diff suppressed because it is too large Load Diff

138
C/arith2.c
View File

@ -213,7 +213,7 @@ p_div2(Term t1, Term t2 USES_REGS) {
Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " div 0", i1);
if (i1 == Int_MIN && i2 == -1) {
#ifdef USE_GMP
return Yap_gmp_add_ints(Int_MAX, 1);
return Yap_gmp_add_ints(Int_MAX, 1);
#else
Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
"// /2 with %d and %d", i1, i2);
@ -443,7 +443,7 @@ p_xor(Term t1, Term t2 USES_REGS)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
@ -643,7 +643,7 @@ p_power(Term t1, Term t2 USES_REGS)
}
/* next function is adapted from:
Inline C++ integer exponentiation routines
Inline C++ integer exponentiation routines
Version 1.01
Copyright (C) 1999-2004 John C. Bowman <bowman@math.ualberta.ca>
*/
@ -654,9 +654,9 @@ ipow(Int x, Int p)
if (p == 0) return ((CELL)1);
if (x == 0 && p > 0) return 0L;
if(p < 0)
if(p < 0)
return (-p % 2) ? x : ((CELL)1);
r = ((CELL)1);
for(;;) {
if(p & 1) {
@ -1142,167 +1142,125 @@ static InitBinEntry InitBinTab[] = {
{"rdiv", op_rdiv}
};
static Int
static Int
p_binary_is( USES_REGS1 )
{ /* X is Y */
Term t = Deref(ARG2);
Term t1, t2;
yap_error_number err;
Term t1, t2, tout;
if (IsVarTerm(t)) {
Yap_ArithError(INSTANTIATION_ERROR,t, "VAR(X , Y)");
return(FALSE);
}
Yap_ClearExs();
t1 = Yap_Eval(Deref(ARG3));
if ((err = Yap_FoundArithError())) {
Atom name;
if (IsIntTerm(t)) {
Int i = IntOfTerm(t);
name = Yap_NameOfBinaryOp(i);
} else {
name = AtomOfTerm(Deref(ARG2));
}
Yap_EvalError(err,ARG3,"X is ~s/2: error in first argument ", RepAtom(name)->StrOfAE);
return FALSE;
}
Yap_ClearExs();
t1 = Yap_Eval(Deref(ARG3));
t2 = Yap_Eval(Deref(ARG4));
if ((err=Yap_FoundArithError())) {
Atom name;
if (IsIntTerm(t)) {
Int i = IntOfTerm(t);
name = Yap_NameOfBinaryOp(i);
} else {
name = AtomOfTerm(Deref(ARG2));
}
Yap_EvalError(err,ARG3,"X is ~s/2: error in first argument ", RepAtom(name)->StrOfAE);
return FALSE;
}
if (IsIntTerm(t)) {
Int i = IntOfTerm(t);
Term tout = eval2(i, t1, t2 PASS_REGS);
if ((err = Yap_FoundArithError()) != YAP_NO_ERROR) {
Term ts[2], terr;
Atom name = Yap_NameOfBinaryOp( i );
Functor f = Yap_MkFunctor( name, 2 );
ts[0] = t1;
ts[1] = t2;
terr = Yap_MkApplTerm( f, 2, ts );
Yap_EvalError(err, terr ,"error in %s/2 ", RepAtom(name)->StrOfAE);
return FALSE;
}
bool go;
do {
go = false;
tout = eval2(i, t1, t2 PASS_REGS);
go = Yap_CheckArithError();
} while (go);
return Yap_unify_constant(ARG1,tout);
}
if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);
ExpEntry *p;
Term out;
bool go;
int j;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
Yap_EvalError(TYPE_ERROR_EVALUABLE, takeIndicator(t),
"functor %s/2 for arithmetic expression",
RepAtom(name)->StrOfAE);
P = FAILCODE;
return(FALSE);
Yap_EvalError(TYPE_ERROR_EVALUABLE, t, "`%s ", name->StrOfAE
);
}
out= eval2(p->FOfEE, t1, t2 PASS_REGS);
if ((err = Yap_FoundArithError()) != YAP_NO_ERROR) {
Term ts[2], terr;
Functor f = Yap_MkFunctor( name, 2 );
ts[0] = t1;
ts[1] = t2;
terr = Yap_MkApplTerm( f, 2, ts );
Yap_EvalError(err, terr ,"error in ~s/2 ", RepAtom(name)->StrOfAE);
return FALSE;
}
return Yap_unify_constant(ARG1,out);
j = p->FOfEE;
do {
go = false;
Yap_ClearExs();
tout = eval2(j, t1, t2 PASS_REGS);
go = Yap_CheckArithError();
} while (go);
return Yap_unify_constant(ARG1,tout);
}
return FALSE;
}
static Int
static Int
do_arith23(arith2_op op USES_REGS)
{ /* X is Y */
Term t = Deref(ARG1);
Int out;
Term t1, t2;
yap_error_number err;
bool go;
Term t1, t2, out;
Yap_ClearExs();
if (IsVarTerm(t)) {
Yap_EvalError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
t1 = Yap_Eval(t);
if (t1 == 0L)
return FALSE;
do {
go = false;
Yap_ClearExs();
t1 = Yap_Eval(t);
t2 = Yap_Eval(Deref(ARG2));
if (t2 == 0L)
return FALSE;
out= eval2(op, t1, t2 PASS_REGS);
if ((err=Yap_FoundArithError())) {
Term ts[2], t;
Functor f = Yap_MkFunctor( Yap_NameOfBinaryOp(op), 2 );
ts[0] = t1;
ts[1] = t2;
t = Yap_MkApplTerm( f, 2, ts );
Yap_EvalError(err, t ,"error in ~s(Y,Z) ",Yap_NameOfBinaryOp(op));
return FALSE;
}
go = Yap_CheckArithError();
} while (go);
return Yap_unify_constant(ARG3,out);
}
static Int
static Int
export_p_plus( USES_REGS1 )
{ /* X is Y */
return do_arith23(op_plus PASS_REGS);
}
static Int
static Int
export_p_minus( USES_REGS1 )
{ /* X is Y */
return do_arith23(op_minus PASS_REGS);
}
static Int
static Int
export_p_times( USES_REGS1 )
{ /* X is Y */
return do_arith23(op_times PASS_REGS);
}
static Int
static Int
export_p_div( USES_REGS1 )
{ /* X is Y */
return do_arith23(op_div PASS_REGS);
}
static Int
static Int
export_p_and( USES_REGS1 )
{ /* X is Y */
return do_arith23(op_and PASS_REGS);
}
static Int
static Int
export_p_or( USES_REGS1 )
{ /* X is Y */
return do_arith23(op_or PASS_REGS);
}
static Int
static Int
export_p_slr( USES_REGS1 )
{ /* X is Y */
return do_arith23(op_slr PASS_REGS);
}
static Int
static Int
export_p_sll( USES_REGS1 )
{ /* X is Y */
return do_arith23(op_sll PASS_REGS);
}
static Int
static Int
p_binary_op_as_integer( USES_REGS1 )
{ /* X is Y */
Term t = Deref(ARG1);
@ -1317,7 +1275,6 @@ p_binary_op_as_integer( USES_REGS1 )
if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);
ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
return Yap_unify(ARG1,ARG2);
}
@ -1376,4 +1333,3 @@ Yap_ReInitBinaryExps(void)
{
return(TRUE);
}

204
C/arrays.c
View File

@ -1,21 +1,25 @@
/******************************************************************""*******
* *
* 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 *
* *
*************************************************************************/
/** @defgroup YAPArrays Named Arrays
/**
@file arrays.c
@namespace prolog
@addtogroup YAPArrays Named Arrays
@ingroup extensions
@{
@ -100,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>
@ -367,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;
@ -693,6 +697,7 @@ static StaticArrayEntry *CreateStaticArray(AtomEntry *ae, size_t dim,
}
}
p->KindOfPE = ArrayProperty;
p->ValueOfVE.ints = NULL;
INIT_RWLOCK(p->ArRWLock);
AddPropToAtom(ae, (PropEntry *)p);
p->NextAE = LOCAL_StaticArrays;
@ -979,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) {
@ -1018,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");
@ -1048,46 +1080,68 @@ 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;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "create static array");
return (FALSE);
} else if (IsAtomTerm(t)) {
/* Create a named array */
AtomEntry *ae = RepAtom(AtomOfTerm(t));
StaticArrayEntry *pp;
ArrayEntry *app;
WRITE_LOCK(ae->ARWLock);
@ -1097,42 +1151,36 @@ 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) {
WRITE_UNLOCK(ae->ARWLock);
return FALSE;
return TRUE;
}
WRITE_UNLOCK(ae->ARWLock);
return TRUE;
} else if (ArrayIsDynamic(app)) {
if (IsVarTerm(app->ValueOfVE) && IsUnboundVar(&app->ValueOfVE)) {
pp = CreateStaticArray(ae, size, props, NULL, pp PASS_REGS);
WRITE_UNLOCK(ae->ARWLock);
if (pp == NULL) {
return false;
}
return true;
} else {
WRITE_UNLOCK(ae->ARWLock);
Yap_Error(PERMISSION_ERROR_CREATE_ARRAY, t,
"cannot create static array over dynamic array");
return false;
}
} else {
if (pp->ArrayEArity == size && pp->ArrayType == props) {
WRITE_UNLOCK(ae->ARWLock);
return true;
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;
} else {
AllocateStaticArraySpace(pp, props, pp->ValueOfVE.ints, size PASS_REGS);
}
Yap_FreeCodeSpace(pp->ValueOfVE.floats);
WRITE_UNLOCK(ae->ARWLock);
return true;
}
WRITE_UNLOCK(ae->ARWLock);
if (!pp) {
return false;
}
return true;
}
Yap_Error(TYPE_ERROR_ATOM, t, "create static array");
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) {

1602
C/atomic.c
View File

File diff suppressed because it is too large Load Diff

55
C/attvar.c
View File

@ -8,31 +8,39 @@
* *
**************************************************************************
* *
* File: attvar.c *
* Last rev: *
* mods: *
* comments: YAP support for attributed vars *
* File: attvar.c * Last rev:
** mods: * comments: YAP support for attributed vars *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
/**
* @file attvar.c
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP-2.lan>
* @date Mon Apr 30 09:31:59 2018
*
* @brief attributed variables
* @namespace prolog
*
*/
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "heapgc.h"
#include "Yatom.h"
#include "attvar.h"
#include "heapgc.h"
#ifndef NULL
#define NULL (void *)0
#endif
/**
@adefgroup AttributedVariables_Builtins Low-level support for Attributed Variables
@defgroup AttributedVariables_Builtins Low-level support for Attributed
Variables
@brief Implementation of Attribute Declarations
@ingroup attributes
@ingroup AttributedVariables
@{
*/
@ -185,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;
}
@ -202,7 +210,7 @@ static void WakeAttVar(CELL *pt1, CELL reg2 USES_REGS) {
void Yap_WakeUp(CELL *pt0) {
CACHE_REGS
CELL d0 = *pt0;
CELL d0 = *pt0;
RESET_VARIABLE(pt0);
WakeAttVar(pt0, d0 PASS_REGS);
}
@ -675,7 +683,6 @@ static Int free_att(USES_REGS1) {
}
}
static Int get_atts(USES_REGS1) {
/* receive a variable in ARG1 */
Term inp = Deref(ARG1);
@ -887,7 +894,7 @@ static Term AllAttVars(USES_REGS1) {
while (pt < myH) {
switch (*pt) {
case (CELL) FunctorAttVar:
case (CELL)FunctorAttVar:
if (IsUnboundVar(pt + 1)) {
if (ASP - myH < 1024) {
LOCAL_Error_Size = (ASP - HR) * sizeof(CELL);
@ -901,24 +908,23 @@ static Term AllAttVars(USES_REGS1) {
}
pt += (1 + ATT_RECORD_ARITY);
break;
case (CELL) FunctorDouble:
case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
pt += 4;
#else
pt += 3;
#endif
break;
case (CELL) FunctorString:
case (CELL)FunctorString:
pt += 3 + pt[1];
break;
case (CELL) FunctorBigInt: {
Int sz = 3 +
(sizeof(MP_INT) +
(((MP_INT *)(pt + 2))->_mp_alloc * sizeof(mp_limb_t))) /
sizeof(CELL);
case (CELL)FunctorBigInt: {
Int sz = 3 + (sizeof(MP_INT) +
(((MP_INT *)(pt + 2))->_mp_alloc * sizeof(mp_limb_t))) /
sizeof(CELL);
pt += sz;
} break;
case (CELL) FunctorLongInt:
case (CELL)FunctorLongInt:
pt += 3;
break;
default:
@ -967,7 +973,7 @@ static Int is_attvar(USES_REGS1) {
static Int attvar_bound(USES_REGS1) {
Term t = Deref(ARG1);
return IsVarTerm(t) && IsAttachedTerm(t) &&
!IsUnboundVar(&(RepAttVar(VarOfTerm(t))->Done));
!IsUnboundVar(&(RepAttVar(VarOfTerm(t))->Done));
}
static Int void_term(USES_REGS1) { return Yap_unify(ARG1, TermVoidAtt); }
@ -1007,7 +1013,7 @@ static Int attvar_bound(USES_REGS1) { return FALSE; }
void Yap_InitAttVarPreds(void) {
CACHE_REGS
Term OldCurrentModule = CurrentModule;
Term OldCurrentModule = CurrentModule;
CurrentModule = ATTRIBUTES_MODULE;
#ifdef COROUTINING
GLOBAL_attas[attvars_ext].bind_op = WakeAttVar;
@ -1029,8 +1035,7 @@ void Yap_InitAttVarPreds(void) {
Yap_InitCPred("rm_att", 4, rm_att, 0);
Yap_InitCPred("bind_attvar", 1, bind_attvar, SafePredFlag);
Yap_InitCPred("unbind_attvar", 1, unbind_attvar, SafePredFlag);
Yap_InitCPred("modules_with_attributes", 2, modules_with_atts,
SafePredFlag);
Yap_InitCPred("modules_with_attributes", 2, modules_with_atts, SafePredFlag);
Yap_InitCPred("void_term", 1, void_term, SafePredFlag);
Yap_InitCPred("free_term", 1, free_term, SafePredFlag);
Yap_InitCPred("fast_unify_attributed", 2, fast_unify, 0);

11
C/bb.c
View File

@ -18,6 +18,17 @@
static char SccsId[] = "%W% %G%";
#endif
/**
* @file bb.c
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP-2.lan>
* @date Mon Apr 30 09:32:54 2018
*
* @brief blackboard
*
* @namespace prolog
*
*/
/** @defgroup BlackBoard The Blackboard
@ingroup builtins

359
C/bignum.c
View File

@ -1,22 +1,33 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: arith1.c *
* Last rev: *
* mods: *
* comments: bignum support through gmp *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: arith1.c *
* Last rev: *
* mods: *
* comments: bignum support through gmp *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
static char SccsId[] = "%W% %G%";
#endif
/**
* @file bignum.c
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP-2.lan>
* @date Mon Apr 30 09:34:59 2018
*
* @brief BigNums and More
* @namespace prolog
*
*
*
*/
#include "Yap.h"
#include "Yatom.h"
@ -33,12 +44,10 @@ static char SccsId[] = "%W% %G%";
#include "YapEval.h"
#include "alloc.h"
Term
Yap_MkBigIntTerm(MP_INT *big)
{
Term Yap_MkBigIntTerm(MP_INT *big) {
CACHE_REGS
Int nlimbs;
MP_INT *dst = (MP_INT *)(HR+2);
MP_INT *dst = (MP_INT *)(HR + 2);
CELL *ret = HR;
Int bytes;
@ -50,38 +59,33 @@ Yap_MkBigIntTerm(MP_INT *big)
// nlimbs = ALIGN_YAPTYPE(bytes,CELL)/CellSize;
// this works, but it shouldn't need to do this...
nlimbs = big->_mp_alloc;
bytes = nlimbs*sizeof(CELL);
if (nlimbs > (ASP-ret)-1024) {
bytes = nlimbs * sizeof(CELL);
if (nlimbs > (ASP - ret) - 1024) {
return TermNil;
}
HR[0] = (CELL)FunctorBigInt;
HR[1] = BIG_INT;
dst->_mp_size = big->_mp_size;
dst->_mp_alloc = nlimbs*(CellSize/sizeof(mp_limb_t));
memmove((void *)(dst+1), (const void *)(big->_mp_d), bytes);
HR = (CELL *)(dst+1)+nlimbs;
dst->_mp_alloc = nlimbs * (CellSize / sizeof(mp_limb_t));
memmove((void *)(dst + 1), (const void *)(big->_mp_d), bytes);
HR = (CELL *)(dst + 1) + nlimbs;
HR[0] = EndSpecials;
HR++;
return AbsAppl(ret);
}
MP_INT *Yap_BigIntOfTerm(Term t) {
MP_INT *new = (MP_INT *)(RepAppl(t) + 2);
MP_INT *
Yap_BigIntOfTerm(Term t)
{
MP_INT *new = (MP_INT *)(RepAppl(t)+2);
new->_mp_d = (mp_limb_t *)(new+1);
return(new);
new->_mp_d = (mp_limb_t *)(new + 1);
return (new);
}
Term
Yap_MkBigRatTerm(MP_RAT *big)
{
Term Yap_MkBigRatTerm(MP_RAT *big) {
CACHE_REGS
Int nlimbs;
MP_INT *dst = (MP_INT *)(HR+2);
MP_INT *dst = (MP_INT *)(HR + 2);
MP_INT *num = mpq_numref(big);
MP_INT *den = mpq_denref(big);
MP_RAT *rat;
@ -89,84 +93,78 @@ Yap_MkBigRatTerm(MP_RAT *big)
if (mpz_cmp_si(den, 1) == 0)
return Yap_MkBigIntTerm(num);
if ((num->_mp_alloc+den->_mp_alloc)*(sizeof(mp_limb_t)/CellSize) > (ASP-ret)-1024) {
if ((num->_mp_alloc + den->_mp_alloc) * (sizeof(mp_limb_t) / CellSize) >
(ASP - ret) - 1024) {
return TermNil;
}
HR[0] = (CELL)FunctorBigInt;
HR[1] = BIG_RATIONAL;
dst->_mp_size = 0;
rat = (MP_RAT *)(dst+1);
rat = (MP_RAT *)(dst + 1);
rat->_mp_num._mp_size = num->_mp_size;
rat->_mp_num._mp_alloc = num->_mp_alloc;
nlimbs = (num->_mp_alloc)*(sizeof(mp_limb_t)/CellSize);
memmove((void *)(rat+1), (const void *)(num->_mp_d), nlimbs*CellSize);
nlimbs = (num->_mp_alloc) * (sizeof(mp_limb_t) / CellSize);
memmove((void *)(rat + 1), (const void *)(num->_mp_d), nlimbs * CellSize);
rat->_mp_den._mp_size = den->_mp_size;
rat->_mp_den._mp_alloc = den->_mp_alloc;
HR = (CELL *)(rat+1)+nlimbs;
nlimbs = (den->_mp_alloc)*(sizeof(mp_limb_t)/CellSize);
memmove((void *)(HR), (const void *)(den->_mp_d), nlimbs*CellSize);
HR = (CELL *)(rat + 1) + nlimbs;
nlimbs = (den->_mp_alloc) * (sizeof(mp_limb_t) / CellSize);
memmove((void *)(HR), (const void *)(den->_mp_d), nlimbs * CellSize);
HR += nlimbs;
dst->_mp_alloc = (HR-(CELL *)(dst+1));
dst->_mp_alloc = (HR - (CELL *)(dst + 1));
HR[0] = EndSpecials;
HR++;
return AbsAppl(ret);
}
MP_RAT *
Yap_BigRatOfTerm(Term t)
{
MP_RAT *new = (MP_RAT *)(RepAppl(t)+2+sizeof(MP_INT)/sizeof(CELL));
MP_RAT *Yap_BigRatOfTerm(Term t) {
MP_RAT *new = (MP_RAT *)(RepAppl(t) + 2 + sizeof(MP_INT) / sizeof(CELL));
mp_limb_t *nt;
nt = new->_mp_num._mp_d = (mp_limb_t *)(new+1);
nt = new->_mp_num._mp_d = (mp_limb_t *)(new + 1);
nt += new->_mp_num._mp_alloc;
new->_mp_den._mp_d = nt;
return new;
}
Term
Yap_RatTermToApplTerm(Term t)
{
Term Yap_RatTermToApplTerm(Term t) {
Term ts[2];
MP_RAT *rat = Yap_BigRatOfTerm(t);
ts[0] = Yap_MkBigIntTerm(mpq_numref(rat));
ts[1] = Yap_MkBigIntTerm(mpq_denref(rat));
return Yap_MkApplTerm(FunctorRDiv,2,ts);
ts[0] = Yap_MkBigIntTerm(mpq_numref(rat));
ts[1] = Yap_MkBigIntTerm(mpq_denref(rat));
return Yap_MkApplTerm(FunctorRDiv, 2, ts);
}
#endif
Term
Yap_AllocExternalDataInStack(CELL tag, size_t bytes)
{
Term Yap_AllocExternalDataInStack(CELL tag, size_t bytes, void *pt) {
CACHE_REGS
Int nlimbs;
MP_INT *dst = (MP_INT *)(HR+2);
MP_INT *dst = (MP_INT *)(HR + 2);
CELL *ret = HR;
nlimbs = ALIGN_BY_TYPE(bytes,CELL)/CellSize;
if (nlimbs > (ASP-ret)-1024) {
CELL **blobp;
nlimbs = ALIGN_BY_TYPE(bytes, CELL) / CellSize;
if (nlimbs > (ASP - ret) - 1024) {
return TermNil;
}
HR[0] = (CELL)FunctorBigInt;
HR[1] = tag;
dst->_mp_size = 0;
dst->_mp_alloc = nlimbs;
HR = (CELL *)(dst+1)+nlimbs;
HR = (CELL *)(dst + 1) + nlimbs;
HR[0] = EndSpecials;
HR++;
if (tag != EXTERNAL_BLOB) {
TrailTerm(TR) = AbsPair(ret);
TR++;
}
blobp = (CELL **)pt;
*blobp = (CELL *)(dst + 1);
return AbsAppl(ret);
}
int Yap_CleanOpaqueVariable(CELL *pt)
{
int Yap_CleanOpaqueVariable(CELL d) {
CELL blob_info, blob_tag;
MP_INT *blobp;
CELL *pt = RepAppl(HeadOfTerm(d));
#ifdef DEBUG
/* sanity checking */
if (pt[0] != (CELL)FunctorBigInt) {
@ -175,23 +173,20 @@ int Yap_CleanOpaqueVariable(CELL *pt)
}
#endif
blob_tag = pt[1];
if (blob_tag < USER_BLOB_START ||
blob_tag >= USER_BLOB_END) {
Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt), "clean opaque: bad blob with tag " UInt_FORMAT ,blob_tag);
if (blob_tag < USER_BLOB_START || blob_tag >= USER_BLOB_END) {
Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt),
"clean opaque: bad blob with tag " UInt_FORMAT, blob_tag);
return FALSE;
}
blob_info = blob_tag - USER_BLOB_START;
blob_info = blob_tag;
if (!GLOBAL_OpaqueHandlers)
return FALSE;
blobp = (MP_INT *)(pt+2);
return false;
if (!GLOBAL_OpaqueHandlers[blob_info].fail_handler)
return TRUE;
return (GLOBAL_OpaqueHandlers[blob_info].fail_handler)((void *)(blobp+1));
return true;
return (GLOBAL_OpaqueHandlers[blob_info].fail_handler)(d);
}
Opaque_CallOnWrite
Yap_blob_write_handler(Term t)
{
YAP_Opaque_CallOnWrite Yap_blob_write_handler(Term t) {
CELL blob_info, blob_tag;
CELL *pt = RepAppl(t);
@ -203,21 +198,19 @@ Yap_blob_write_handler(Term t)
}
#endif
blob_tag = pt[1];
if (blob_tag < USER_BLOB_START ||
blob_tag >= USER_BLOB_END) {
Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt), "clean opaque: bad blob with tag " UInt_FORMAT ,blob_tag);
if (blob_tag < USER_BLOB_START || blob_tag >= USER_BLOB_END) {
Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt),
"clean opaque: bad blob with tag " UInt_FORMAT, blob_tag);
return FALSE;
}
blob_info = blob_tag - USER_BLOB_START;
blob_info = blob_tag;
if (!GLOBAL_OpaqueHandlers) {
return NULL;
}
return GLOBAL_OpaqueHandlers[blob_info].write_handler;
}
Opaque_CallOnGCMark
Yap_blob_gc_mark_handler(Term t)
{
YAP_Opaque_CallOnGCMark Yap_blob_gc_mark_handler(Term t) {
CELL blob_info, blob_tag;
CELL *pt = RepAppl(t);
@ -229,19 +222,16 @@ Yap_blob_gc_mark_handler(Term t)
}
#endif
blob_tag = pt[1];
if (blob_tag < USER_BLOB_START ||
blob_tag >= USER_BLOB_END) {
if (blob_tag < USER_BLOB_START || blob_tag >= USER_BLOB_END) {
return NULL;
}
blob_info = blob_tag - USER_BLOB_START;
blob_info = blob_tag;
if (!GLOBAL_OpaqueHandlers)
return NULL;
return GLOBAL_OpaqueHandlers[blob_info].gc_mark_handler;
return GLOBAL_OpaqueHandlers[blob_info].mark_handler;
}
Opaque_CallOnGCRelocate
Yap_blob_gc_relocate_handler(Term t)
{
YAP_Opaque_CallOnGCRelocate Yap_blob_gc_relocate_handler(Term t) {
CELL blob_info, blob_tag;
CELL *pt = RepAppl(t);
@ -253,19 +243,18 @@ Yap_blob_gc_relocate_handler(Term t)
}
#endif
blob_tag = pt[1];
if (blob_tag < USER_BLOB_START ||
blob_tag >= USER_BLOB_END) {
Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt), "clean opaque: bad blob with tag " UInt_FORMAT ,blob_tag);
if (blob_tag < USER_BLOB_START || blob_tag >= USER_BLOB_END) {
Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt),
"clean opaque: bad blob with tag " UInt_FORMAT, blob_tag);
return FALSE;
}
blob_info = blob_tag - USER_BLOB_START;
blob_info = blob_tag;
if (!GLOBAL_OpaqueHandlers)
return NULL;
return GLOBAL_OpaqueHandlers[blob_info].gc_relocate_handler;
return GLOBAL_OpaqueHandlers[blob_info].relocate_handler;
}
extern Int Yap_blob_tag(Term t)
{
extern Int Yap_blob_tag(Term t) {
CELL *pt = RepAppl(t);
#ifdef DEBUG
@ -278,9 +267,7 @@ extern Int Yap_blob_tag(Term t)
return pt[1];
}
void *
Yap_blob_info(Term t)
{
void *Yap_blob_info(Term t) {
MP_INT *blobp;
CELL *pt = RepAppl(t);
@ -293,88 +280,83 @@ Yap_blob_info(Term t)
#endif
if (!GLOBAL_OpaqueHandlers)
return FALSE;
blobp = (MP_INT *)(pt+2);
return (void *)(blobp+1);
blobp = (MP_INT *)(pt + 2);
return (void *)(blobp + 1);
}
Term
Yap_MkULLIntTerm(YAP_ULONG_LONG n)
{
Term Yap_MkULLIntTerm(YAP_ULONG_LONG n) {
#if __GNUC__ && USE_GMP
mpz_t new;
char tmp[256];
Term t;
mpz_t new;
char tmp[256];
Term t;
#ifdef _WIN32
snprintf(tmp,256,"%I64u",n);
snprintf(tmp, 256, "%I64u", n);
#elif HAVE_SNPRINTF
snprintf(tmp,256,"%llu",n);
snprintf(tmp, 256, "%llu", n);
#else
sprintf(tmp,"%llu",n);
sprintf(tmp, "%llu", n);
#endif
/* try to scan it as a bignum */
mpz_init_set_str (new, tmp, 10);
if (mpz_fits_slong_p(new)) {
CACHE_REGS
return MkIntegerTerm(mpz_get_si(new));
}
t = Yap_MkBigIntTerm(new);
mpz_clear(new);
return t;
#else
/* try to scan it as a bignum */
mpz_init_set_str(new, tmp, 10);
if (mpz_fits_slong_p(new)) {
CACHE_REGS
return MkIntegerTerm(n);
return MkIntegerTerm(mpz_get_si(new));
}
t = Yap_MkBigIntTerm(new);
mpz_clear(new);
return t;
#else
CACHE_REGS
return MkIntegerTerm(n);
#endif
}
CELL *
Yap_HeapStoreOpaqueTerm(Term t)
{
CELL *Yap_HeapStoreOpaqueTerm(Term t) {
CELL *ptr = RepAppl(t);
size_t sz;
void *new;
if (ptr[0] == (CELL)FunctorBigInt) {
sz = sizeof(MP_INT)+2*CellSize+
((MP_INT *)(ptr+2))->_mp_alloc*sizeof(mp_limb_t);
sz = sizeof(MP_INT) + 2 * CellSize +
((MP_INT *)(ptr + 2))->_mp_alloc * sizeof(mp_limb_t);
} else { /* string */
sz = sizeof(CELL)*(2+ptr[1]);
sz = sizeof(CELL) * (2 + ptr[1]);
}
new = Yap_AllocCodeSpace(sz);
if (!new) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "subgoal_search_loop: no space for %s", StringOfTerm(t) );
Yap_Error(RESOURCE_ERROR_HEAP, TermNil,
"subgoal_search_loop: no space for %s", StringOfTerm(t));
} else {
if (ptr[0] == (CELL)FunctorBigInt) {
MP_INT *new = (MP_INT *)(RepAppl(t)+2);
MP_INT *new = (MP_INT *)(RepAppl(t) + 2);
new->_mp_d = (mp_limb_t *)(new+1);
new->_mp_d = (mp_limb_t *)(new + 1);
}
memmove(new, ptr, sz);
}
return new;
}
size_t
Yap_OpaqueTermToString(Term t, char *str, size_t max)
{
size_t Yap_OpaqueTermToString(Term t, char *str, size_t max) {
size_t str_index = 0;
CELL * li = RepAppl(t);
CELL *li = RepAppl(t);
unsigned char *ptr = (unsigned char *)StringOfTerm(AbsAppl(li));
if (li[0] == (CELL)FunctorString) {
str_index += sprintf(& str[str_index], "\"");
str_index += sprintf(&str[str_index], "\"");
do {
utf8proc_int32_t chr;
ptr += get_utf8(ptr, -1, &chr);
if (chr == '\0') break;
str_index += sprintf(str+str_index, "%C", chr);
ptr += get_utf8(ptr, -1, &chr);
if (chr == '\0')
break;
str_index += sprintf(str + str_index, "%C", chr);
} while (TRUE);
str_index += sprintf(str+str_index, "\"");
str_index += sprintf(str + str_index, "\"");
} else {
CELL big_tag = li[1];
if (big_tag == ARRAY_INT || big_tag == ARRAY_FLOAT) {
str_index += sprintf(& str[str_index], "{...}");
str_index += sprintf(&str[str_index], "{...}");
#ifdef USE_GMP
} else if (big_tag == BIG_INT) {
MP_INT *big = Yap_BigIntOfTerm(AbsAppl(li));
@ -398,52 +380,35 @@ Yap_OpaqueTermToString(Term t, char *str, size_t max)
return;
}
} */
str_index += sprintf(& str[str_index], "0");
str_index += sprintf(&str[str_index], "0");
}
return str_index;
}
static Int
p_is_bignum( USES_REGS1 )
{
static Int p_is_bignum(USES_REGS1) {
#ifdef USE_GMP
Term t = Deref(ARG1);
return(
IsNonVarTerm(t) &&
IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorBigInt &&
RepAppl(t)[1] == BIG_INT
);
return (IsNonVarTerm(t) && IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorBigInt && RepAppl(t)[1] == BIG_INT);
#else
return FALSE;
#endif
}
static Int
p_is_string( USES_REGS1 )
{
static Int p_is_string(USES_REGS1) {
Term t = Deref(ARG1);
return(
IsNonVarTerm(t) &&
IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorString
);
return (IsNonVarTerm(t) && IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorString);
}
static Int
p_nb_set_bit( USES_REGS1 )
{
static Int p_nb_set_bit(USES_REGS1) {
#ifdef USE_GMP
Term t = Deref(ARG1);
Term ti = Deref(ARG2);
Int i;
if (!(
IsNonVarTerm(t) &&
IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorBigInt &&
RepAppl(t)[1] == BIG_INT
))
if (!(IsNonVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == FunctorBigInt &&
RepAppl(t)[1] == BIG_INT))
return FALSE;
if (!IsIntegerTerm(ti)) {
return FALSE;
@ -462,9 +427,7 @@ p_nb_set_bit( USES_REGS1 )
#endif
}
static Int
p_has_bignums( USES_REGS1 )
{
static Int p_has_bignums(USES_REGS1) {
#ifdef USE_GMP
return TRUE;
#else
@ -472,9 +435,7 @@ p_has_bignums( USES_REGS1 )
#endif
}
static Int
p_is_opaque( USES_REGS1 )
{
static Int p_is_opaque(USES_REGS1) {
Term t = Deref(ARG1);
if (IsVarTerm(t))
return FALSE;
@ -485,14 +446,16 @@ p_is_opaque( USES_REGS1 )
if (f != FunctorBigInt)
return FALSE;
pt = RepAppl(t);
return ( pt[1] != BIG_RATIONAL || pt[1] != BIG_INT );
return (pt[1] != BIG_RATIONAL || pt[1] != BIG_INT);
}
return FALSE;
}
static Int
p_is_rational( USES_REGS1 )
{
/** @pred rational( ?:T )
Checks whether _T_ is a rational number.
*/
static Int p_is_rational(USES_REGS1) {
Term t = Deref(ARG1);
if (IsVarTerm(t))
return FALSE;
@ -507,14 +470,12 @@ p_is_rational( USES_REGS1 )
if (f != FunctorBigInt)
return FALSE;
pt = RepAppl(t);
return ( pt[1] == BIG_RATIONAL || pt[1] == BIG_INT );
return (pt[1] == BIG_RATIONAL || pt[1] == BIG_INT);
}
return FALSE;
}
static Int
p_rational( USES_REGS1 )
{
static Int p_rational(USES_REGS1) {
#ifdef USE_GMP
Term t = Deref(ARG1);
Functor f;
@ -534,37 +495,25 @@ p_rational( USES_REGS1 )
return FALSE;
rat = Yap_BigRatOfTerm(t);
while ((t1 = Yap_MkBigIntTerm(mpq_numref(rat))) == TermNil ||
(t2 = Yap_MkBigIntTerm(mpq_denref(rat))) == TermNil) {
UInt size =
(mpq_numref(rat)->_mp_alloc)*(sizeof(mp_limb_t)/CellSize) +
(mpq_denref(rat)->_mp_alloc)*(sizeof(mp_limb_t)/CellSize);
(t2 = Yap_MkBigIntTerm(mpq_denref(rat))) == TermNil) {
UInt size = (mpq_numref(rat)->_mp_alloc) * (sizeof(mp_limb_t) / CellSize) +
(mpq_denref(rat)->_mp_alloc) * (sizeof(mp_limb_t) / CellSize);
if (!Yap_gcl(size, 3, ENV, P)) {
Yap_Error(RESOURCE_ERROR_STACK, t, LOCAL_ErrorMessage);
return FALSE;
}
}
return
Yap_unify(ARG2, t1) &&
Yap_unify(ARG3, t2);
return Yap_unify(ARG2, t1) && Yap_unify(ARG3, t2);
#else
return FALSE;
#endif
}
void
Yap_InitBigNums(void)
{
void Yap_InitBigNums(void) {
Yap_InitCPred("$has_bignums", 0, p_has_bignums, SafePredFlag);
Yap_InitCPred("$bignum", 1, p_is_bignum, SafePredFlag);
Yap_InitCPred("rational", 3, p_rational, 0);
Yap_InitCPred("rational", 1, p_is_rational, SafePredFlag);
/** @pred rational( _T_)
Checks whether `T` is a rational number.
*/
Yap_InitCPred("string", 1, p_is_string, SafePredFlag);
Yap_InitCPred("opaque", 1, p_is_opaque, SafePredFlag);
Yap_InitCPred("nb_set_bit", 2, p_nb_set_bit, SafePredFlag);

14
C/blobs.c
View File

@ -17,11 +17,7 @@
/* for freeBSD9.1 */
#define _WITH_DPRINTF
#ifdef __APPLE__
#include "fmemopen.h"
#endif
#include "blobs.h"
#include "YapBlobs.h"
static blob_type_t unregistered_blob_atom = {
YAP_BLOB_MAGIC_B, PL_BLOB_NOCOPY | PL_BLOB_TEXT, "unregistered"};
@ -52,7 +48,7 @@ char *Yap_blob_to_string(AtomEntry *ref, const char *s0, size_t sz) {
size_t sz0 = strlcpy(s, (char *)RepAtom(AtomSWIStream)->StrOfAE, sz);
#else
size_t sz0;
char *f = (char *)memcpy(s, (char *)RepAtom(AtomSWIStream)->StrOfAE, sz);
char *f = (char *)memmove(s, (char *)RepAtom(AtomSWIStream)->StrOfAE, sz);
f[0] = '\0';
sz0 = f - s;
#endif
@ -160,7 +156,7 @@ AtomEntry *Yap_lookupBlob(void *blob, size_t len, void *type0, int *new) {
ae->PropsOfAE = AbsBlobProp(b);
ae->NextOfAE = AbsAtom(Blobs);
ae->rep.blob->length = len;
memcpy(ae->rep.blob->data, blob, len);
memmove(ae->rep.blob->data, blob, len);
Blobs = ae;
if (NOfBlobs > NOfBlobsMax) {
Yap_signal(YAP_CDOVF_SIGNAL);
@ -209,8 +205,8 @@ bool YAP_get_blob(Term t, void **blob, size_t *len, blob_type_t **type) {
return TRUE;
}
void *YAP_blob_data(Atom x, size_t *len, blob_type_t **type) {
void *YAP_blob_data(YAP_Atom at, size_t *len, blob_type_t **type) {
Atom x = at;
if (!IsBlob(x)) {
if (len)

1023
C/c_interface.c
View File

File diff suppressed because it is too large Load Diff

549
C/cdmgr.c
View File

@ -19,8 +19,8 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#endif
#include "Yap.h"
#include "clause.h"
#include "YapEval.h"
#include "clause.h"
#include "tracer.h"
#include "yapio.h"
#ifdef YAPOR
@ -32,6 +32,7 @@ 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>
@ -46,7 +47,7 @@ static void assertz_dynam_clause(PredEntry *, yamop *);
static void expand_consult(void);
static int not_was_reconsulted(PredEntry *, Term, int);
static int RemoveIndexation(PredEntry *);
static Int p_number_of_clauses(USES_REGS1);
static Int number_of_clauses(USES_REGS1);
static Int p_compile(USES_REGS1);
static Int p_purge_clauses(USES_REGS1);
static Int p_setspy(USES_REGS1);
@ -55,7 +56,7 @@ static Int p_startconsult(USES_REGS1);
static Int p_showconslultlev(USES_REGS1);
static Int p_endconsult(USES_REGS1);
static Int p_undefined(USES_REGS1);
static Int p_new_multifile(USES_REGS1);
static Int new_multifile(USES_REGS1);
static Int p_is_multifile(USES_REGS1);
static Int p_optimizer_on(USES_REGS1);
static Int p_optimizer_off(USES_REGS1);
@ -76,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;
@ -93,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;
@ -115,7 +128,8 @@ restart:
Yap_Error(INSTANTIATION_ERROR, t0, pname);
return NULL;
} else if (IsAtomTerm(t)) {
return RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
return ap;
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
return Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsPairTerm(t)) {
@ -140,7 +154,8 @@ restart:
t = ArgOfTerm(2, t);
goto restart;
}
return RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
return ap;
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t0, pname);
}
@ -248,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;
}
@ -297,7 +312,7 @@ void Yap_BuildMegaClause(PredEntry *ap) {
mcl->ClLine = cl->usc.ClLine;
ptr = mcl->ClCode;
while (TRUE) {
memcpy((void *)ptr, (void *)cl->ClCode, sz);
memmove((void *)ptr, (void *)cl->ClCode, sz);
if (has_blobs) {
LOCAL_ClDiff = (char *)(ptr) - (char *)cl->ClCode;
restore_opcodes(ptr, NULL PASS_REGS);
@ -376,7 +391,7 @@ static void split_megaclause(PredEntry *ap) {
new->ClSize = mcl->ClItemSize;
new->usc.ClLine = Yap_source_line_no();
new->ClNext = NULL;
memcpy((void *)new->ClCode, (void *)ptr, mcl->ClItemSize);
memmove((void *)new->ClCode, (void *)ptr, mcl->ClItemSize);
if (prev) {
prev->ClNext = new;
} else {
@ -496,7 +511,7 @@ static void RemoveMainIndex(PredEntry *ap) {
#ifdef TABLING
|| ap->PredFlags & TabledPredFlag
#endif /* TABLING */
) {
) {
ap->OpcodeOfPred = INDEX_OPCODE;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred =
(yamop *)(&(ap->OpcodeOfPred));
@ -1016,10 +1031,11 @@ static void retract_all(PredEntry *p, int in_use) {
}
p->cs.p_code.FirstClause = NULL;
p->cs.p_code.LastClause = NULL;
if (p->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag)) {
if (is_live(p)) {
p->OpcodeOfPred = FAIL_OPCODE;
} else {
p->OpcodeOfPred = UNDEF_OPCODE;
p->PredFlags |= UndefPredFlag;
}
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
if (trueGlobalPrologFlag(PROFILING_FLAG)) {
@ -1381,8 +1397,8 @@ static void expand_consult(void) {
}
new_cs = new_cl + InitialConsultCapacity;
/* start copying */
memcpy((void *)new_cs, (void *)LOCAL_ConsultLow,
OldConsultCapacity * sizeof(consult_obj));
memmove((void *)new_cs, (void *)LOCAL_ConsultLow,
OldConsultCapacity * sizeof(consult_obj));
/* copying done, release old space */
Yap_FreeCodeSpace((char *)LOCAL_ConsultLow);
/* next, set up pointers correctly */
@ -1448,26 +1464,35 @@ static int not_was_reconsulted(PredEntry *p, Term t, int mode) {
return TRUE; /* careful */
}
static void addcl_permission_error(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
LOCAL_Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE;
LOCAL_ErrorMessage = Malloc( 256 );
if (in_use) {
if (Arity == 0)
sprintf(LOCAL_ErrorMessage, "static predicate %s is in use", ap->StrOfAE);
else
sprintf(LOCAL_ErrorMessage,
"static predicate %s/" Int_FORMAT " is in use", ap->StrOfAE,
Arity);
} else {
if (Arity == 0)
sprintf(LOCAL_ErrorMessage, "system predicate %s", ap->StrOfAE);
else
sprintf(LOCAL_ErrorMessage, "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) {
@ -1486,7 +1511,9 @@ PredEntry *Yap_PredFromClause(Term t USES_REGS) {
t = ArgOfTerm(2, t);
} else if (f == FunctorAssert) {
t = ArgOfTerm(1, t);
} else if (f == FunctorComma && extra_arity == 2) {
} else if (f == FunctorComma
&& extra_arity == 2) {
t = ArgOfTerm(1, t);
} else if (f == FunctorDoubleArrow) {
extra_arity = 2;
@ -1637,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
*
@ -1647,6 +1674,14 @@ bool Yap_constPred(PredEntry *p) {
pred_flags_t pflags;
pflags = p->PredFlags;
if (pflags &
((UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)))
return true;
if (p->PredFlags &
(SysExportPredFlag | MultiFileFlag | DynamicPredFlag | LogUpdatePredFlag))
return false;
if (Yap_isSystemModule(p->ModuleOfPred)) {
if (p->cs.p_code.NOfClauses == 0) {
p->src.OwnerFile = Yap_source_file_name();
@ -1656,14 +1691,6 @@ bool Yap_constPred(PredEntry *p) {
return false;
}
}
if (pflags &
((UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)))
return true;
if (p->PredFlags &
(SysExportPredFlag | MultiFileFlag | DynamicPredFlag | LogUpdatePredFlag))
return false;
return false;
}
@ -1686,6 +1713,9 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref)
Term tf;
int mode;
if (tmode == 0) {
tmode = TermConsult;
}
if (tmode == TermConsult) {
mode = consult;
} else if (tmode == TermReconsult) {
@ -1719,14 +1749,15 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref)
at = NameOfFunctor(f);
p = RepPredProp(PredPropByFunc(f, mod));
}
Yap_PutValue(AtomAbol, TermNil);
PELOCK(20, p);
/* we are redefining a prolog module predicate */
if (Yap_constPred(p)) {
addcl_permission_error(RepAtom(at), Arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), Arity,
FALSE);
UNLOCKPE(30, p);
return false;
}
Yap_PutValue(AtomAbol, TermNil);
pflags = p->PredFlags;
/* we are redefining a prolog module predicate */
if (pflags & MegaClausePredFlag) {
@ -1735,11 +1766,12 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref)
/* The only problem we have now is when we need to throw away
Indexing blocks
*/
if (pflags & IndexedPredFlag) {
if (pflags & IndexedPredFlag && p->cs.p_code.NOfClauses > 1) {
Yap_AddClauseToIndex(p, cp, mode == asserta);
}
if (pflags & (SpiedPredFlag | CountPredFlag | ProfiledPredFlag))
if (pflags & (SpiedPredFlag | CountPredFlag | ProfiledPredFlag)) {
spy_flag = true;
}
if (Yap_discontiguous(p, tmode PASS_REGS)) {
Term disc[3], sc[4];
if (p->ArityOfPE) {
@ -1751,12 +1783,12 @@ 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);
sc[2] = MkAtomTerm(LOCAL_SourceFileName);
sc[3] = t;
t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, sc);
sc[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 1), 1, &t);
sc[1] = MkAtomTerm(AtomWarning);
Yap_PrintWarning(Yap_MkApplTerm(Yap_MkFunctor(AtomError, 2), 2, sc));
Yap_PrintWarning(t);
} else if (Yap_multiple(p, tmode PASS_REGS)) {
Term disc[4], sc[4];
if (p->ArityOfPE) {
@ -1772,9 +1804,7 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref)
sc[2] = MkAtomTerm(LOCAL_SourceFileName);
sc[3] = t;
t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, sc);
sc[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 1), 1, &t);
sc[1] = MkAtomTerm(AtomWarning);
Yap_PrintWarning(Yap_MkApplTerm(Yap_MkFunctor(AtomError, 2), 2, sc));
Yap_PrintWarning(t);
}
if (mode == consult)
not_was_reconsulted(p, t, true);
@ -1809,6 +1839,7 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref)
p->PredFlags = p->PredFlags | CompiledPredFlag;
}
if (p->cs.p_code.FirstClause == NULL) {
p->PredFlags &= ~UndefPredFlag;
if (!(pflags & DynamicPredFlag)) {
add_first_static(p, cp, spy_flag);
/* make sure we have a place to jump to */
@ -1867,8 +1898,6 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref)
} else {
tf = Yap_MkStaticRefTerm(ClauseCodeToStaticClause(cp), p);
}
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "add %s/%ld %p",
RepAtom(at)->StrOfAE, Arity);
if (mod == PROLOG_MODULE)
mod = TermProlog;
if (pflags & MultiFileFlag) {
@ -1909,7 +1938,12 @@ void Yap_EraseStaticClause(StaticClause *cl, PredEntry *ap, Term mod) {
if (ap->cs.p_code.LastClause == cl->ClCode) {
/* got rid of all clauses */
ap->cs.p_code.LastClause = ap->cs.p_code.FirstClause = NULL;
ap->OpcodeOfPred = UNDEF_OPCODE;
if (is_live(ap)) {
ap->OpcodeOfPred = FAIL_OPCODE;
} else {
ap->OpcodeOfPred = UNDEF_OPCODE;
ap->PredFlags |= UndefPredFlag;
}
ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
} else {
yamop *ncl = cl->ClNext->ClCode;
@ -2017,9 +2051,9 @@ static Int p_compile(USES_REGS1) { /* '$compile'(+C,+Flags,+C0,-Ref) */
if (mode == assertz && LOCAL_consult_level && mod == CurrentModule)
mode = consult;
*/
code_adr = Yap_cclause(t, 5, mod,
Deref(ARG3)); /* vsc: give the number of arguments to
cclause() in case there is a overflow */
code_adr = Yap_cclause(t, 5, mod, Deref(ARG3)); /* vsc: give the number of
arguments to cclause() in case there is a
overflow */
t = Deref(ARG1); /* just in case there was an heap overflow */
if (!LOCAL_ErrorMessage) {
YAPEnterCriticalSection();
@ -2047,12 +2081,12 @@ Atom Yap_ConsultingFile(USES_REGS1) {
if (LOCAL_consult_level == 0) {
return (AtomUser);
} else {
return (Yap_ULookupAtom(LOCAL_ConsultBase[2].filename));
return LOCAL_ConsultBase[2].f_name;
}
}
/* consult file *file*, *mode* may be one of either consult or reconsult */
static void init_consult(int mode, const unsigned char *file) {
void Yap_init_consult(int mode, const char *filenam) {
CACHE_REGS
if (!LOCAL_ConsultSp) {
InitConsultStack();
@ -2061,7 +2095,7 @@ static void init_consult(int mode, const unsigned char *file) {
expand_consult();
}
LOCAL_ConsultSp--;
LOCAL_ConsultSp->filename = file;
LOCAL_ConsultSp->f_name = Yap_LookupAtom(filenam);
LOCAL_ConsultSp--;
LOCAL_ConsultSp->mode = mode;
LOCAL_ConsultSp--;
@ -2075,17 +2109,13 @@ static void init_consult(int mode, const unsigned char *file) {
LOCAL_LastAssertedPred = NULL;
}
void Yap_init_consult(int mode, const char *file) {
init_consult(mode, (const unsigned char *)file);
}
static Int p_startconsult(USES_REGS1) { /* '$start_consult'(+Mode) */
Term t;
char *smode = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
int mode;
mode = strcmp("consult", (char *)smode);
init_consult(mode, RepAtom(AtomOfTerm(Deref(ARG2)))->UStrOfAE);
Yap_init_consult(mode, RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE);
t = MkIntTerm(LOCAL_consult_level);
return (Yap_unify_constant(ARG3, t));
}
@ -2372,7 +2402,7 @@ static Int p_rmspy(USES_REGS1) { /* '$rm_spy'(+T,+Mod) */
******************************************************************/
static Int
p_number_of_clauses(USES_REGS1) { /* '$number_of_clauses'(Predicate,M,N) */
number_of_clauses(USES_REGS1) { /* '$number_of_clauses'(Predicate,M,N) */
Term t = Deref(ARG1);
Term mod = Deref(ARG2);
int ncl = 0;
@ -2398,47 +2428,41 @@ static Int
return (Yap_unify_constant(ARG3, MkIntegerTerm(ncl)));
}
static Int p_new_multifile(USES_REGS1) { /* '$new_multifile'(+N,+Ar,+Mod) */
/* @pred '$new_multifile'(+G,+Mod)
* sets the multi-file flag
* */
static Int new_multifile(USES_REGS1) {
PredEntry *pe;
Atom at;
arity_t arity;
PredEntry *pe;
Term t = Deref(ARG1);
Term mod = Deref(ARG3);
if (IsVarTerm(t))
return (FALSE);
if (IsAtomTerm(t))
at = AtomOfTerm(t);
else
return (FALSE);
t = Deref(ARG2);
if (IsVarTerm(t))
return (FALSE);
if (IsIntTerm(t))
arity = IntOfTerm(t);
else
pe = new_pred(Deref(ARG1), Deref(ARG2), "multifile");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
pe = RepPredProp(PredPropByAtom(at, mod));
at = (Atom)pe->FunctorOfPred;
else
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, arity), mod));
PELOCK(26, pe);
if (pe->PredFlags &
(UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)) {
UNLOCKPE(26, pe);
addcl_permission_error(RepAtom(at), arity, FALSE);
return false;
}
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & MultiFileFlag) {
UNLOCKPE(26, pe);
return true;
}
if (pe->cs.p_code.NOfClauses) {
if (pe->PredFlags & (TabledPredFlag | ForeignPredFlags)) {
UNLOCKPE(26, pe);
addcl_permission_error(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);
return false;
}
pe->PredFlags &= ~UndefPredFlag;
pe->PredFlags |= MultiFileFlag;
/* mutifile-predicates are weird, they do not seat really on the default
* module */
@ -2463,6 +2487,7 @@ static Int p_is_multifile(USES_REGS1) { /* '$is_multifile'(+S,+Mod) */
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27, pe);
out = (pe->PredFlags & MultiFileFlag);
UNLOCKPE(44, pe);
return (out);
@ -2506,13 +2531,36 @@ static Int new_system_predicate(
static Int
p_is_system_predicate(USES_REGS1) { /* '$is_multifile'(+S,+Mod) */
PredEntry *pe;
bool out;
Term t1 = Deref(ARG1);
pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "system_predicate");
// pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate");
// if (!pe)
pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate");
// if (!pe) pe = Yap_get_pred(t1, USER_MODULE, "system_predicate");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27, pe);
out = (pe->PredFlags & SystemPredFlags);
return (pe->ModuleOfPred == 0);
// return true;
// PELOCK(27, pe);
// out = (pe->PredFlags & SystemPredFlags);
// UNLOCKPE(44, pe);
// return (out);
}
static Int
p_is_opaque_predicate(USES_REGS1) { /* '$is_multifile'(+S,+Mod) */
PredEntry *pe;
Term t1 = Deref(ARG1);
bool out;
// pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate");
// if (!pe)
pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate");
// if (!pe) pe = Yap_get_pred(t1, USER_MODULE, "system_predicate");
if (EndOfPAEntr(pe))
return FALSE;
return (pe->ModuleOfPred == 0 ||
pe->PredFlags & (SystemPredFlags | ForeignPredFlags));
UNLOCKPE(44, pe);
return (out);
}
@ -2626,7 +2674,7 @@ static Int p_set_owner_file(USES_REGS1) { /* '$owner_file'(+P,M,F) */
return TRUE;
}
static Int p_mk_d(USES_REGS1) { /* '$make_dynamic'(+P) */
static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
PredEntry *pe;
Atom at;
arity_t arity;
@ -2645,7 +2693,8 @@ static Int p_mk_d(USES_REGS1) { /* '$make_dynamic'(+P) */
(UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)) {
UNLOCKPE(30, pe);
addcl_permission_error(RepAtom(at), arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
FALSE);
return false;
}
if (pe->PredFlags & LogUpdatePredFlag) {
@ -2658,11 +2707,13 @@ static Int p_mk_d(USES_REGS1) { /* '$make_dynamic'(+P) */
}
if (pe->cs.p_code.NOfClauses != 0) {
UNLOCKPE(26, pe);
addcl_permission_error(RepAtom(at), arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
FALSE);
return false;
}
if (pe->OpcodeOfPred == UNDEF_OPCODE) {
pe->OpcodeOfPred = FAIL_OPCODE;
pe->PredFlags &= ~UndefPredFlag;
}
pe->src.OwnerFile = Yap_ConsultingFile(PASS_REGS1);
pe->PredFlags |= LogUpdatePredFlag;
@ -2683,6 +2734,43 @@ static Int p_is_dynamic(USES_REGS1) { /* '$is_dynamic'(+P) */
return (out);
}
/* @pred '$new_multifile'(+G,+Mod)
* sets the multi-file flag
* */
static Int new_meta_pred(USES_REGS1) {
PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "meta_predicate");
if (EndOfPAEntr(pe))
return false;
PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & MetaPredFlag) {
UNLOCKPE(26, pe);
return true;
}
if (pe->cs.p_code.NOfClauses) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
FALSE);
return false;
}
pe->PredFlags |= MetaPredFlag;
if (!(pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag))) {
/* static */
pe->PredFlags |= (SourcePredFlag | CompiledPredFlag);
}
UNLOCKPE(43, pe);
return true;
}
static Int p_is_metapredicate(USES_REGS1) { /* '$is_metapredicate'(+P) */
PredEntry *pe;
bool out;
@ -2708,13 +2796,13 @@ static Int p_pred_exists(USES_REGS1) { /* '$pred_exists'(+P,+M) */
UNLOCKPE(54, pe);
return false;
}
out = (pe->OpcodeOfPred != UNDEF_OPCODE);
out = (is_live(pe) || pe->OpcodeOfPred != UNDEF_OPCODE);
UNLOCKPE(55, pe);
return out;
}
static Int p_set_pred_module(USES_REGS1) { /* '$set_pred_module'(+P,+Mod)
*/
*/
PredEntry *pe;
pe = Yap_get_pred(Deref(ARG1), CurrentModule, "set_pred_module/1");
@ -2727,7 +2815,7 @@ static Int p_set_pred_module(USES_REGS1) { /* '$set_pred_module'(+P,+Mod)
}
static Int p_set_pred_owner(USES_REGS1) { /* '$set_pred_module'(+P,+File)
*/
*/
PredEntry *pe;
Term a2 = Deref(ARG2);
@ -2783,12 +2871,7 @@ static Int p_undefined(USES_REGS1) { /* '$undefined'(P,Mod) */
if (EndOfPAEntr(pe))
return TRUE;
PELOCK(36, pe);
if (pe->PredFlags & (CPredFlag | UserCPredFlag | TestPredFlag | AsmPredFlag |
DynamicPredFlag | LogUpdatePredFlag | TabledPredFlag)) {
UNLOCKPE(57, pe);
return FALSE;
}
if (pe->OpcodeOfPred == UNDEF_OPCODE) {
if (!is_live(pe) && pe->OpcodeOfPred == UNDEF_OPCODE) {
UNLOCKPE(58, pe);
return TRUE;
}
@ -2820,7 +2903,7 @@ static Int p_kill_dynamic(USES_REGS1) { /* '$kill_dynamic'(P,M) */
pe->OpcodeOfPred = UNDEF_OPCODE;
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred =
(yamop *)(&(pe->OpcodeOfPred));
pe->PredFlags = 0;
pe->PredFlags = UndefPredFlag;
UNLOCKPE(62, pe);
return (TRUE);
}
@ -3020,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,
@ -3261,7 +3311,7 @@ static Int fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb,
}
static Int /* $hidden_predicate(P) */
p_log_update_clause(USES_REGS1) {
p_log_update_clause(USES_REGS1) {
PredEntry *pe;
Term t1 = Deref(ARG1);
Int ret;
@ -3281,7 +3331,7 @@ static Int /* $hidden_predicate(P) */
}
static Int /* $hidden_predicate(P) */
p_continue_log_update_clause(USES_REGS1) {
p_continue_log_update_clause(USES_REGS1) {
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
@ -3411,7 +3461,7 @@ static Int fetch_next_lu_clause_erase(PredEntry *pe, yamop *i_code, Term th,
}
static Int /* $hidden_predicate(P) */
p_log_update_clause_erase(USES_REGS1) {
p_log_update_clause_erase(USES_REGS1) {
PredEntry *pe;
Term t1 = Deref(ARG1);
Int ret;
@ -3432,7 +3482,7 @@ static Int /* $hidden_predicate(P) */
}
static Int /* $hidden_predicate(P) */
p_continue_log_update_clause_erase(USES_REGS1) {
p_continue_log_update_clause_erase(USES_REGS1) {
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
@ -3873,7 +3923,7 @@ static Int fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th,
}
static Int /* $hidden_predicate(P) */
p_static_clause(USES_REGS1) {
p_static_clause(USES_REGS1) {
PredEntry *pe;
Term t1 = Deref(ARG1);
yamop *new_cp;
@ -3892,7 +3942,7 @@ static Int /* $hidden_predicate(P) */
}
static Int /* $hidden_predicate(P) */
p_continue_static_clause(USES_REGS1) {
p_continue_static_clause(USES_REGS1) {
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
@ -4588,9 +4638,9 @@ static bool pred_flag_clause(Functor f, Term mod, const char *name,
}
#endif
tn = Yap_MkApplTerm(f, 2, s);
yamop *code_adr =
Yap_cclause(tn, 2, mod, tn); /* vsc: give the number of arguments to
cclause() in case there is a overflow */
yamop *code_adr = Yap_cclause(tn, 2, mod, tn); /* vsc: give the number of
arguments to cclause() in case there is a overflow
*/
if (LOCAL_ErrorMessage) {
return false;
}
@ -4687,10 +4737,11 @@ void Yap_InitCdMgr(void) {
Yap_InitCPred("$is_exo", 2, p_is_exo, TestPredFlag | SafePredFlag);
Yap_InitCPred("$owner_file", 3, owner_file, SafePredFlag);
Yap_InitCPred("$set_owner_file", 3, p_set_owner_file, SafePredFlag);
Yap_InitCPred("$mk_d", 2, p_mk_d, SafePredFlag);
Yap_InitCPred("$mk_dynamic", 2, mk_dynamic, SafePredFlag);
Yap_InitCPred("$new_meta_pred", 2, new_meta_pred, SafePredFlag);
Yap_InitCPred("$sys_export", 2, p_sys_export, TestPredFlag | SafePredFlag);
Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag);
Yap_InitCPred("$number_of_clauses", 3, p_number_of_clauses,
Yap_InitCPred("$number_of_clauses", 3, number_of_clauses,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$undefined", 2, p_undefined, SafePredFlag | TestPredFlag);
Yap_InitCPred("$undefp_handler", 2, undefp_handler,
@ -4703,14 +4754,16 @@ void Yap_InitCdMgr(void) {
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$kill_dynamic", 2, p_kill_dynamic,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$new_multifile", 3, p_new_multifile,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$new_multifile", 2, new_multifile,
SafePredFlag | SyncPredFlag | HiddenPredFlag);
Yap_InitCPred("$is_multifile", 2, p_is_multifile,
TestPredFlag | SafePredFlag);
Yap_InitCPred("$new_system_predicate", 3, new_system_predicate,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$is_system_predicate", 2, p_is_system_predicate,
TestPredFlag | SafePredFlag);
Yap_InitCPred("$is_opaque_predicate", 2, p_is_opaque_predicate,
TestPredFlag | SafePredFlag);
Yap_InitCPred("$new_discontiguous", 3, p_new_discontiguous,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$is_discontiguous", 2, p_is_discontiguous,
@ -4734,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);

28
C/cmppreds.c
View File

@ -16,6 +16,18 @@
* *
*************************************************************************/
/**
* @file cmppreds.c
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP-2.lan>
* @date Mon Apr 30 09:35:58 2018
*
* @brief comparison
*
* @namespace prolog
*
*
*
*/
/// @file cmppreds.c
/**
@ -540,7 +552,7 @@ Int p_compare(USES_REGS1) { /* compare(?Op,?T1,?T2) */
return Yap_unify_constant(ARG1, MkAtomTerm(p));
}
/** @pred _X_ \== _Y_ is iso
/** @pred X \== Y is iso
Terms _X_ and _Y_ are not strictly identical.
*/
@ -548,7 +560,7 @@ static Int a_noteq(Term t1, Term t2) { return (compare(t1, t2) != 0); }
static Int a_gen_lt(Term t1, Term t2) { return (compare(t1, t2) < 0); }
/** @pred _X_ @=< _Y_ is iso
/** @pred X @=< Y is iso
Term _X_ does not follow term _Y_ in the standard order.
@ -556,14 +568,14 @@ Term _X_ does not follow term _Y_ in the standard order.
*/
static Int a_gen_le(Term t1, Term t2) { return (compare(t1, t2) <= 0); }
/** @pred _X_ @> _Y_ is iso
/** @pred X @> Y is iso
Term _X_ does not follow term _Y_ in the standard order
*/
static Int a_gen_gt(Term t1, Term t2) { return compare(t1, t2) > 0; }
/** @pred _X_ @>= _Y_ is iso
/** @pred X @>= Y is iso
Term _X_ does not precede term _Y_ in the standard order.
*/
@ -711,7 +723,7 @@ static Int p_acomp(USES_REGS1) { /* $a_compare(?R,+X,+Y) */
}
/**
@pred +_X_ =:= _Y_ is iso
@pred +X '=:=' Y is iso
Equality of arithmetic expressions
The value of the expression _X_ is equal to the value of expression _Y_.
@ -778,7 +790,7 @@ static Int a_gt(Term t1, Term t2) { /* A > B */
}
/**
@pred +_X_ >= +_Y_ is iso
@pred +X >= +Y is iso
Greater than or equal to arithmetic expressions
The value of the expression _X_ is greater than or equal to the
@ -791,7 +803,7 @@ static Int a_ge(Term t1, Term t2) { /* A >= B */
}
/**
@pred +_X_ \< +_Y_ is iso
@pred +X < +Y is iso
Lesser than arithmetic expressions
The value of the expression _X_ is less than the value of expression
@ -806,7 +818,7 @@ static Int a_lt(Term t1, Term t2) { /* A < B */
/**
*
@pred _X_ =< + _Y_
@pred +X =< +Y
Lesser than or equal to arithmetic expressions

16
C/compiler.c
View File

@ -719,7 +719,7 @@ restart:
dest = Yap_emit_extra_size(blob_op, sz / CellSize, sz, &cglobs->cint);
/* copy the bignum */
memcpy(dest, src, sz);
memmove(dest, src, sz);
/* note that we don't need to copy size info, unless we wanted
to garbage collect clauses ;-) */
cglobs->cint.icpc = cglobs->cint.cpc;
@ -758,7 +758,7 @@ restart:
dest = Yap_emit_extra_size(blob_op, sz / CellSize, sz, &cglobs->cint);
/* copy the bignum */
memcpy(dest, src, sz);
memmove(dest, src, sz);
/* note that we don't need to copy size info, unless we wanted
to garbage collect clauses ;-) */
cglobs->cint.icpc = cglobs->cint.cpc;
@ -3513,14 +3513,20 @@ yamop *Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod,
LOCAL_ErrorMessage = "clause head should be atom or compound term";
return (0);
} else {
loop:
/* find out which predicate we are compiling for */
if (IsAtomTerm(head)) {
Atom ap = AtomOfTerm(head);
cglobs.cint.CurrentPred = RepPredProp(PredPropByAtom(ap, mod));
} else {
Functor f = FunctorOfTerm(head);
if (f == FunctorModule) {
mod = ArgOfTerm(1,head);
head = ArgOfTerm(2,head);
goto loop;
}
cglobs.cint.CurrentPred =
RepPredProp(PredPropByFunc(FunctorOfTerm(head), mod));
RepPredProp(PredPropByFunc(f, mod));
}
/* insert extra instructions to count calls */
PELOCK(52, cglobs.cint.CurrentPred);
@ -3569,7 +3575,7 @@ yamop *Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod,
cglobs.space_op->rnd1 = cglobs.space_used;
#ifdef DEBUG
if (GLOBAL_Option['g' - 96])
if (GLOBAL_Option['g' - 96] )
Yap_ShowCode(&cglobs.cint);
#endif
} else {

7
C/computils.c
View File

@ -60,13 +60,15 @@ static char SccsId[] = "%W% %G%";
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#define COMPILER_NAMES 1
#include "YapCompile.h"
#undef COMPILER_NAMES
#include "YapCompile.h"
#include "yapio.h"
#if HAVE_STRING_H
#include <string.h>
#endif
/*
* The compiler creates an instruction chain which will be assembled after
* afterwards
@ -545,7 +547,6 @@ write_functor(Functor f)
}
}
char *opDesc[] = { mklist(f_arr) };
static void send_pred(PredEntry *p)
{
@ -720,7 +721,7 @@ ShowOp (compiler_vm_op ic, const char *f, struct PSEUDO *cpc)
Yap_DebugPlWrite (MkIntTerm (rn & 1));
break;
case 'w':
Yap_DebugPlWrite (arg);
Yap_DebugPlWrite (MkIntTerm(arg));
break;
case 'o':
Yap_DebugPlWrite ((Term) * cptr++);

21
C/control_absmi_insts.h
View File

@ -1,5 +1,7 @@
/************************************************************************\
* Cut & Commit Instructions *
* Cut & Commit Inst
ructions *
\************************************************************************/
#ifdef INDENT_CODE
@ -194,18 +196,18 @@
/* Macros for stack trimming */
/* execute Label */
BOp(execute, pp);
BOp(execute, Osbpp);
{
PredEntry *pt0;
CACHE_Y_AS_ENV(YREG);
pt0 = PREG->y_u.pp.p;
pt0 = PREG->y_u.Osbpp.p;
#ifndef NO_CHECKING
check_stack(NoStackExecute, HR);
goto skip_do_execute;
#endif
do_execute:
FETCH_Y_FROM_ENV(YREG);
pt0 = PREG->y_u.pp.p;
pt0 = PREG->y_u.Osbpp.p;
skip_do_execute:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
@ -244,17 +246,17 @@
/* dexecute Label */
/* joint deallocate and execute */
BOp(dexecute, pp);
BOp(dexecute, Osbpp);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,PREG->y_u.pp.p,XREGS+1);
low_level_trace(enter_pred,PREG->y_u.Osbpp.p,XREGS+1);
#endif /* LOW_LEVEL_TRACER */
CACHE_Y_AS_ENV(YREG);
{
PredEntry *pt0;
CACHE_A1();
pt0 = PREG->y_u.pp.p;
pt0 = PREG->y_u.Osbpp.p;
#ifndef NO_CHECKING
/* check stacks */
check_stack(NoStackDExecute, HR);
@ -262,7 +264,7 @@
#endif
continue_dexecute:
FETCH_Y_FROM_ENV(YREG);
pt0 = PREG->y_u.pp.p;
pt0 = PREG->y_u.Osbpp.p;
skip_dexecute:
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
@ -425,6 +427,8 @@
Op(deallocate, p);
CACHE_Y_AS_ENV(YREG);
// do this before checking
SREG = YREG;
check_trail(TR);
#ifndef NO_CHECKING
/* check stacks */
@ -433,7 +437,6 @@
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

253
C/dbase.c
View File

@ -18,83 +18,94 @@
static char SccsId[] = "%W% %G%";
#endif
/**
* @file dbase.c
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP-2.lan>
* @date Mon Apr 30 09:36:46 2018
*
* @brief record and other forms of storing terms.
*
*/
/** @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"
@ -259,7 +270,7 @@ static Int p_rcdz(USES_REGS1);
static Int p_rcdzp(USES_REGS1);
static Int p_drcdap(USES_REGS1);
static Int p_drcdzp(USES_REGS1);
static Term GetDBTerm(DBTerm *, int src CACHE_TYPE);
static Term GetDBTerm(const DBTerm *, int src CACHE_TYPE);
static DBProp FetchDBPropFromKey(Term, int, int, char *);
static Int i_recorded(DBProp, Term CACHE_TYPE);
static Int c_recorded(int CACHE_TYPE);
@ -267,8 +278,8 @@ static Int co_rded(USES_REGS1);
static Int in_rdedp(USES_REGS1);
static Int co_rdedp(USES_REGS1);
static Int p_first_instance(USES_REGS1);
static void ErasePendingRefs(DBTerm *CACHE_TYPE);
static void RemoveDBEntry(DBRef CACHE_TYPE);
static void ErasePendingRefs(const DBTerm *CACHE_TYPE);
static void RemoveDBEntry(const DBRef CACHE_TYPE);
static void EraseLogUpdCl(LogUpdClause *);
static void MyEraseClause(DynamicClause *CACHE_TYPE);
static void PrepareToEraseClause(DynamicClause *, DBRef);
@ -292,10 +303,10 @@ static void sf_include(SFKeep *);
#endif
static Int p_init_queue(USES_REGS1);
static Int p_enqueue(USES_REGS1);
static void keepdbrefs(DBTerm *CACHE_TYPE);
static void keepdbrefs(const DBTerm *ref USES_REGS);
static Int p_dequeue(USES_REGS1);
static void ErDBE(DBRef CACHE_TYPE);
static void ReleaseTermFromDB(DBTerm *CACHE_TYPE);
static void ReleaseTermFromDB(const DBTerm *ref USES_REGS);
static PredEntry *new_lu_entry(Term);
static PredEntry *new_lu_int_key(Int);
static PredEntry *find_lu_entry(Term);
@ -418,12 +429,6 @@ static Int cmpclls(CELL *a, CELL *b, Int n) {
return TRUE;
}
#if !THREADS
int Yap_DBTrailOverflow() {
return ((CELL *)LOCAL_s_dbg->lr > (CELL *)LOCAL_s_dbg->tofref - 2048);
}
#endif
/* get DB entry for ap/arity; */
static Prop FindDBPropHavingLock(AtomEntry *ae, int CodeDB, unsigned int arity,
Term dbmod) {
@ -633,7 +638,7 @@ static CELL *copy_double(CELL *st, CELL *pt) {
static CELL *copy_string(CELL *st, CELL *pt) {
UInt sz = pt[1] + 3;
/* first thing, store a link to the list before we move on */
memcpy(st, pt, sizeof(CELL) * sz);
memmove(st, pt, sizeof(CELL) * sz);
/* now reserve space */
return st + sz;
}
@ -647,7 +652,7 @@ static CELL *copy_big_int(CELL *st, CELL *pt) {
st[0] = (CELL)FunctorBigInt;
st[1] = pt[1];
/* then the actual number */
memcpy((void *)(st + 2), (void *)(pt + 2), sz);
memmove((void *)(st + 2), (void *)(pt + 2), sz);
st = st + 2 + sz / CellSize;
/* then the tail for gc */
st[0] = EndSpecials;
@ -959,7 +964,7 @@ loop:
if (HR + sz >= ASP) {
goto error2;
}
memcpy((void *)HR, (void *)(to_visit_base), sz * sizeof(CELL *));
memmove((void *)HR, (void *)(to_visit_base), sz * sizeof(CELL *));
to_visit_base = (CELL **)HR;
to_visit = to_visit_base + sz;
}
@ -1402,12 +1407,14 @@ static DBRef CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat,
SMALLUNSGN flag;
int NOfLinks = 0;
/* place DBRefs in ConsultStack */
DBRef *TmpRefBase = (DBRef *)LOCAL_TrailTop;
DBRef *TmpRefBase;
CELL *CodeAbs; /* how much code did we find */
int vars_found = FALSE;
yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR;
retry_record:
LOCAL_Error_TYPE = YAP_NO_ERROR;
TmpRefBase = (DBRef *)LOCAL_TrailTop;
if (p == NULL) {
if (IsVarTerm(Tm)) {
#ifdef COROUTINING
@ -1481,7 +1488,7 @@ static DBRef CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat,
/* attachment */
if (IsVarTerm(Tm)) {
tt = (CELL)(ppt0->Contents);
ntp = MkDBTerm(VarOfTerm(Tm), VarOfTerm(Tm), ntp0, ntp0 + 1, ntp0 - 1,
ntp = MkDBTerm(VarOfTerm(Tm), VarOfTerm(Tm), ntp0, ntp0 + 1, ntp0 - 1,
&attachments, &vars_found, dbg);
if (ntp == NULL) {
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
@ -1506,7 +1513,7 @@ static DBRef CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat,
} else {
unsigned int arity;
Functor fun;
vars_found = true;
tt = AbsAppl(ppt0->Contents);
/* we need to store the functor manually */
fun = FunctorOfTerm(Tm);
@ -1516,13 +1523,37 @@ static DBRef CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat,
ntp = copy_double(ntp0, RepAppl(Tm));
break;
case (CELL)FunctorString:
ntp = copy_string(ntp0, RepAppl(Tm));
{
UInt sz = 1024+sizeof(CELL)*(3 + RepAppl(Tm)[1]);
if (sz >
(char*)AuxSp-(char*)ppt0) {
LOCAL_Error_Size = sz;
if (!Yap_ExpandPreAllocCodeSpace(LOCAL_Error_Size, NULL, TRUE)) {
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage);
return NULL;
}
goto retry_record;
}
}
ntp = copy_string(ntp0, RepAppl(Tm));
break;
case (CELL)FunctorDBRef:
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return CreateDBWithDBRef(Tm, p, dbg);
#ifdef USE_GMP
case (CELL)FunctorBigInt:
{
UInt sz = 1024+sizeof(CELL)*Yap_SizeOfBigInt(Tm);
if (sz >
(char*)AuxSp-(char*)ppt0) {
LOCAL_Error_Size = sizeof(CELL)*(3 + RepAppl(Tm)[1]);
if (!Yap_ExpandPreAllocCodeSpace(LOCAL_Error_Size, NULL, TRUE)) {
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage);
return NULL;
}
goto retry_record;
}
}
ntp = copy_big_int(ntp0, RepAppl(Tm));
break;
#endif
@ -1649,7 +1680,7 @@ static DBRef CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat,
nar = ppt->Contents + Unsigned(NOfCells);
}
woar = (link_entry *)nar;
memcpy((void *)woar, (const void *)dbg->LinkAr,
memmove((void *)woar, (const void *)dbg->LinkAr,
(size_t)(NOfLinks * sizeof(link_entry)));
woar += NOfLinks;
#ifdef ALIGN_LONGS
@ -1709,7 +1740,6 @@ static DBRef record(int Flag, Term key, Term t_data, Term t_code USES_REGS) {
int needs_vars;
struct db_globs dbg;
LOCAL_s_dbg = &dbg;
dbg.found_one = NULL;
#ifdef SFUNC
FathersPlace = NIL;
@ -1785,7 +1815,6 @@ static DBRef record_at(int Flag, DBRef r0, Term t_data, Term t_code USES_REGS) {
int needs_vars;
struct db_globs dbg;
LOCAL_s_dbg = &dbg;
#ifdef SFUNC
FathersPlace = NIL;
#endif
@ -1870,7 +1899,6 @@ static LogUpdClause *new_lu_db_entry(Term t, PredEntry *pe) {
if (!pe || !(pe->PredFlags & ThreadLocalPredFlag))
d_flag |= InQueue;
#endif
LOCAL_s_dbg = &dbg;
ipc = NEXTOP(((LogUpdClause *)NULL)->ClCode, e);
if ((x = (DBTerm *)CreateDBStruct(t, NULL, d_flag, &needs_vars, (UInt)ipc,
&dbg)) == NULL) {
@ -2502,7 +2530,7 @@ Int Yap_unify_immediate_ref(DBRef ref USES_REGS) {
}
}
static Term GetDBTerm(DBTerm *DBSP, int src USES_REGS) {
static Term GetDBTerm(const DBTerm *DBSP, int src USES_REGS) {
Term t = DBSP->Entry;
if (IsVarTerm(t)
@ -3762,7 +3790,7 @@ static Int p_heap_space_info(USES_REGS1) {
* This is called when we are erasing a data base clause, because we may have
* pending references
*/
static void ErasePendingRefs(DBTerm *entryref USES_REGS) {
static void ErasePendingRefs(const DBTerm *entryref USES_REGS) {
DBRef *cp;
DBRef ref;
@ -3923,11 +3951,11 @@ static void complete_lu_erase(LogUpdClause *clau) {
static void EraseLogUpdCl(LogUpdClause *clau) {
PredEntry *ap;
ap = clau->ClPred;
/* no need to erase what has been erased */
if (!(clau->ClFlags & ErasedMask)) {
/* get ourselves out of the list */
clau->ClFlags |= ErasedMask;
/* get ourselves out of the list */
if (clau->ClNext != NULL) {
clau->ClNext->ClPrev = clau->ClPrev;
}
@ -3951,7 +3979,6 @@ static void EraseLogUpdCl(LogUpdClause *clau) {
}
ap->cs.p_code.NOfClauses--;
}
clau->ClFlags |= ErasedMask;
#ifndef THREADS
{
LogUpdClause *er_head = DBErasedList;
@ -4894,17 +4921,21 @@ static Int cont_current_key_integer(USES_REGS1) {
return Yap_unify(term, ARG1) && Yap_unify(term, ARG2);
}
Term Yap_FetchTermFromDB(DBTerm *ref) {
Term Yap_FetchTermFromDB(const void *ref) {
CACHE_REGS
if (ref == NULL)
return 0;
return GetDBTerm(ref, FALSE PASS_REGS);
}
Term Yap_FetchClauseTermFromDB(DBTerm *ref) {
Term Yap_FetchClauseTermFromDB(const void *ref) {
CACHE_REGS
if (ref == NULL)
return 0;
return GetDBTerm(ref, TRUE PASS_REGS);
}
Term Yap_PopTermFromDB(DBTerm *ref) {
Term Yap_PopTermFromDB(const void *ref) {
CACHE_REGS
Term t = GetDBTerm(ref, FALSE PASS_REGS);
@ -4918,7 +4949,6 @@ static DBTerm *StoreTermInDB(Term t, int nargs USES_REGS) {
int needs_vars;
struct db_globs dbg;
LOCAL_s_dbg = &dbg;
LOCAL_Error_Size = 0;
while ((x = (DBTerm *)CreateDBStruct(t, (DBProp)NULL, InQueue, &needs_vars, 0,
&dbg)) == NULL) {
@ -4949,7 +4979,6 @@ DBTerm *Yap_StoreTermInDBPlusExtraSpace(Term t, UInt extra_size, UInt *sz) {
struct db_globs dbg;
DBTerm *o;
LOCAL_s_dbg = &dbg;
o = (DBTerm *)CreateDBStruct(t, (DBProp)NULL, InQueue, &needs_vars,
extra_size, &dbg);
*sz = dbg.sz;
@ -5122,7 +5151,7 @@ static Int p_enqueue_unlocked(USES_REGS1) {
entry itself is still accessible from a trail entry, so we could not remove
the target entry,
*/
static void keepdbrefs(DBTerm *entryref USES_REGS) {
static void keepdbrefs (const DBTerm *entryref USES_REGS) {
DBRef *cp;
DBRef ref;
@ -5281,7 +5310,7 @@ static Int p_resize_int_keys(USES_REGS1) {
return resize_int_keys(IntegerOfTerm(t1));
}
static void ReleaseTermFromDB(DBTerm *ref USES_REGS) {
static void ReleaseTermFromDB(const DBTerm *ref USES_REGS) {
if (!ref)
return;
keepdbrefs(ref PASS_REGS);
@ -5289,7 +5318,7 @@ static void ReleaseTermFromDB(DBTerm *ref USES_REGS) {
FreeDBSpace((char *)ref);
}
void Yap_ReleaseTermFromDB(DBTerm *ref) {
void Yap_ReleaseTermFromDB(const void *ref) {
CACHE_REGS
ReleaseTermFromDB(ref PASS_REGS);
}

4
C/dlmalloc.c
View File

@ -1978,7 +1978,7 @@ Void_t* rEALLOc(oldmem, bytes) Void_t* oldmem; size_t bytes;
assert(ncopies >= 3);
if (ncopies > 9)
memcpy(d, s, copysize);
memmove(d, s, copysize);
else {
*(d+0) = *(s+0);
@ -2077,7 +2077,7 @@ Void_t* rEALLOc(oldmem, bytes) Void_t* oldmem; size_t bytes;
/* Must alloc, copy, free. */
newmem = mALLOc(nb - MALLOC_ALIGN_MASK);
if (newmem != 0) {
memcpy(newmem, oldmem, oldsize - 2*SIZE_SZ);
memmove(newmem, oldmem, oldsize - 2*SIZE_SZ);
fREe(oldmem);
}
}

1195
C/errors.c
View File

File diff suppressed because it is too large Load Diff

62
C/eval.c
View File

@ -17,8 +17,19 @@
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
//! @file eval.c
/**
* @file eval.c
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP-2.lan>
* @date Mon Apr 30 09:37:59 2018
*
* @brief is/2
*
*
* @namespace prolog
*
*
*
*/
//! @{
@ -91,6 +102,8 @@ static Term get_matrix_element(Term t1, Term t2 USES_REGS) {
}
static Term Eval(Term t USES_REGS) {
eval_context_t ctx;
ctx.p = LOCAL_ctx;
if (IsVarTerm(t)) {
Yap_ArithError(INSTANTIATION_ERROR, t, "in arithmetic");
@ -134,20 +147,19 @@ static Term Eval(Term t USES_REGS) {
return get_matrix_element(ArgOfTerm(1, t), t2 PASS_REGS);
}
}
ctx.f = fun;
ctx.fp = RepAppl(t);
LOCAL_ctx = &ctx;
*RepAppl(t) = (CELL)AtomFoundVar;
t1 = Eval(ArgOfTerm(1, t) PASS_REGS);
if (t1 == 0L) {
*RepAppl(t) = (CELL)fun;
return FALSE;
}
if (n == 1) {
*RepAppl(t) = (CELL)fun;
LOCAL_ctx = ctx.p;
return Yap_eval_unary(p->FOfEE, t1);
}
t2 = Eval(ArgOfTerm(2, t) PASS_REGS);
*RepAppl(t) = (CELL)fun;
if (t2 == 0L)
return FALSE;
LOCAL_ctx = ctx.p;
return Yap_eval_binary(p->FOfEE, t1, t2);
}
} /* else if (IsPairTerm(t)) */
@ -161,7 +173,9 @@ static Term Eval(Term t USES_REGS) {
}
}
Term Yap_InnerEval__(Term t USES_REGS) { return Eval(t PASS_REGS); }
Term Yap_InnerEval__(Term t USES_REGS) {
return Eval(t PASS_REGS);
}
#ifdef BEAM
Int BEAM_is(void);
@ -196,30 +210,18 @@ arithmetic_operators
/// @memberof is/2
static Int p_is(USES_REGS1) { /* X is Y */
Term out;
yap_error_number err;
Term out = TermNil;
bool go;
Term t = Deref(ARG2);
if (IsVarTerm(t)) {
Yap_EvalError(INSTANTIATION_ERROR, t, "X is Y");
Yap_ThrowError(INSTANTIATION_ERROR, t, "var(Y) in X is Y");
return (FALSE);
}
Yap_ClearExs();
do {
out = Yap_InnerEval(Deref(ARG2));
if ((err = Yap_FoundArithError()) == YAP_NO_ERROR)
break;
if (err == RESOURCE_ERROR_STACK) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, CP)) {
Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
return FALSE;
}
} else {
Yap_EvalError(err, takeIndicator(ARG2), "X is Exp");
return FALSE;
}
} while (TRUE);
go = false;
out = Yap_Eval(t PASS_REGS);
go = Yap_CheckArithError();
} while (go);
return Yap_unify_constant(ARG1, out);
}
@ -257,7 +259,7 @@ static Int p_isnan(USES_REGS1) { /* X isnan Y */
}
/**
@pred isinf(? X:float) is det</b>
@pred isinf(? X:float) is det
Interface to the IEE754 `isinf` test.
*/
@ -387,7 +389,7 @@ void Yap_EvalError__(const char *file, const char *function, int lineno,
buf[0] = '\0';
}
va_end(ap);
Yap_ThrowError__(file, function, lineno, type, where, buf);
Yap_Error__(false, file, function, lineno, type, where, buf);
}
/**

933
C/exec.c
View File

File diff suppressed because it is too large Load Diff

16
C/exo.c
View File

@ -87,10 +87,10 @@ inline BITS32 fmix32 ( BITS32 h )
return h;
}
//-----------------------------------------------------------------------------
INLINE_ONLY inline BITS32
INLINE_ONLY BITS32
HASH_MURMUR3_32 (UInt arity, CELL *cl, UInt bnds[], UInt sz);
INLINE_ONLY inline BITS32
INLINE_ONLY BITS32
HASH_MURMUR3_32 (UInt arity, CELL *cl, UInt bnds[], UInt sz)
{
UInt hash;
@ -139,10 +139,10 @@ HASH_MURMUR3_32 (UInt arity, CELL *cl, UInt bnds[], UInt sz)
/*DJB2*/
#define DJB2_OFFSET 5381
INLINE_ONLY inline BITS32
INLINE_ONLY BITS32
HASH_DJB2(UInt arity, CELL *cl, UInt bnds[], UInt sz);
INLINE_ONLY inline BITS32
INLINE_ONLY BITS32
HASH_DJB2(UInt arity, CELL *cl, UInt bnds[], UInt sz)
{
BITS32 hash;
@ -165,11 +165,11 @@ HASH_DJB2(UInt arity, CELL *cl, UInt bnds[], UInt sz)
return hash;
}
INLINE_ONLY inline BITS32
INLINE_ONLY BITS32
HASH_RS(UInt arity, CELL *cl, UInt bnds[], UInt sz);
/* RS Hash Function */
INLINE_ONLY inline BITS32
INLINE_ONLY BITS32
HASH_RS(UInt arity, CELL *cl, UInt bnds[], UInt sz)
{
UInt hash=0;
@ -194,7 +194,7 @@ HASH_RS(UInt arity, CELL *cl, UInt bnds[], UInt sz)
return hash;
}
INLINE_ONLY inline BITS32
INLINE_ONLY BITS32
HASH_FVN_1A(UInt arity, CELL *cl, UInt bnds[], UInt sz);
/* Simple hash function:
@ -203,7 +203,7 @@ HASH_FVN_1A(UInt arity, CELL *cl, UInt bnds[], UInt sz);
hash0 spreads extensions coming from different elements.
spread over j quadrants.
*/
INLINE_ONLY inline BITS32
INLINE_ONLY BITS32
HASH_FVN_1A(UInt arity, CELL *cl, UInt bnds[], UInt sz)
{
UInt hash;

2
C/exo_udi.c
View File

@ -253,7 +253,7 @@ IntervalUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
qsort(s0+1, (size_t)*s0, sizeof(BITS32), compar);
it->links[offset0] = s0-sorted0;
if (it->udi_free_args) {
memcpy(sorted, s0+1, sizeof(BITS32)*(*s0));
memmove(sorted, s0+1, sizeof(BITS32)*(*s0));
qsort(sorted, (size_t)*s0, sizeof(BITS32), compar2);
sorted += *s0;
}

758
C/fail_absmi_insts.h
View File

@ -4,411 +4,415 @@
#ifdef INDENT_CODE
{
{
{
#endif /* INDENT_CODE */
/* trust_fail */
BOp(trust_fail, e);
{
while (POP_CHOICE_POINT(B->cp_b))
{
POP_EXECUTE();
}
}
/* trust_fail */
BOp(trust_fail, e);
{
while (POP_CHOICE_POINT(B->cp_b)) {
POP_EXECUTE();
}
}
#ifdef YAPOR
{
choiceptr cut_pt;
cut_pt = B->cp_b;
CUT_prune_to(cut_pt);
B = cut_pt;
}
{
choiceptr cut_pt;
cut_pt = B->cp_b;
CUT_prune_to(cut_pt);
B = cut_pt;
}
#else
B = B->cp_b;
#endif /* YAPOR */
goto fail;
ENDBOp();
B = B->cp_b;
#endif /* YAPOR */
goto fail;
ENDBOp();
#ifdef YAPOR
shared_fail:
B = Get_LOCAL_top_cp();
SET_BB(PROTECT_FROZEN_B(B));
goto fail;
#endif /* YAPOR */
shared_fail:
B = Get_LOCAL_top_cp();
SET_BB(PROTECT_FROZEN_B(B));
goto fail;
#endif /* YAPOR */
/* fail */
PBOp(op_fail, e);
/* fail */
PBOp(op_fail, e);
if (PP) {
UNLOCK(PP->PELock);
PP = NULL;
}
if (PP) {
UNLOCK(PP->PELock);
PP = NULL;
}
#ifdef COROUTINING
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackFail, HR);
ENDCACHE_Y_AS_ENV();
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackFail, HR);
ENDCACHE_Y_AS_ENV();
#endif
fail:
{
register tr_fr_ptr pt0 = TR;
fail : {
register tr_fr_ptr pt0 = TR;
#if defined(YAPOR) || defined(THREADS)
if (PP) {
UNLOCK(PP->PELock);
PP = NULL;
}
if (PP) {
UNLOCK(PP->PELock);
PP = NULL;
}
#endif
PREG = B->cp_ap;
save_pc();
CACHE_TR(B->cp_tr);
PREFETCH_OP(PREG);
failloop:
if (pt0 == S_TR) {
SP = SP0;
PREG = B->cp_ap;
save_pc();
CACHE_TR(B->cp_tr);
PREFETCH_OP(PREG);
failloop:
if (pt0 == S_TR) {
SP = SP0;
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
int go_on = true;
yamop *ipc = PREG;
if (Yap_do_low_level_trace) {
int go_on = true;
yamop *ipc = PREG;
while (go_on) {
op_numbers opnum = Yap_op_from_opcode(ipc->opc);
while (go_on) {
op_numbers opnum = Yap_op_from_opcode(ipc->opc);
go_on = false;
switch (opnum) {
go_on = false;
switch (opnum) {
#ifdef TABLING
case _table_load_answer:
low_level_trace(retry_table_loader, LOAD_CP(B)->cp_pred_entry, NULL);
break;
case _table_try_answer:
case _table_retry_me:
case _table_trust_me:
case _table_retry:
case _table_trust:
case _table_completion:
case _table_load_answer:
low_level_trace(retry_table_loader, LOAD_CP(B)->cp_pred_entry, NULL);
break;
case _table_try_answer:
case _table_retry_me:
case _table_trust_me:
case _table_retry:
case _table_trust:
case _table_completion:
#ifdef THREADS_CONSUMER_SHARING
case _table_answer_resolution_completion:
case _table_answer_resolution_completion:
#endif /* THREADS_CONSUMER_SHARING */
#ifdef DETERMINISTIC_TABLING
if (IS_DET_GEN_CP(B))
low_level_trace(retry_table_generator, DET_GEN_CP(B)->cp_pred_entry, NULL);
else
if (IS_DET_GEN_CP(B))
low_level_trace(retry_table_generator, DET_GEN_CP(B)->cp_pred_entry,
NULL);
else
#endif /* DETERMINISTIC_TABLING */
low_level_trace(retry_table_generator, GEN_CP(B)->cp_pred_entry, (CELL *)(GEN_CP(B) + 1));
break;
case _table_answer_resolution:
low_level_trace(retry_table_consumer, CONS_CP(B)->cp_pred_entry, NULL);
break;
case _trie_trust_var:
case _trie_retry_var:
case _trie_trust_var_in_pair:
case _trie_retry_var_in_pair:
case _trie_trust_val:
case _trie_retry_val:
case _trie_trust_val_in_pair:
case _trie_retry_val_in_pair:
case _trie_trust_atom:
case _trie_retry_atom:
case _trie_trust_atom_in_pair:
case _trie_retry_atom_in_pair:
case _trie_trust_null:
case _trie_retry_null:
case _trie_trust_null_in_pair:
case _trie_retry_null_in_pair:
case _trie_trust_pair:
case _trie_retry_pair:
case _trie_trust_appl:
case _trie_retry_appl:
case _trie_trust_appl_in_pair:
case _trie_retry_appl_in_pair:
case _trie_trust_extension:
case _trie_retry_extension:
case _trie_trust_double:
case _trie_retry_double:
case _trie_trust_longint:
case _trie_retry_longint:
case _trie_trust_gterm:
case _trie_retry_gterm:
low_level_trace(retry_table_loader, UndefCode, NULL);
break;
low_level_trace(retry_table_generator, GEN_CP(B)->cp_pred_entry,
(CELL *)(GEN_CP(B) + 1));
break;
case _table_answer_resolution:
low_level_trace(retry_table_consumer, CONS_CP(B)->cp_pred_entry,
NULL);
break;
case _trie_trust_var:
case _trie_retry_var:
case _trie_trust_var_in_pair:
case _trie_retry_var_in_pair:
case _trie_trust_val:
case _trie_retry_val:
case _trie_trust_val_in_pair:
case _trie_retry_val_in_pair:
case _trie_trust_atom:
case _trie_retry_atom:
case _trie_trust_atom_in_pair:
case _trie_retry_atom_in_pair:
case _trie_trust_null:
case _trie_retry_null:
case _trie_trust_null_in_pair:
case _trie_retry_null_in_pair:
case _trie_trust_pair:
case _trie_retry_pair:
case _trie_trust_appl:
case _trie_retry_appl:
case _trie_trust_appl_in_pair:
case _trie_retry_appl_in_pair:
case _trie_trust_extension:
case _trie_retry_extension:
case _trie_trust_double:
case _trie_retry_double:
case _trie_trust_longint:
case _trie_retry_longint:
case _trie_trust_gterm:
case _trie_retry_gterm:
low_level_trace(retry_table_loader, UndefCode, NULL);
break;
#endif /* TABLING */
case _or_else:
case _or_last:
low_level_trace(retry_or, NULL, NULL);
break;
case _retry2:
case _retry3:
case _retry4:
ipc = NEXTOP(ipc,l);
go_on = true;
break;
case _jump:
ipc = ipc->y_u.l.l;
go_on = true;
break;
case _retry_c:
case _retry_userc:
low_level_trace(retry_pred, ipc->y_u.OtapFs.p, B->cp_args);
break;
case _retry_profiled:
case _count_retry:
ipc = NEXTOP(ipc,p);
go_on = true;
break;
case _retry_me:
case _trust_me:
case _count_retry_me:
case _count_trust_me:
case _profiled_retry_me:
case _profiled_trust_me:
case _retry_and_mark:
case _profiled_retry_and_mark:
case _retry:
case _trust:
low_level_trace(retry_pred, ipc->y_u.Otapl.p, B->cp_args);
break;
case _try_logical:
case _retry_logical:
case _profiled_retry_logical:
case _count_retry_logical:
case _trust_logical:
case _profiled_trust_logical:
case _count_trust_logical:
low_level_trace(retry_pred, ipc->y_u.OtILl.d->ClPred, B->cp_args);
break;
case _Nstop:
case _Ystop:
low_level_trace(retry_pred, NULL, B->cp_args);
break;
default:
break;
}
}
}
#endif /* LOW_LEVEL_TRACER */
#ifdef FROZEN_STACKS
#ifdef YAPOR_SBA
if (pt0 < TR_FZ || pt0 > (ADDR)CurrentTrailTop+MinTrailGap)
#else
if (pt0 < TR_FZ)
#endif /* YAPOR_SBA */
{
TR = TR_FZ;
TRAIL_LINK(pt0);
} else
#endif /* FROZEN_STACKS */
RESTORE_TR();
GONext();
}
BEGD(d1);
d1 = TrailTerm(pt0-1);
pt0--;
if (IsVarTerm(d1)) {
#if defined(YAPOR_SBA) && defined(YAPOR)
/* clean up the trail when we backtrack */
if (Unsigned((Int)(d1)-(Int)(H_FZ)) >
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
RESET_VARIABLE(STACK_TO_SBA(d1));
} else
#endif
/* normal variable */
RESET_VARIABLE(d1);
goto failloop;
}
/* pointer to code space */
/* or updatable variable */
#if defined(TERM_EXTENSIONS) || defined(FROZEN_STACKS) || defined(MULTI_ASSIGNMENT_VARIABLES)
if (IsPairTerm(d1))
#endif /* TERM_EXTENSIONS || FROZEN_STACKS || MULTI_ASSIGNMENT_VARIABLES */
{
register CELL flags;
CELL *pt1 = RepPair(d1);
#ifdef LIMIT_TABLING
if ((ADDR) pt1 == LOCAL_TrailBase) {
sg_fr_ptr sg_fr = (sg_fr_ptr) TrailVal(pt0);
TrailTerm(pt0) = AbsPair((CELL *)(pt0 - 1));
SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use --> compiled */
insert_into_global_sg_fr_list(sg_fr);
goto failloop;
}
#endif /* LIMIT_TABLING */
#ifdef FROZEN_STACKS /* TRAIL */
/* avoid frozen segments */
if (
#ifdef YAPOR_SBA
(ADDR) pt1 >= HeapTop
#else
IN_BETWEEN(LOCAL_TrailBase, pt1, (ADDR)CurrentTrailTop+MinTrailGap)
#endif /* YAPOR_SBA */
)
{
pt0 = (tr_fr_ptr) pt1;
goto failloop;
} else
#endif /* FROZEN_STACKS */
if (IN_BETWEEN(H0,pt1,HR)) {
if (IsAttVar(pt1)) {
goto failloop;
} else if (*pt1 == (CELL)FunctorBigInt) {
Yap_CleanOpaqueVariable(pt1);
goto failloop;
}
}
#ifdef FROZEN_STACKS /* TRAIL */
/* don't reset frozen variables */
if (pt0 < TR_FZ)
goto failloop;
#endif
flags = *pt1;
#if MULTIPLE_STACKS
if (FlagOn(DBClMask, flags)) {
DBRef dbr = DBStructFlagsToDBStruct(pt1);
int erase;
LOCK(dbr->lock);
DEC_DBREF_COUNT(dbr);
erase = (dbr->Flags & ErasedMask) && (dbr->ref_count == 0);
UNLOCK(dbr->lock);
if (erase) {
saveregs();
Yap_ErDBE(dbr);
setregs();
}
} else {
if (flags & LogUpdMask) {
if (flags & IndexMask) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt1);
int erase;
#if PARALLEL_YAP
PredEntry *ap = cl->ClPred;
#endif
PELOCK(8,ap);
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
if (erase) {
saveregs();
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_ErLogUpdIndex(cl);
setregs();
} else if (cl->ClFlags & DirtyMask) {
saveregs();
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_CleanUpIndex(cl);
setregs();
}
UNLOCK(ap->PELock);
} else {
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1);
int erase;
#if PARALLEL_YAP
PredEntry *ap = cl->ClPred;
#endif
/* BB support */
if (ap) {
PELOCK(9,ap);
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
if (erase) {
saveregs();
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_ErLogUpdCl(cl);
setregs();
}
UNLOCK(ap->PELock);
}
}
} else {
DynamicClause *cl = ClauseFlagsToDynamicClause(pt1);
int erase;
LOCK(cl->ClLock);
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
UNLOCK(cl->ClLock);
if (erase) {
saveregs();
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_ErCl(cl);
setregs();
}
}
}
#else
ResetFlag(InUseMask, flags);
*pt1 = flags;
if (FlagOn((ErasedMask|DirtyMask), flags)) {
if (FlagOn(DBClMask, flags)) {
saveregs();
Yap_ErDBE(DBStructFlagsToDBStruct(pt1));
setregs();
} else {
saveregs();
if (flags & LogUpdMask) {
if (flags & IndexMask) {
if (FlagOn(ErasedMask, flags)) {
Yap_ErLogUpdIndex(ClauseFlagsToLogUpdIndex(pt1));
} else {
Yap_CleanUpIndex(ClauseFlagsToLogUpdIndex(pt1));
}
} else {
Yap_ErLogUpdCl(ClauseFlagsToLogUpdClause(pt1));
}
} else {
Yap_ErCl(ClauseFlagsToDynamicClause(pt1));
}
setregs();
}
}
#endif
goto failloop;
}
#ifdef MULTI_ASSIGNMENT_VARIABLES
else /* if (IsApplTerm(d1)) */ {
CELL *pt = RepAppl(d1);
/* AbsAppl means */
/* multi-assignment variable */
/* so the next cell is the old value */
#ifdef FROZEN_STACKS
--pt0;
pt[0] = TrailVal(pt0);
#else
pt[0] = TrailTerm(pt0-1);
pt0 -= 2;
#endif /* FROZEN_STACKS */
goto failloop;
}
#endif
ENDD(d1);
ENDCACHE_TR();
case _or_else:
case _or_last:
low_level_trace(retry_or, NULL, NULL);
break;
case _retry2:
case _retry3:
case _retry4:
ipc = NEXTOP(ipc, l);
go_on = true;
break;
case _jump:
ipc = ipc->y_u.l.l;
go_on = true;
break;
case _retry_c:
case _retry_userc:
low_level_trace(retry_pred, ipc->y_u.OtapFs.p, B->cp_args);
break;
case _retry_profiled:
case _count_retry:
ipc = NEXTOP(ipc, p);
go_on = true;
break;
case _retry_me:
case _trust_me:
case _count_retry_me:
case _count_trust_me:
case _profiled_retry_me:
case _profiled_trust_me:
case _retry_and_mark:
case _profiled_retry_and_mark:
case _retry:
case _trust:
low_level_trace(retry_pred, ipc->y_u.Otapl.p, B->cp_args);
break;
case _try_logical:
case _retry_logical:
case _profiled_retry_logical:
case _count_retry_logical:
case _trust_logical:
case _profiled_trust_logical:
case _count_trust_logical:
low_level_trace(retry_pred, ipc->y_u.OtILl.d->ClPred, B->cp_args);
break;
case _Nstop:
case _Ystop:
low_level_trace(retry_pred, NULL, B->cp_args);
break;
default:
break;
}
}
}
#endif /* LOW_LEVEL_TRACER */
#ifdef FROZEN_STACKS
#ifdef YAPOR_SBA
if (pt0 < TR_FZ || pt0 > (ADDR)CurrentTrailTop + MinTrailGap)
#else
if (pt0 < TR_FZ)
#endif /* YAPOR_SBA */
{
TR = TR_FZ;
TRAIL_LINK(pt0);
} else
#endif /* FROZEN_STACKS */
RESTORE_TR();
GONext();
}
BEGD(d1);
d1 = TrailTerm(pt0 - 1);
pt0--;
if (IsVarTerm(d1)) {
#if defined(YAPOR_SBA) && defined(YAPOR)
/* clean up the trail when we backtrack */
if (Unsigned((Int)(d1) - (Int)(H_FZ)) >
Unsigned((Int)(B_FZ) - (Int)(H_FZ))) {
RESET_VARIABLE(STACK_TO_SBA(d1));
} else
#endif
/* normal variable */
RESET_VARIABLE(d1);
goto failloop;
}
/* pointer to code space */
/* or updatable variable */
#if defined(TERM_EXTENSIONS) || defined(FROZEN_STACKS) || \
defined(MULTI_ASSIGNMENT_VARIABLES)
if (IsPairTerm(d1))
#endif /* TERM_EXTENSIONS || FROZEN_STACKS || MULTI_ASSIGNMENT_VARIABLES */
{
register CELL flags;
CELL *pt1 = RepPair(d1);
#ifdef LIMIT_TABLING
if ((ADDR)pt1 == LOCAL_TrailBase) {
sg_fr_ptr sg_fr = (sg_fr_ptr)TrailVal(pt0);
TrailTerm(pt0) = AbsPair((CELL *)(pt0 - 1));
SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use -->
compiled */
insert_into_global_sg_fr_list(sg_fr);
goto failloop;
}
#endif /* LIMIT_TABLING */
#ifdef FROZEN_STACKS /* TRAIL */
/* avoid frozen segments */
if (
#ifdef YAPOR_SBA
(ADDR)pt1 >= HeapTop
#else
IN_BETWEEN(LOCAL_TrailBase, pt1, (ADDR)CurrentTrailTop + MinTrailGap)
#endif /* YAPOR_SBA */
) {
pt0 = (tr_fr_ptr)pt1;
goto failloop;
} else
#endif /* FROZEN_STACKS */
if (IN_BETWEEN(H0, pt1, HR)) {
if (IsAttVar(pt1)) {
goto failloop;
} else {
TR = pt0;
Yap_CleanOpaqueVariable(d1);
goto failloop;
}
}
#ifdef FROZEN_STACKS /* TRAIL */
/* don't reset frozen variables */
if (pt0 < TR_FZ)
goto failloop;
#endif
flags = *pt1;
#if MULTIPLE_STACKS
if (FlagOn(DBClMask, flags)) {
DBRef dbr = DBStructFlagsToDBStruct(pt1);
int erase;
LOCK(dbr->lock);
DEC_DBREF_COUNT(dbr);
erase = (dbr->Flags & ErasedMask) && (dbr->ref_count == 0);
UNLOCK(dbr->lock);
if (erase) {
saveregs();
Yap_ErDBE(dbr);
setregs();
}
} else {
if (flags & LogUpdMask) {
if (flags & IndexMask) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt1);
int erase;
#if PARALLEL_YAP
PredEntry *ap = cl->ClPred;
#endif
PELOCK(8, ap);
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
if (erase) {
saveregs();
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_ErLogUpdIndex(cl);
setregs();
} else if (cl->ClFlags & DirtyMask) {
saveregs();
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_CleanUpIndex(cl);
setregs();
}
UNLOCK(ap->PELock);
} else {
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1);
int erase;
#if PARALLEL_YAP
PredEntry *ap = cl->ClPred;
#endif
/* BB support */
if (ap) {
PELOCK(9, ap);
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
if (erase) {
saveregs();
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_ErLogUpdCl(cl);
setregs();
}
UNLOCK(ap->PELock);
}
}
} else {
DynamicClause *cl = ClauseFlagsToDynamicClause(pt1);
int erase;
LOCK(cl->ClLock);
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
UNLOCK(cl->ClLock);
if (erase) {
saveregs();
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_ErCl(cl);
setregs();
}
}
}
#else
ResetFlag(InUseMask, flags);
*pt1 = flags;
if (FlagOn((ErasedMask | DirtyMask), flags)) {
if (FlagOn(DBClMask, flags)) {
saveregs();
Yap_ErDBE(DBStructFlagsToDBStruct(pt1));
setregs();
} else {
saveregs();
if (flags & LogUpdMask) {
if (flags & IndexMask) {
if (FlagOn(ErasedMask, flags)) {
Yap_ErLogUpdIndex(ClauseFlagsToLogUpdIndex(pt1));
} else {
Yap_CleanUpIndex(ClauseFlagsToLogUpdIndex(pt1));
}
} else {
Yap_ErLogUpdCl(ClauseFlagsToLogUpdClause(pt1));
}
} else {
Yap_ErCl(ClauseFlagsToDynamicClause(pt1));
}
setregs();
}
}
#endif
goto failloop;
}
#ifdef MULTI_ASSIGNMENT_VARIABLES
else /* if (IsApplTerm(d1)) */
{
CELL *pt = RepAppl(d1);
/* AbsAppl means */
/* multi-assignment variable */
/* so the next cell is the old value */
#ifdef FROZEN_STACKS
--pt0;
pt[0] = TrailVal(pt0);
#else
pt[0] = TrailTerm(pt0 - 1);
pt0 -= 2;
#endif /* FROZEN_STACKS */
goto failloop;
}
#endif
ENDD(d1);
ENDCACHE_TR();
}
#ifdef COROUTINING
NoStackFail:
BEGD(d0);
NoStackFail:
BEGD(d0);
#ifdef SHADOW_S
Yap_REGS.S_ = SREG;
Yap_REGS.S_ = SREG;
#endif
saveregs();
d0 = interrupt_fail( PASS_REGS1 );
setregs();
saveregs();
d0 = interrupt_fail(PASS_REGS1);
setregs();
#ifdef SHADOW_S
SREG = Yap_REGS.S_;
SREG = Yap_REGS.S_;
#endif
if (!d0) FAIL();
JMPNext();
ENDD(d0);
if (!d0)
FAIL();
JMPNext();
ENDD(d0);
#endif /* COROUTINING */
ENDPBOp();
ENDPBOp();
#ifdef INDENT_CODE
}
#endif /* INDENT_CODE */

335
C/flags.c
View File

@ -1,25 +1,43 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- *
* *
**************************************************************************
* *
* File: flags.c *
* Last rev: *
* mods: *
* comments: abstract machine definitions *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- *
* *
**************************************************************************
* *
* File: flags.c *
* Last rev: *
* mods: *
* comments: abstract machine definitions *
* *
*************************************************************************/
/** @file C/flags.c
@addtogroup Flags
@ingroup core
@brief Prolog parameter setting,
*/
/*
* @namespace prolog
*/
/**
@{
@defgroup YAPFlags_Impl C-code to handle Prolog flags.
@ingroup YAPFlags
@brief Low-level code to support flags.
Prolog Flags can be:
= thread-local or global
= module-based or module-independent.
= read-only or read-write
= System or User Defined.
= Have type boolean, number, atom constant or may be a general term.
*/
// this is where we define flags
@ -51,7 +69,9 @@ static Term indexer(Term inp);
static Term stream(Term inp);
static bool getenc(Term inp);
static bool typein(Term inp);
static bool dqf(Term t2);
static bool dqs(Term t2);
static bool bqs(Term t2);
static bool sqf(Term t2);
static bool set_error_stream(Term inp);
static bool set_input_stream(Term inp);
static bool set_output_stream(Term inp);
@ -60,27 +80,38 @@ static void newFlag(Term fl, Term val);
static Int current_prolog_flag(USES_REGS1);
static Int set_prolog_flag(USES_REGS1);
#include "Yatom.h"
#include "YapEval.h"
#include "Yatom.h"
#include "yapio.h"
#define YAP_FLAG(ID, NAME, WRITABLE, DEF, INIT, HELPER) \
{ NAME, WRITABLE, DEF, INIT, HELPER }
#define START_LOCAL_FLAGS static flag_info local_flags_setup[] = {
#define END_LOCAL_FLAGS \
LZERO_FLAG \
} \
;
#define START_GLOBAL_FLAGS static flag_info global_flags_setup[] = {
#define END_GLOBAL_FLAGS \
GZERO_FLAG \
} \
;
#define GZERO_FLAG \
{ NULL, false, NULL, NULL, NULL }
#define LZERO_FLAG \
{ NULL, false, NULL, NULL, NULL }
static flag_info global_flags_setup[] = {
#include "YapGFlagInfo.h"
GZERO_FLAG};
static flag_info local_flags_setup[] = {
#include "YapLFlagInfo.h"
LZERO_FLAG};
static Term indexer(Term inp) {
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (inp == TermOff || inp == TermSingle || inp == TermCompact ||
inp == TermMulti || inp == TermOn || inp == TermMax)
return inp;
@ -90,13 +121,15 @@ static Term indexer(Term inp) {
"set_prolog_flag index in {off,single,compact,multi,on,max}");
return TermZERO;
}
Yap_Error(TYPE_ERROR_ATOM, inp,
"set_prolog_flag in {dec10,error,fail,quiet}");
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag index to an atom");
return TermZERO;
}
static bool dqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags &= ~(DBLQ_CHARS | DBLQ_CODES | DBLQ_ATOM | DBLQ_STRING);
if (IsStringTerm(t2)) {
t2 = MkStringTerm(RepAtom(AtomOfTerm(t2))->StrOfAE);
}
if (IsAtomTerm(t2)) {
if (t2 == TermString) {
new->flags |= DBLQ_STRING;
@ -112,20 +145,22 @@ static bool dqf1(ModEntry *new, Term t2 USES_REGS) {
return true;
}
/* bad argument, but still an atom */
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
} else {
Yap_Error(TYPE_ERROR_ATOM, t2, "set_prolog_flag(double_quotes, %s), should "
"be {string,atom,codes,chars}",
Yap_Error(TYPE_ERROR_ATOM, t2,
"set_prolog_flag(double_quotes, %s), should "
"be {string,atom,codes,chars}",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
}
}
static bool dqf(Term t2) {
static bool dqs(Term t2) {
CACHE_REGS
ModEntry *new = Yap_GetModuleEntry(CurrentModule);
return dqf1(new, t2 PASS_REGS);
@ -133,6 +168,9 @@ static bool dqf(Term t2) {
static bool bqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags &= ~(BCKQ_CHARS | BCKQ_CODES | BCKQ_ATOM | BCKQ_STRING);
if (IsStringTerm(t2)) {
t2 = MkStringTerm(RepAtom(AtomOfTerm(t2))->StrOfAE);
}
if (IsAtomTerm(t2)) {
if (t2 == TermString) {
new->flags |= BCKQ_STRING;
@ -147,9 +185,10 @@ static bool bqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags |= BCKQ_CHARS;
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
} else {
@ -159,10 +198,57 @@ static bool bqf1(ModEntry *new, Term t2 USES_REGS) {
}
}
static bool bqs(Term t2) {
CACHE_REGS
ModEntry *new = Yap_GetModuleEntry(CurrentModule);
return bqf1(new, t2 PASS_REGS);
}
static bool sqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags &= ~(SNGQ_CHARS | SNGQ_CODES | SNGQ_ATOM | SNGQ_STRING);
if (IsStringTerm(t2)) {
t2 = MkStringTerm(RepAtom(AtomOfTerm(t2))->StrOfAE);
}
if (IsAtomTerm(t2)) {
if (t2 == TermString) {
new->flags |= SNGQ_STRING;
return true;
} else if (t2 == TermAtom) {
new->flags |= SNGQ_ATOM;
return true;
} else if (t2 == TermCodes) {
new->flags |= SNGQ_CODES;
return true;
} else if (t2 == TermChars) {
new->flags |= SNGQ_CHARS;
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
} else {
Yap_Error(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
}
}
static bool sqf(Term t2) {
CACHE_REGS
ModEntry *new = Yap_GetModuleEntry(CurrentModule);
return sqf1(new, t2 PASS_REGS);
}
static Term isaccess(Term inp) {
if (inp == TermReadWrite || inp == TermReadOnly)
return inp;
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag access in {read_write,read_only}");
@ -176,8 +262,9 @@ static Term isaccess(Term inp) {
static Term stream(Term inp) {
if (IsVarTerm(inp))
return inp;
if (Yap_CheckStream(inp, Input_Stream_f | Output_Stream_f | Append_Stream_f |
Socket_Stream_f,
if (Yap_CheckStream(inp,
Input_Stream_f | Output_Stream_f | Append_Stream_f |
Socket_Stream_f,
"yap_flag/3") >= 0)
return inp;
return 0;
@ -186,25 +273,19 @@ static Term stream(Term inp) {
static bool set_error_stream(Term inp) {
if (IsVarTerm(inp))
return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_error_stream));
LOCAL_c_error_stream = Yap_CheckStream(
inp, Output_Stream_f | Append_Stream_f | Socket_Stream_f, "yap_flag/3");
return true;
return Yap_SetErrorStream(inp);
}
static bool set_input_stream(Term inp) {
if (IsVarTerm(inp))
return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_input_stream));
LOCAL_c_input_stream =
Yap_CheckStream(inp, Input_Stream_f | Socket_Stream_f, "yap_flag/3");
return true;
return Yap_SetInputStream(inp);
}
static bool set_output_stream(Term inp) {
if (IsVarTerm(inp))
return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_output_stream));
LOCAL_c_output_stream = Yap_CheckStream(
inp, Output_Stream_f | Append_Stream_f | Socket_Stream_f, "yap_flag/3");
return true;
return Yap_SetOutputStream(inp);
}
static Term isground(Term inp) {
@ -215,6 +296,9 @@ static Term flagscope(Term inp) {
if (inp == TermGlobal || inp == TermThread || inp == TermModule)
return inp;
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag access in {global,module,thread}");
@ -229,8 +313,11 @@ 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);
}
if (!IsAtomTerm(inp)) {
if (!IsAtomTerm(inp)) {
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return false;
}
@ -241,6 +328,9 @@ static bool mkprompt(Term inp) {
static bool getenc(Term inp) {
CACHE_REGS
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (!IsVarTerm(inp) && !IsAtomTerm(inp)) {
Yap_Error(TYPE_ERROR_ATOM, inp, "get_encoding");
return false;
@ -272,6 +362,9 @@ static bool typein(Term inp) {
tin = TermProlog;
return Yap_unify(inp, tin);
}
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (!IsAtomTerm(inp)) {
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return false;
@ -382,6 +475,9 @@ static bool typein(Term inp) {
if (IsAtomTerm(hd)) {
do {
Term hd = HeadOfTerm(inp);
if (IsStringTerm(hd)) {
hd = MkStringTerm(RepAtom(AtomOfTerm(hd))->StrOfAE);
}
if (!IsAtomTerm(hd)) {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false;
@ -411,7 +507,7 @@ static bool typein(Term inp) {
return true;
}
static bool list_atom( Term inp ) {
x static bool list_atom( Term inp ) {
if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
return false;
@ -420,6 +516,10 @@ static bool typein(Term inp) {
if (IsPairTerm(inp)) {
Term hd = HeadOfTerm(inp);
do {
if (IsStringTerm(hd)) {
hd = MkStringTerm(RepAtom(AtomOfTerm(hd))->StrOfAE);
}
if (!IsAtomTerm(hd)) {
Yap_Error(TYPE_ERROR_ATOM, inp0, "set_prolog_flag in \"...\"");
return false;
@ -444,6 +544,9 @@ static Term list_option(Term inp) {
do {
Term hd = HeadOfTerm(inp);
inp = TailOfTerm(inp);
if (IsStringTerm(hd)) {
hd = MkStringTerm(RepAtom(AtomOfTerm(hd))->StrOfAE);
}
if (IsAtomTerm(hd)) {
continue;
}
@ -464,6 +567,9 @@ static Term list_option(Term inp) {
Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
return TermZERO;
} else /* lone option */ {
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (IsAtomTerm(inp)) {
return inp;
} else if (IsApplTerm(inp)) {
@ -667,17 +773,17 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
flag_term *tarr = GLOBAL_Flags;
if (!(fv->type(t2)))
return false;
if (fv->helper && !(fv->helper(t2)))
return false;
Term tout = tarr[fv->FlagOfVE].at;
if (IsVarTerm(tout)) {
Term t;
while ((t = Yap_PopTermFromDB(tarr[fv->FlagOfVE].DBT)) == 0) {
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return false;
}
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return false;
}
}
} else if (IsAtomOrIntTerm(t2))
tarr[fv->FlagOfVE].at = t2;
@ -721,9 +827,10 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
"bad option %s for character_escapes flag, use true or false",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
return false;
} else if (fv->FlagOfVE == BACKQUOTED_STRING_FLAG) {
} else if (fv->FlagOfVE == BACK_QUOTES_FLAG) {
return bqf1(me, t2 PASS_REGS);
;
} else if (fv->FlagOfVE == SINGLE_QUOTES_FLAG) {
return sqf1(me, t2 PASS_REGS);
}
// bad key?
return false;
@ -750,7 +857,7 @@ static Term getYapFlagInModule(Term tflag, Term mod) {
} else if (fv->FlagOfVE == CHARACTER_ESCAPES_FLAG) {
if (me->flags & M_CHARESCAPE)
return TermTrue;
} else if (fv->FlagOfVE == BACKQUOTED_STRING_FLAG) {
} else if (fv->FlagOfVE == BACK_QUOTES_FLAG) {
if (me->flags & BCKQ_CHARS)
return TermChars;
if (me->flags & BCKQ_CODES)
@ -758,6 +865,14 @@ static Term getYapFlagInModule(Term tflag, Term mod) {
if (me->flags & BCKQ_ATOM)
return TermAtom;
return TermString;
} else if (fv->FlagOfVE == SINGLE_QUOTES_FLAG) {
if (me->flags & SNGQ_CHARS)
return TermChars;
if (me->flags & SNGQ_CODES)
return TermCodes;
if (me->flags & SNGQ_ATOM)
return TermAtom;
return TermString;
} else if (fv->FlagOfVE == DOUBLE_QUOTES_FLAG) {
if (me->flags & DBLQ_CHARS)
return TermChars;
@ -783,7 +898,8 @@ static Int cont_yap_flag(USES_REGS1) {
Term modt = CurrentModule;
tflag = Yap_StripModule(tflag, &modt);
while (i != gmax && i != UNKNOWN_FLAG && i != CHARACTER_ESCAPES_FLAG &&
i != BACKQUOTED_STRING_FLAG)
i != BACK_QUOTES_FLAG && i != SINGLE_QUOTES_FLAG &&
i != DOUBLE_QUOTES_FLAG)
i++;
if (i == gmax)
cut_fail();
@ -959,6 +1075,9 @@ static Int current_prolog_flag2(USES_REGS1) {
return cont_yap_flag(PASS_REGS1);
}
do_cut(0);
if (IsStringTerm(tflag)) {
tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE);
}
if (!IsAtomTerm(tflag)) {
Yap_Error(TYPE_ERROR_ATOM, tflag, "current_prolog_flag/3");
return (FALSE);
@ -974,7 +1093,7 @@ static Int current_prolog_flag2(USES_REGS1) {
tarr = LOCAL_Flags;
tout = tarr[fv->FlagOfVE].at;
if (tout == TermZERO) {
Yap_DebugPlWriteln(tflag);
// Yap_DebugPlWriteln(tflag);
return false;
}
if (IsVarTerm(tout))
@ -987,14 +1106,16 @@ void Yap_setModuleFlags(ModEntry *new, ModEntry *cme) {
Atom at = new->AtomOfME;
if (at == AtomProlog || CurrentModule == PROLOG_MODULE) {
new->flags =
M_SYSTEM | UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING;
new->flags = M_SYSTEM | UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES |
BCKQ_STRING | SNGQ_ATOM;
if (at == AtomUser)
new->flags = UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING;
new->flags =
UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING | SNGQ_ATOM;
} else if (cme && cme->flags && cme != new) {
new->flags = cme->flags;
} else {
new->flags = (UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING);
new->flags =
(UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING | SNGQ_ATOM);
}
// printf("cme=%s new=%s flags=%x\n",cme,at->StrOfAE,new->flags);
}
@ -1006,6 +1127,10 @@ bool setYapFlag(Term tflag, Term t2) {
Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2");
return (FALSE);
}
if (IsStringTerm(tflag)) {
tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE);
}
if (IsApplTerm(tflag) && FunctorOfTerm(tflag) == FunctorModule) {
Term modt;
tflag = Yap_StripModule(tflag, &modt);
@ -1040,7 +1165,9 @@ bool setYapFlag(Term tflag, Term t2) {
switch (fv->FlagOfVE) {
case UNKNOWN_FLAG:
case CHARACTER_ESCAPES_FLAG:
case BACKQUOTED_STRING_FLAG:
case BACK_QUOTES_FLAG:
case DOUBLE_QUOTES_FLAG:
case SINGLE_QUOTES_FLAG:
return setYapFlagInModule(tflag, t2, CurrentModule);
default:
tarr = GLOBAL_Flags;
@ -1080,16 +1207,26 @@ 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);
}
if (IsStringTerm(tflag)) {
tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE);
}
if (IsApplTerm(tflag) && FunctorOfTerm(tflag) == FunctorModule) {
Term modt;
tflag = Yap_StripModule(tflag, &modt);
if (IsStringTerm(tflag)) {
tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE);
}
if (!isatom(tflag))
return false;
if (IsStringTerm(modt)) {
modt = MkStringTerm(RepAtom(AtomOfTerm(modt))->StrOfAE);
}
if (!isatom(modt))
return false;
return getYapFlagInModule(tflag, modt);
@ -1098,6 +1235,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;
@ -1141,7 +1282,7 @@ static Int set_prolog_flag(USES_REGS1) {
After executing this goal, YAP keeps information on the source
of the predicates that will be consulted. This enables the use of
[listing/0](@ref listing), `listing/1` and [clause/2](@ref clause) for those
listing/0, listing/1 and clause/2 for those
clauses.
The same as `source_mode(_,on)` or as declaring all newly defined
@ -1256,10 +1397,6 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION));
return true;
}
if (!strcmp(ss, "YAP_NUMERIC_VERSION")) {
tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION));
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be either true (on) or false (off)", s);
return false;
@ -1324,11 +1461,14 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
return false;
}
CACHE_REGS
const unsigned char *us = (const unsigned char *)s;
t0 = Yap_BufferToTermWithPrioBindings(us, strlen(s) + 1, TermNil,
GLOBAL_MaxPriority, 0L);
const char *us = (const char *)s;
t0 = Yap_BufferToTermWithPrioBindings(us, TermNil, 0L, strlen(s) + 1,
GLOBAL_MaxPriority);
if (!t0)
return false;
if (IsStringTerm(t0)) {
t0 = MkStringTerm(RepAtom(AtomOfTerm(t0))->StrOfAE);
}
if (IsAtomTerm(t0) || IsIntTerm(t0)) {
// do yourself flags
if (t0 == MkAtomTerm(AtomQuery)) {
@ -1373,12 +1513,16 @@ do_prolog_flag_property(Term tflag,
xarg *args;
prolog_flag_property_choices_t i;
bool rc = true;
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END);
args =
Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false;
}
if (IsStringTerm(tflag)) {
tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE);
}
if (!IsAtomTerm(tflag)) {
if (IsApplTerm(tflag) && FunctorOfTerm(tflag) == FunctorModule) {
Term modt = CurrentModule;
@ -1426,7 +1570,9 @@ do_prolog_flag_property(Term tflag,
if (fv->global) {
if (fv->FlagOfVE == UNKNOWN_FLAG ||
fv->FlagOfVE == CHARACTER_ESCAPES_FLAG ||
fv->FlagOfVE == BACKQUOTED_STRING_FLAG)
fv->FlagOfVE == SINGLE_QUOTES_FLAG ||
fv->FlagOfVE == DOUBLE_QUOTES_FLAG ||
fv->FlagOfVE == BACK_QUOTES_FLAG)
Yap_unify(TermModule, args[PROLOG_FLAG_PROPERTY_SCOPE].tvalue);
rc = rc &&
Yap_unify(TermGlobal, args[PROLOG_FLAG_PROPERTY_SCOPE].tvalue);
@ -1459,7 +1605,8 @@ static Int cont_prolog_flag_property(USES_REGS1) { /* current_prolog_flag */
lab = MkAtomTerm(Yap_LookupAtom(local_flags_setup[i - gmax].name));
} else {
if (i == UNKNOWN_FLAG || i == CHARACTER_ESCAPES_FLAG ||
i == BACKQUOTED_STRING_FLAG) {
i == SINGLE_QUOTES_FLAG || i == DOUBLE_QUOTES_FLAG ||
i == BACK_QUOTES_FLAG) {
Term labs[2];
labs[0] = MkVarTerm();
labs[1] = MkAtomTerm(Yap_LookupAtom(global_flags_setup[i].name));
@ -1492,6 +1639,9 @@ static Int prolog_flag_property(USES_REGS1) { /* Init current_prolog_flag */
Term t1 = Deref(ARG1);
/* make valgrind happy by always filling in memory */
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(0);
if (IsStringTerm(t1)) {
t1 = MkStringTerm(RepAtom(AtomOfTerm(t1))->StrOfAE);
}
if (IsVarTerm(t1)) {
return (cont_prolog_flag_property(PASS_REGS1));
} else {
@ -1537,8 +1687,9 @@ static Int do_create_prolog_flag(USES_REGS1) {
prolog_flag_property_choices_t i;
Term tflag = Deref(ARG1), tval = Deref(ARG2), opts = Deref(ARG3);
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END);
args =
Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false;
@ -1590,15 +1741,15 @@ static Int do_create_prolog_flag(USES_REGS1) {
}
/**
* Init System Prolog flags. This is done in two phases:
* early on, it takes care of the atomic flags that are required by other
*modules;
* later, it looks at flags that are structured terms
*
* @param bootstrap: wether this is done before stack initialization, or
*afterwards.
* Complex terms can only be built in the second step.
*/
* Init System Prolog flags. This is done in two phases:
* early on, it takes care of the atomic flags that are required by other
*modules;
* later, it looks at flags that are structured terms
*
* @param bootstrap: wether this is done before stack initialization, or
*afterwards.
* Complex terms can only be built in the second step.
*/
void Yap_InitFlags(bool bootstrap) {
CACHE_REGS
@ -1646,13 +1797,13 @@ 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__)
/** @pred prolog_flag( ?Flag, - Value)
Obtain the value for a YAP Prolog flag, same as current_prolog_flag/2_.
Obtain the value for a YAP Prolog flag, same as current_prolog_flag/2.
*/
Yap_InitCPredBack("prolog_flag", 3, 1, current_prolog_flag, cont_yap_flag,
Yap_InitCPredBack("prolog_flag", 3, 1, prolog_flag, cont_yap_flag,
0);
Yap_InitCPredBack("yap_flag", 3, 1, prolog_flag, cont_yap_flag, 0);
Yap_InitCPredBack("yap_flag", 3, 1, yap_flag, cont_yap_flag, 0);
Yap_InitCPredBack("prolog_flag", 2, 1, current_prolog_flag2,
cont_current_prolog_flag, 0);
Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag2,
@ -1670,3 +1821,5 @@ void Yap_InitFlags(bool bootstrap) {
}
/* Accessing and changing the flags for a predicate */
// @}

16
C/fli_absmi_insts.h
View File

@ -56,7 +56,7 @@
CPredicate f = PREG->y_u.Osbpp.p->cs.f_code;
PREG = NEXTOP(PREG, Osbpp);
saveregs();
d0 = (f)(PASS_REGS1);
d0 = f(PASS_REGS1);
setregs();
#ifdef SHADOW_S
SREG = Yap_REGS.S_;
@ -74,7 +74,7 @@
ENDBOp();
/* execute Label */
BOp(execute_cpred, pp);
BOp(execute_cpred, Osbpp);
check_trail(TR);
{
PredEntry *pt0;
@ -103,7 +103,7 @@
SET_ASP(YREG, E_CB * sizeof(CELL));
/* for slots to work */
#endif /* FROZEN_STACKS */
pt0 = PREG->y_u.pp.p;
pt0 = PREG->y_u.Osbpp.p;
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
low_level_trace(enter_pred, pt0, XREGS + 1);
@ -131,7 +131,7 @@
#endif /* DEPTH_LIMIT */
/* now call C-Code */
{
CPredicate f = PREG->y_u.pp.p->cs.f_code;
CPredicate f = PREG->y_u.Osbpp.p->cs.f_code;
yamop *oldPREG = PREG;
saveregs();
d0 = f(PASS_REGS1);
@ -623,10 +623,16 @@
BOp(undef_p, e);
/* save S for module name */
saveregs();
if (LOCAL_DoingUndefp) {
PREG=FAILCODE;
JMPNext();
}
LOCAL_DoingUndefp = true;
saveregs();
undef_goal(PASS_REGS1);
setregs();
/* for profiler */
LOCAL_DoingUndefp = false;
CACHE_A1();
JMPNext();
ENDBOp();

67
C/globals.c
View File

@ -22,10 +22,10 @@ static char SccsId[] = "%W% %G%";
* @file globals.c
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 23:16:17 2015
*
*
* @brief support for backtrable and non-backtrackable variables in Prolog.
*
*
*
*
*/
/**
@ -163,6 +163,11 @@ static inline CELL *ArenaLimit(Term arena) {
return arena_base + sz;
}
/* pointer to top of an arena */
CELL *Yap_ArenaLimit(Term arena) {
return ArenaLimit(arena);
}
/* pointer to top of an arena */
static inline CELL *ArenaPt(Term arena) { return (CELL *)RepAppl(arena); }
@ -346,18 +351,26 @@ 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; \
S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \
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,
CELL *HLow USES_REGS) {
struct cp_frame *to_visit0,
*to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace();
int lvl = push_text_stack();
struct cp_frame *to_visit0, *to_visit = Malloc(1024*sizeof(struct cp_frame));
struct cp_frame *to_visit_max;
CELL *HB0 = HB;
tr_fr_ptr TR0 = TR;
int ground = TRUE;
HB = HLow;
to_visit0 = to_visit;
to_visit_max = to_visit+1024;
loop:
while (pt0 < pt0_end) {
register CELL d0;
@ -377,8 +390,8 @@ loop:
*ptf = AbsPair(HR);
ptf++;
#ifdef RATIONAL_TREES
if (to_visit + 1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow;
if (to_visit >= to_visit_max-32) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
@ -390,8 +403,9 @@ loop:
to_visit++;
#else
if (pt0 < pt0_end) {
if (to_visit + 1 >= (CELL **)AuxSp) {
goto heap_overflow;
if (to_visit + 32 >= to_visit_max - 32) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
@ -461,7 +475,7 @@ loop:
goto overflow;
}
*ptf++ = AbsAppl(HR);
memcpy(HR, ap2, sizeof(CELL) * (3 + ap2[1]));
memmove(HR, ap2, sizeof(CELL) * (3 + ap2[1]));
HR += ap2[1] + 3;
break;
default: {
@ -488,8 +502,8 @@ loop:
ptf++;
/* store the terms to visit */
#ifdef RATIONAL_TREES
if (to_visit + 1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow;
if (to_visit + 32 >= to_visit_max) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
@ -502,7 +516,7 @@ loop:
#else
if (pt0 < pt0_end) {
if (to_visit++ >= (CELL **)AuxSp) {
goto heap_overflow;
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
@ -588,6 +602,7 @@ loop:
HB = HB0;
clean_dirty_tr(TR0 PASS_REGS);
/* follow chain of multi-assigned variables */
pop_text_stack(lvl);
return 0;
overflow:
@ -606,26 +621,9 @@ overflow:
}
#endif
reset_trail(TR0);
pop_text_stack(lvl);
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;
*pt0 = to_visit->oldv;
}
#endif
reset_trail(TR0);
return -2;
trail_overflow:
/* oops, we're in trouble */
HR = HLow;
@ -642,6 +640,7 @@ trail_overflow:
}
#endif
reset_trail(TR0);
pop_text_stack(lvl);
return -4;
}
@ -757,7 +756,7 @@ restart:
res = -1;
goto error_handler;
}
memcpy(HR, ap, sizeof(CELL) * (3 + ap[1]));
memmove(HR, ap, sizeof(CELL) * (3 + ap[1]));
HR += ap[1] + 3;
break;
default: {
@ -1244,7 +1243,7 @@ Term Yap_SaveTerm(Term t0) {
CACHE_REGS
Term to;
to = CopyTermToArena(
t0, LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena,
Deref(t0), LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena,
garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS);
if (to == 0L)
return to;
@ -2779,7 +2778,7 @@ void Yap_InitGlobals(void) {
Yap_InitCPred("nb_create", 4, p_nb_create2, 0L);
Yap_InitCPredBack("$nb_current", 1, 1, init_current_nb, cont_current_nb,
SafePredFlag);
/// @{
/// @{
/// @addtogroup nb
CurrentModule = GLOBALS_MODULE;
Yap_InitCPred("nb_queue", 1, p_nb_queue, 0L);

72
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%";
@ -841,7 +841,7 @@ static void RemoveCode(CODEADDR clau)
}
}
static int
static Int
showprofres( USES_REGS1 ) {
buf_ptr buf;
@ -973,7 +973,7 @@ prof_alrm(int signo, siginfo_t *si, void *scv)
current_p = PREVOP(P,Osbpp)->y_u.Osbpp.p->CodeOfPred;
} else if ((oop = Yap_op_from_opcode(P->opc)) == _execute_cpred) {
/* doing C-code */
current_p = P->y_u.pp.p->CodeOfPred;
current_p = P->y_u.Osbpp.p->CodeOfPred;
} else {
current_p = P;
}

10
C/grow.c
View File

@ -205,13 +205,13 @@ CopyLocalAndTrail( USES_REGS1 )
static void
IncrementalCopyStacksFromWorker( USES_REGS1 )
{
memcpy((void *) PtoGloAdjust((CELL *)LOCAL_start_global_copy),
memmove((void *) PtoGloAdjust((CELL *)LOCAL_start_global_copy),
(void *) (LOCAL_start_global_copy),
(size_t) (LOCAL_end_global_copy - LOCAL_start_global_copy));
memcpy((void *) PtoLocAdjust((CELL *)LOCAL_start_local_copy),
memmove((void *) PtoLocAdjust((CELL *)LOCAL_start_local_copy),
(void *) LOCAL_start_local_copy,
(size_t) (LOCAL_end_local_copy - LOCAL_start_local_copy));
memcpy((void *) PtoTRAdjust((tr_fr_ptr)LOCAL_start_trail_copy),
memmove((void *) PtoTRAdjust((tr_fr_ptr)LOCAL_start_trail_copy),
(void *) (LOCAL_start_trail_copy),
(size_t) (LOCAL_end_trail_copy - LOCAL_start_trail_copy));
}
@ -586,8 +586,8 @@ AdjustGlobal(Int sz, bool thread_copying USES_REGS)
(sizeof(MP_INT)+
(((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/CellSize;
//printf("sz *%ld* at @%ld@\n", sz, pt-H0);
Opaque_CallOnGCMark f;
Opaque_CallOnGCRelocate f2;
YAP_Opaque_CallOnGCMark f;
YAP_Opaque_CallOnGCRelocate f2;
Term t = AbsAppl(pt);
if ( (f = Yap_blob_gc_mark_handler(t)) ) {

365
C/heapgc.c
View File

File diff suppressed because it is too large Load Diff

21
C/index.c
View File

@ -633,7 +633,10 @@ type_of_verb(rest,passive).
*/
#include "absmi.h"
#include <absmi.h>
#include <Yatom.h>
#include "YapCompile.h"
#if DEBUG
#include "yapio.h"
@ -822,7 +825,7 @@ static inline int smaller_or_eq(Term t1, Term t2) {
}
static inline void clcpy(ClauseDef *d, ClauseDef *s) {
memcpy((void *)d, (void *)s, sizeof(ClauseDef));
memmove((void *)d, (void *)s, sizeof(ClauseDef));
}
static void insort(ClauseDef base[], CELL *p, CELL *q, int my_p) {
@ -2667,7 +2670,7 @@ static ClauseDef *copy_clauses(ClauseDef *max0, ClauseDef *min0, CELL *top,
save_machine_regs();
siglongjmp(cint->CompilerBotch, 4);
}
memcpy((void *)top, (void *)min0, sz);
memmove((void *)top, (void *)min0, sz);
return (ClauseDef *)top;
}
@ -2940,13 +2943,15 @@ yamop *Yap_PredIsIndexable(PredEntry *ap, UInt NSlots, yamop *next_pc) {
cint.cls = NULL;
LOCAL_Error_Size = 0;
if (ap->cs.p_code.NOfClauses < 2)
return NULL;
if ((setjres = sigsetjmp(cint.CompilerBotch, 0)) == 3) {
restore_machine_regs();
recover_from_failed_susp_on_cls(&cint, 0);
if (!Yap_gcl(LOCAL_Error_Size, ap->ArityOfPE + NSlots, ENV, next_pc)) {
CleanCls(&cint);
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return FAILCODE;
return NULL;
}
} else if (setjres == 2) {
restore_machine_regs();
@ -2954,7 +2959,7 @@ yamop *Yap_PredIsIndexable(PredEntry *ap, UInt NSlots, yamop *next_pc) {
if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
CleanCls(&cint);
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
return FAILCODE;
return NULL;
}
} else if (setjres == 4) {
restore_machine_regs();
@ -2962,7 +2967,7 @@ yamop *Yap_PredIsIndexable(PredEntry *ap, UInt NSlots, yamop *next_pc) {
if (!Yap_growtrail(LOCAL_Error_Size, FALSE)) {
CleanCls(&cint);
Yap_Error(RESOURCE_ERROR_TRAIL, TermNil, LOCAL_ErrorMessage);
return FAILCODE;
return NULL;
}
} else if (setjres != 0) {
restore_machine_regs();
@ -2970,7 +2975,7 @@ yamop *Yap_PredIsIndexable(PredEntry *ap, UInt NSlots, yamop *next_pc) {
if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
CleanCls(&cint);
return FAILCODE;
return NULL;
}
}
restart_index:
@ -2983,7 +2988,7 @@ restart_index:
if (compile_index(&cint) == (UInt)FAILCODE) {
Yap_ReleaseCMem(&cint);
CleanCls(&cint);
return FAILCODE;
return NULL;
}
#if DEBUG
if (GLOBAL_Option['i' - 'a' + 1]) {

37
C/init.c
View File

@ -75,8 +75,8 @@ static void SetOp(int, int, char *, Term);
static void InitOps(void);
static void InitDebug(void);
static void CleanBack(PredEntry *, CPredicate, CPredicate, CPredicate);
static void InitStdPreds(void);
static void InitCodes(void);
static void InitStdPreds(struct yap_boot_params *yapi);
static void InitCodes(struct yap_boot_params *yapi);
static void InitVersion(void);
void exit(int);
static void InitWorker(int wid);
@ -165,8 +165,10 @@ The following is the list of the declarations of the predefined operators:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
:-op(1200,fx,['?-', ':-']).
:-op(1200,xfx,[':-','-->']).
:-op(1150,fx,[block,dynamic,mode,public,multifile,meta_predicate,
sequential,table,initialization]).
:-op(1150,fx,[block,
discontiguous,dynamic,
initialization,mode,multifile,meta_predicate,
public,sequential,table]).
:-op(1100,xfy,[';','|']).
:-op(1050,xfy,->).
:-op(1000,xfy,',').
@ -299,7 +301,7 @@ bool Yap_dup_op(OpEntry *op, ModEntry *she) {
OpEntry *info = (OpEntry *)Yap_AllocAtomSpace(sizeof(OpEntry));
if (!info)
return false;
memcpy(info, op, sizeof(OpEntry));
memmove(info, op, sizeof(OpEntry));
info->NextForME = she->OpForME;
she->OpForME = info;
info->OpModule = MkAtomTerm(she->AtomOfME);
@ -980,12 +982,14 @@ void Yap_InitCPredBack_(const char *Name, arity_t Arity, arity_t Extra,
}
}
static void InitStdPreds(void) {
static void InitStdPreds(struct yap_boot_params *yapi)
{
CurrentModule = PROLOG_MODULE;
Yap_InitCPreds();
Yap_InitBackCPreds();
BACKUP_MACHINE_REGS();
Yap_InitFlags(false);
Yap_InitPlIO();
Yap_InitPlIO(yapi);
#if HAVE_MPE
Yap_InitMPE();
#endif
@ -1159,7 +1163,7 @@ void Yap_init_yapor_workers(void) {
worker_id = proc;
Yap_remap_yapor_memory();
LOCAL = REMOTE(worker_id);
memcpy(REMOTE(worker_id), REMOTE(0), sizeof(struct worker_local));
memmove(REMOTE(worker_id), REMOTE(0), sizeof(struct worker_local));
InitWorker(worker_id);
break;
} else
@ -1268,7 +1272,8 @@ struct worker_local *Yap_local;
struct worker_local Yap_local;
#endif
static void InitCodes(void) {
static void InitCodes(struct yap_boot_params *yapi)
{
CACHE_REGS
#if THREADS
int wid;
@ -1315,9 +1320,11 @@ const char *Yap_version(void) {
return RepAtom(AtomOfTerm(t))->StrOfAE;
}
void Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts,
void Yap_InitWorkspace(struct yap_boot_params *yapi,
UInt Heap, UInt Stack, UInt Trail, UInt Atts,
UInt max_table_size, int n_workers, int sch_loop,
int delay_load) {
int delay_load)
{
CACHE_REGS
/* initialize system stuff */
@ -1399,7 +1406,7 @@ void Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts,
#else
Yap_InitAbsmi();
#endif
InitCodes();
InitCodes(yapi);
InitOps();
InitDebug();
InitVersion();
@ -1428,8 +1435,8 @@ void Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts,
GLOBAL_AllowLocalExpansion = true;
GLOBAL_AllowTrailExpansion = true;
Yap_InitExStacks(0, Trail, Stack);
Yap_InitYaamRegs(0);
InitStdPreds();
Yap_InitYaamRegs(0, true);
InitStdPreds(yapi);
/* make sure tmp area is available */
{ Yap_ReleasePreAllocCodeSpace(Yap_PreAllocCodeSpace()); }
}
@ -1472,7 +1479,7 @@ void Yap_exit(int value) {
run_halt_hooks(value);
Yap_ShutdownLoadForeign();
}
Yap_CloseStreams(false);
Yap_CloseStreams();
Yap_CloseReadline();
#if USE_SYSTEM_MALLOC
#endif

61
C/inlines.c
View File

@ -21,10 +21,11 @@
@file inlines.c
@{
@defgroup YAP_Inlines Inlined Tests nad Ter Manipulation
@ingroup builtins
@{
*/
@ -51,6 +52,57 @@ static Int p_dif( USES_REGS1 );
static Int p_eq( USES_REGS1 );
static Int p_arg( USES_REGS1 );
static Int p_functor( USES_REGS1 );
static Int p_fail( USES_REGS1 );
static Int p_true( USES_REGS1 );
/** @pred fail is iso
Always fails. Defined as if by:
~~~~~
fail :- 2=1.
~~~~~
*/
/** @pred false is iso
The same as fail. Defined as if by:
~~~~~
false :- 2=1.
~~~~~
*/
static Int p_fail( USES_REGS1 )
{
return false;
}
/** @pred true is iso
Succeed.
Succeeds once. Defined as if by:
~~~~~
true :- true.
~~~~~
*/
/** @pred otherwise is iso
Succeed.
Succeeds once. Defined as if by:
~~~~~
otherwise.
~~~~~
*/
static Int p_true( USES_REGS1 )
{
return true;
}
/** @pred atom( _T_) is iso
@ -1150,6 +1202,11 @@ cont_genarg( USES_REGS1 )
CurrentModule = ARG_MODULE;
Yap_InitCPredBack("genarg", 3, 3, genarg, cont_genarg,SafePredFlag);
CurrentModule = cm;
}
Yap_InitCPred("true", 0, p_true, SafePredFlag);
Yap_InitCPred("otherwise", 0, p_true, SafePredFlag);
Yap_InitCPred("false", 0, p_fail, SafePredFlag);
Yap_InitCPred("fail", 0, p_fail, SafePredFlag);
}
// @}

103
C/load_dl.c
View File

@ -1,17 +1,17 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: load_dl.c *
* comments: dl based dynamic loaderr of external routines *
* tested on i486-linuxelf *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: load_dl.c *
* comments: dl based dynamic loaderr of external routines *
* tested on i486-linuxelf *
*************************************************************************/
#include "Yap.h"
#include "YapHeap.h"
@ -47,7 +47,7 @@ int Yap_CallFunctionByName(const char *thing_string) {
| RTLD_NOLOAD
#endif
#endif
);
);
// you could do RTLD_NOW as well. shouldn't matter
if (!handle) {
CACHE_REGS
@ -64,7 +64,7 @@ int Yap_CallFunctionByName(const char *thing_string) {
/*
* YAP_FindExecutable(argv[0]) should be called on yap initialization to
* locate the executable of Yap
*/
*/
char *Yap_FindExecutable(void) {
#if HAVE_GETEXECNAME
// Solaris
@ -76,11 +76,11 @@ char *Yap_FindExecutable(void) {
if (!_NSGetExecutablePath(buf, &size)) {
buf = realloc(buf, size + 1);
return buf;
} return "yap";
}
return "yap";
#elif defined(__linux__)
enum { BUFFERSIZE = 1024 };
char *buf = malloc(BUFFERSIZE);
ssize_t len = readlink("/proc/self/exe", buf, sizeof(buf) - 1);
char *buf = malloc(YAP_FILENAME_MAX);
ssize_t len = readlink("/proc/self/exe", buf, YAP_FILENAME_MAX - 1);
if (len != -1) {
buf[len] = '\0';
@ -158,74 +158,55 @@ int Yap_CloseForeignFile(void *handle) {
/*
* LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
* code files and libraries and locates an initialization routine
*/
static Int LoadForeign(StringList ofiles, StringList libs, char *proc_name,
*/
static Int LoadForeign(StringList
ofiles, StringList libs, char *proc_name,
YapInitProc *init_proc) {
CACHE_REGS
LOCAL_ErrorMessage = NULL;
while (libs) {
const char *file = AtomName(libs->name);
if (!Yap_findFile(file, NULL, NULL, LOCAL_FileNameBuf, true, YAP_OBJ, true, true)) {
/* use LD_LIBRARY_PATH */
strncpy(LOCAL_FileNameBuf, (char *)AtomName(libs->name),
YAP_FILENAME_MAX);
}
#ifdef __osf__
if ((libs->handle = dlopen(LOCAL_FileNameBuf, RTLD_LAZY)) == NULL)
#else
if ((libs->handle = dlopen(LOCAL_FileNameBuf, RTLD_LAZY | RTLD_GLOBAL)) ==
if ((libs->handle = dlopen(file, RTLD_LAZY | RTLD_GLOBAL)) ==
NULL)
#endif
{
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE);
strcpy(LOCAL_ErrorMessage, dlerror());
return LOAD_FAILLED;
if (LOCAL_ErrorMessage == NULL) {
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE);
strcpy(LOCAL_ErrorMessage, dlerror());
}
}
libs = libs->next;
}
while (ofiles) {
void *handle;
/* load libraries first so that their symbols are available to
other routines */
/* dlopen wants to follow the LD_CONFIG_PATH */
const char *file = AtomName(ofiles->name);
if (!Yap_findFile(file, NULL, NULL, LOCAL_FileNameBuf, true, YAP_OBJ, true, true)) {
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE);
strcpy(LOCAL_ErrorMessage,
"%% Trying to open unexisting file in LoadForeign");
return LOAD_FAILLED;
}
#ifdef __osf__
if ((handle = dlopen(LOCAL_FileNameBuf, RTLD_LAZY)) == 0)
#else
if ((handle = dlopen(LOCAL_FileNameBuf, RTLD_LAZY | RTLD_GLOBAL)) == 0)
#endif
if ((ofiles->handle = dlopen(file, RTLD_LAZY | RTLD_GLOBAL)) ==
NULL)
{
fprintf(stderr, "dlopen of image %s failed: %s\n", LOCAL_FileNameBuf,
dlerror());
/* strcpy(LOCAL_ErrorSay,dlerror());*/
return LOAD_FAILLED;
if (LOCAL_ErrorMessage == NULL) {
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE);
fprintf(stderr, "dlopen of image %s failed: %s\n", LOCAL_FileNameBuf,
dlerror());
}
}
ofiles->handle = handle;
if (proc_name && !*init_proc)
*init_proc = (YapInitProc)dlsym(handle, proc_name);
if (ofiles->handle && proc_name && !*init_proc)
*init_proc = (YapInitProc)dlsym(ofiles->handle, proc_name);
ofiles = ofiles->next;
}
if (!*init_proc) {
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE);
snprintf(LOCAL_ErrorMessage,
"Could not locate routine %s in %s: %s\n",
proc_name, LOCAL_FileNameBuf, dlerror());
fprintf(stderr,
"Could not locate routine %s in %s: %s\n",
proc_name, LOCAL_FileNameBuf, dlerror());
if (!*init_proc && LOCAL_ErrorMessage == NULL) {
char *buf = malloc(1058);
snprintf(buf, 1058 - 1, "Could not locate routine %s in %s: %s\n",
proc_name, LOCAL_FileNameBuf, dlerror());
return LOAD_FAILLED;
}

188
C/load_foreign.c
View File

@ -13,15 +13,14 @@
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%.2";
static char SccsId[] = "%W% %G%.2";
#endif
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "yapio.h"
#include "YapText.h"
#include "Yatom.h"
#include "yapio.h"
#include <stdlib.h>
#if HAVE_STRING_H
#include <string.h>
@ -35,11 +34,9 @@ static char SccsId[] = "%W% %G%.2";
#endif
#endif
Int p_load_foreign( USES_REGS1 );
Int p_load_foreign(USES_REGS1);
Int
p_load_foreign( USES_REGS1 )
{
Int p_load_foreign(USES_REGS1) {
StringList ofiles = NULL;
StringList libs = NULL;
char *InitProcName;
@ -48,18 +45,22 @@ p_load_foreign( USES_REGS1 )
StringList new;
bool returncode = FALSE;
yhandle_t CurSlot = Yap_StartSlots();
#if __ANDROID__
return true;
#endif
// Yap_DebugPlWrite(ARG1); printf("%s\n", " \n");
//Yap_DebugPlWrite(ARG2); printf("%s\n", " \n");
//ap_DebugPlWrite(ARG3); printf("%s\n", " \n");
// Yap_DebugPlWrite(ARG2); printf("%s\n", " \n");
// ap_DebugPlWrite(ARG3); printf("%s\n", " \n");
/* collect the list of object files */
t = Deref(ARG1);
while(1) {
if (t == TermNil) break;
while (1) {
if (t == TermNil)
break;
t1 = HeadOfTerm(t);
t = TailOfTerm(t);
new = (StringList) Yap_AllocCodeSpace(sizeof(StringListItem));
new = (StringList)Yap_AllocCodeSpace(sizeof(StringListItem));
new->next = ofiles;
new->name = AtomOfTerm(t1);
ofiles = new;
@ -67,11 +68,12 @@ p_load_foreign( USES_REGS1 )
/* collect the list of library files */
t = Deref(ARG2);
while(1) {
if (t == TermNil) break;
while (1) {
if (t == TermNil)
break;
t1 = HeadOfTerm(t);
t = TailOfTerm(t);
new = (StringList) Yap_AllocCodeSpace(sizeof(StringListItem));
new = (StringList)Yap_AllocCodeSpace(sizeof(StringListItem));
new->next = libs;
new->name = AtomOfTerm(t1);
libs = new;
@ -82,17 +84,30 @@ p_load_foreign( USES_REGS1 )
InitProcName = (char *)RepAtom(AtomOfTerm(t1))->StrOfAE;
// verify if it was waiting for initialization
if (Yap_LateInit( InitProcName ) ){
returncode = true;
} else
/* call the OS specific function for dynamic loading */
if(Yap_LoadForeign(ofiles,libs,InitProcName,&InitProc)==LOAD_SUCCEEDED) {
Yap_StartSlots( );
if (Yap_LateInit(InitProcName)) {
returncode = true;
} else
/* call the OS specific function for dynamic loading */
if (Yap_LoadForeign(ofiles, libs, InitProcName, &InitProc) ==
LOAD_SUCCEEDED) {
if (InitProc == NULL) {
char *f;
if (ofiles) {
f = RepAtom(ofiles->name)->StrOfAE;
} else {
f = RepAtom(libs->name)->StrOfAE;
}
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG3,
"Foreign module %s does not have initialization function %s", f,
InitProcName);
return false;
}
Yap_StartSlots();
(*InitProc)();
Yap_CloseSlots(CurSlot);
returncode = true;
}
/* I should recover space if load foreign fails */
if (returncode == TRUE) {
ForeignObj *f_code = (ForeignObj *)Yap_AllocCodeSpace(sizeof(ForeignObj));
@ -117,61 +132,60 @@ p_load_foreign( USES_REGS1 )
return returncode;
}
static Int
p_open_shared_object( USES_REGS1 ) {
static Int p_open_shared_object(USES_REGS1) {
Term t = Deref(ARG1);
Term tflags = Deref(ARG2);
char *s;
void *handle;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t,"open_shared_object/3");
Yap_Error(INSTANTIATION_ERROR, t, "open_shared_object/3");
return FALSE;
}
}
if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM,t,"open_shared_object/3");
Yap_Error(TYPE_ERROR_ATOM, t, "open_shared_object/3");
return FALSE;
}
if (IsVarTerm(tflags)) {
Yap_Error(INSTANTIATION_ERROR,tflags,"open_shared_object/3");
return FALSE;
}
if (!IsIntegerTerm(tflags)) {
Yap_Error(TYPE_ERROR_INTEGER,tflags,"open_shared_object/3");
Yap_Error(INSTANTIATION_ERROR, tflags, "open_shared_object/3");
return FALSE;
}
if (!IsIntegerTerm(tflags)) {
Yap_Error(TYPE_ERROR_INTEGER, tflags, "open_shared_object/3");
return FALSE;
}
s = (char *)RepAtom(AtomOfTerm(t))->StrOfAE;
if ((handle = Yap_LoadForeignFile(s, IntegerOfTerm(tflags)))==NULL) {
Yap_Error(EXISTENCE_ERROR_SOURCE_SINK,t,"open_shared_object_failed for %s"
" with %s\n", s, LOCAL_ErrorMessage);
if ((handle = Yap_LoadForeignFile(s, IntegerOfTerm(tflags))) == NULL) {
Yap_Error(EXISTENCE_ERROR_SOURCE_SINK, t,
"open_shared_object_failed for %s"
" with %s\n",
s, LOCAL_ErrorMessage);
return FALSE;
} else {
return Yap_unify(MkIntegerTerm((Int)handle),ARG3);
return Yap_unify(MkIntegerTerm((Int)handle), ARG3);
}
}
static Int
p_close_shared_object( USES_REGS1 ) {
static Int p_close_shared_object(USES_REGS1) {
Term t = Deref(ARG1);
void *handle;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t,"close_shared_object/1");
Yap_Error(INSTANTIATION_ERROR, t, "close_shared_object/1");
return FALSE;
}
}
if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER,t,"close_shared_object/1");
Yap_Error(TYPE_ERROR_INTEGER, t, "close_shared_object/1");
return FALSE;
}
handle = (char *)IntegerOfTerm(t);
return Yap_CloseForeignFile(handle);
}
static Int
p_call_shared_object_function( USES_REGS1 ) {
static Int p_call_shared_object_function(USES_REGS1) {
Term t = Deref(ARG1);
Term tfunc = Deref(ARG2);
Term tmod;
@ -180,51 +194,51 @@ p_call_shared_object_function( USES_REGS1 ) {
Int res;
tmod = CurrentModule;
restart:
restart:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t,"call_shared_object_function/2");
Yap_Error(INSTANTIATION_ERROR, t, "call_shared_object_function/2");
return FALSE;
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
Functor fun = FunctorOfTerm(t);
if (fun == FunctorModule) {
tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod) ) {
Yap_Error(INSTANTIATION_ERROR,t,"call_shared_object_function/2");
return FALSE;
if (IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR, t, "call_shared_object_function/2");
return FALSE;
}
if (!IsAtomTerm(tmod) ) {
Yap_Error(TYPE_ERROR_ATOM,ARG1,"call_shared_object_function/2");
return FALSE;
if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG1, "call_shared_object_function/2");
return FALSE;
}
t = ArgOfTerm(2, t);
goto restart;
}
} else if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER,t,"call_shared_object_function/2");
Yap_Error(TYPE_ERROR_INTEGER, t, "call_shared_object_function/2");
return FALSE;
}
handle = (void *)IntegerOfTerm(t);
if (IsVarTerm(tfunc)) {
Yap_Error(INSTANTIATION_ERROR,t,"call_shared_object_function/2");
Yap_Error(INSTANTIATION_ERROR, t, "call_shared_object_function/2");
return FALSE;
}
}
if (!IsAtomTerm(tfunc)) {
Yap_Error(TYPE_ERROR_ATOM,t,"call_shared_object_function/2/3");
Yap_Error(TYPE_ERROR_ATOM, t, "call_shared_object_function/2/3");
return FALSE;
}
CurrentModule = tmod;
res = Yap_CallForeignFile(handle, (char *)RepAtom(AtomOfTerm(tfunc))->StrOfAE);
res =
Yap_CallForeignFile(handle, (char *)RepAtom(AtomOfTerm(tfunc))->StrOfAE);
CurrentModule = OldCurrentModule;
return res;
}
static Int
p_obj_suffix( USES_REGS1 ) {
return Yap_unify(Yap_CharsToListOfCodes(SO_EXT, ENC_ISO_LATIN1 PASS_REGS),ARG1);
static Int p_obj_suffix(USES_REGS1) {
return Yap_unify(Yap_CharsToListOfCodes(SO_EXT, ENC_ISO_LATIN1 PASS_REGS),
ARG1);
}
static Int
p_open_shared_objects( USES_REGS1 ) {
static Int p_open_shared_objects(USES_REGS1) {
#ifdef SO_EXT
return TRUE;
#else
@ -232,26 +246,25 @@ p_open_shared_objects( USES_REGS1 ) {
#endif
}
void
Yap_InitLoadForeign( void )
{
Yap_InitCPred("$load_foreign_files", 3, p_load_foreign, SafePredFlag|SyncPredFlag);
void Yap_InitLoadForeign(void) {
Yap_InitCPred("$load_foreign_files", 3, p_load_foreign,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$open_shared_objects", 0, p_open_shared_objects, SafePredFlag);
Yap_InitCPred("$open_shared_object", 3, p_open_shared_object, SyncPredFlag);
Yap_InitCPred("close_shared_object", 1, p_close_shared_object, SyncPredFlag|SafePredFlag);
/** @pred close_shared_object(+ _Handle_)
Yap_InitCPred("close_shared_object", 1, p_close_shared_object,
SyncPredFlag | SafePredFlag);
/** @pred close_shared_object(+ _Handle_)
Detach the shared object identified by _Handle_.
Detach the shared object identified by _Handle_.
*/
Yap_InitCPred("$call_shared_object_function", 2, p_call_shared_object_function, SyncPredFlag);
*/
Yap_InitCPred("$call_shared_object_function", 2,
p_call_shared_object_function, SyncPredFlag);
Yap_InitCPred("$obj_suffix", 1, p_obj_suffix, SafePredFlag);
}
void
Yap_ReOpenLoadForeign(void)
{
void Yap_ReOpenLoadForeign(void) {
CACHE_REGS
ForeignObj *f_code = ForeignCodeLoaded;
Term OldModule = CurrentModule;
@ -260,19 +273,18 @@ Yap_ReOpenLoadForeign(void)
YapInitProc InitProc = NULL;
CurrentModule = f_code->module;
if(Yap_ReLoadForeign(f_code->objs,f_code->libs,(char *)RepAtom(f_code->f)->StrOfAE,&InitProc)==LOAD_SUCCEEDED) {
if (Yap_ReLoadForeign(f_code->objs, f_code->libs,
(char *)RepAtom(f_code->f)->StrOfAE,
&InitProc) == LOAD_SUCCEEDED) {
if (InitProc)
(*InitProc)();
(*InitProc)();
}
f_code = f_code->next;
}
CurrentModule = OldModule;
}
X_API bool load_none(void)
{
return true;
}

4
C/meta_absmi_insts.h
View File

@ -116,7 +116,7 @@
}
pen = RepPredProp(PredPropByFunc(f, mod));
execute_pred_f:
if (pen->PredFlags & MetaPredFlag) {
if (pen->PredFlags & (MetaPredFlag|UndefPredFlag)) {
/* just strip all of M:G */
if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,d0);
@ -242,7 +242,7 @@
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (pen->ModuleOfPred) {
if (DEPTH == MkIntTerm(0)) {
FAIL();
FAIL();
} else {
DEPTH = RESET_DEPTH();
}

107
C/modules.c
View File

@ -14,6 +14,8 @@
* comments: module support *
* *
*************************************************************************/
#ifdef SCCSLookupSystemModule
static char SccsId[] = "%W% %G%";
#endif
@ -50,9 +52,11 @@ static ModEntry *initMod(AtomEntry *toname, AtomEntry *ae) {
INIT_RWLOCK(n->ModRWLock);
n->KindOfPE = ModProperty;
n->PredForME = NULL;
n->OpForME = NULL;
n->NextME = CurrentModules;
CurrentModules = n;
n->AtomOfME = ae;
n->NextOfPE = NULL;
n->OwnerFile = Yap_ConsultingFile(PASS_REGS1);
AddPropToAtom(ae, (PropEntry *)n);
Yap_setModuleFlags(n, parent);
@ -257,7 +261,7 @@ static Int change_module(USES_REGS1) { /* $change_module(N) */
}
static Int current_module1(USES_REGS1) { /* $current_module(Old)
*/
*/
if (CurrentModule)
return Yap_unify_constant(ARG1, CurrentModule);
return Yap_unify_constant(ARG1, TermProlog);
@ -372,57 +376,58 @@ static Int new_system_module(USES_REGS1) {
}
static Int strip_module(USES_REGS1) {
Term t1 = Deref(ARG1), tmod = CurrentModule;
if (tmod == PROLOG_MODULE) {
tmod = TermProlog;
}
t1 = Yap_StripModule(t1, &tmod);
if (!t1) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return FALSE;
}
return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod);
Term t1 = Deref(ARG1), tmod = CurrentModule;
if (tmod == PROLOG_MODULE) {
tmod = TermProlog;
}
t1 = Yap_StripModule(t1, &tmod);
if (!t1) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return FALSE;
}
return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod);
}
static Int yap_strip_clause(USES_REGS1) {
Functor f;
Term t1 = Deref(ARG1), tmod = LOCAL_SourceModule;
if (tmod == PROLOG_MODULE) {
tmod = TermProlog;
Term t1 = Deref(ARG1), tmod = LOCAL_SourceModule;
if (tmod == PROLOG_MODULE) {
tmod = TermProlog;
}
t1 = Yap_StripModule(t1, &tmod);
if (IsVarTerm(t1) || IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR, t1, "trying to obtain module");
return false;
} else if (IsApplTerm(t1)) {
Functor f = FunctorOfTerm(t1);
if (IsExtensionFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return false;
}
t1 = Yap_StripModule(t1, &tmod);
if (IsVarTerm(t1)) {
if (f == FunctorAssert || f == FunctorDoubleArrow) {
Term thmod = tmod;
Term th = ArgOfTerm(1, t1);
th = Yap_StripModule(th, &thmod);
if (IsVarTerm(th)) {
Yap_Error(INSTANTIATION_ERROR, t1, "trying to obtain module");
return false;
} else if (IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR, tmod, "trying to obtain module");
} else if (IsVarTerm(thmod)) {
Yap_Error(INSTANTIATION_ERROR, thmod, "trying to obtain module");
return false;
} else if (IsIntTerm(t1) || (IsApplTerm(t1) && IsExtensionFunctor((f = FunctorOfTerm(t1))))) {
} else if (IsIntTerm(th) ||
(IsApplTerm(th) && IsExtensionFunctor(FunctorOfTerm(t1)))) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return false;
} else if (!IsAtomTerm(thmod)) {
Yap_Error(TYPE_ERROR_ATOM, thmod, "trying to obtain module");
return false;
}
}
} else if (IsIntTerm(t1) || IsIntTerm(tmod)) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return false;
} else if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, tmod, "trying to obtain module");
return false;
}
if (f == FunctorAssert || f == FunctorDoubleArrow) {
Term thmod = tmod;
Term th = ArgOfTerm(1, t1);
th = Yap_StripModule(th, &thmod);
if (IsVarTerm(th)) {
Yap_Error(INSTANTIATION_ERROR, t1, "trying to obtain module");
return false;
} else if (IsVarTerm(thmod)) {
Yap_Error(INSTANTIATION_ERROR, thmod, "trying to obtain module");
return false;
} else if (IsIntTerm(th) || (IsApplTerm(th) && IsExtensionFunctor(FunctorOfTerm(t1)))) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return false;
}else if (!IsAtomTerm(thmod)) {
Yap_Error(TYPE_ERROR_ATOM, thmod, "trying to obtain module");
return false;
}
}
return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod);
}
return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod);
}
Term Yap_YapStripModule(Term t, Term *modp) {
@ -502,7 +507,7 @@ static Int context_module(USES_REGS1) {
* @param Mod is the current text source module.
*
* : _Mod_ is the current read-in or source module.
*/
*/
static Int source_module(USES_REGS1) {
if (LOCAL_SourceModule == PROLOG_MODULE) {
return Yap_unify(ARG1, TermProlog);
@ -516,7 +521,7 @@ static Int source_module(USES_REGS1) {
* @param Mod is the current text source module.
*
* : _Mod_ is the current read-in or source module.
*/
*/
static Int current_source_module(USES_REGS1) {
Term t;
if (LOCAL_SourceModule == PROLOG_MODULE) {
@ -607,14 +612,15 @@ void Yap_InitModulesC(void) {
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$change_module", 1, change_module,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("strip_module", 3, strip_module, SafePredFlag | SyncPredFlag);
Yap_InitCPred("$yap_strip_module", 3, yap_strip_module, SafePredFlag | SyncPredFlag);
Yap_InitCPred("strip_module", 3, strip_module, SafePredFlag | SyncPredFlag);
Yap_InitCPred("$yap_strip_module", 3, yap_strip_module,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("source_module", 1, source_module, SafePredFlag | SyncPredFlag);
Yap_InitCPred("current_source_module", 2, current_source_module,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$yap_strip_clause", 3, yap_strip_clause,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("context_module", 1, context_module, 0);
Yap_InitCPred("$yap_strip_clause", 3, yap_strip_clause,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("context_module", 1, context_module, 0);
Yap_InitCPred("$is_system_module", 1, is_system_module, SafePredFlag);
Yap_InitCPred("$copy_operators", 2, copy_operators, 0);
Yap_InitCPred("new_system_module", 1, new_system_module, SafePredFlag);
@ -626,6 +632,7 @@ void Yap_InitModulesC(void) {
void Yap_InitModules(void) {
CACHE_REGS
CurrentModules = NULL;
LookupSystemModule(MkAtomTerm(AtomProlog));
LOCAL_SourceModule = MkAtomTerm(AtomProlog);
LookupModule(USER_MODULE);

261
C/parser.c
View File

@ -1,144 +1,29 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: parser.c *
* Last rev: *
* mods: *
* comments: Prolog's parser *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: parser.c *
* Last rev: *
* mods: *
* comments: Prolog's parser *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
/**
@addtogroup YAPSyntax
describe the syntax for Prolog terms. In a second level we describe
the \a tokens from which Prolog \a terms are
built.
@defgroup Formal_Syntax Syntax of Terms
@ingroup YAPSyntax
@{
Below, we describe the syntax of YAP terms from the different
classes of tokens defined above. The formalism used will be <em>BNF</em>,
extended where necessary with attributes denoting integer precedence or
operator type.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
term
----> subterm(1200) end_of_term_marker
subterm(N) ----> term(M) [M <= N]
term(N) ----> op(N, fx) subterm(N-1)
| op(N, fy) subterm(N)
| subterm(N-1) op(N, xfx) subterm(N-1)
| subterm(N-1) op(N, xfy) subterm(N)
| subterm(N) op(N, yfx) subterm(N-1)
| subterm(N-1) op(N, xf)
| subterm(N) op(N, yf)
term(0) ----> atom '(' arguments ')'
| '(' subterm(1200) ')'
| '{' subterm(1200) '}'
| list
| string
| number
| atom
| variable
arguments ----> subterm(999)
| subterm(999) ',' arguments
list ----> '[]'
| '[' list_expr ']'
list_expr ----> subterm(999)
| subterm(999) list_tail
list_tail ----> ',' list_expr
| ',..' subterm(999)
| '|' subterm(999)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Notes:
+ \a op(N,T) denotes an atom which has been previously declared with type
\a T and base precedence \a N.
+ Since ',' is itself a pre-declared operator with type \a xfy and
precedence 1000, is \a subterm starts with a '(', \a op must be
followed by a space to avoid ambiguity with the case of a functor
followed by arguments, e.g.:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ (a,b) [the same as '+'(','(a,b)) of arity one]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
versus
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+(a,b) [the same as '+'(a,b) of arity two]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
In the first rule for term(0) no blank space should exist between
\a atom and '('.
+
Each term to be read by the YAP parser must end with a single
dot, followed by a blank (in the sense mentioned in the previous
paragraph). When a name consisting of a single dot could be taken for
the end of term marker, the ambiguity should be avoided by surrounding the
dot with single quotes.
@}
*/
/*
* Description:
*
* parser: produces a prolog term from an array of tokens
*
* parser usage: the parser takes its input from an array of token descriptions
* addressed by the global variable 'tokptr' and produces a Term as result. A
* macro 'NextToken' should be defined in 'yap.h' for advancing 'tokptr' from
* one token to the next. In the distributed version this macro also updates
* a variable named 'toktide' for keeping track of how far the parser went
* before failling with a syntax error. The parser should be invoked with
* 'tokptr' pointing to the first token. The last token should have type
* 'eot_tok'. The parser return either a Term. Syntactic errors are signaled
* by a return value 0. The parser builds new terms on the 'global stack' and
* also uses an auxiliary stack pointed to by 'AuxSp'. In the distributed
* version this auxiliary stack is assumed to grow downwards. This
* assumption, however, is only relevant to routine 'ParseArgs', and to the
* variable toktide. conclusion: set tokptr pointing to first token set AuxSp
* Call Parse
*
* VSC: Working whithout known bugs in 87/4/6
*
* LD: -I or +I evaluated by parser 87/4/28
*
* LD: parser extended 87/4/28
*
*/
#include "Yap.h"
#include "YapEval.h"
#include "YapHeap.h"
#include "YapText.h"
#include "Yatom.h"
#include "YapEval.h"
#include "yapio.h"
/* stuff we want to use in standard YAP code */
#include "iopreds.h"
@ -157,7 +42,9 @@ dot with single quotes.
/* weak backtraking mechanism based on long_jump */
typedef struct jmp_buff_struct { sigjmp_buf JmpBuff; } JMPBUFF;
typedef struct jmp_buff_struct {
sigjmp_buf JmpBuff;
} JMPBUFF;
static void GNextToken(CACHE_TYPE1);
static void checkfor(Term, JMPBUFF *, encoding_t CACHE_TYPE);
@ -165,19 +52,20 @@ static Term ParseArgs(Atom, Term, JMPBUFF *, Term, encoding_t, Term CACHE_TYPE);
static Term ParseList(JMPBUFF *, encoding_t, Term CACHE_TYPE);
static Term ParseTerm(int, JMPBUFF *, encoding_t, Term CACHE_TYPE);
extern Term Yap_tokRep(void* tokptr);
extern const char * Yap_tokText(void *tokptr);
extern Term Yap_tokRep(void *tokptr);
extern const char *Yap_tokText(void *tokptr);
static void syntax_msg(const char *msg, ...) {
CACHE_REGS
va_list ap;
if (!LOCAL_ErrorMessage ||
(LOCAL_Error_TYPE == SYNTAX_ERROR &&
LOCAL_ActiveError->prologParserLine < LOCAL_tokptr->TokPos)) {
LOCAL_tokptr->TokPos < LOCAL_ActiveError->parserPos)) {
if (!LOCAL_ErrorMessage) {
LOCAL_ErrorMessage = malloc(1024 + 1);
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE + 1);
}
LOCAL_ActiveError->prologParserLine = 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);
@ -226,7 +114,7 @@ static void syntax_msg(const char *msg, ...) {
#define FAIL siglongjmp(FailBuff->JmpBuff, 1)
VarEntry *Yap_LookupVar(const char *var) /* lookup variable in variables table
* */
* */
{
CACHE_REGS
VarEntry *p;
@ -299,7 +187,7 @@ static Term VarNames(VarEntry *p, Term l USES_REGS) {
VarNames(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP - 4096) {
save_machine_regs();
longjmp(*LOCAL_IOBotch, 1);
longjmp(LOCAL_IOBotch, 1);
}
return (o);
} else {
@ -329,7 +217,7 @@ static Term Singletons(VarEntry *p, Term l USES_REGS) {
Singletons(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP - 4096) {
save_machine_regs();
longjmp(*LOCAL_IOBotch, 1);
longjmp(LOCAL_IOBotch, 1);
}
return (o);
} else {
@ -354,7 +242,7 @@ static Term Variables(VarEntry *p, Term l USES_REGS) {
Variables(p->VarRight, Variables(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP - 4096) {
save_machine_regs();
siglongjmp(*LOCAL_IOBotch, 1);
siglongjmp(LOCAL_IOBotch, 1);
}
return (o);
} else {
@ -364,7 +252,7 @@ static Term Variables(VarEntry *p, Term l USES_REGS) {
Term Yap_Variables(VarEntry *p, Term l) {
CACHE_REGS
l = Variables(LOCAL_AnonVarTable, l PASS_REGS);
l = Variables(LOCAL_AnonVarTable, l PASS_REGS);
return Variables(p, l PASS_REGS);
}
@ -468,7 +356,7 @@ inline static void checkfor(Term c, JMPBUFF *FailBuff,
strncpy(s, Yap_tokText(LOCAL_tokptr), 1023);
syntax_msg("line %d: expected to find "
"\'%c....................................\', found %s",
LOCAL_tokptr->TokPos, c, s);
LOCAL_tokptr->TokLine, c, s);
FAIL;
}
NextToken;
@ -549,12 +437,12 @@ static Term ParseArgs(Atom a, Term close, JMPBUFF *FailBuff, Term arg1,
func = Yap_MkFunctor(a, 1);
if (func == NULL) {
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokLine);
FAIL;
}
t = Yap_MkApplTerm(func, nargs, p);
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
return TermNil;
}
NextToken;
@ -564,7 +452,7 @@ static Term ParseArgs(Atom a, Term close, JMPBUFF *FailBuff, Term arg1,
while (1) {
Term *tp = (Term *)ParserAuxSp;
if (ParserAuxSp + 1 > LOCAL_TrailTop) {
syntax_msg("line %d: Trail Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Trail Overflow", LOCAL_tokptr->TokLine);
FAIL;
}
*tp++ = Unsigned(ParseTerm(999, FailBuff, enc, cmod PASS_REGS));
@ -582,12 +470,12 @@ static Term ParseArgs(Atom a, Term close, JMPBUFF *FailBuff, Term arg1,
* order
*/
if (HR > ASP - (nargs + 1)) {
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
FAIL;
}
func = Yap_MkFunctor(a, nargs);
if (func == NULL) {
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokLine);
FAIL;
}
#ifdef SFUNC
@ -602,7 +490,7 @@ static Term ParseArgs(Atom a, Term close, JMPBUFF *FailBuff, Term arg1,
t = Yap_MkApplTerm(func, nargs, p);
#endif
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
return TermNil;
}
/* check for possible overflow against local stack */
@ -611,8 +499,8 @@ static Term ParseArgs(Atom a, Term close, JMPBUFF *FailBuff, Term arg1,
}
static Term MakeAccessor(Term t, Functor f USES_REGS) {
UInt arity = ArityOfFunctor(FunctorOfTerm(t));
int i;
UInt arity = ArityOfFunctor(FunctorOfTerm(t));
int i;
Term tf[2], tl = TermNil;
tf[1] = ArgOfTerm(1, t);
@ -638,7 +526,7 @@ loop:
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
to_store[1] = TermNil;
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
FAIL;
} else {
to_store[1] = AbsPair(HR);
@ -653,7 +541,7 @@ loop:
}
} else {
syntax_msg("line %d: looking for symbol ',','|' got symbol '%s'",
LOCAL_tokptr->TokPos, Yap_tokText(LOCAL_tokptr));
LOCAL_tokptr->TokLine, Yap_tokText(LOCAL_tokptr));
FAIL;
}
return (o);
@ -725,13 +613,13 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
TRY(
/* build appl on the heap */
func = Yap_MkFunctor(AtomOfTerm(t), 1); if (func == NULL) {
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokLine);
FAIL;
} t = ParseTerm(oprprio, FailBuff, enc, cmod PASS_REGS);
t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
FAIL;
} curprio = opprio;
, break;)
@ -762,7 +650,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
break;
case Error_tok:
syntax_msg("line %d: found ill-formed \"%s\"", LOCAL_tokptr->TokPos,
syntax_msg("line %d: found ill-formed \"%s\"", LOCAL_tokptr->TokLine,
Yap_tokText(LOCAL_tokptr));
FAIL;
@ -798,14 +686,14 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
t = Yap_MkApplTerm(FunctorBraces, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
FAIL;
}
checkfor(TermEndCurlyBracket, FailBuff, enc PASS_REGS);
break;
default:
syntax_msg("line %d: unexpected ponctuation signal %s",
LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr));
LOCAL_tokptr->TokLine, Yap_tokRep(LOCAL_tokptr));
FAIL;
}
break;
@ -896,7 +784,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
NextToken;
break;
default:
syntax_msg("line %d: expected operator, got \'%s\'", LOCAL_tokptr->TokPos,
syntax_msg("line %d: expected operator, got \'%s\'", LOCAL_tokptr->TokLine,
Yap_tokText(LOCAL_tokptr));
FAIL;
}
@ -912,9 +800,8 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
/* try parsing as infix operator */
Volatile int oldprio = curprio;
TRY3(
func = Yap_MkFunctor(save_opinfo, 2);
if (func == NULL) {
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokPos);
func = Yap_MkFunctor(save_opinfo, 2); if (func == NULL) {
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokLine);
FAIL;
} NextToken;
{
@ -924,7 +811,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
t = Yap_MkApplTerm(func, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
FAIL;
}
},
@ -937,13 +824,13 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
/* parse as posfix operator */
Functor func = Yap_MkFunctor(AtomOfTerm(LOCAL_tokptr->TokInfo), 1);
if (func == NULL) {
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokLine);
FAIL;
}
t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
FAIL;
}
curprio = opprio;
@ -953,7 +840,8 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
break;
}
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (LOCAL_tokptr->TokInfo == TermComma && prio >= 1000 && curprio <= 999) {
if (LOCAL_tokptr->TokInfo == TermComma && prio >= 1000 &&
curprio <= 999) {
Volatile Term args[2];
NextToken;
args[0] = t;
@ -961,7 +849,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
t = Yap_MkApplTerm(FunctorComma, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
FAIL;
}
curprio = 1000;
@ -977,7 +865,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
t = Yap_MkApplTerm(FunctorVBar, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
FAIL;
}
curprio = opprio;
@ -1000,19 +888,18 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
curprio = opprio;
continue;
} else if (LOCAL_tokptr->TokInfo == TermBeginCurlyBracket &&
IsPosfixOp(AtomBraces, &opprio, &oplprio,
cmod PASS_REGS) &&
IsPosfixOp(AtomBraces, &opprio, &oplprio, cmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomBraces, TermEndCurlyBracket, FailBuff, t,
enc, cmod PASS_REGS);
t = ParseArgs(AtomBraces, TermEndCurlyBracket, FailBuff, t, enc,
cmod PASS_REGS);
t = MakeAccessor(t, FunctorBraces PASS_REGS);
curprio = opprio;
continue;
}
}
if (LOCAL_tokptr->Tok <= Ord(String_tok)) {
syntax_msg("line %d: expected operator, got \'%s\'", LOCAL_tokptr->TokPos,
Yap_tokText(LOCAL_tokptr));
syntax_msg("line %d: expected operator, got \'%s\'",
LOCAL_tokptr->TokLine, Yap_tokText(LOCAL_tokptr));
FAIL;
}
break;
@ -1022,18 +909,24 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) {
CACHE_REGS
// ensure that if we throw an exception
// t will be 0.
// 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
if (GLOBAL_Option['p' - 'a' + 1]) {
Yap_DebugPlWrite(MkIntTerm(LOCAL_tokptr->TokLine));
Yap_DebugPutc(stderr, '[');
if (t == 0)
Yap_DebugPlWrite(MkIntTerm(0));
@ -1046,12 +939,16 @@ Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) {
Yap_CloseSlots(sls);
}
if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) {
LOCAL_Error_TYPE = SYNTAX_ERROR;
if (LOCAL_tokptr->TokNext) {
LOCAL_ErrorMessage = "operator misssing . ";
} else {
LOCAL_ErrorMessage = "term does not end on . ";
}
LOCAL_Error_TYPE = SYNTAX_ERROR;
if (LOCAL_tokptr->TokNext) {
size_t sz = strlen("bracket or operator expected.");
LOCAL_ErrorMessage =malloc(sz+1);
strncpy(LOCAL_ErrorMessage, "bracket or operator expected.", sz );
} else {
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;
}
if (t != 0 && LOCAL_Error_TYPE == SYNTAX_ERROR) {

141
C/qlyr.c
View File

@ -1,20 +1,20 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- *
* *
**************************************************************************
* *
* File: qlyr.c *
* comments: quick saver/loader *
* *
* Last rev: $Date: 2011-08-29$,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- *
* *
**************************************************************************
* *
* File: qlyr.c *
* comments: quick saver/loader *
* *
* Last rev: $Date: 2011-08-29$,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* *
*************************************************************************/
/**
*
* @file qlyr.c
@ -79,11 +79,18 @@ static char *Yap_AlwaysAllocCodeSpace(UInt size) {
return out;
}
static void QLYR_ERROR(qlfr_err_t my_err) {
#define QLYR_ERROR(err) \
QLYR_ERROR__(__FILE__, __FUNCTION__, __LINE__, err)
static void QLYR_ERROR__(const char *file, const char *function, int lineno,
qlfr_err_t my_err) {
// __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %s in saved state
// %s",GLOBAL_RestoreFile, qlyr_error[my_err]);
Yap_Error(SYSTEM_ERROR_SAVED_STATE, TermNil, "error %s in saved state %s",
GLOBAL_RestoreFile, qlyr_error[my_err]);
Yap_Error__(false, file, function, lineno, SYSTEM_ERROR_SAVED_STATE, TermNil, "error %s in saved state %s",
GLOBAL_RestoreFile, qlyr_error[my_err]);
Yap_exit(1);
}
@ -590,8 +597,32 @@ static void RestoreHashPreds(USES_REGS1) {}
static void RestoreAtomList(Atom atm USES_REGS) {}
static bool maybe_read_bytes(FILE *stream, void *ptr, size_t sz) {
do {
size_t count;
if ((count = fread(ptr, 1, sz, stream)) == sz)
return true;
if (feof(stream) || ferror(stream))
return false;
sz -= count;
ptr += count;
} while (true);
}
static size_t read_bytes(FILE *stream, void *ptr, size_t sz) {
return fread(ptr, sz, 1, stream);
do {
size_t count = fread(ptr, 1, sz, stream);
if (count == sz)
return sz;
if (feof(stream)) {
PlIOError(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM, TermNil, "read_qly/3: expected %ld bytes got %ld", sz, count);
return 0;
} else if (ferror(stream)) {
PlIOError(PERMISSION_ERROR_INPUT_STREAM, TermNil, "read_qly/3: expected %ld bytes got error %s", sz, strerror(errno));
return 0;
}
sz -= count;
} while(true);
}
static unsigned char read_byte(FILE *stream) { return getc(stream); }
@ -625,34 +656,26 @@ static pred_flags_t read_predFlags(FILE *stream) {
return v;
}
static bool checkChars(FILE *stream, char s[]) {
int ch, c;
char *p = s;
while ((ch = *p++)) {
if ((c = read_byte(stream)) != ch) {
return false;
}
}
return TRUE;
}
static Atom do_header(FILE *stream) {
char s[256], *p = s, ch;
char s[2049], *p = s, *q;
char h0[] = "#!/bin/sh\nexec_dir=${YAPBINDIR:-";
char h1[] = "exec $exec_dir/yap $0 \"$@\"\nsaved ";
Atom at;
if (!checkChars(stream, "#!/bin/sh\nexec_dir=${YAPBINDIR:-"))
if (!maybe_read_bytes( stream, s, 2048) )
return NIL;
while ((ch = read_byte(stream)) != '\n')
;
if (!checkChars(stream, "exec $exec_dir/yap $0 \"$@\"\nsaved "))
if (strstr(s, h0)!= s)
return NIL;
while ((ch = read_byte(stream)) != ',')
*p++ = ch;
*p++ = '\0';
at = Yap_LookupAtom(s);
while ((ch = read_byte(stream)))
;
if ((p=strstr(s, h1)) == NULL) {
return NIL;
}
p += strlen(h1);
q = strchr(p,',');
if (!q)
return NIL;
q[0] = '\0';
at = Yap_LookupAtom(p);
return at;
}
@ -667,13 +690,22 @@ static Int get_header(USES_REGS1) {
return FALSE;
}
if (!(stream = Yap_GetInputStream(t1, "header scanning in qload"))) {
return FALSE;
return false;
}
if ((at = do_header(stream)) == NIL)
rc = FALSE;
else
sigjmp_buf signew, *sighold = LOCAL_RestartEnv;
LOCAL_RestartEnv = &signew;
if (sigsetjmp(signew, 1) != 0) {
LOCAL_RestartEnv = sighold;
return false;
}
if ((at = do_header(stream)) == NIL)
rc = false;
else {
rc = Yap_unify(ARG2, MkAtomTerm(at));
return rc;
}
LOCAL_RestartEnv = sighold;
return rc;
}
static void ReadHash(FILE *stream) {
@ -696,7 +728,7 @@ static void ReadHash(FILE *stream) {
Atom at;
qlf_tag_t tg = read_tag(stream);
if (tg == QLY_ATOM) {
if (tg == QLY_ATOM) {
char *rep = (char *)AllocTempSpace();
UInt len;
@ -804,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);
}
@ -842,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;
@ -855,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) {
@ -886,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);
@ -916,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);
@ -1044,6 +1081,8 @@ static void ReInitProlog(void) {
static Int qload_program(USES_REGS1) {
FILE *stream;
Term t1 = Deref(ARG1);
if (IsVarTerm(t1)) {
@ -1053,7 +1092,7 @@ static Int qload_program(USES_REGS1) {
if ((stream = Yap_GetInputStream(t1, "from read_program"))) {
return FALSE;
}
Yap_Reset(YAP_RESET_FROM_RESTORE);
Yap_Reset(YAP_RESET_FROM_RESTORE, true);
if (do_header(stream) == NIL)
return FALSE;
read_module(stream);
@ -1063,10 +1102,10 @@ static Int qload_program(USES_REGS1) {
return true;
}
YAP_file_type_t Yap_Restore(const char *s, const char *lib_dir) {
YAP_file_type_t Yap_Restore(const char *s) {
CACHE_REGS
FILE *stream = Yap_OpenRestore(s, lib_dir);
FILE *stream = Yap_OpenRestore(s);
if (!stream)
return -1;
GLOBAL_RestoreFile = s;

446
C/qlyw.c
View File

@ -1,20 +1,20 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- *
* *
**************************************************************************
* *
* File: qlyw.c *
* comments: quick saver/loader *
* *
* Last rev: $Date: 2011-08-29$,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- *
* *
**************************************************************************
* *
* File: qlyw.c *
* comments: quick saver/loader *
* *
* Last rev: $Date: 2011-08-29$,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* *
*************************************************************************/
/**
*
@ -25,49 +25,49 @@
*
*/
#include "absmi.h"
#include "Foreign.h"
#include "absmi.h"
#include "alloc.h"
#include "yapio.h"
#include "iopreds.h"
#include "attvar.h"
#include "iopreds.h"
#include "yapio.h"
#if HAVE_STRING_H
#include <string.h>
#endif
#include "qly.h"
static void RestoreEntries(PropEntry *, int USES_REGS);
static void CleanCode(PredEntry * USES_REGS);
static void RestoreEntries(PropEntry *, int USES_REGS);
static void CleanCode(PredEntry *USES_REGS);
static void
GrowAtomTable(void) {
static void GrowAtomTable(void) {
CACHE_REGS
UInt size = LOCAL_ExportAtomHashTableSize;
export_atom_hash_entry_t *p, *newt, *oldt = LOCAL_ExportAtomHashChain;
UInt new_size = size + (size > 1024 ? size : 1024);
UInt i;
newt = (export_atom_hash_entry_t *)calloc(new_size,sizeof(export_atom_hash_entry_t));
newt = (export_atom_hash_entry_t *)calloc(new_size,
sizeof(export_atom_hash_entry_t));
if (!newt) {
return;
}
p = oldt;
for (i = 0 ; i < size ; p++,i++) {
for (i = 0; i < size; p++, i++) {
Atom a = p->val;
export_atom_hash_entry_t *newp;
CELL hash;
const unsigned char *apt;
if (!a) continue;
if (!a)
continue;
apt = RepAtom(a)->UStrOfAE;
hash = HashFunction(apt)/(2*sizeof(CELL)) % new_size;
newp = newt+hash;
hash = HashFunction(apt) / (2 * sizeof(CELL)) % new_size;
newp = newt + hash;
while (newp->val) {
newp++;
if (newp == newt+new_size)
newp = newt;
if (newp == newt + new_size)
newp = newt;
}
newp->val = a;
}
@ -76,29 +76,24 @@ GrowAtomTable(void) {
free(oldt);
}
static void
LookupAtom(Atom at)
{
static void LookupAtom(Atom at) {
CACHE_REGS
const unsigned char *p = RepAtom(at)->UStrOfAE;
CELL hash = HashFunction(p) % LOCAL_ExportAtomHashTableSize;
export_atom_hash_entry_t *a;
a = LOCAL_ExportAtomHashChain+hash;
a = LOCAL_ExportAtomHashChain + hash;
while (a->val) {
if (a->val == at) {
return;
}
a++;
if (a == LOCAL_ExportAtomHashChain+LOCAL_ExportAtomHashTableSize)
if (a == LOCAL_ExportAtomHashChain + LOCAL_ExportAtomHashTableSize)
a = LOCAL_ExportAtomHashChain;
}
a->val = at;
LOCAL_ExportAtomHashTableNum++;
if (LOCAL_ExportAtomHashTableNum >
LOCAL_ExportAtomHashTableSize/2
) {
if (LOCAL_ExportAtomHashTableNum > LOCAL_ExportAtomHashTableSize / 2) {
GrowAtomTable();
if (!LOCAL_ExportAtomHashChain) {
return;
@ -106,31 +101,32 @@ LookupAtom(Atom at)
}
}
static void
GrowFunctorTable(void) {
static void GrowFunctorTable(void) {
CACHE_REGS
UInt size = LOCAL_ExportFunctorHashTableSize;
export_functor_hash_entry_t *p, *newt, *oldt = LOCAL_ExportFunctorHashChain;
UInt new_size = size + (size > 1024 ? size : 1024);
UInt i;
newt = (export_functor_hash_entry_t *)calloc(new_size,sizeof(export_functor_hash_entry_t));
newt = (export_functor_hash_entry_t *)calloc(
new_size, sizeof(export_functor_hash_entry_t));
if (!newt) {
return;
}
p = oldt;
for (i = 0 ; i < size ; p++,i++) {
for (i = 0; i < size; p++, i++) {
Functor f = p->val;
export_functor_hash_entry_t *newp;
CELL hash;
if (!f) continue;
hash = ((CELL)(f))/(2*sizeof(CELL)) % new_size;
newp = newt+hash;
if (!f)
continue;
hash = ((CELL)(f)) / (2 * sizeof(CELL)) % new_size;
newp = newt + hash;
while (newp->val) {
newp++;
if (newp == newt+new_size)
newp = newt;
if (newp == newt + new_size)
newp = newt;
}
newp->val = p->val;
newp->arity = p->arity;
@ -141,22 +137,21 @@ GrowFunctorTable(void) {
free(oldt);
}
static void
LookupFunctor(Functor fun)
{
static void LookupFunctor(Functor fun) {
CACHE_REGS
CELL hash = ((CELL)(fun))/(2*sizeof(CELL)) % LOCAL_ExportFunctorHashTableSize;
CELL hash =
((CELL)(fun)) / (2 * sizeof(CELL)) % LOCAL_ExportFunctorHashTableSize;
export_functor_hash_entry_t *f;
Atom name = NameOfFunctor(fun);
UInt arity = ArityOfFunctor(fun);
UInt arity = ArityOfFunctor(fun);
f = LOCAL_ExportFunctorHashChain+hash;
f = LOCAL_ExportFunctorHashChain + hash;
while (f->val) {
if (f->val == fun) {
return;
}
f++;
if (f == LOCAL_ExportFunctorHashChain+LOCAL_ExportFunctorHashTableSize)
if (f == LOCAL_ExportFunctorHashChain + LOCAL_ExportFunctorHashTableSize)
f = LOCAL_ExportFunctorHashChain;
}
LookupAtom(name);
@ -164,9 +159,7 @@ LookupFunctor(Functor fun)
f->name = name;
f->arity = arity;
LOCAL_ExportFunctorHashTableNum++;
if (LOCAL_ExportFunctorHashTableNum >
LOCAL_ExportFunctorHashTableSize/2
) {
if (LOCAL_ExportFunctorHashTableNum > LOCAL_ExportFunctorHashTableSize / 2) {
GrowFunctorTable();
if (!LOCAL_ExportFunctorHashChain) {
return;
@ -174,31 +167,33 @@ LookupFunctor(Functor fun)
}
}
static void
GrowPredTable(void) {
static void GrowPredTable(void) {
CACHE_REGS
UInt size = LOCAL_ExportPredEntryHashTableSize;
export_pred_entry_hash_entry_t *p, *newt, *oldt = LOCAL_ExportPredEntryHashChain;
export_pred_entry_hash_entry_t *p, *newt,
*oldt = LOCAL_ExportPredEntryHashChain;
UInt new_size = size + (size > 1024 ? size : 1024);
UInt i;
newt = (export_pred_entry_hash_entry_t *)calloc(new_size,sizeof(export_pred_entry_hash_entry_t));
newt = (export_pred_entry_hash_entry_t *)calloc(
new_size, sizeof(export_pred_entry_hash_entry_t));
if (!newt) {
return;
}
p = oldt;
for (i = 0 ; i < size ; p++,i++) {
for (i = 0; i < size; p++, i++) {
PredEntry *pe = p->val;
export_pred_entry_hash_entry_t *newp;
CELL hash;
if (!pe) continue;
hash = ((CELL)(pe))/(2*sizeof(CELL)) % new_size;
newp = newt+hash;
if (!pe)
continue;
hash = ((CELL)(pe)) / (2 * sizeof(CELL)) % new_size;
newp = newt + hash;
while (newp->val) {
newp++;
if (newp == newt+new_size)
newp = newt;
if (newp == newt + new_size)
newp = newt;
}
newp->val = p->val;
newp->arity = p->arity;
@ -210,21 +205,21 @@ GrowPredTable(void) {
free(oldt);
}
static void
LookupPredEntry(PredEntry *pe)
{
static void LookupPredEntry(PredEntry *pe) {
CACHE_REGS
CELL hash = (((CELL)(pe))/(2*sizeof(CELL))) % LOCAL_ExportPredEntryHashTableSize;
CELL hash =
(((CELL)(pe)) / (2 * sizeof(CELL))) % LOCAL_ExportPredEntryHashTableSize;
export_pred_entry_hash_entry_t *p;
UInt arity = pe->ArityOfPE;
UInt arity = pe->ArityOfPE;
p = LOCAL_ExportPredEntryHashChain+hash;
p = LOCAL_ExportPredEntryHashChain + hash;
while (p->val) {
if (p->val == pe) {
return;
}
p++;
if (p == LOCAL_ExportPredEntryHashChain+LOCAL_ExportPredEntryHashTableSize)
if (p ==
LOCAL_ExportPredEntryHashChain + LOCAL_ExportPredEntryHashTableSize)
p = LOCAL_ExportPredEntryHashChain;
}
p->arity = arity;
@ -258,8 +253,7 @@ LookupPredEntry(PredEntry *pe)
LookupAtom(p->module);
LOCAL_ExportPredEntryHashTableNum++;
if (LOCAL_ExportPredEntryHashTableNum >
LOCAL_ExportPredEntryHashTableSize/2
) {
LOCAL_ExportPredEntryHashTableSize / 2) {
GrowPredTable();
if (!LOCAL_ExportPredEntryHashChain) {
return;
@ -267,32 +261,32 @@ LookupPredEntry(PredEntry *pe)
}
}
static void
GrowDBRefTable(void) {
static void GrowDBRefTable(void) {
CACHE_REGS
UInt size = LOCAL_ExportDBRefHashTableSize;
export_dbref_hash_entry_t *p, *newt, *oldt = LOCAL_ExportDBRefHashChain;
UInt new_size = size + (size > 1024 ? size : 1024);
UInt i;
newt = (export_dbref_hash_entry_t *)calloc(new_size,sizeof(export_dbref_hash_entry_t));
newt = (export_dbref_hash_entry_t *)calloc(new_size,
sizeof(export_dbref_hash_entry_t));
if (!newt) {
return;
}
p = oldt;
for (i = 0 ; i < size ; p++,i++) {
for (i = 0; i < size; p++, i++) {
DBRef dbr = p->val;
export_dbref_hash_entry_t *newp;
CELL hash;
if (!dbr) continue;
hash = ((CELL)(dbr))/(2*sizeof(CELL)) % new_size;
newp = newt+hash;
if (!dbr)
continue;
hash = ((CELL)(dbr)) / (2 * sizeof(CELL)) % new_size;
newp = newt + hash;
while (newp->val) {
newp++;
if (newp == newt+new_size)
newp = newt;
if (newp == newt + new_size)
newp = newt;
}
newp->val = p->val;
newp->sz = p->sz;
@ -303,30 +297,27 @@ GrowDBRefTable(void) {
free(oldt);
}
static void
LookupDBRef(DBRef ref)
{
static void LookupDBRef(DBRef ref) {
CACHE_REGS
CELL hash = ((CELL)(ref))/(2*sizeof(CELL)) % LOCAL_ExportDBRefHashTableSize;
CELL hash =
((CELL)(ref)) / (2 * sizeof(CELL)) % LOCAL_ExportDBRefHashTableSize;
export_dbref_hash_entry_t *a;
a = LOCAL_ExportDBRefHashChain+hash;
a = LOCAL_ExportDBRefHashChain + hash;
while (a->val) {
if (a->val == ref) {
a->refs++;
return;
}
a++;
if (a == LOCAL_ExportDBRefHashChain+LOCAL_ExportDBRefHashTableSize)
if (a == LOCAL_ExportDBRefHashChain + LOCAL_ExportDBRefHashTableSize)
a = LOCAL_ExportDBRefHashChain;
}
a->val = ref;
a->sz = ((LogUpdClause *)ref)->ClSize;
a->refs = 1;
LOCAL_ExportDBRefHashTableNum++;
if (LOCAL_ExportDBRefHashTableNum >
LOCAL_ExportDBRefHashTableSize/2
) {
if (LOCAL_ExportDBRefHashTableNum > LOCAL_ExportDBRefHashTableSize / 2) {
GrowDBRefTable();
if (!LOCAL_ExportDBRefHashChain) {
return;
@ -334,27 +325,28 @@ LookupDBRef(DBRef ref)
}
}
static void
InitHash(void)
{
static void InitHash(void) {
CACHE_REGS
LOCAL_ExportFunctorHashTableNum = 0;
LOCAL_ExportFunctorHashTableSize = EXPORT_FUNCTOR_TABLE_SIZE;
LOCAL_ExportFunctorHashChain = (export_functor_hash_entry_t *)calloc(LOCAL_ExportFunctorHashTableSize, sizeof(export_functor_hash_entry_t ));
LOCAL_ExportFunctorHashChain = (export_functor_hash_entry_t *)calloc(
LOCAL_ExportFunctorHashTableSize, sizeof(export_functor_hash_entry_t));
LOCAL_ExportAtomHashTableNum = 0;
LOCAL_ExportAtomHashTableSize = EXPORT_ATOM_TABLE_SIZE;
LOCAL_ExportAtomHashChain = (export_atom_hash_entry_t *)calloc( LOCAL_ExportAtomHashTableSize, sizeof(export_atom_hash_entry_t));
LOCAL_ExportAtomHashChain = (export_atom_hash_entry_t *)calloc(
LOCAL_ExportAtomHashTableSize, sizeof(export_atom_hash_entry_t));
LOCAL_ExportPredEntryHashTableNum = 0;
LOCAL_ExportPredEntryHashTableSize = EXPORT_PRED_ENTRY_TABLE_SIZE;
LOCAL_ExportPredEntryHashChain = (export_pred_entry_hash_entry_t *)calloc(LOCAL_ExportPredEntryHashTableSize, sizeof(export_pred_entry_hash_entry_t));
LOCAL_ExportPredEntryHashChain = (export_pred_entry_hash_entry_t *)calloc(
LOCAL_ExportPredEntryHashTableSize,
sizeof(export_pred_entry_hash_entry_t));
LOCAL_ExportDBRefHashTableNum = 0;
LOCAL_ExportDBRefHashTableSize = EXPORT_DBREF_TABLE_SIZE;
LOCAL_ExportDBRefHashChain = (export_dbref_hash_entry_t *)calloc(EXPORT_DBREF_TABLE_SIZE, sizeof(export_dbref_hash_entry_t));
LOCAL_ExportDBRefHashChain = (export_dbref_hash_entry_t *)calloc(
EXPORT_DBREF_TABLE_SIZE, sizeof(export_dbref_hash_entry_t));
}
static void
CloseHash(void)
{
static void CloseHash(void) {
CACHE_REGS
LOCAL_ExportFunctorHashTableNum = 0;
LOCAL_ExportFunctorHashTableSize = 0L;
@ -370,37 +362,27 @@ CloseHash(void)
free(LOCAL_ExportDBRefHashChain);
}
static inline Atom
AtomAdjust(Atom a)
{
static inline Atom AtomAdjust(Atom a) {
LookupAtom(a);
return a;
}
static inline Functor
FuncAdjust(Functor f)
{
static inline Functor FuncAdjust(Functor f) {
LookupFunctor(f);
return f;
}
static inline Term
AtomTermAdjust(Term t)
{
static inline Term AtomTermAdjust(Term t) {
LookupAtom(AtomOfTerm(t));
return t;
}
static inline Term
TermToGlobalOrAtomAdjust(Term t)
{
static inline Term TermToGlobalOrAtomAdjust(Term t) {
if (t && IsAtomTerm(t))
return AtomTermAdjust(t);
return t;
}
#define IsOldCode(P) FALSE
#define IsOldCodeCellPtr(P) FALSE
#define IsOldDelay(P) FALSE
@ -420,7 +402,7 @@ TermToGlobalOrAtomAdjust(Term t)
#define NoAGCAtomAdjust(P) (P)
#define OrArgAdjust(P)
#define TabEntryAdjust(P)
#define IntegerAdjust(D) (D)
#define IntegerAdjust(D) (D)
#define AddrAdjust(P) (P)
#define MFileAdjust(P) (P)
#define CodeVarAdjust(P) (P)
@ -430,28 +412,22 @@ TermToGlobalOrAtomAdjust(Term t)
#define IntegerInCodeAdjust(P)
#define OpcodeAdjust(P) (P)
static inline Term
ModuleAdjust(Term t)
{
if (!t) return t;
static inline Term ModuleAdjust(Term t) {
if (!t)
return t;
return AtomTermAdjust(t);
}
static inline PredEntry *
PredEntryAdjust(PredEntry *pe)
{
static inline PredEntry *PredEntryAdjust(PredEntry *pe) {
LookupPredEntry(pe);
return pe;
}
static inline PredEntry *
PtoPredAdjust(PredEntry *pe)
{
static inline PredEntry *PtoPredAdjust(PredEntry *pe) {
LookupPredEntry(pe);
return pe;
}
#define ExternalFunctionAdjust(P) (P)
#define DBRecordAdjust(P) (P)
#define ModEntryPtrAdjust(P) (P)
@ -468,10 +444,8 @@ PtoPredAdjust(PredEntry *pe)
#define DelayAdjust(P) (P)
#define GlobalAdjust(P) (P)
#define DBRefAdjust(P,DoRef) DBRefAdjust__(P PASS_REGS)
static inline DBRef
DBRefAdjust__ (DBRef dbt USES_REGS)
{
#define DBRefAdjust(P, DoRef) DBRefAdjust__(P PASS_REGS)
static inline DBRef DBRefAdjust__(DBRef dbt USES_REGS) {
LookupDBRef(dbt);
return dbt;
}
@ -514,67 +488,48 @@ DBRefAdjust__ (DBRef dbt USES_REGS)
#define rehash(oldcode, NOfE, KindOfEntries)
static void RestoreFlags( UInt NFlags )
{
}
static void RestoreFlags(UInt NFlags) {}
#include "rheap.h"
static void
RestoreHashPreds( USES_REGS1 )
{
}
static void RestoreHashPreds(USES_REGS1) {}
static void RestoreAtomList(Atom atm USES_REGS) {}
static void
RestoreAtomList(Atom atm USES_REGS)
{
}
static size_t save_bytes(FILE *stream, void *ptr, size_t sz)
{
static size_t save_bytes(FILE *stream, void *ptr, size_t sz) {
return fwrite(ptr, sz, 1, stream);
}
static size_t save_byte(FILE *stream, int byte)
{
static size_t save_byte(FILE *stream, int byte) {
fputc(byte, stream);
return 1;
}
static size_t save_bits16(FILE *stream, BITS16 val)
{
static size_t save_bits16(FILE *stream, BITS16 val) {
BITS16 v = val;
return save_bytes(stream, &v, sizeof(BITS16));
}
static size_t save_UInt(FILE *stream, UInt val)
{
static size_t save_UInt(FILE *stream, UInt val) {
UInt v = val;
return save_bytes(stream, &v, sizeof(UInt));
}
static size_t save_Int(FILE *stream, Int val)
{
static size_t save_Int(FILE *stream, Int val) {
Int v = val;
return save_bytes(stream, &v, sizeof(Int));
}
static size_t save_tag(FILE *stream, qlf_tag_t tag)
{
static size_t save_tag(FILE *stream, qlf_tag_t tag) {
return save_byte(stream, tag);
}
static size_t save_predFlags(FILE *stream, pred_flags_t predFlags)
{
static size_t save_predFlags(FILE *stream, pred_flags_t predFlags) {
pred_flags_t v = predFlags;
return save_bytes(stream, &v, sizeof(pred_flags_t));
}
static int
SaveHash(FILE *stream)
{
static int SaveHash(FILE *stream) {
CACHE_REGS
UInt i;
/* first, current opcodes */
@ -582,25 +537,26 @@ SaveHash(FILE *stream)
save_UInt(stream, (UInt)&ARG1);
CHECK(save_tag(stream, QLY_START_OPCODES));
save_Int(stream, _std_top);
for (i= 0; i <= _std_top; i++) {
for (i = 0; i <= _std_top; i++) {
save_UInt(stream, (UInt)Yap_opcode(i));
}
CHECK(save_tag(stream, QLY_START_ATOMS));
CHECK(save_UInt(stream, LOCAL_ExportAtomHashTableNum));
for (i = 0; i < LOCAL_ExportAtomHashTableSize; i++) {
export_atom_hash_entry_t *a = LOCAL_ExportAtomHashChain+i;
export_atom_hash_entry_t *a = LOCAL_ExportAtomHashChain + i;
if (a->val) {
Atom at = a->val;
CHECK(save_UInt(stream, (UInt)at));
CHECK(save_tag(stream, QLY_ATOM));
CHECK(save_UInt(stream, strlen((char *)RepAtom(at)->StrOfAE)));
CHECK(save_bytes(stream, (char *)at->StrOfAE, (strlen((char *)at->StrOfAE)+1)*sizeof(char)));
CHECK(save_tag(stream, QLY_ATOM));
CHECK(save_UInt(stream, strlen((char *)RepAtom(at)->StrOfAE)));
CHECK(save_bytes(stream, (char *)at->StrOfAE,
(strlen((char *)at->StrOfAE) + 1) * sizeof(char)));
}
}
save_tag(stream, QLY_START_FUNCTORS);
save_UInt(stream, LOCAL_ExportFunctorHashTableNum);
for (i = 0; i < LOCAL_ExportFunctorHashTableSize; i++) {
export_functor_hash_entry_t *f = LOCAL_ExportFunctorHashChain+i;
export_functor_hash_entry_t *f = LOCAL_ExportFunctorHashChain + i;
if (!(f->val))
continue;
CHECK(save_UInt(stream, (UInt)(f->val)));
@ -610,7 +566,7 @@ SaveHash(FILE *stream)
save_tag(stream, QLY_START_PRED_ENTRIES);
save_UInt(stream, LOCAL_ExportPredEntryHashTableNum);
for (i = 0; i < LOCAL_ExportPredEntryHashTableSize; i++) {
export_pred_entry_hash_entry_t *p = LOCAL_ExportPredEntryHashChain+i;
export_pred_entry_hash_entry_t *p = LOCAL_ExportPredEntryHashChain + i;
if (!(p->val))
continue;
CHECK(save_UInt(stream, (UInt)(p->val)));
@ -621,7 +577,7 @@ SaveHash(FILE *stream)
save_tag(stream, QLY_START_DBREFS);
save_UInt(stream, LOCAL_ExportDBRefHashTableNum);
for (i = 0; i < LOCAL_ExportDBRefHashTableSize; i++) {
export_dbref_hash_entry_t *p = LOCAL_ExportDBRefHashChain+i;
export_dbref_hash_entry_t *p = LOCAL_ExportDBRefHashChain + i;
if (p->val) {
CHECK(save_UInt(stream, (UInt)(p->val)));
CHECK(save_UInt(stream, p->sz));
@ -633,9 +589,8 @@ SaveHash(FILE *stream)
return 1;
}
static size_t
save_clauses(FILE *stream, PredEntry *pp) {
yamop *FirstC, *LastC;
static size_t save_clauses(FILE *stream, PredEntry *pp) {
yamop *FirstC, *LastC;
FirstC = pp->cs.p_code.FirstClause;
LastC = pp->cs.p_code.LastClause;
@ -647,11 +602,11 @@ save_clauses(FILE *stream, PredEntry *pp) {
while (cl != NULL) {
if (IN_BETWEEN(cl->ClTimeStart, pp->TimeStampOfPred, cl->ClTimeEnd)) {
UInt size = cl->ClSize;
CHECK(save_tag(stream, QLY_START_LU_CLAUSE));
CHECK(save_UInt(stream, (UInt)cl));
CHECK(save_UInt(stream, size));
CHECK(save_bytes(stream, cl, size));
UInt size = cl->ClSize;
CHECK(save_tag(stream, QLY_START_LU_CLAUSE));
CHECK(save_UInt(stream, (UInt)cl));
CHECK(save_UInt(stream, size));
CHECK(save_bytes(stream, cl, size));
}
cl = cl->ClNext;
}
@ -674,7 +629,8 @@ save_clauses(FILE *stream, PredEntry *pp) {
CHECK(save_UInt(stream, (UInt)cl));
CHECK(save_UInt(stream, size));
CHECK(save_bytes(stream, dcl, size));
if (cl == LastC) return 1;
if (cl == LastC)
return 1;
cl = NextDynamicClause(cl);
} while (TRUE);
} else {
@ -689,15 +645,15 @@ save_clauses(FILE *stream, PredEntry *pp) {
CHECK(save_UInt(stream, (UInt)cl));
CHECK(save_UInt(stream, size));
CHECK(save_bytes(stream, cl, size));
if (cl->ClCode == LastC) return 1;
if (cl->ClCode == LastC)
return 1;
cl = cl->ClNext;
} while (TRUE);
}
return 1;
}
static size_t
save_pred(FILE *stream, PredEntry *ap) {
static size_t save_pred(FILE *stream, PredEntry *ap) {
CHECK(save_UInt(stream, (UInt)ap));
CHECK(save_predFlags(stream, ap->PredFlags));
if (ap->PredFlags & ForeignPredFlags)
@ -708,19 +664,17 @@ save_pred(FILE *stream, PredEntry *ap) {
return save_clauses(stream, ap);
}
static int
clean_pred(PredEntry *pp USES_REGS) {
static int clean_pred(PredEntry *pp USES_REGS) {
if (pp->PredFlags & ForeignPredFlags) {
return true;
} else {
CleanClauses(pp->cs.p_code.FirstClause, pp->cs.p_code.LastClause, pp PASS_REGS);
CleanClauses(pp->cs.p_code.FirstClause, pp->cs.p_code.LastClause,
pp PASS_REGS);
}
return true;
}
static size_t
mark_pred(PredEntry *ap)
{
static size_t mark_pred(PredEntry *ap) {
CACHE_REGS
if (ap->ModuleOfPred != IDB_MODULE) {
if (ap->ArityOfPE) {
@ -735,7 +689,7 @@ mark_pred(PredEntry *ap)
FuncAdjust(ap->FunctorOfPred);
}
}
if (!(ap->PredFlags & (MultiFileFlag|NumberDBPredFlag)) &&
if (!(ap->PredFlags & (MultiFileFlag | NumberDBPredFlag)) &&
ap->src.OwnerFile) {
AtomAdjust(ap->src.OwnerFile);
}
@ -743,22 +697,20 @@ mark_pred(PredEntry *ap)
return 1;
}
static size_t
mark_ops(FILE *stream, Term mod) {
static size_t mark_ops(FILE *stream, Term mod) {
OpEntry *op = OpList;
while (op) {
if (!mod || op->OpModule == mod) {
AtomAdjust(op->OpName);
if (op->OpModule)
AtomTermAdjust(op->OpModule);
AtomTermAdjust(op->OpModule);
}
op = op->OpNext;
}
return 1;
}
static size_t
save_ops(FILE *stream, Term mod) {
static size_t save_ops(FILE *stream, Term mod) {
OpEntry *op = OpList;
while (op) {
if (!mod || op->OpModule == mod) {
@ -775,19 +727,20 @@ save_ops(FILE *stream, Term mod) {
return 1;
}
static int
save_header(FILE *stream, char type[])
{
char msg[256];
static size_t save_header(FILE *stream, char type[]) {
char msg[2048];
sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%s %s\n", YAP_BINDIR, type, YAP_FULL_VERSION);
return save_bytes(stream, msg, strlen(msg)+1);
memset(msg, 0, 2048);
sprintf(msg,
"#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 "
"\"$@\"\n%s %s\n",
YAP_BINDIR, type, YAP_FULL_VERSION);
return save_bytes(stream, msg, 2048);
}
static size_t
save_module(FILE *stream, Term mod) {
static size_t save_module(FILE *stream, Term mod) {
PredEntry *ap = Yap_ModulePred(mod);
save_header( stream, "saved module," );
save_header(stream, "saved module,");
InitHash();
ModuleAdjust(mod);
while (ap) {
@ -813,12 +766,11 @@ save_module(FILE *stream, Term mod) {
return 1;
}
static size_t
save_program(FILE *stream) {
static size_t save_program(FILE *stream) {
ModEntry *me = CurrentModules;
InitHash();
save_header( stream, "saved state," );
save_header(stream, "saved state,");
/* should we allow the user to see hidden predicates? */
while (me) {
PredEntry *pp;
@ -826,7 +778,7 @@ save_program(FILE *stream) {
AtomAdjust(me->AtomOfME);
while (pp != NULL) {
#if DEBUG
// Yap_PrintPredName( pp );
// Yap_PrintPredName( pp );
#endif
pp = PredEntryAdjust(pp);
CHECK(mark_pred(pp));
@ -858,12 +810,11 @@ save_program(FILE *stream) {
return 1;
}
static size_t
save_file(FILE *stream, Atom FileName) {
static size_t save_file(FILE *stream, Atom FileName) {
ModEntry *me = CurrentModules;
InitHash();
save_header( stream, "saved file," );
save_header(stream, "saved file,");
/* should we allow the user to see hidden predicates? */
while (me) {
PredEntry *pp;
@ -872,10 +823,10 @@ save_file(FILE *stream, Atom FileName) {
while (pp != NULL) {
pp = PredEntryAdjust(pp);
if (pp &&
!(pp->PredFlags & (MultiFileFlag|NumberDBPredFlag|AtomDBPredFlag|CPredFlag|AsmPredFlag|UserCPredFlag)) &&
pp->ModuleOfPred != IDB_MODULE &&
pp->src.OwnerFile == FileName) {
CHECK(mark_pred(pp));
!(pp->PredFlags & (MultiFileFlag | NumberDBPredFlag | AtomDBPredFlag |
CPredFlag | AsmPredFlag | UserCPredFlag)) &&
pp->ModuleOfPred != IDB_MODULE && pp->src.OwnerFile == FileName) {
CHECK(mark_pred(pp));
}
pp = pp->NextPredOfModule;
}
@ -893,10 +844,11 @@ save_file(FILE *stream, Atom FileName) {
CHECK(save_UInt(stream, (UInt)MkAtomTerm(me->AtomOfME)));
while (pp != NULL) {
if (pp &&
!(pp->PredFlags & (MultiFileFlag|NumberDBPredFlag|AtomDBPredFlag|CPredFlag|AsmPredFlag|UserCPredFlag)) &&
pp->src.OwnerFile == FileName) {
CHECK(save_tag(stream, QLY_START_PREDICATE));
CHECK(save_pred(stream, pp));
!(pp->PredFlags & (MultiFileFlag | NumberDBPredFlag | AtomDBPredFlag |
CPredFlag | AsmPredFlag | UserCPredFlag)) &&
pp->src.OwnerFile == FileName) {
CHECK(save_tag(stream, QLY_START_PREDICATE));
CHECK(save_pred(stream, pp));
}
pp = pp->NextPredOfModule;
}
@ -909,78 +861,72 @@ save_file(FILE *stream, Atom FileName) {
return 1;
}
static Int
qsave_module_preds( USES_REGS1 )
{
static Int qsave_module_preds(USES_REGS1) {
FILE *stream;
Term tmod = Deref(ARG2);
Term t1 = Deref(ARG1);
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR,t1,"save_module/3");
Yap_Error(INSTANTIATION_ERROR, t1, "save_module/3");
return FALSE;
}
if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM,t1,"save_module/3");
return(FALSE);
Yap_Error(TYPE_ERROR_ATOM, t1, "save_module/3");
return (FALSE);
}
if (!(stream = Yap_GetOutputStream(t1, "save_module") )){
if (!(stream = Yap_GetOutputStream(t1, "save_module"))) {
return FALSE;
}
if (IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR,tmod,"save_module/2");
Yap_Error(INSTANTIATION_ERROR, tmod, "save_module/2");
return FALSE;
}
if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM,tmod,"save_module/2");
Yap_Error(TYPE_ERROR_ATOM, tmod, "save_module/2");
return FALSE;
}
return save_module(stream, tmod) != 0;
}
static Int
qsave_program( USES_REGS1 )
{
static Int qsave_program(USES_REGS1) {
FILE *stream;
Term t1 = Deref(ARG1);
if (!(stream = Yap_GetOutputStream(t1,"save_program")) ) {
if (!(stream = Yap_GetOutputStream(t1, "save_program"))) {
return FALSE;
}
return save_program(stream) != 0;
}
static Int
qsave_file( USES_REGS1 )
{
static Int qsave_file(USES_REGS1) {
FILE *stream;
Term t1 = Deref(ARG1);
Term tfile = Deref(ARG2);
if (!(stream = Yap_GetOutputStream(t1, "save_file/2") ) ) {
if (!(stream = Yap_GetOutputStream(t1, "save_file/2"))) {
return FALSE;
}
if (IsVarTerm(tfile)) {
Yap_Error(INSTANTIATION_ERROR,tfile,"save_file/2");
Yap_Error(INSTANTIATION_ERROR, tfile, "save_file/2");
return FALSE;
}
if (!IsAtomTerm(tfile)) {
Yap_Error(TYPE_ERROR_ATOM,tfile,"save_file/2");
Yap_Error(TYPE_ERROR_ATOM, tfile, "save_file/2");
return FALSE;
}
return save_file(stream, AtomOfTerm(tfile) ) != 0;
return save_file(stream, AtomOfTerm(tfile)) != 0;
}
void Yap_InitQLY(void)
{
Yap_InitCPred("$qsave_module_preds", 2, qsave_module_preds, SyncPredFlag|UserCPredFlag);
Yap_InitCPred("$qsave_program", 1, qsave_program, SyncPredFlag|UserCPredFlag);
Yap_InitCPred("$qsave_file_preds", 2, qsave_file, SyncPredFlag|UserCPredFlag);
void Yap_InitQLY(void) {
Yap_InitCPred("$qsave_module_preds", 2, qsave_module_preds,
SyncPredFlag | UserCPredFlag);
Yap_InitCPred("$qsave_program", 1, qsave_program,
SyncPredFlag | UserCPredFlag);
Yap_InitCPred("$qsave_file_preds", 2, qsave_file,
SyncPredFlag | UserCPredFlag);
if (FALSE) {
restore_codes();
}
}
/// @}

885
C/save.c
View File

File diff suppressed because it is too large Load Diff

384
C/scanner.c
View File

File diff suppressed because it is too large Load Diff

13
C/signals.c
View File

@ -28,9 +28,9 @@ static char SccsId[] = "%W% %G%";
#include <io.h>
#include <stdio.h>
#endif
#include "YapEval.h"
#include "YapHeap.h"
#include "Yatom.h"
#include "YapEval.h"
#include "yapio.h"
#ifdef TABLING
#include "tab.macros.h"
@ -65,9 +65,8 @@ static yap_signals InteractSIGINT(int ch) {
case 'a':
/* abort computation */
#if PUSH_REGS
// restore_absmi_regs(&Yap_standard_regs);
// restore_absmi_regs(&Yap_standard_regs);
#endif
siglongjmp(LOCAL_RestartEnv, 4);
return YAP_ABORT_SIGNAL;
case 'b':
/* continue */
@ -111,9 +110,11 @@ static yap_signals InteractSIGINT(int ch) {
}
}
/*
This function talks to the user about a signal. We assume we are in
the context of the main Prolog thread (trivial in Unix, but hard in WIN32)
/**
This function interacts with the user about a signal. We assume we are in
the context of the main Prolog thread (trivial in Unix, but hard in WIN32).
*/
static yap_signals ProcessSIGINT(void) {
CACHE_REGS

502
C/stack.c
View File

@ -1,22 +1,22 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: stack.c *
* comments: Stack Introspection *
* *
* Last rev: $Date: 2008-07-22 23:34:44 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* Revision 1.230 2008/06/02 17:20:28 vsc *
* *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: stack.c *
* comments: Stack Introspection *
* *
* Last rev: $Date: 2008-07-22 23:34:44 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* Revision 1.230 2008/06/02 17:20:28 vsc *
* *
* *
*************************************************************************/
/**
* @file stack.c
@ -29,29 +29,42 @@
*/
#include "Yap.h"
#include "clause.h"
#include "YapEval.h"
#include "clause.h"
#include "iopreds.h"
#include "tracer.h"
#include "yapio.h"
#ifdef YAPOR
#include "or.macros.h"
#endif /* YAPOR */
#ifdef TABLING
#include "tab.macros.h"
#endif /* TABLING */
#if HAVE_STRING_H
#include <string.h>
#endif
#include <heapgc.h>
#if !defined(YAPOR) && !defined(THREADS)
static void mark_pred(int, PredEntry *);
static void do_toggle_static_predicates_in_use(int);
#endif
static Int in_use(USES_REGS1);
static Int PredForCode(yamop *, Atom *, arity_t *, Term *, PredEntry **);
static LogUpdIndex *find_owner_log_index(LogUpdIndex *, yamop *);
static StaticIndex *find_owner_static_index(StaticIndex *, yamop *);
#define IN_BLOCK(P, B, SZ) \
@ -102,7 +115,7 @@ static PredEntry *PredForChoicePt(yamop *p_code, op_numbers *opn) {
*opn = opnum;
switch (opnum) {
case _Nstop:
return NULL;
return PredFail;
case _jump:
p_code = p_code->y_u.l.l;
break;
@ -163,13 +176,7 @@ static PredEntry *PredForChoicePt(yamop *p_code, op_numbers *opn) {
/* compile error --> return ENV_ToP(gc_B->cp_cp); */
#endif /* TABLING */
case _or_else:
if (p_code == p_code->y_u.Osblp.l) {
/* repeat */
Atom at = AtomRepeatSpace;
return RepPredProp(PredPropByAtom(at, PROLOG_MODULE));
} else {
return p_code->y_u.Osblp.p0;
}
return p_code->y_u.Osblp.p0;
break;
case _or_last:
#ifdef YAPOR
@ -202,7 +209,7 @@ static PredEntry *PredForChoicePt(yamop *p_code, op_numbers *opn) {
*
* usually pretty straightforward, it can fall in trouble with
8 OR-P or tabling.
*/
*/
PredEntry *Yap_PredForChoicePt(choiceptr cp, op_numbers *op) {
if (cp == NULL)
return NULL;
@ -210,6 +217,7 @@ PredEntry *Yap_PredForChoicePt(choiceptr cp, op_numbers *op) {
}
#if !defined(YAPOR) && !defined(THREADS)
static yamop *cur_clause(PredEntry *pe, yamop *codeptr) {
StaticClause *cl;
@ -260,8 +268,8 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
/* check first environments that are younger than our latest choicepoint */
if (check_everything && env_ptr) {
/*
I do not need to check environments for asserts,
only for retracts
I do not need to check environments for asserts,
only for retracts
*/
while (env_ptr && b_ptr > (choiceptr)env_ptr) {
yamop *cp = (yamop *)env_ptr[E_CP];
@ -276,9 +284,9 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
}
/* now mark the choicepoint */
if (b_ptr)
if (b_ptr) {
pe = PredForChoicePt(b_ptr->cp_ap, NULL);
else
} else
return false;
if (pe == p) {
if (check_everything)
@ -386,14 +394,20 @@ static Int toggle_static_predicates_in_use(USES_REGS1) {
static void clause_was_found(PredEntry *pp, Atom *pat, UInt *parity) {
if (pp->ModuleOfPred == IDB_MODULE) {
if (pp->PredFlags & NumberDBPredFlag) {
*parity = 0;
*pat = AtomInteger;
if (parity)
*parity = 0;
if (pat)
*pat = AtomInteger;
} else if (pp->PredFlags & AtomDBPredFlag) {
*parity = 0;
*pat = (Atom)pp->FunctorOfPred;
if (parity)
*parity = 0;
if (pat)
*pat = (Atom)pp->FunctorOfPred;
} else {
*pat = NameOfFunctor(pp->FunctorOfPred);
*parity = ArityOfFunctor(pp->FunctorOfPred);
if (pat)
*pat = NameOfFunctor(pp->FunctorOfPred);
if (parity)
*parity = ArityOfFunctor(pp->FunctorOfPred);
}
} else {
if (parity) {
@ -523,6 +537,41 @@ static Int find_code_in_clause(PredEntry *pp, yamop *codeptr, void **startp,
return (0);
}
/*
static bool put_clause_loc(yap_error_descriptor_t *t, void *clcode, PredEntry
*pp) {
CACHE_REGS
if (pp->PredFlags & LogUpdatePredFlag) {
LogUpdClause *cl = clcode;
if (cl->ClFlags & FactMask) {
t->prologPredLine = cl->lusl.ClLine;
} else {
t->prologPredLine = cl->lusl.ClSource->ag.line_number;
}
} else if (pp->PredFlags & DynamicPredFlag) {
// DynamicClause *cl;
// cl = ClauseCodeToDynamicClause(clcode);
return false;
} else if (pp->PredFlags & MegaClausePredFlag) {
MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause);
t->prologPredLine = mcl->ClLine;
} else {
StaticClause *cl;
cl = clcode;
if (cl->ClFlags & FactMask) {
t->prologPredLine = cl->usc.ClLine;
} else if (cl->ClFlags & SrcMask) {
t->prologPredLine = cl->usc.ClSource->ag.line_number;
} else
return MkIntTerm(0);
}
return MkIntTerm(0);
}
*/
static Term clause_loc(void *clcode, PredEntry *pp) {
CACHE_REGS
@ -607,7 +656,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) {
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,
@ -779,7 +828,8 @@ static PredEntry *found_expand(yamop *pc, void **startp,
return pp;
}
static PredEntry *found_ystop(yamop *pc, int clause_code, void **startp, void **endp, PredEntry *pp USES_REGS) {
static PredEntry *found_ystop(yamop *pc, int clause_code, void **startp,
void **endp, PredEntry *pp USES_REGS) {
if (pc == YESCODE) {
pp = RepPredProp(Yap_GetPredPropByAtom(AtomTrue, CurrentModule));
if (startp)
@ -787,17 +837,17 @@ static PredEntry *found_ystop(yamop *pc, int clause_code, void **startp, void **
if (endp)
*endp = (CODEADDR)YESCODE + (CELL)(NEXTOP((yamop *)NULL, e));
return pp;
}
if (!pp) {
yamop *o = PREVOP(pc,pp);
if (o->opc ==Yap_opcode(_execute_cpred)) {
pp = o->y_u.pp.p0;
} else {
/* must be an index */
PredEntry **pep = (PredEntry **)pc->y_u.l.l;
pp = pep[-1];
}
}
if (!pp) {
yamop *o = PREVOP(pc, Osbpp);
if (o->opc == Yap_opcode(_execute_cpred)) {
pp = o->y_u.Osbpp.p0;
} else {
/* must be an index */
PredEntry **pep = (PredEntry **)pc->y_u.l.l;
pp = pep[-1];
}
}
if (pp->PredFlags & LogUpdatePredFlag) {
if (clause_code) {
LogUpdClause *cl = ClauseCodeToLogUpdClause(pc->y_u.l.l);
@ -839,7 +889,9 @@ static PredEntry *ClauseInfoForCode(yamop *codeptr, void **startp,
return pp;
}
pc = codeptr;
#include "walkclause.h"
return NULL;
}
@ -1069,51 +1121,37 @@ static Term clause_info(yamop *codeptr, PredEntry *pp) {
return Yap_MkApplTerm(FunctorModule, 2, ts);
}
bool set_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) {
LOCAL_ActiveError->prologPredName = (Atom)pp->FunctorOfPred;
LOCAL_ActiveError->prologPredArity = 0;
t->prologPredName = AtomName((Atom)pp->FunctorOfPred);
t->prologPredArity = 0;
} else {
LOCAL_ActiveError->prologPredName = NameOfFunctor(pp->FunctorOfPred);
LOCAL_ActiveError->prologPredArity = pp->ArityOfPE;
t->prologPredName = AtomName(NameOfFunctor(pp->FunctorOfPred));
t->prologPredArity = pp->ArityOfPE;
}
LOCAL_ActiveError->prologPredModule =
(pp->ModuleOfPred ? pp->ModuleOfPred : TermProlog);
LOCAL_ActiveError->prologPredFile = pp->src.OwnerFile;
t->prologPredModule =
(pp->ModuleOfPred ? RepAtom(AtomOfTerm(pp->ModuleOfPred))->StrOfAE
: "prolog");
t->prologPredFile = RepAtom(pp->src.OwnerFile)->StrOfAE;
if (codeptr->opc == UNDEF_OPCODE) {
LOCAL_ActiveError->prologPredFirstLine = 0;
LOCAL_ActiveError->prologPredLine = 0;
LOCAL_ActiveError->prologPredLastLine = 0;
return true;
t->prologPredLine = 0;
return t;
} else if (pp->cs.p_code.NOfClauses) {
if ((LOCAL_ActiveError->prologPredCl =
find_code_in_clause(pp, codeptr, &begin, NULL)) <= 0) {
LOCAL_ActiveError->prologPredLine = 0;
if ((t->prologPredLine = find_code_in_clause(pp, codeptr, &begin, NULL)) <=
0) {
t->prologPredLine = 0;
} else {
LOCAL_ActiveError->prologPredLine = IntegerOfTerm(clause_loc(begin, pp));
t->prologPredLine = IntegerOfTerm(clause_loc(begin, pp));
}
if (pp->PredFlags & LogUpdatePredFlag) {
LOCAL_ActiveError->prologPredFirstLine = IntegerOfTerm(
ts[0] = clause_loc(
ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp));
LOCAL_ActiveError->prologPredLastLine = IntegerOfTerm(
ts[1] = clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause),
pp));
} else {
LOCAL_ActiveError->prologPredFirstLine = IntegerOfTerm(
ts[0] = clause_loc(
ClauseCodeToStaticClause(pp->cs.p_code.FirstClause), pp));
LOCAL_ActiveError->prologPredLastLine = IntegerOfTerm(
ts[1] = clause_loc(ClauseCodeToStaticClause(pp->cs.p_code.LastClause),
pp));
}
return true;
return t;
} else {
return false;
t->prologPredLine = t->errorLine;
t->prologPredFile = t->errorFile;
return t;
}
}
@ -1141,29 +1179,47 @@ static Term error_culprit(bool internal USES_REGS) {
return TermNil;
}
bool Yap_find_prolog_culprit(USES_REGS1) {
yap_error_descriptor_t *
Yap_prolog_add_culprit(yap_error_descriptor_t *t PASS_REGS) {
PredEntry *pe;
void *startp, *endp;
// case number 1: Yap_Error called from built-in.
pe = ClauseInfoForCode(P, &startp, &endp PASS_REGS);
if (pe && (CurrentModule == 0 || !(pe->PredFlags & HiddenPredFlag))) {
return set_clause_info(P, pe);
return set_clause_info(t, P, pe);
} else {
CELL *curENV = ENV;
yamop *curCP = CP;
choiceptr curB = B;
PredEntry *pe = EnvPreg(curCP);
while (curCP != YESCODE) {
curENV = (CELL *)(curENV[E_E]);
if (curENV == NULL)
break;
pe = EnvPreg(curCP);
if (pe->ModuleOfPred)
return set_clause_info(curCP, pe);
curCP = (yamop *)(curENV[E_CP]);
if (curENV) {
pe = EnvPreg(curCP);
curENV = (CELL *)(curENV[E_E]);
if (curENV < ASP || curENV >= LCL0) {
break;
}
curCP = (yamop *)curENV[E_CP];
if (pe == NULL) {
pe = PredMetaCall;
}
if (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag))
return set_clause_info(t, curCP, pe);
curCP = (yamop *)(curENV[E_CP]);
} else if (0) {
if (curB->cp_ap != NOCODE && curB->cp_ap != TRUSTFAILCODE &&
curB->cp_ap != FAILCODE) {
pe = curB->cp_ap->y_u.Otapl.p;
if (pe && (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag)))
return set_clause_info(t, curB->cp_ap, pe);
}
curB = curB->cp_b;
}
}
}
return TermNil;
return NULL;
}
static Term all_calls(bool internal USES_REGS) {
@ -1187,19 +1243,20 @@ static Term all_calls(bool internal USES_REGS) {
return Yap_MkApplTerm(f, 6, ts);
}
/**
* report the current status of the stacks up to level $N$
*
* @param depth
*
* @return data on the current program counter
*/
Term Yap_all_calls(void) {
CACHE_REGS
return all_calls(true PASS_REGS);
}
/**
* @pred current_stack( +Depth )
*
* report the current status of the stacks up to level $N$
*
* @param Depth
*
* @return data on the current Prolog stack.
*/
static Int current_stack(USES_REGS1) {
Term t;
while ((t = all_calls(false PASS_REGS)) == 0L) {
@ -1316,15 +1373,15 @@ void Yap_dump_code_area_for_profiler(void) {
while (pp != NULL) {
/* if (pp->ArityOfPE) {
fprintf(stderr,"%s/%d %p\n",
RepAtom(NameOfFunctor(pp->FunctorOfPred))->StrOfAE,
pp->ArityOfPE,
pp);
} else {
fprintf(stderr,"%s %p\n",
RepAtom((Atom)(pp->FunctorOfPred))->StrOfAE,
pp);
}*/
fprintf(stderr,"%%s/%d %p\n",
RepAtom(NameOfFunctor(pp->FunctorOfPred))->StrOfAE,
pp->ArityOfPE,
pp);
} else {
fprintf(stderr,"%%s %p\n",
RepAtom((Atom)(pp->FunctorOfPred))->StrOfAE,
pp);
}*/
add_code_in_pred(pp);
pp = pp->NextPredOfModule;
}
@ -1368,7 +1425,7 @@ static Term BuildActivePred(PredEntry *ap, CELL *vect) {
arity_t i;
if (!ap->ArityOfPE) {
return MkVarTerm();
return MkAtomTerm((Atom)ap->FunctorOfPred);
}
for (i = 0; i < ap->ArityOfPE; i++) {
Term t = Deref(vect[i]);
@ -1630,7 +1687,7 @@ static Int p_choicepoint_info(USES_REGS1) {
}
static Int /* $parent_pred(Module, Name, Arity) */
parent_pred(USES_REGS1) {
parent_pred(USES_REGS1) {
/* This predicate is called from the debugger.
We assume a sequence of the form a -> b */
Atom at;
@ -1646,8 +1703,11 @@ static Int /* $parent_pred(Module, Name, Arity) */
}
void Yap_dump_stack(void);
void DumpActiveGoals(CACHE_TYPE1);
static int hidden(Atom);
static int legal_env(CELL *CACHE_TYPE);
#define ONLOCAL(ptr) \
@ -1718,13 +1778,74 @@ void Yap_dump_stack(void) {
/* check if handled */
if (handled_exception(PASS_REGS1))
return;
#if DEBUG
#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);
fprintf(stderr, "%% YAP mode: %ux\n", (unsigned int)LOCAL_PrologMode);
if (LOCAL_ErrorMessage)
fprintf(stderr, "%% LOCAL_ErrorMessage: %s\n", LOCAL_ErrorMessage);
#endif
fprintf(stderr, "%% \n%% =====================================\n%%\n");
fprintf(stderr, "%% \n%% YAP Status:\n");
fprintf(stderr, "%% \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));
fprintf(stderr, "%% Execution mode\n");
if (LOCAL_PrologMode & BootMode)
fprintf(stderr, "%% Bootstrap\n");
if (LOCAL_PrologMode & UserMode)
fprintf(stderr, "%% User Prolo\n");
if (LOCAL_PrologMode & CritMode)
fprintf(stderr, "%% Exclusive Access Mode\n");
if (LOCAL_PrologMode & AbortMode)
fprintf(stderr, "%% Abort\n");
if (LOCAL_PrologMode & InterruptMode)
fprintf(stderr, "%% Interrupt\n");
if (LOCAL_PrologMode & InErrorMode)
fprintf(stderr, "%% Error\n");
if (LOCAL_PrologMode & ConsoleGetcMode)
fprintf(stderr, "%% Prompt Console\n");
if (LOCAL_PrologMode & ExtendStackMode)
fprintf(stderr, "%% Stack expansion \n");
if (LOCAL_PrologMode & GrowHeapMode)
fprintf(stderr, "%% Data Base Expansion\n");
if (LOCAL_PrologMode & GrowStackMode)
fprintf(stderr, "%% User Prolog\n");
if (LOCAL_PrologMode & GCMode)
fprintf(stderr, "%% Garbage Collection\n");
if (LOCAL_PrologMode & ErrorHandlingMode)
fprintf(stderr, "%% Error handler\n");
if (LOCAL_PrologMode & CCallMode)
fprintf(stderr, "%% System Foreign Code\n");
if (LOCAL_PrologMode & UnifyMode)
fprintf(stderr, "%% Off-line Foreign Code\n");
if (LOCAL_PrologMode & UserCCallMode)
fprintf(stderr, "%% User Foreig C\n");
if (LOCAL_PrologMode & MallocMode)
fprintf(stderr, "%% Heap Allocaror\n");
if (LOCAL_PrologMode & SystemMode)
fprintf(stderr, "%% Prolog Internals\n");
if (LOCAL_PrologMode & AsyncIntMode)
fprintf(stderr, "%% Async Interruot mode\n");
if (LOCAL_PrologMode & InReadlineMode)
fprintf(stderr, "%% 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_output_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "%% Continuation: %s\n", (char *)HR);
Yap_output_bug_location(B->cp_ap, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "%% Alternative: %s\n", (char *)HR);
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
fprintf(stderr, "%% \n%% YAP Stack Usage:\n");
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
if (HR > ASP || HR > LCL0) {
fprintf(stderr, "%% YAP ERROR: Global Collided against Local (%p--%p)\n",
HR, ASP);
@ -1734,7 +1855,7 @@ void Yap_dump_stack(void) {
HeapTop, LOCAL_GlobalBase);
} else {
#if !USE_SYSTEM_MALLOC
fprintf(stderr, "%ldKB of Code Space (%p--%p)\n",
fprintf(stderr, "%%ldKB of Code Space (%p--%p)\n",
(long int)((CELL)HeapTop - (CELL)Yap_HeapBase) / 1024, Yap_HeapBase,
HeapTop);
#if USE_DL_MALLOC
@ -1747,10 +1868,6 @@ void Yap_dump_stack(void) {
}
#endif
#endif
Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "%%\n%% PC: %s\n", (char *)HR);
Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "%% Continuation: %s\n", (char *)HR);
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",
@ -1773,12 +1890,15 @@ void Yap_dump_stack(void) {
}
}
#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");
while (b_ptr != NULL) {
while (env_ptr && env_ptr <= (CELL *)b_ptr) {
Yap_detect_bug_location(ipc, FIND_PRED_FROM_ENV, 256);
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);
@ -1794,7 +1914,7 @@ void Yap_dump_stack(void) {
}
if (b_ptr) {
if (!max_count--) {
fprintf(stderr, "%% .....\n");
fprintf(stderr, "// .....\n");
return;
}
if (b_ptr->cp_ap && /* tabling */
@ -1802,7 +1922,7 @@ void Yap_dump_stack(void) {
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);
Yap_output_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256);
fprintf(stderr, "%% %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);
@ -1813,6 +1933,7 @@ void Yap_dump_stack(void) {
}
}
void DumpActiveGoals(USES_REGS1) {
/* try to dump active goals */
CELL *ep = YENV; /* and current environment */
@ -1868,7 +1989,7 @@ void DumpActiveGoals(USES_REGS1) {
op_numbers opnum;
if (!ONLOCAL(b_ptr) || b_ptr->cp_b == NULL)
break;
fprintf(stderr, "%p ", b_ptr);
fprintf(stderr, "%% %p ", b_ptr);
pe = Yap_PredForChoicePt(b_ptr, &opnum);
if (opnum == _Nstop) {
fprintf(stderr, " ********** C-Code Interface Boundary ***********\n");
@ -1947,7 +2068,12 @@ void DumpActiveGoals(USES_REGS1) {
}
}
void Yap_detect_bug_location(yamop *yap_pc, int where_from, int psize) {
/**
* Used for debugging.
*
*/
void Yap_output_bug_location(yamop *yap_pc, int where_from, int psize) {
Atom pred_name;
UInt pred_arity;
Term pred_module;
@ -1956,39 +2082,40 @@ void Yap_detect_bug_location(yamop *yap_pc, int where_from, int psize) {
if ((cl = Yap_PredForCode(yap_pc, where_from, &pred_name, &pred_arity,
&pred_module)) == 0) {
/* system predicate */
fprintf(stderr, "%s", "meta-call");
fprintf(stderr, "%% %s", "meta-call");
} else if (pred_module == 0) {
fprintf(stderr, "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,
fprintf(stderr, "%% %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",
fprintf(stderr, "%% %s:%s/%lu at clause %lu",
RepAtom(AtomOfTerm(pred_module))->StrOfAE,
RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity,
(unsigned long int)cl);
}
}
static Term build_bug_location(yamop *codeptr, PredEntry *pe) {
static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p,
yamop *codeptr, PredEntry *pe) {
CACHE_REGS
Term p[5];
if (pe->ModuleOfPred == PROLOG_MODULE)
p[0] = TermProlog;
p->prologPredModule = AtomName(AtomProlog);
else
p[0] = pe->ModuleOfPred;
p->prologPredModule = AtomName(AtomOfTerm(pe->ModuleOfPred));
if (pe->ArityOfPE)
p[1] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
p->prologPredName = AtomName(NameOfFunctor(pe->FunctorOfPred));
else
p[1] = MkAtomTerm((Atom)pe->FunctorOfPred);
p[2] = MkIntegerTerm(pe->ArityOfPE);
p->prologPredName = AtomName((Atom)(pe->FunctorOfPred));
p->prologPredArity = pe->ArityOfPE;
p->prologPredFile = AtomName(pe->src.OwnerFile);
p->prologPredLine = 0;
if (pe->src.OwnerFile) {
p[3] = MkAtomTerm(pe->src.OwnerFile);
if (pe->PredFlags & MegaClausePredFlag) {
MegaClause *mcl;
mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
p[4] = MkIntegerTerm(mcl->ClLine);
p->prologPredLine = mcl->ClLine;
} else {
void *clcode;
if (find_code_in_clause(pe, codeptr, &clcode, NULL) > 0) {
@ -1996,68 +2123,76 @@ static Term build_bug_location(yamop *codeptr, PredEntry *pe) {
LogUpdClause *cl = clcode;
if (cl->ClFlags & FactMask) {
p[4] = MkIntegerTerm(cl->lusl.ClLine);
} else {
p[4] = MkIntegerTerm(cl->lusl.ClSource->ag.line_number);
p->prologPredLine = cl->lusl.ClSource->ag.line_number;
}
} else if (pe->PredFlags & DynamicPredFlag) {
p[4] = MkIntTerm(0);
p->prologPredLine = 0;
} else {
StaticClause *cl;
cl = clcode;
if (cl->ClFlags & FactMask) {
p[4] = MkIntTerm(cl->usc.ClLine);
p->prologPredLine = MkIntTerm(cl->usc.ClLine);
} else if (cl->ClFlags & SrcMask) {
p[4] = MkIntTerm(cl->usc.ClSource->ag.line_number);
p->prologPredLine = cl->usc.ClSource->ag.line_number;
} else
p[4] = MkIntTerm(0);
p->prologPredLine = 0;
}
} else {
p[4] = MkIntTerm(0);
p->prologPredLine = 0;
}
}
} else if (pe->OpcodeOfPred == UNDEF_OPCODE) {
RESET_VARIABLE(p + 3);
RESET_VARIABLE(p + 4);
p->prologPredFile = "undefined";
} else {
// by default, user_input
p[3] = MkAtomTerm(AtomUserIn);
p[4] = MkIntTerm(0);
p->prologPredFile = AtomName(AtomUserIn);
p->prologPredLine = 0;
}
return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("p"), 5), 5, p);
return p;
}
Term Yap_pc_location(yamop *pc, choiceptr b_ptr, CELL *env) {
yap_error_descriptor_t *Yap_pc_add_location(yap_error_descriptor_t *t,
void *pc0, void *b_ptr0,
void *env0) {
CACHE_REGS
yamop *codeptr = pc;
yamop *xc = pc0;
// choiceptr b_ptr = b_ptr0;
// CELL *env = env0;
PredEntry *pe;
if (PP == NULL) {
if (PredForCode(pc, NULL, NULL, NULL, &pe) <= 0)
return TermNil;
if (PredForCode(xc, NULL, NULL, NULL, &pe) <= 0)
return NULL;
} else
pe = PP;
if (pe != NULL
// pe->ModuleOfPred != PROLOG_MODULE &&
// &&!(pe->PredFlags & HiddenPredFlag)
) {
return build_bug_location(codeptr, pe);
) {
return add_bug_location(t, xc, pe);
}
return TermNil;
return NULL;
}
Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first) {
yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,
void *cp0, void *b_ptr0,
void *env0, YAP_Int ignore_first) {
yamop *cp = cp0;
choiceptr b_ptr = b_ptr0;
CELL *env = env0;
while (true) {
if (b_ptr == NULL || env == NULL)
return TermNil;
return NULL;
PredEntry *pe = EnvPreg(cp);
if (pe == PredTrue)
return TermNil;
if (ignore_first <= 0 && pe
return NULL;
if (ignore_first <= 0 &&
pe
// pe->ModuleOfPred != PROLOG_MODULE &&s
&& !(pe->PredFlags & HiddenPredFlag)) {
return build_bug_location(cp, pe);
return add_bug_location(t, cp, pe);
} else {
if (NULL && b_ptr && b_ptr->cp_env < env) {
cp = b_ptr->cp_cp;
@ -2072,14 +2207,43 @@ Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first) {
}
}
/*
Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first)
{ while (true) { if (b_ptr == NULL || env == NULL) return TermNil; PredEntry
*pe = EnvPreg(cp); if (pe == PredTrue) return TermNil; if (ignore_first <= 0
&& pe
// pe->ModuleOfPred != PROLOG_MODULE &&s
&& !(pe->PredFlags & HiddenPredFlag)) {
return add_bug_location(cp, pe);
} else {
if (NULL && b_ptr && b_ptr->cp_env < env) {
cp = b_ptr->cp_cp;
env = b_ptr->cp_env;
b_ptr = b_ptr->cp_b;
} else {
cp = (yamop *)env[E_CP];
env = ENV_Parent(env);
}
ignore_first--;
}
}
}
*/
static Term mkloc(yap_error_descriptor_t *t) { return TermNil; }
static Int clause_location(USES_REGS1) {
return Yap_unify(Yap_pc_location(P, B, ENV), ARG1) &&
Yap_unify(Yap_env_location(CP, B, ENV, 1), ARG2);
yap_error_descriptor_t t;
memset(&t, 0, sizeof(yap_error_descriptor_t));
return Yap_unify(mkloc(Yap_pc_add_location(&t, P, B, ENV)), ARG1) &&
Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 1)), ARG2);
}
static Int ancestor_location(USES_REGS1) {
return Yap_unify(Yap_env_location(CP, B, ENV, 2), ARG1) &&
Yap_unify(Yap_env_location(CP, B, ENV, 3), ARG2);
yap_error_descriptor_t t;
memset(&t, 0, sizeof(yap_error_descriptor_t));
return Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 2)), ARG2) &&
Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 3)), ARG2);
}
void Yap_InitStInfo(void) {

2
C/stackinfo.c
View File

@ -26,7 +26,7 @@
* @brief Get to know what is in your stack.
*
*
*/
` */
#include "Yap.h"
#include "clause.h"

23
C/stdpreds.c
View File

@ -948,9 +948,10 @@ static Int current_predicate(USES_REGS1) {
static OpEntry *NextOp(Prop pp USES_REGS) {
while (!EndOfPAEntr(pp) && pp->KindOfPE != OpProperty &&
(RepOpProp(pp)->OpModule != PROLOG_MODULE
|| RepOpProp(pp)->OpModule != CurrentModule) )
while (!EndOfPAEntr(pp) &&
pp->KindOfPE != OpProperty &&
(RepOpProp(pp)->OpModule != PROLOG_MODULE || RepOpProp(pp)->OpModule != CurrentModule)
)
pp = pp->NextOfPE;
return RepOpProp(pp);
}
@ -1348,13 +1349,17 @@ static Int p_statistics_lu_db_size(USES_REGS1) {
}
static Int p_executable(USES_REGS1) {
if (GLOBAL_argv && GLOBAL_argv[0])
Yap_findFile(GLOBAL_argv[0], NULL, NULL, LOCAL_FileNameBuf, true, YAP_EXE,
true, true);
else
strncpy(LOCAL_FileNameBuf, Yap_FindExecutable(), YAP_FILENAME_MAX - 1);
int lvl = push_text_stack();
const char *tmp =
return Yap_unify(MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)), ARG1);
Yap_AbsoluteFile(GLOBAL_argv[0], true);
if (!tmp || tmp[0] == '\0' ) {
tmp = Malloc(YAP_FILENAME_MAX + 1);
strncpy((char *)tmp, Yap_FindExecutable(), YAP_FILENAME_MAX);
}
Atom at = Yap_LookupAtom(tmp);
pop_text_stack(lvl);
return Yap_unify(MkAtomTerm(at), ARG1);
}
static Int p_system_mode(USES_REGS1) {

1098
C/text.c
View File

File diff suppressed because it is too large Load Diff

1257
C/text.c.new Normal file
View File

File diff suppressed because it is too large Load Diff

17
C/threads.c
View File

@ -28,7 +28,7 @@ static char SccsId[] = "%W% %G%";
#include "YapHeap.h"
#include "YapEval.h"
#include "yapio.h"
#include "blobs.h"
#include "YapBlobs.h"
#include <stdio.h>
#if HAVE_UNISTD_H
#include <unistd.h>
@ -384,7 +384,7 @@ setup_engine(int myworker_id, int init_thread)
// create a mbox
mboxCreate( MkIntTerm(myworker_id), &REMOTE_ThreadHandle(myworker_id).mbox_handle PASS_REGS );
Yap_InitTime( myworker_id );
Yap_InitYaamRegs( myworker_id );
Yap_InitYaamRegs( myworker_id, true] );
REFRESH_CACHE_REGS
Yap_ReleasePreAllocCodeSpace(Yap_PreAllocCodeSpace());
/* I exist */
@ -1174,9 +1174,9 @@ p_with_mutex( USES_REGS1 )
rc = TRUE;
}
end:
excep = Yap_GetException();
excep = Yap_GetException(LOCAL_ComiittedError);
if ( !UnLockMutex(mut PASS_REGS) ) {
return FALSE;
return FALSE;c
}
if (creeping) {
Yap_signal( YAP_CREEP_SIGNAL );
@ -1756,7 +1756,7 @@ p_new_mutex(void)
p_with_mutex( USES_REGS1 )
{
Int mut;
Term t1 = Deref(ARG1), excep;
Term t1 = Deref(ARG1);
Int rc = FALSE;
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
PredEntry *pe;
@ -1813,11 +1813,12 @@ p_new_mutex(void)
}
end:
ARG1 = MkIntegerTerm(mut);
excep = Yap_GetException();
yap_error_descriptor_t *err = Yap_GetException();
if (creeping) {
Yap_signal( YAP_CREEP_SIGNAL );
} else if ( excep != 0) {
return Yap_JumpToEnv(excep);
} else if ( err ) {
LOCAL_ActiveError->errorNo = err->errorNo;
return Yap_JumpToEnv();
}
return rc;
}

73
C/tracer.c
View File

@ -1,19 +1,19 @@
/*************************************************************************
* *
* YAP Prolog @(#)amidefs.h 1.3 3/15/90
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: tracer.h *
* Last rev: *
* mods: *
* comments: definitions for low level tracer *
* *
*************************************************************************/
* *
* YAP Prolog @(#)amidefs.h 1.3 3/15/90
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: tracer.h *
* Last rev: *
* mods: *
* comments: definitions for low level tracer *
* *
*************************************************************************/
#include "Yap.h"
@ -48,7 +48,7 @@ static char *send_tracer_message(char *start, char *name, arity_t arity,
s = s1;
expand = false;
}
min = 1024;
min = 1024;
if (name == NULL) {
#ifdef YAPOR
d = snprintf(s, max, "(%d)%s", worker_id, start);
@ -81,32 +81,36 @@ static char *send_tracer_message(char *start, char *name, arity_t arity,
if (max > 16) {
*s++ = ',';
*s++ = ' ';
max-=2;
max -= 2;
} else {
expand = true;
continue;
}
}
const char *sn = Yap_TermToString(args[i], NULL, LOCAL_encoding,
const char *sn = Yap_TermToBuffer(args[i],
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) {
min = sz + 1024;
min = sz + 1024;
expand = true;
free((void*)sn);
continue;
}
strcpy(s, sn);
free((void*)sn);
sn = NULL;
s += sz;
max -= sz;
max -= sz;
}
if (arity) {
*s++ = ' ';
*s++ = ')';
max -= 2;
max -= 2;
}
}
} while (expand);
@ -114,7 +118,7 @@ static char *send_tracer_message(char *start, char *name, arity_t arity,
return s;
}
#if defined(__GNUC__)
#if defined(__GNUC__) || defined(__clang__)
unsigned long long vsc_count;
#else
unsigned long vsc_count;
@ -159,7 +163,7 @@ void jmp_deb2(void) { fprintf(stderr, "Here\n"); }
void jmp_deb(int i) {
if (i)
printf("Here we go %ld\n", old_value++);
printf("Here we go " Int_FORMAT "\n", old_value++);
if (old_value == 716)
jmp_deb2();
}
@ -202,6 +206,7 @@ bool low_level_trace__(yap_low_level_port port, PredEntry *pred, CELL *args) {
int l = push_text_stack();
/* extern int gc_calls; */
vsc_count++;
//fprintf(stderr,"%p-%p\n",B->cp_tr,TR);
// if (HR < ASP ) return;
// fif (vsc_count == 12534) jmp_deb( 2 );
char *buf = Malloc(512), *top = buf + 511, *b = buf;
@ -346,7 +351,7 @@ bool low_level_trace__(yap_low_level_port port, PredEntry *pred, CELL *args) {
if (p == pe) {
UNLOCK(Yap_heap_regs->low_level_trace_lock);
pop_text_stack(l);
ReleaseAndReturn(true);
return (true);
}
if (env_ptr != NULL)
env_ptr = (CELL *)(env_ptr[E_E]);
@ -354,8 +359,9 @@ bool low_level_trace__(yap_low_level_port port, PredEntry *pred, CELL *args) {
printf("\n");
}
#endif
b += snprintf(b, top - b, "%lld %ld ", vsc_count, LCL0 - (CELL *)B);
b += snprintf(b, top - b, "%ld ", LCL0 - (CELL *)Yap_REGS.CUT_C_TOP);
b += snprintf(b, top - b, "%llud " UInt_FORMAT " ", vsc_count,
LCL0 - (CELL *)B);
b += snprintf(b, top - b, Int_FORMAT " ", LCL0 - (CELL *)Yap_REGS.CUT_C_TOP);
#if defined(THREADS) || defined(YAPOR)
b += snprintf(b, top - b, "(%d)", worker_id);
#endif
@ -363,12 +369,13 @@ bool low_level_trace__(yap_low_level_port port, PredEntry *pred, CELL *args) {
if (pred == NULL) {
UNLOCK(Yap_low_level_trace_lock);
pop_text_stack(l);
ReleaseAndReturn(true);
return (true);
}
if (pred->ModuleOfPred == PROLOG_MODULE) {
if (!LOCAL_do_trace_primitives) {
UNLOCK(Yap_low_level_trace_lock);
ReleaseAndReturn(true);
pop_text_stack(l);
return (true);
}
mname = "prolog";
} else {
@ -453,14 +460,14 @@ bool low_level_trace__(yap_low_level_port port, PredEntry *pred, CELL *args) {
}
UNLOCK(Yap_low_level_trace_lock);
#if __ANDROID__
__android_log_print(ANDROID_LOG_DEBUG, "YAPDroid", "%s\n", buf);
__android_log_print(ANDROID_LOG_ERROR, "YAPDroid", "%s\n", buf);
#else
*b++ = '\n';
*b = '\0';
fputs(buf, stderr);
#endif
pop_text_stack(l);
ReleaseAndReturn(true);
return (true);
}
void toggle_low_level_trace(void) {
@ -482,7 +489,7 @@ static Int reset_total_choicepoints(USES_REGS1) {
}
static Int show_low_level_trace(USES_REGS1) {
fprintf(stderr, "Call counter=%llu\n", vsc_count);
fprintf(stderr, "Call counter=%lld\n", vsc_count);
return (TRUE);
}
@ -508,7 +515,7 @@ not being output.
static Int stop_low_level_trace(USES_REGS1) {
Yap_do_low_level_trace = FALSE;
LOCAL_do_trace_primitives = TRUE;
#if DEBUG_LOCKS
#if DEBUG_LOCKS////
debug_locks = TRUE;
#endif
return (TRUE);

2
C/unify.c
View File

@ -604,12 +604,10 @@ InitReverseLookupOpcode(void)
int hash_size_mask = OP_HASH_SIZE-1;
UInt sz = OP_HASH_SIZE*sizeof(struct opcode_tab_entry);
while (OP_RTABLE == NULL) {
if ((OP_RTABLE = (op_entry *)Yap_AllocCodeSpace(sz)) == NULL) {
if (!Yap_growheap(FALSE, sz, NULL)) {
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"Couldn't obtain space for the reverse translation opcode table");
}
}
}
memset(OP_RTABLE, 0, sz);

2
C/unify_absmi_insts.h
View File

@ -2,6 +2,8 @@
* Get Instructions *
\************************************************************************/
#include <amiops.h>
#ifdef INDENT_CODE
{
{

533
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) {
@ -182,7 +182,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
if (HR+sz > ASP - 2048) {
goto overflow;
}
memcpy((void *)HR, (void *)ap2, sz*sizeof(CELL));
memmove((void *)HR, (void *)ap2, sz*sizeof(CELL));
HR += sz;
} else {
*ptf++ = d0; /* you can just copy other extensions. */
@ -361,7 +361,7 @@ trail_overflow:
reset_trail(TR0);
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
return -3;
}
}
static Term
@ -531,25 +531,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 +840,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 +921,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 +930,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 +946,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 +978,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 +989,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 +1003,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);
}
@ -800,12 +1051,12 @@ Atom export_atom(Atom at, char **hpp, char *buf, size_t len)
ptr = (char *)AdjustSize((CELL*)ptr, buf);
p0 = ptr;
*ptr++ = 0;
sz = strlen(RepAtom(at)->StrOfAE);
if (sz + 1 >= len)
return (Atom)NULL;
strcpy(ptr, RepAtom(at)->StrOfAE);
*hpp = ptr+(sz+1);
*ptr++ = 0;
sz = strlen(RepAtom(at)->StrOfAE);
if (sz + 1 >= len)
return (Atom)NULL;
strcpy(ptr, RepAtom(at)->StrOfAE);
*hpp = ptr+(sz+1);
return (Atom)(p0-buf);
}
@ -827,7 +1078,7 @@ Functor export_functor(Functor f, char **hpp, char *buf, size_t len)
return (Functor)(((char *)hptr-buf)+1);
}
#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \
#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \
do { \
if ((CELL *)(D) < CellDifH(HR,HLow)) { (A) = (CELL *)(D); break; } \
(A) = (CELL *)(D); \
@ -845,7 +1096,7 @@ export_term_to_buffer(Term inpt, char *buf, char *bptr, CELL *t0 , CELL *tf, siz
if (buf + len < (char *)((CELL *)td + (tf-t0))) {
return FALSE;
}
memcpy((void *)td, (void *)t0, (tf-t0)* sizeof(CELL));
memmove((void *)td, (void *)t0, (tf-t0)* sizeof(CELL));
bf[0] = (td-buf);
bf[1] = (tf-t0);
bf[2] = inpt;
@ -945,7 +1196,7 @@ export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0,
if (HR+sz > ASP - 2048) {
goto overflow;
}
memcpy((void *)HR, (void *)ap2, sz*sizeof(CELL));
memmove((void *)HR, (void *)ap2, sz*sizeof(CELL));
HR += sz;
continue;
}
@ -1263,7 +1514,7 @@ Yap_ImportTerm(char * buf) {
return 0L;
}
}
memcpy(HR, buf+bc[0], sizeof(CELL)*sz);
memmove(HR, buf+bc[0], sizeof(CELL)*sz);
if (IsApplTerm(tinp)) {
tret = AbsAppl(HR);
import_compound(HR, (char *)HR, buf, HR);
@ -1617,8 +1868,9 @@ p_term_variables( USES_REGS1 ) /* variables in term t */
/**
* Exports a nil-terminated list with all the variables in a term.
* @param[in] the term
* @param[in] the arity of the calling predicate (required for exact garbage collection).
* @param[t] the term
* @param[arity] the arity of the calling predicate (required for exact garbage collection).
* @param[USES_REGS] threading
*/
Term
Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */
@ -1649,16 +1901,24 @@ Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */
return out;
}
typedef struct att_rec {
CELL *beg, *end;
CELL oval;
} att_rec_t;
static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS)
{
register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
int lvl = push_text_stack();
att_rec_t *to_visit0, *to_visit = Malloc(1024*sizeof(att_rec_t));
att_rec_t *to_visit_max;
register tr_fr_ptr TR0 = TR;
CELL *InitialH = HR;
CELL output = AbsPair(HR);
to_visit0 = to_visit;
loop:
to_visit_max = to_visit0+1024;
restart:
do {
while (pt0 < pt0_end) {
register CELL d0;
register CELL *ptd0;
@ -1669,7 +1929,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
attvars_in_term_nvar:
{
if (IsPairTerm(d0)) {
if (to_visit + 1024 >= (CELL **)AuxSp) {
if (to_visit + 32 >= to_visit_max) {
goto aux_overflow;
}
{
@ -1681,10 +1941,10 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
}
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
to_visit->beg = pt0;
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
@ -1696,8 +1956,8 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
pt0 = RepPair(d0) - 1;
pt0_end = pt0+2;
} else if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2;
Functor f;
CELL *ap2;
/* store the terms to visit */
ap2 = RepAppl(d0);
f = (Functor)(*ap2);
@ -1705,14 +1965,14 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
continue;
}
/* store the terms to visit */
if (to_visit + 1024 >= (CELL **)AuxSp) {
if (to_visit + 32 >= to_visit_max) {
goto aux_overflow;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
to_visit->beg = pt0;
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
@ -1721,9 +1981,9 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
to_visit += 2;
}
#endif
d0 = ArityOfFunctor(f);
arity_t a = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
pt0_end = ap2 + a;
}
continue;
}
@ -1749,15 +2009,16 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
HR += 2;
HR[-2] = (CELL)ptd0;
/* store the terms to visit */
if (to_visit + 1024 >= (CELL **)AuxSp) {
if (to_visit + 32 >= to_visit_max) {
goto aux_overflow;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermNil;
to_visit->beg = pt0;
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@ -1768,24 +2029,25 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
pt0 = &RepAttVar(ptd0)->Value;
pt0_end = &RepAttVar(ptd0)->Atts;
}
continue;
}
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
if (to_visit == to_visit0)
break;
#ifdef RATIONAL_TREES
to_visit -= 3;
pt0 = to_visit[0];
pt0_end = to_visit[1];
*pt0 = (CELL)to_visit[2];
to_visit --;
pt0 = to_visit->beg;
pt0_end = to_visit->end;
*pt0 = to_visit->oval;
#else
to_visit -= 2;
pt0 = to_visit[0];
pt0_end = to_visit[1];
#endif
goto loop;
}
} while(true);
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
pop_text_stack(lvl);
if (HR != InitialH) {
/* close the list */
Term t2 = Deref(inp);
@ -1803,43 +2065,39 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
trail_overflow:
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
to_visit --;
pt0 = to_visit->beg;
*pt0 = to_visit->oval;
}
#endif
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
pop_text_stack(lvl);
HR = InitialH;
return 0L;
aux_overflow:
LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **);
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
}
#endif
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
HR = InitialH;
return 0L;
{
size_t d1 = to_visit-to_visit0;
size_t d2 = to_visit_max-to_visit0;
to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024);
to_visit = to_visit0+d1;
to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **);
}
pt0--;
goto restart;
global_overflow:
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
to_visit --;
pt0 = to_visit->beg;
*pt0 = to_visit->oval;
}
#endif
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
pop_text_stack(lvl);
HR = InitialH;
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
LOCAL_Error_Size = (ASP-HR)*sizeof(CELL);
@ -1865,6 +2123,8 @@ p_term_attvars( USES_REGS1 ) /* variables in term t */
}
else {
Functor f = FunctorOfTerm(t);
if (IsExtensionFunctor(f))
return Yap_unify(TermNil, ARG2);
out = attvars_in_complex_term(RepAppl(t),
RepAppl(t)+
ArityOfFunctor(f), TermNil PASS_REGS);
@ -3467,7 +3727,7 @@ hash_complex_term(register CELL *pt0,
*st++ = LongIntOfTerm(d0);
break;
case (CELL)FunctorString:
memcpy(st, RepAppl(d0), (3+RepAppl(d0)[1])*sizeof(CELL));
memmove(st, RepAppl(d0), (3+RepAppl(d0)[1])*sizeof(CELL));
st += 3+RepAppl(d0)[1];
break;
#ifdef USE_GMP
@ -3482,7 +3742,7 @@ hash_complex_term(register CELL *pt0,
goto global_overflow;
}
/* then the actual number */
memcpy((void *)(st+1), (void *)(pt+1), sz);
memmove((void *)(st+1), (void *)(pt+1), sz);
st = st+sz/CellSize;
}
break;
@ -4585,16 +4845,22 @@ renumbervar(Term t, Int id USES_REGS)
ts[1] = MkIntegerTerm(id);
}
extern int vsc;
int vsc;
static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS)
{
register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
int lvl = push_text_stack();
att_rec_t *to_visit0, *to_visit = Malloc(1024*sizeof(att_rec_t));
att_rec_t *to_visit_max;
register tr_fr_ptr TR0 = TR;
CELL *InitialH = HR;
to_visit0 = to_visit;
loop:
to_visit_max = to_visit0+1024;
loop:
while (pt0 < pt0_end) {
register CELL d0;
register CELL *ptd0;
@ -4605,14 +4871,14 @@ static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end
vars_in_term_nvar:
{
if (IsPairTerm(d0)) {
if (to_visit + 1024 >= (CELL **)AuxSp) {
if (to_visit + 32 >= to_visit_max) {
goto aux_overflow;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
to_visit->beg = pt0;
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
@ -4624,8 +4890,8 @@ static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end
pt0 = RepPair(d0) - 1;
pt0_end = RepPair(d0) + 1;
} else if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2;
Functor f;
CELL *ap2;
/* store the terms to visit */
ap2 = RepAppl(d0);
f = (Functor)(*ap2);
@ -4637,21 +4903,16 @@ static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end
continue;
}
/* store the terms to visit */
if (to_visit + 1024 >= (CELL **)AuxSp) {
goto aux_overflow;
}
if (to_visit + 32 >= to_visit_max) {
goto aux_overflow;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit += 2;
}
to_visit->beg = pt0;
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermNil;
#endif
d0 = ArityOfFunctor(f);
pt0 = ap2;
@ -4687,10 +4948,10 @@ static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end
/* 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];
to_visit --;
pt0 = to_visit->beg;
pt0_end = to_visit->end;
*pt0 = to_visit->oval;
#else
to_visit -= 2;
pt0 = to_visit[0];
@ -4700,52 +4961,50 @@ static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end
}
prune(B PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
pop_text_stack(lvl);
return numbv;
trail_overflow:
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
to_visit --;
pt0 = to_visit->beg;
pt0_end = to_visit->end;
*pt0 = to_visit->oval;
}
#endif
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
HR = InitialH;
pop_text_stack(lvl);
return numbv-1;
aux_overflow:
LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **);
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
}
#endif
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
HR = InitialH;
return numbv-1;
{
size_t d1 = to_visit-to_visit0;
size_t d2 = to_visit_max-to_visit0;
to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024);
to_visit = to_visit0+d1;
to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **);
}
pt0--;
goto loop;
global_overflow:
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
to_visit --;
pt0 = to_visit->beg;
pt0_end = to_visit->end;
*pt0 = to_visit->oval;
}
#endif
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
HR = InitialH;
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
LOCAL_Error_Size = (ASP-HR)*sizeof(CELL);
pop_text_stack(lvl);
return numbv-1;
}

295
C/write.c
View File

@ -1,4 +1,3 @@
/*************************************************************************
* *
* YAP Prolog *
@ -9,10 +8,9 @@
* *
**************************************************************************
* *
* File: write.c *
* Last rev: *
* mods: *
* comments: Writing a Prolog Term *
* File: write.c * Last
*rev: * mods:
** comments: Writing a Prolog Term *
* *
*************************************************************************/
#ifdef SCCS
@ -84,28 +82,29 @@ typedef struct write_globs {
#define lastw wglb->lw
#define last_minus wglb->last_atom_minus
static bool callPortray(Term t, struct DB_TERM **old_EXp, int sno USES_REGS) {
static bool callPortray(Term t, int sno USES_REGS) {
PredEntry *pe;
Int b0 = LCL0 - (CELL *)B;
*old_EXp = Yap_RefToException();
UNLOCK(GLOBAL_Stream[sno].streamlock);
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, &t, true PASS_REGS)) {
choiceptr B0 = (choiceptr)(LCL0 - b0);
if (Yap_HasException() && !*old_EXp)
*old_EXp = Yap_RefToException();
Yap_fail_all(B0 PASS_REGS);
LOCK(GLOBAL_Stream[sno].streamlock);
return true;
}
LOCK(GLOBAL_Stream[sno].streamlock);
if (Yap_HasException() && !*old_EXp)
*old_EXp = Yap_RefToException();
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 *);
@ -117,7 +116,7 @@ static void putAtom(Atom, int, struct write_globs *);
static void writeTerm(Term, int, int, int, struct write_globs *,
struct rewind_term *);
#define wrputc(WF, X) \
#define wrputc(WF, X) \
(X)->stream_wputc(X - GLOBAL_Stream, WF) /* writes a character */
/*
@ -191,7 +190,7 @@ inline static void wrputs(char *s, StreamDesc *stream) {
static char *ensure_space(size_t sz) {
CACHE_REGS
char *s;
char *s;
s = (char *)Yap_PreAllocCodeSpace();
while (s + sz >= (char *)AuxSp) {
@ -271,10 +270,10 @@ static void writebig(Term t, int p, int depth, int rinfixarg,
return;
#endif
} else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) {
Opaque_CallOnWrite f;
YAP_Opaque_CallOnWrite f;
CELL blob_info;
blob_info = big_tag - USER_BLOB_START;
blob_info = big_tag;
if (GLOBAL_OpaqueHandlers &&
(f = GLOBAL_OpaqueHandlers[blob_info].write_handler)) {
(f)(wglb->stream->file, big_tag, ExternalBlobFromTerm(t), 0);
@ -322,7 +321,7 @@ static void wrputf(Float f, struct write_globs *wglb) /* writes a float */
/* always use C locale for writing numbers */
#if O_LOCALE
const unsigned char *decimalpoint =
(unsigned char *)localeconv()->decimal_point;
(unsigned char *)localeconv()->decimal_point;
size_t l1 = strlen((const char *)decimalpoint + 1);
#else
const unsigned char decimalpoint[2] = ".";
@ -354,7 +353,7 @@ static void wrputf(Float f, struct write_globs *wglb) /* writes a float */
found_dot = TRUE;
wrputs(".0", stream);
}
found_dot = TRUE;
found_dot = true;
}
wrputc(ch, stream);
pt++;
@ -378,9 +377,8 @@ static void wrputf(Float f, struct write_globs *wglb) /* writes a float */
int Yap_FormatFloat(Float f, char **s, size_t sz) {
CACHE_REGS
struct write_globs wglb;
struct write_globs wglb;
int sno;
char *so;
sno = Yap_open_buf_write_stream(GLOBAL_Stream[LOCAL_c_output_stream].encoding,
0);
@ -389,10 +387,7 @@ int Yap_FormatFloat(Float f, char **s, size_t sz) {
wglb.lw = separator;
wglb.stream = GLOBAL_Stream + sno;
wrputf(f, &wglb);
wrputc('\0', wglb.stream);
so = Yap_MemExportStreamPtr(sno);
*s = Malloc( strlen(so) )+1;
strcpy(*s, so );
*s = Yap_MemExportStreamPtr(sno);
Yap_CloseStream(sno);
return true;
}
@ -479,12 +474,12 @@ AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
static void write_quoted(wchar_t ch, wchar_t quote, wrf stream) {
CACHE_REGS
if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) {
wrputc(ch, stream);
if (ch == '\'')
wrputc('\'', stream); /* be careful about quotes */
return;
}
if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) {
wrputc(ch, stream);
if (ch == '\'')
wrputc('\'', stream); /* be careful about quotes */
return;
}
if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\' &&
ch != '`') {
wrputc(ch, stream);
@ -566,13 +561,15 @@ static void write_string(const unsigned char *s,
qt = '"';
wrputc(qt, stream);
do {
int delta;
ptr += (delta = get_utf8(ptr, -1, &chr) );
int delta;
ptr += (delta = get_utf8(ptr, -1, &chr));
if (chr == '\0') {
break;
}
if (delta == 0) {chr = *ptr++; }
if (delta == 0) {
chr = *ptr++;
}
write_quoted(chr, qt, stream);
} while (true);
wrputc(qt, stream);
@ -588,7 +585,7 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
wrputblob(RepAtom(atom), Quote_illegal, wglb);
return;
}
s = RepAtom(atom)->UStrOfAE;
s = RepAtom(atom)->UStrOfAE;
/* #define CRYPT_FOR_STEVE 1*/
#ifdef CRYPT_FOR_STEVE
if (Yap_GetValue(AtomCryptAtoms) != TermNil &&
@ -609,7 +606,7 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
wrputc('\'', stream);
while (*s) {
int32_t ch;
s += get_utf8(s, 1, &ch);
s += get_utf8(s, -1, &ch);
write_quoted(ch, '\'', stream);
}
wrputc('\'', stream);
@ -678,67 +675,12 @@ 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
if (lastw == alphanum) {
wrputc(' ', wglb->stream);
}
if (lastw == alphanum) {
wrputc(' ', wglb->stream);
}
wrputc('_', wglb->stream);
/* make sure we don't get no creepy spaces where they shouldn't be */
lastw = separator;
@ -758,12 +700,11 @@ static void write_var(CELL *t, struct write_globs *wglb,
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);
wrputc(',', wglb->stream);
PROTECT(*t,writeTerm(*l, 999, 1, FALSE, wglb, &nrwt));
attv = RepAttVar(t);
wrputc(',', wglb->stream);
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;
@ -776,24 +717,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) {
@ -806,14 +729,12 @@ 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 */
@ -844,29 +765,18 @@ 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);
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,
writeTerm(ti, 999, depth, FALSE,
wglb, &nrwt);
restore_from_write(&nrwt, wglb);
}
}
@ -874,10 +784,9 @@ 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;
struct rewind_term nrwt;
nrwt.parent = rwt;
nrwt.u_sd.s.ptr = 0;
@ -885,8 +794,6 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
putAtom(Atom3Dots, wglb->Quote_illegal, wglb);
return;
}
DBTerm *ex;
Yap_ResetException(worker_id);
t = Deref(t);
if (IsVarTerm(t)) {
write_var((CELL *)t, wglb, &nrwt);
@ -900,20 +807,16 @@ 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,
writeTerm(TailOfTerm(t), 999, depth + 1,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
wrclose_bracket(wglb, TRUE);
return;
}
if (wglb->Use_portray)
if (callPortray(t, &ex, wglb->stream - GLOBAL_Stream PASS_REGS)) {
Yap_CopyException(ex);
Yap_RaiseException();
if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
return;
}
if (trueGlobalPrologFlag(WRITE_STRINGS_FLAG) && IsCodesTerm(t)) {
@ -949,7 +852,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
case (CELL)FunctorLongInt:
wrputn(LongIntOfTerm(t), wglb);
return;
/* case (CELL)FunctorBigInt: */
/* case (CELL)FunctorBigInt: */
default:
writebig(t, p, depth, rinfixarg, wglb, rwt);
return;
@ -974,9 +877,8 @@ 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++;
@ -986,16 +888,14 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
}
#endif
if (wglb->Use_portray) {
if (callPortray(t, &ex, wglb->stream - GLOBAL_Stream PASS_REGS)) {
Yap_CopyException(ex);
Yap_RaiseException();
if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
return;
}
}
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
Term tright = ArgOfTerm(1, t);
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright));
Yap_IsOp(AtomOfTerm(tright));
if (op > p) {
wropen_bracket(wglb, TRUE);
}
@ -1006,9 +906,8 @@ 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,
writeTerm(tright, rp, depth + 1, TRUE,
wglb, &nrwt);
restore_from_write(&nrwt, wglb);
if (bracket_right) {
wrclose_bracket(wglb, TRUE);
}
@ -1033,7 +932,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
offset = 1;
}
bracket_left =
!IsVarTerm(tleft) && IsAtomTerm(tleft) && Yap_IsOp(AtomOfTerm(tleft));
!IsVarTerm(tleft) && IsAtomTerm(tleft) && Yap_IsOp(AtomOfTerm(tleft));
if (op > p) {
/* avoid stuff such as \+ (a,b) being written as \+(a,b) */
wropen_bracket(wglb, TRUE);
@ -1041,9 +940,8 @@ 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,
writeTerm(ArgOfTerm(offset,t), lp, depth + 1,
rinfixarg, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
if (bracket_left) {
wrclose_bracket(wglb, TRUE);
}
@ -1076,9 +974,9 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
Term tleft = ArgOfTerm(1, t);
Term tright = ArgOfTerm(2, t);
int bracket_left =
!IsVarTerm(tleft) && IsAtomTerm(tleft) && Yap_IsOp(AtomOfTerm(tleft));
!IsVarTerm(tleft) && IsAtomTerm(tleft) && Yap_IsOp(AtomOfTerm(tleft));
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright));
Yap_IsOp(AtomOfTerm(tright));
if (op > p) {
/* avoid stuff such as \+ (a,b) being written as \+(a,b) */
@ -1088,9 +986,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);
}
@ -1109,9 +1006,8 @@ 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,
writeTerm(ArgOfTerm(2,t), rp, depth + 1, TRUE,
wglb, &nrwt);
restore_from_write(&nrwt, wglb);
if (bracket_right) {
wrclose_bracket(wglb, TRUE);
}
@ -1151,17 +1047,15 @@ 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,
writeTerm(ArgOfTerm(1, t), 999, depth + 1,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
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,
writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority,
depth + 1, FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
wrputc('}', wglb->stream);
lastw = separator;
} else if (atom == AtomArray) {
@ -1172,35 +1066,37 @@ 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,
writeTerm(ArgOfTerm(op, t), 999, depth + 1,
FALSE, wglb, &nrwt);
t = AbsAppl(restore_from_write(&nrwt, wglb) - op);
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) {
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);
}
}
@ -1213,13 +1109,16 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
/* write options */
{
CACHE_REGS
struct write_globs wglb;
struct write_globs wglb;
struct rewind_term rwt;
yhandle_t sls = Yap_CurrentSlot();
int lvl = push_text_stack();
if (t == 0)
return;
if (!mywrite) {
CACHE_REGS
wglb.stream = GLOBAL_Stream + LOCAL_c_error_stream;
wglb.stream = GLOBAL_Stream + LOCAL_c_error_stream;
} else
wglb.stream = mywrite;
wglb.lw = start;
@ -1237,8 +1136,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);
@ -1252,31 +1161,7 @@ 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);
}
char *Yap_TermToString(Term t, size_t *lengthp, encoding_t enc, int flags) {
CACHE_REGS
int sno = Yap_open_buf_write_stream(enc, flags);
const char *sf;
DBTerm *e = LOCAL_BallTerm;
if (sno < 0)
return NULL;
LOCAL_c_output_stream = sno;
if (enc)
GLOBAL_Stream[sno].encoding = enc;
else
GLOBAL_Stream[sno].encoding = LOCAL_encoding;
Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority);
sf = Yap_MemExportStreamPtr(sno);
size_t len = strlen(sf);
char *new = malloc( len + 1 );
strcpy( new, sf );
Yap_CloseStream(sno);
if (e)
LOCAL_BallTerm = e;
return new;
}

0
interactive.py → C/y
View File

687
C/yap-args.c
View File

@ -1,33 +1,41 @@
/*************************************************************************
* *
* 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: parse arguments *
* *
*************************************************************************/
/* static char SccsId[] = "X 4.3.3"; */
/*************************************************************************
* *
* 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: parse arguments *
* *
*************************************************************************/
/* static char SccsId[] = "X 4.3.3"; */
#include "Yap.h"
#include "YapHeap.h"
#include "YapInterface.h"
#include "config.h"
#include "YapStreams.h"
#include "iopreds.h"
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_STDINT_H
#include <stdint.h>
#endif
#include <stddef.h>
#include <stdlib.h>
#include <stddef.h>
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
#ifdef HAVE_UNISTD_H
#undef HAVE_UNISTD_H
@ -35,16 +43,325 @@
#endif
#include <stdio.h>
#if HAVE_STRING_H
#include <string.h>
#endif
#if HAVE_ERRNO_H
#include <errno.h>
#endif
#if HAVE_DIRECT_H
#include <direct.h>
#endif
#if HAVE_LIBGEN_H
#include <libgen.h>
#endif
X_API bool YAP_initialized = false;
static int n_mdelays = 0;
static YAP_delaymodule_t *m_delays;
static void init_globals(YAP_init_args *yap_init) {
GLOBAL_FAST_BOOT_FLAG = yap_init->FastBoot;
#if defined(YAPOR) || defined(TABLING)
Yap_init_root_frames();
#endif /* YAPOR || TABLING */
#ifdef YAPOR
Yap_init_yapor_workers();
#if YAPOR_THREADS
if (Yap_thread_self() != 0) {
#else
if (worker_id != 0) {
#endif
#if defined(YAPOR_COPY) || defined(YAPOR_SBA)
/*
In the SBA we cannot just happily inherit registers
from the other workers
*/
Yap_InitYaamRegs(worker_id, true);
#endif /* YAPOR_COPY || YAPOR_SBA */
#ifndef YAPOR_THREADS
Yap_InitPreAllocCodeSpace(0);
#endif /* YAPOR_THREADS */
/* slaves, waiting for work */
CurrentModule = USER_MODULE;
P = GETWORK_FIRST_TIME;
Yap_exec_absmi(FALSE, YAP_EXEC_ABSMI);
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"abstract machine unexpected exit (YAP_Init)");
}
#endif /* YAPOR */
RECOVER_MACHINE_REGS();
/* make sure we do this after restore */
if (yap_init->MaxStackSize) {
GLOBAL_AllowLocalExpansion = FALSE;
} else {
GLOBAL_AllowLocalExpansion = TRUE;
}
if (yap_init->MaxGlobalSize) {
GLOBAL_AllowGlobalExpansion = FALSE;
} else {
GLOBAL_AllowGlobalExpansion = TRUE;
}
if (yap_init->MaxTrailSize) {
GLOBAL_AllowTrailExpansion = FALSE;
} else {
GLOBAL_AllowTrailExpansion = TRUE;
}
if (yap_init->PrologRCFile) {
Yap_PutValue(AtomConsultOnBoot,
MkAtomTerm(Yap_LookupAtom(yap_init->PrologRCFile)));
/*
This must be done again after restore, as yap_flags
has been overwritten ....
*/
setBooleanGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG,
yap_init->HaltAfterBoot);
}
if (yap_init->PrologTopLevelGoal) {
Yap_PutValue(AtomTopLevelGoal,
MkAtomTerm(Yap_LookupAtom(yap_init->PrologTopLevelGoal)));
}
if (yap_init->PrologGoal) {
Yap_PutValue(AtomInitGoal,
MkAtomTerm(Yap_LookupAtom(yap_init->PrologGoal)));
}
if (yap_init->PrologAddPath) {
Yap_PutValue(AtomExtendFileSearchPath,
MkAtomTerm(Yap_LookupAtom(yap_init->PrologAddPath)));
}
if (yap_init->QuietMode) {
setVerbosity(TermSilent);
}
}
const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR,
*Yap_PLDIR, *Yap_BOOTSTRAP, *Yap_COMMONSDIR, *Yap_INPUT_STARTUP,
*Yap_OUTPUT_STARTUP, *Yap_BOOTFILE, *Yap_INCLUDEDIR;
/**
* consult loop in C: used to boot the system, butt supports goal execution and
* recursive consulting.
*
* */
static bool consult(const char *b_file USES_REGS) {
Term t;
int c_stream, osno, oactive;
Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1);
Functor functor_command1 = Yap_MkFunctor(Yap_LookupAtom(":-"), 1);
Functor functor_compile2 = Yap_MkFunctor(Yap_LookupAtom("c_compile"), 1);
/* consult in C */
int lvl = push_text_stack();
char *full;
/* the consult mode does not matter here, really */
if ((osno = Yap_CheckAlias(AtomLoopStream)) < 0) {
osno = 0;
}
c_stream = YAP_InitConsult(YAP_BOOT_MODE, b_file, &full, &oactive);
if (c_stream < 0) {
fprintf(stderr, "[ FATAL ERROR: could not open file %s ]\n", b_file);
pop_text_stack(lvl);
exit(1);
}
if (!Yap_AddAlias(AtomLoopStream, c_stream)) {
pop_text_stack(lvl);
return false;
}
do {
CACHE_REGS
YAP_Reset(YAP_FULL_RESET, false);
Yap_StartSlots();
Term vs = MkVarTerm(), pos = MkVarTerm();
t = YAP_ReadClauseFromStream(c_stream, vs, pos);
// Yap_GetNèwSlot(t);
if (t == TermEof)
break;
if (t == 0) {
fprintf(stderr, "[ SYNTAX ERROR: while parsing stream %s at line %ld ]\n",
b_file, GLOBAL_Stream[c_stream].linecount);
} else if (IsVarTerm(t) || t == TermNil) {
fprintf(stderr, "[ line: " Int_FORMAT ": term cannot be compiled ]",
GLOBAL_Stream[c_stream].linecount);
} else if (IsApplTerm(t) && (FunctorOfTerm(t) == functor_query ||
FunctorOfTerm(t) == functor_command1)) {
t = ArgOfTerm(1, t);
if (IsApplTerm(t) && FunctorOfTerm(t) == functor_compile2) {
consult(RepAtom(AtomOfTerm(ArgOfTerm(1, t)))->StrOfAE);
} else {
YAP_RunGoalOnce(t);
}
} else {
YAP_CompileClause(t);
}
yap_error_descriptor_t *errd;
if ((errd = Yap_GetException(LOCAL_ActiveError))) {
fprintf(stderr, "%s:%ld:0: Error %s %s Found\n", errd->errorFile,
(long int)errd->errorLine, errd->classAsText, errd->errorAsText);
}
} while (true);
BACKUP_MACHINE_REGS();
YAP_EndConsult(c_stream, &osno, full);
if (!Yap_AddAlias(AtomLoopStream, osno)) {
pop_text_stack(lvl);
return false;
}
pop_text_stack(lvl);
return true;
}
///
///
static const char *sel(bool dir, bool ok1, const char *s1, bool ok2,
const char *s2, ...) {
if (ok1 && s1)
return s1;
if (ok2)
return s2;
return NULL;
}
static const char *join(const char *s0, const char *s1) {
CACHE_REGS
if (!s0 || s0[0] == '\0')
return s1;
if (!s1 || s1[0] == '\0')
return s0;
// int lvl = push_text_stack();
char *buf = malloc(FILENAME_MAX + 1);
strcpy(buf, s0);
strcat(buf, s1);
return buf;
}
static void Yap_set_locations(YAP_init_args *iap) {
/// ROOT_DIR is the home of the YAP system. It can be:
/// -- provided by the user;
/// -- obtained from DESTDIR + DE=efalkRoot
///
/// It is:
// --_not useful in Android, WIN32;
/// -- DESTDIR/ in Anaconda
/// -- /usr/locall in most Unix style systems
Yap_ROOTDIR = sel(true, iap->ROOTDIR != NULL, iap->ROOTDIR, true,
#if __ANDROID__
NULL,
#else
join(getenv("DESTDIR"), YAP_ROOTDIR),
#endif
false);
/// BINDIR: where the OS stores header files, namely libYap...
Yap_BINDIR = sel(true, iap->BINDIR != NULL, iap->BINDIR, true,
#if __ANDROID__
NULL,
#else
join(getenv("DESTDIR"), YAP_BINDIR),
#endif
false);
/// LIBDIR: where the OS stores dynamic libraries, namely libYap...
Yap_LIBDIR = sel(true, iap->LIBDIR != NULL, iap->LIBDIR, true,
#if __ANDROID__
NULL,
#else
join(getenv("DESTDIR"), YAP_LIBDIR),
#endif
false);
/// DLLDIR: where libraries can find expicitely loaded DLLs
Yap_DLLDIR = sel(true, iap->DLLDIR != NULL, iap->DLLDIR, true,
#if __ANDROID__
NULL,
#else
join(getenv("DESTDIR"), YAP_DLLDIR),
#endif
false);
/// INCLUDEDIR: where the OS stores header files, namely libYap...
Yap_INCLUDEDIR = sel(true, iap->INCLUDEDIR != NULL, iap->INCLUDEDIR, true,
#if __ANDROID__
NULL,
#else
join(getenv("DESTDIR"), YAP_INCLUDEDIR),
#endif
false);
/// SHAREDIR: where OS & ARCH independent files live
Yap_SHAREDIR = sel(true, iap->SHAREDIR != NULL, iap->SHAREDIR, true,
#if __ANDROID__
"/assets",
#else
join(getenv("DESTDIR"), YAP_SHAREDIR),
#endif
false);
/// PLDIR: where we can find Prolog files
Yap_PLDIR = sel(true, iap->PLDIR != NULL, iap->PLDIR, true,
#if __ANDROID__
"/assets/Yap",
#else
join(getenv("DESTDIR"), YAP_PLDIR),
#endif
false);
/// ``COMMONSDIR: Prolog Commons
Yap_COMMONSDIR = sel(true, iap->COMMONSDIR != NULL, iap->COMMONSDIR, true,
#if __ANDROID__
"/assets/PrologCommons",
#else
join(getenv("DESTDIR"), YAP_SHAREDIR "/PrologCommons"),
#endif
false);
/// BOOTPLDIR: where we can find Prolog bootstrap files
Yap_BOOTSTRAP = sel(true, iap->BOOTSTRAP != NULL, iap->BOOTSTRAP, true,
#if __ANDROID__
"/assets/Yap/pl/boot.yap",
#else
join(getenv("DESTDIR"), YAP_BOOTSTRAP),
#endif
false);
/// BOOTFILE: where we can find the core Prolog boot file
Yap_BOOTFILE = sel(false, iap->BOOTFILE != NULL, iap->BOOTFILE, true,
#if __ANDROID__
"/assets/Yap/pl/boot.yap",
#else
join(getenv("DESTDIR"), YAP_BOOTFILE),
#endif
false);
/// STARTUP: where we can find the core Prolog bootstrap file
Yap_OUTPUT_STARTUP =
sel(false, iap->OUTPUT_STARTUP != NULL, iap->OUTPUT_STARTUP, true,
#if __ANDROID__
NULL,
#else
join(getenv("DESTDIR"), YAP_OUTPUT_STARTUP),
#endif
false);
Yap_INPUT_STARTUP =
sel(false, iap->INPUT_STARTUP != NULL, iap->INPUT_STARTUP, true,
#if __ANDROID__
NULL,
#else
join(getenv("DESTDIR"), YAP_INPUT_STARTUP),
#endif
false);
if (Yap_ROOTDIR)
setAtomicGlobalPrologFlag(HOME_FLAG,
MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR)));
if (Yap_PLDIR)
setAtomicGlobalPrologFlag(PROLOG_LIBRARY_DIRECTORY_FLAG,
MkAtomTerm(Yap_LookupAtom(Yap_PLDIR)));
if (Yap_DLLDIR)
setAtomicGlobalPrologFlag(PROLOG_FOREIGN_DIRECTORY_FLAG,
MkAtomTerm(Yap_LookupAtom(Yap_DLLDIR)));
}
static void print_usage(void) {
fprintf(stderr, "\n[ Valid switches for command line arguments: ]\n");
fprintf(stderr, " -? Shows this screen\n");
@ -68,7 +385,7 @@ static void print_usage(void) {
fprintf(stderr, " -GSize Max Area for Global Stack\n");
fprintf(stderr,
" -LSize Max Area for Local Stack (number must follow L)\n");
fprintf(stderr, " -TSize Max Area for Trail (number must follow L)\n");
fprintf(stderr, " -TSize Max Area for Trail (number must follow T)\n");
fprintf(stderr, " -nosignals disable signal handling from Prolog\n");
fprintf(stderr, "\n[Execution Modes]\n");
fprintf(stderr, " -J0 Interpreted mode (default)\n");
@ -85,8 +402,9 @@ static void print_usage(void) {
defined(YAPOR_THREADS)
fprintf(stderr, " -w Number of workers (default: %d)\n",
DEFAULT_NUMBERWORKERS);
fprintf(stderr, " -sl Loop scheduler executions before look for hiden "
"shared work (default: %d)\n",
fprintf(stderr,
" -sl Loop scheduler executions before look for hiden "
"shared work (default: %d)\n",
DEFAULT_SCHEDULERLOOP);
fprintf(stderr, " -d Value of delayed release of load (default: %d)\n",
DEFAULT_DELAYEDRELEASELOAD);
@ -135,21 +453,33 @@ static int dump_runtime_variables(void) {
return 1;
}
YAP_file_type_t Yap_InitDefaults(YAP_init_args *iap, char saved_state[],
int argc, char *argv[]) {
X_API YAP_file_type_t Yap_InitDefaults(void *x, char *saved_state, int argc,
char *argv[]) {
if (!LOCAL_TextBuffer)
LOCAL_TextBuffer = Yap_InitTextAllocator();
YAP_init_args *iap = x;
memset(iap, 0, sizeof(YAP_init_args));
#if __ANDROID__
iap->boot_file_type = YAP_BOOT_PL;
iap->SavedState = NULL;
iap->INPUT_STARTUP = NULL;
iap->assetManager = NULL;
#else
iap->boot_file_type = YAP_QLY;
iap->SavedState = saved_state;
iap->INPUT_STARTUP = saved_state;
#endif
iap->Argc = argc;
iap->Argv = argv;
return iap->boot_file_type;
return YAP_QLY;
}
/**
* @short Paese command line
* @param argc number of arguments
* @param argv arguments
* @param iap options, see YAP_init_args
* @return boot from saved state or restore; error
*/
X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
YAP_init_args *iap) {
char *p;
@ -163,24 +493,21 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
case 'b':
iap->boot_file_type = YAP_PL;
if (p[1])
iap->YapPrologBootFile = p + 1;
iap->BOOTFILE = p + 1;
else if (argv[1] && *argv[1] != '-') {
iap->YapPrologBootFile = *++argv;
iap->BOOTFILE = *++argv;
argc--;
} else {
iap->YapPrologBootFile = "boot.yap";
}
break;
case 'B':
iap->boot_file_type = YAP_BOOT_PL;
if (p[1])
iap->YapPrologBootFile = p + 1;
iap->BOOTSTRAP = p + 1;
else if (argv[1] && *argv[1] != '-') {
iap->YapPrologBootFile = *++argv;
iap->BOOTSTRAP = *++argv;
argc--;
} else {
iap->YapPrologBootFile = "boot.yap";
}
iap->install = true;
break;
case '?':
print_usage();
@ -214,7 +541,7 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
argc--;
argv++;
if (strcmp(*argv, "none")) {
iap->YapPrologRCFile = *argv;
iap->PrologRCFile = *argv;
}
break;
}
@ -306,7 +633,7 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
break;
}
if (ch) {
iap->YapPrologTopLevelGoal = add_end_dot(*argv);
iap->PrologTopLevelGoal = add_end_dot(*argv);
} else {
*ssize = i;
}
@ -381,7 +708,7 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
goto GetSize;
}
iap->QuietMode = TRUE;
iap->HaltAfterConsult = TRUE;
iap->HaltAfterBoot = true;
case 'l':
p++;
if (!*++argv) {
@ -390,11 +717,11 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
exit(1);
} else if (!strcmp("--", *argv)) {
/* shell script, the next entry should be the file itself */
iap->YapPrologRCFile = argv[1];
iap->PrologRCFile = argv[1];
argc = 1;
break;
} else {
iap->YapPrologRCFile = *argv;
iap->PrologRCFile = *argv;
argc--;
}
if (*p) {
@ -415,7 +742,7 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
/* run goal before top-level */
case 'g':
if ((*argv)[0] == '\0')
iap->YapPrologGoal = *argv;
iap->PrologGoal = *argv;
else {
argc--;
if (argc == 0) {
@ -424,24 +751,24 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologGoal = *argv;
iap->PrologGoal = *argv;
}
break;
/* run goal as top-level */
case 'z':
if ((*argv)[0] == '\0')
iap->YapPrologTopLevelGoal = *argv;
iap->PrologTopLevelGoal = *argv;
else {
argc--;
if (argc == 0) {
fprintf(
stderr,
" [ YAP unrecoverable error: missing goal for option 'z' ]\n");
fprintf(stderr, " [ YAP unrecoverable error: missing goal for "
"option 'z' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologTopLevelGoal = add_end_dot(*argv);
iap->PrologTopLevelGoal = add_end_dot(*argv);
}
iap->HaltAfterBoot = true;
break;
case 'n':
if (!strcmp("nosignals", p)) {
@ -453,14 +780,27 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
if (!strcmp("-nosignals", p)) {
iap->PrologCannotHandleInterrupts = true;
break;
} else if (!strncmp("-output-saved-state=", p,
strlen("-output-saved-state="))) {
iap->OUTPUT_STARTUP = p + strlen("-output-saved-state=");
} else if (!strncmp("-home=", p, strlen("-home="))) {
GLOBAL_Home = p + strlen("-home=");
iap->ROOTDIR = p + strlen("-home=");
} else if (!strncmp("-system-library-directory=", p,
strlen("-system-library-directory="))) {
iap->LIBDIR = p + strlen("-system-library-directory=");
} else if (!strncmp("-system-shared-directory=", p,
strlen("-system-shared-directory="))) {
iap->SHAREDIR = p + strlen("-system-shared-directory=");
} else if (!strncmp("-prolog-library-directory=", p,
strlen("-prolog-library-directory="))) {
iap->PLDIR = p + strlen("-prolog-library-directory=");
} else if (!strncmp("-dll-library-directory=", p,
strlen("-dll-library-directory="))) {
iap->DLLDIR = p + strlen("-dll-library-directory=");
} else if (!strncmp("-home=", p, strlen("-home="))) {
iap->ROOTDIR = p + strlen("-home=");
} else if (!strncmp("-cwd=", p, strlen("-cwd="))) {
#if __WINDOWS__
if (_chdir(p + strlen("-cwd=")) < 0) {
#else
if (chdir(p + strlen("-cwd=")) < 0) {
#endif
if (!Yap_ChDir(p + strlen("-cwd="))) {
fprintf(stderr, " [ YAP unrecoverable error in setting cwd: %s ]\n",
strerror(errno));
}
@ -476,10 +816,22 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
ssize = &(iap->HeapSize);
p += strlen("-heap=");
goto GetSize;
} else if (!strncmp("-max-stack=", p, strlen("-max-stack="))) {
ssize = &(iap->MaxStackSize);
p += strlen("-max-stack=");
goto GetSize;
} else if (!strncmp("-max-trail=", p, strlen("-max-trail="))) {
ssize = &(iap->MaxTrailSize);
p += strlen("-max-trail=");
goto GetSize;
} else if (!strncmp("-max-heap=", p, strlen("-max-heap="))) {
ssize = &(iap->MaxHeapSize);
p += strlen("-max-heap=");
goto GetSize;
} else if (!strncmp("-goal=", p, strlen("-goal="))) {
iap->YapPrologGoal = p + strlen("-goal=");
iap->PrologGoal = p + strlen("-goal=");
} else if (!strncmp("-top-level=", p, strlen("-top-level="))) {
iap->YapPrologTopLevelGoal = p + strlen("-top-level=");
iap->PrologTopLevelGoal = p + strlen("-top-level=");
} else if (!strncmp("-table=", p, strlen("-table="))) {
ssize = &(iap->MaxTableSpaceSize);
p += strlen("-table=");
@ -493,17 +845,16 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
break;
case 'p':
if ((*argv)[0] == '\0')
iap->YapPrologAddPath = *argv;
iap->PrologAddPath = *argv;
else {
argc--;
if (argc == 0) {
fprintf(
stderr,
" [ YAP unrecoverable error: missing paths for option 'p' ]\n");
fprintf(stderr, " [ YAP unrecoverable error: missing paths for "
"option 'p' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologAddPath = *argv;
iap->PrologAddPath = *argv;
}
break;
/* nf: Begin preprocessor code */
@ -538,8 +889,222 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
}
}
else {
iap->SavedState = p;
iap->INPUT_STARTUP = p;
}
}
return iap->boot_file_type;
}
/**
YAP_DelayInit()
ensures initialization is done after engine creation.
It receives a pointer to function and a string describing
the module.
*/
X_API bool YAP_DelayInit(YAP_ModInit_t f, const char s[]) {
if (m_delays) {
m_delays = realloc(m_delays, (n_mdelays + 1) * sizeof(YAP_delaymodule_t));
} else {
m_delays = malloc(sizeof(YAP_delaymodule_t));
}
m_delays[n_mdelays].f = f;
m_delays[n_mdelays].s = s;
n_mdelays++;
return true;
}
bool Yap_LateInit(const char s[]) {
int i;
for (i = 0; i < n_mdelays; i++) {
if (!strcmp(m_delays[i].s, s)) {
m_delays[i].f();
return true;
}
}
return false;
}
struct ssz_t {
size_t Heap, Stack, Trail;
};
bool Yap_Embedded;
static void init_hw(YAP_init_args *yap_init, struct ssz_t *spt) {
Yap_page_size = Yap_InitPageSize(); /* init memory page size, required by
later functions */
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
Yap_init_yapor_global_local_memory();
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */
if (yap_init->Embedded) {
yap_init->install = false;
GLOBAL_PrologShouldHandleInterrupts =
yap_init->PrologCannotHandleInterrupts = true;
} else {
GLOBAL_PrologShouldHandleInterrupts =
!yap_init->PrologCannotHandleInterrupts;
}
Yap_InitSysbits(0); /* init signal handling and time, required by later
functions */
GLOBAL_argv = yap_init->Argv;
GLOBAL_argc = yap_init->Argc;
#if __ANDROID__
// if (yap_init->assetManager)
// Yap_InitAssetManager();
#endif
if (yap_init->TrailSize == 0) {
if (spt->Trail == 0)
spt->Trail = DefTrailSpace;
} else {
spt->Trail = yap_init->TrailSize;
}
// Atts = yap_init->AttsSize;
if (yap_init->StackSize == 0) {
spt->Stack = DefStackSpace;
} else {
spt->Stack = yap_init->StackSize;
}
#ifndef USE_SYSTEM_MALLOC
if (yap_init->HeapSize == 0) {
if (spt->Heap == 0)
spt->Heap = DefHeapSpace;
} else {
spt->Heap = yap_init->HeapSize;
}
#endif
}
static void end_init(YAP_init_args *iap) {
YAP_initialized = true;
if (iap->HaltAfterBoot)
Yap_exit(0);
LOCAL_PrologMode &= ~BootMode;
CurrentModule = USER_MODULE;
}
static void start_modules(void) {
Term cm = CurrentModule;
size_t i;
for (i = 0; i < n_mdelays; i++) {
CurrentModule = MkAtomTerm(YAP_LookupAtom(m_delays[i].s));
m_delays[i].f();
}
CurrentModule = cm;
}
/* this routine is supposed to be called from an external program
that wants to control Yap */
X_API void YAP_Init(YAP_init_args *yap_init) {
bool try_restore = yap_init->boot_file_type == YAP_QLY;
bool do_bootstrap = yap_init->boot_file_type == YAP_BOOT_PL;
struct ssz_t minfo;
if (YAP_initialized)
/* ignore repeated calls to YAP_Init */
return;
if (!LOCAL_TextBuffer)
LOCAL_TextBuffer = Yap_InitTextAllocator();
Yap_Embedded = yap_init->Embedded;
minfo.Trail = 0, minfo.Stack = 0, minfo.Trail = 0;
init_hw(yap_init, &minfo);
Yap_InitWorkspace(yap_init, minfo.Heap, minfo.Stack, minfo.Trail, 0,
yap_init->MaxTableSpaceSize, yap_init->NumberWorkers,
yap_init->SchedulerLoop, yap_init->DelayedReleaseLoad);
//
CACHE_REGS
if (yap_init->QuietMode) {
setVerbosity(TermSilent);
}
if (yap_init->PrologRCFile != NULL) {
/*
This must be done before restore, otherwise
restore will print out messages ....
*/
setBooleanGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG,
yap_init->HaltAfterBoot);
}
/* tell the system who should cope with interrupts */
Yap_ExecutionMode = yap_init->ExecutionMode;
Yap_set_locations(yap_init);
if (do_bootstrap || !try_restore ||
!Yap_SavedInfo(Yap_INPUT_STARTUP, &minfo.Trail, &minfo.Stack,
&minfo.Heap)) {
init_globals(yap_init);
start_modules();
CurrentModule = PROLOG_MODULE;
TermEof = MkAtomTerm(Yap_LookupAtom("end_of_file"));
LOCAL_consult_level = -1;
consult(Yap_BOOTSTRAP PASS_REGS);
setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG,
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);
start_modules();
if (yap_init->install && Yap_OUTPUT_STARTUP) {
setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG,
MkAtomTerm(Yap_LookupAtom(Yap_INPUT_STARTUP)));
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true);
}
LOCAL_consult_level = -1;
}
YAP_RunGoalOnce(TermInitProlog);
if (yap_init->install && Yap_OUTPUT_STARTUP) {
Term t = MkAtomTerm(Yap_LookupAtom(Yap_OUTPUT_STARTUP));
Term g = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("qsave_program"), 1),
1, &t);
YAP_RunGoalOnce(g);
}
end_init(yap_init);
}
#if (DefTrailSpace < MinTrailSpace)
#undef DefTrailSpace
#define DefTrailSpace MinTrailSpace
#endif
#if (DefStackSpace < MinStackSpace)
#undef DefStackSpace
#define DefStackSpace MinStackSpace
#endif
#if (DefHeapSpace < MinHeapSpace)
#undef DefHeapSpace
#define DefHeapSpace MinHeapSpace
#endif
#define DEFAULT_NUMBERWORKERS 1
#define DEFAULT_SCHEDULERLOOP 10
#define DEFAULT_DELAYEDRELEASELOAD 3
X_API void YAP_FastInit(char *saved_state, int argc, char *argv[]) {
YAP_init_args init_args;
YAP_file_type_t out;
if ((out = Yap_InitDefaults(&init_args, saved_state, argc, argv)) !=
YAP_FOUND_BOOT_ERROR)
YAP_Init(&init_args);
if (out == YAP_FOUND_BOOT_ERROR) {
Yap_Error(init_args.ErrorNo, TermNil, init_args.ErrorCause);
}
}

272
CMakeDoxyfile.in Normal file
View File

@ -0,0 +1,272 @@
#
# DO NOT EDIT! THIS FILE WAS GENERATED BY CMAKE!
#
DOXYFILE_ENCODING = @DOXYGEN_DOXYFILE_ENCODING@
PROJECT_NAME = @DOXYGEN_PROJECT_NAME@
PROJECT_NUMBER = @DOXYGEN_PROJECT_NUMBER@
PROJECT_BRIEF = @DOXYGEN_PROJECT_BRIEF@
PROJECT_LOGO = @DOXYGEN_PROJECT_LOGO@
OUTPUT_DIRECTORY = @DOXYGEN_OUTPUT_DIRECTORY@
CREATE_SUBDIRS = @DOXYGEN_CREATE_SUBDIRS@
ALLOW_UNICODE_NAMES = @DOXYGEN_ALLOW_UNICODE_NAMES@
OUTPUT_LANGUAGE = @DOXYGEN_OUTPUT_LANGUAGE@
BRIEF_MEMBER_DESC = @DOXYGEN_BRIEF_MEMBER_DESC@
REPEAT_BRIEF = @DOXYGEN_REPEAT_BRIEF@
ABBREVIATE_BRIEF = @DOXYGEN_ABBREVIATE_BRIEF@
ALWAYS_DETAILED_SEC = @DOXYGEN_ALWAYS_DETAILED_SEC@
INLINE_INHERITED_MEMB = @DOXYGEN_INLINE_INHERITED_MEMB@
FULL_PATH_NAMES = @DOXYGEN_FULL_PATH_NAMES@
STRIP_FROM_PATH = @DOXYGEN_STRIP_FROM_PATH@
STRIP_FROM_INC_PATH = @DOXYGEN_STRIP_FROM_INC_PATH@
SHORT_NAMES = @DOXYGEN_SHORT_NAMES@
JAVADOC_AUTOBRIEF = @DOXYGEN_JAVADOC_AUTOBRIEF@
QT_AUTOBRIEF = @DOXYGEN_QT_AUTOBRIEF@
MULTILINE_CPP_IS_BRIEF = @DOXYGEN_MULTILINE_CPP_IS_BRIEF@
INHERIT_DOCS = @DOXYGEN_INHERIT_DOCS@
SEPARATE_MEMBER_PAGES = @DOXYGEN_SEPARATE_MEMBER_PAGES@
TAB_SIZE = @DOXYGEN_TAB_SIZE@
ALIASES = @DOXYGEN_ALIASES@
TCL_SUBST = @DOXYGEN_TCL_SUBST@
OPTIMIZE_OUTPUT_FOR_C = @DOXYGEN_OPTIMIZE_OUTPUT_FOR_C@
OPTIMIZE_OUTPUT_JAVA = @DOXYGEN_OPTIMIZE_OUTPUT_JAVA@
OPTIMIZE_FOR_FORTRAN = @DOXYGEN_OPTIMIZE_FOR_FORTRAN@
OPTIMIZE_OUTPUT_VHDL = @DOXYGEN_OPTIMIZE_OUTPUT_VHDL@
EXTENSION_MAPPING = @DOXYGEN_EXTENSION_MAPPING@
MARKDOWN_SUPPORT = @DOXYGEN_MARKDOWN_SUPPORT@
TOC_INCLUDE_HEADINGS = @DOXYGEN_TOC_INCLUDE_HEADINGS@
AUTOLINK_SUPPORT = @DOXYGEN_AUTOLINK_SUPPORT@
BUILTIN_STL_SUPPORT = @DOXYGEN_BUILTIN_STL_SUPPORT@
CPP_CLI_SUPPORT = @DOXYGEN_CPP_CLI_SUPPORT@
SIP_SUPPORT = @DOXYGEN_SIP_SUPPORT@
IDL_PROPERTY_SUPPORT = @DOXYGEN_IDL_PROPERTY_SUPPORT@
DISTRIBUTE_GROUP_DOC = @DOXYGEN_DISTRIBUTE_GROUP_DOC@
GROUP_NESTED_COMPOUNDS = @DOXYGEN_GROUP_NESTED_COMPOUNDS@
SUBGROUPING = @DOXYGEN_SUBGROUPING@
INLINE_GROUPED_CLASSES = @DOXYGEN_INLINE_GROUPED_CLASSES@
INLINE_SIMPLE_STRUCTS = @DOXYGEN_INLINE_SIMPLE_STRUCTS@
TYPEDEF_HIDES_STRUCT = @DOXYGEN_TYPEDEF_HIDES_STRUCT@
LOOKUP_CACHE_SIZE = @DOXYGEN_LOOKUP_CACHE_SIZE@
EXTRACT_ALL = @DOXYGEN_EXTRACT_ALL@
EXTRACT_PRIVATE = @DOXYGEN_EXTRACT_PRIVATE@
EXTRACT_PACKAGE = @DOXYGEN_EXTRACT_PACKAGE@
EXTRACT_STATIC = @DOXYGEN_EXTRACT_STATIC@
EXTRACT_LOCAL_CLASSES = @DOXYGEN_EXTRACT_LOCAL_CLASSES@
EXTRACT_LOCAL_METHODS = @DOXYGEN_EXTRACT_LOCAL_METHODS@
EXTRACT_ANON_NSPACES = @DOXYGEN_EXTRACT_ANON_NSPACES@
HIDE_UNDOC_MEMBERS = @DOXYGEN_HIDE_UNDOC_MEMBERS@
HIDE_UNDOC_CLASSES = @DOXYGEN_HIDE_UNDOC_CLASSES@
HIDE_FRIEND_COMPOUNDS = @DOXYGEN_HIDE_FRIEND_COMPOUNDS@
HIDE_IN_BODY_DOCS = @DOXYGEN_HIDE_IN_BODY_DOCS@
INTERNAL_DOCS = @DOXYGEN_INTERNAL_DOCS@
CASE_SENSE_NAMES = @DOXYGEN_CASE_SENSE_NAMES@
HIDE_SCOPE_NAMES = @DOXYGEN_HIDE_SCOPE_NAMES@
HIDE_COMPOUND_REFERENCE= @DOXYGEN_HIDE_COMPOUND_REFERENCE@
SHOW_INCLUDE_FILES = @DOXYGEN_SHOW_INCLUDE_FILES@
SHOW_GROUPED_MEMB_INC = @DOXYGEN_SHOW_GROUPED_MEMB_INC@
FORCE_LOCAL_INCLUDES = @DOXYGEN_FORCE_LOCAL_INCLUDES@
INLINE_INFO = @DOXYGEN_INLINE_INFO@
SORT_MEMBER_DOCS = @DOXYGEN_SORT_MEMBER_DOCS@
SORT_BRIEF_DOCS = @DOXYGEN_SORT_BRIEF_DOCS@
SORT_MEMBERS_CTORS_1ST = @DOXYGEN_SORT_MEMBERS_CTORS_1ST@
SORT_GROUP_NAMES = @DOXYGEN_SORT_GROUP_NAMES@
SORT_BY_SCOPE_NAME = @DOXYGEN_SORT_BY_SCOPE_NAME@
STRICT_PROTO_MATCHING = @DOXYGEN_STRICT_PROTO_MATCHING@
GENERATE_TODOLIST = @DOXYGEN_GENERATE_TODOLIST@
GENERATE_TESTLIST = @DOXYGEN_GENERATE_TESTLIST@
GENERATE_BUGLIST = @DOXYGEN_GENERATE_BUGLIST@
GENERATE_DEPRECATEDLIST= @DOXYGEN_GENERATE_DEPRECATEDLIST@
ENABLED_SECTIONS = @DOXYGEN_ENABLED_SECTIONS@
MAX_INITIALIZER_LINES = @DOXYGEN_MAX_INITIALIZER_LINES@
SHOW_USED_FILES = @DOXYGEN_SHOW_USED_FILES@
SHOW_FILES = @DOXYGEN_SHOW_FILES@
SHOW_NAMESPACES = @DOXYGEN_SHOW_NAMESPACES@
FILE_VERSION_FILTER = @DOXYGEN_FILE_VERSION_FILTER@
LAYOUT_FILE = @DOXYGEN_LAYOUT_FILE@
CITE_BIB_FILES = @DOXYGEN_CITE_BIB_FILES@
QUIET = @DOXYGEN_QUIET@
WARNINGS = @DOXYGEN_WARNINGS@
WARN_IF_UNDOCUMENTED = @DOXYGEN_WARN_IF_UNDOCUMENTED@
WARN_IF_DOC_ERROR = @DOXYGEN_WARN_IF_DOC_ERROR@
WARN_NO_PARAMDOC = @DOXYGEN_WARN_NO_PARAMDOC@
WARN_AS_ERROR = @DOXYGEN_WARN_AS_ERROR@
WARN_FORMAT = @DOXYGEN_WARN_FORMAT@
WARN_LOGFILE = @DOXYGEN_WARN_LOGFILE@
INPUT = @DOXYGEN_INPUT@
INPUT_ENCODING = @DOXYGEN_INPUT_ENCODING@
FILE_PATTERNS = @DOXYGEN_FILE_PATTERNS@
RECURSIVE = @DOXYGEN_RECURSIVE@
EXCLUDE = @DOXYGEN_EXCLUDE@
EXCLUDE_SYMLINKS = @DOXYGEN_EXCLUDE_SYMLINKS@
EXCLUDE_PATTERNS = @DOXYGEN_EXCLUDE_PATTERNS@
EXCLUDE_SYMBOLS = @DOXYGEN_EXCLUDE_SYMBOLS@
EXAMPLE_PATH = @DOXYGEN_EXAMPLE_PATH@
EXAMPLE_PATTERNS = @DOXYGEN_EXAMPLE_PATTERNS@
EXAMPLE_RECURSIVE = @DOXYGEN_EXAMPLE_RECURSIVE@
IMAGE_PATH = @DOXYGEN_IMAGE_PATH@
INPUT_FILTER = @DOXYGEN_INPUT_FILTER@
FILTER_PATTERNS = @DOXYGEN_FILTER_PATTERNS@
FILTER_SOURCE_FILES = @DOXYGEN_FILTER_SOURCE_FILES@
FILTER_SOURCE_PATTERNS = @DOXYGEN_FILTER_SOURCE_PATTERNS@
USE_MDFILE_AS_MAINPAGE = @DOXYGEN_USE_MDFILE_AS_MAINPAGE@
SOURCE_BROWSER = @DOXYGEN_SOURCE_BROWSER@
INLINE_SOURCES = @DOXYGEN_INLINE_SOURCES@
STRIP_CODE_COMMENTS = @DOXYGEN_STRIP_CODE_COMMENTS@
REFERENCED_BY_RELATION = @DOXYGEN_REFERENCED_BY_RELATION@
REFERENCES_RELATION = @DOXYGEN_REFERENCES_RELATION@
REFERENCES_LINK_SOURCE = @DOXYGEN_REFERENCES_LINK_SOURCE@
SOURCE_TOOLTIPS = @DOXYGEN_SOURCE_TOOLTIPS@
USE_HTAGS = @DOXYGEN_USE_HTAGS@
VERBATIM_HEADERS = @DOXYGEN_VERBATIM_HEADERS@
CLANG_ASSISTED_PARSING = @DOXYGEN_CLANG_ASSISTED_PARSING@
CLANG_OPTIONS = @DOXYGEN_CLANG_OPTIONS@
ALPHABETICAL_INDEX = @DOXYGEN_ALPHABETICAL_INDEX@
COLS_IN_ALPHA_INDEX = @DOXYGEN_COLS_IN_ALPHA_INDEX@
IGNORE_PREFIX = @DOXYGEN_IGNORE_PREFIX@
GENERATE_HTML = @DOXYGEN_GENERATE_HTML@
HTML_OUTPUT = @DOXYGEN_HTML_OUTPUT@
HTML_FILE_EXTENSION = @DOXYGEN_HTML_FILE_EXTENSION@
HTML_HEADER = @DOXYGEN_HTML_HEADER@
HTML_FOOTER = @DOXYGEN_HTML_FOOTER@
HTML_STYLESHEET = @DOXYGEN_HTML_STYLESHEET@
HTML_EXTRA_STYLESHEET = @DOXYGEN_HTML_EXTRA_STYLESHEET@
HTML_EXTRA_FILES = @DOXYGEN_HTML_EXTRA_FILES@
HTML_COLORSTYLE_HUE = @DOXYGEN_HTML_COLORSTYLE_HUE@
HTML_COLORSTYLE_SAT = @DOXYGEN_HTML_COLORSTYLE_SAT@
HTML_COLORSTYLE_GAMMA = @DOXYGEN_HTML_COLORSTYLE_GAMMA@
HTML_TIMESTAMP = @DOXYGEN_HTML_TIMESTAMP@
HTML_DYNAMIC_SECTIONS = @DOXYGEN_HTML_DYNAMIC_SECTIONS@
HTML_INDEX_NUM_ENTRIES = @DOXYGEN_HTML_INDEX_NUM_ENTRIES@
GENERATE_DOCSET = @DOXYGEN_GENERATE_DOCSET@
DOCSET_FEEDNAME = @DOXYGEN_DOCSET_FEEDNAME@
DOCSET_BUNDLE_ID = @DOXYGEN_DOCSET_BUNDLE_ID@
DOCSET_PUBLISHER_ID = @DOXYGEN_DOCSET_PUBLISHER_ID@
DOCSET_PUBLISHER_NAME = @DOXYGEN_DOCSET_PUBLISHER_NAME@
GENERATE_HTMLHELP = @DOXYGEN_GENERATE_HTMLHELP@
CHM_FILE = @DOXYGEN_CHM_FILE@
HHC_LOCATION = @DOXYGEN_HHC_LOCATION@
GENERATE_CHI = @DOXYGEN_GENERATE_CHI@
CHM_INDEX_ENCODING = @DOXYGEN_CHM_INDEX_ENCODING@
BINARY_TOC = @DOXYGEN_BINARY_TOC@
TOC_EXPAND = @DOXYGEN_TOC_EXPAND@
GENERATE_QHP = @DOXYGEN_GENERATE_QHP@
QCH_FILE = @DOXYGEN_QCH_FILE@
QHP_NAMESPACE = @DOXYGEN_QHP_NAMESPACE@
QHP_VIRTUAL_FOLDER = @DOXYGEN_QHP_VIRTUAL_FOLDER@
QHP_CUST_FILTER_NAME = @DOXYGEN_QHP_CUST_FILTER_NAME@
QHP_CUST_FILTER_ATTRS = @DOXYGEN_QHP_CUST_FILTER_ATTRS@
QHP_SECT_FILTER_ATTRS = @DOXYGEN_QHP_SECT_FILTER_ATTRS@
QHG_LOCATION = @DOXYGEN_QHG_LOCATION@
GENERATE_ECLIPSEHELP = @DOXYGEN_GENERATE_ECLIPSEHELP@
ECLIPSE_DOC_ID = @DOXYGEN_ECLIPSE_DOC_ID@
DISABLE_INDEX = @DOXYGEN_DISABLE_INDEX@
GENERATE_TREEVIEW = @DOXYGEN_GENERATE_TREEVIEW@
ENUM_VALUES_PER_LINE = @DOXYGEN_ENUM_VALUES_PER_LINE@
TREEVIEW_WIDTH = @DOXYGEN_TREEVIEW_WIDTH@
EXT_LINKS_IN_WINDOW = @DOXYGEN_EXT_LINKS_IN_WINDOW@
FORMULA_FONTSIZE = @DOXYGEN_FORMULA_FONTSIZE@
FORMULA_TRANSPARENT = @DOXYGEN_FORMULA_TRANSPARENT@
USE_MATHJAX = @DOXYGEN_USE_MATHJAX@
MATHJAX_FORMAT = @DOXYGEN_MATHJAX_FORMAT@
MATHJAX_RELPATH = @DOXYGEN_MATHJAX_RELPATH@
MATHJAX_EXTENSIONS = @DOXYGEN_MATHJAX_EXTENSIONS@
MATHJAX_CODEFILE = @DOXYGEN_MATHJAX_CODEFILE@
SEARCHENGINE = @DOXYGEN_SEARCHENGINE@
SERVER_BASED_SEARCH = @DOXYGEN_SERVER_BASED_SEARCH@
EXTERNAL_SEARCH = @DOXYGEN_EXTERNAL_SEARCH@
SEARCHENGINE_URL = @DOXYGEN_SEARCHENGINE_URL@
SEARCHDATA_FILE = @DOXYGEN_SEARCHDATA_FILE@
EXTERNAL_SEARCH_ID = @DOXYGEN_EXTERNAL_SEARCH_ID@
EXTRA_SEARCH_MAPPINGS = @DOXYGEN_EXTRA_SEARCH_MAPPINGS@
GENERATE_LATEX = @DOXYGEN_GENERATE_LATEX@
LATEX_OUTPUT = @DOXYGEN_LATEX_OUTPUT@
LATEX_CMD_NAME = @DOXYGEN_LATEX_CMD_NAME@
MAKEINDEX_CMD_NAME = @DOXYGEN_MAKEINDEX_CMD_NAME@
COMPACT_LATEX = @DOXYGEN_COMPACT_LATEX@
PAPER_TYPE = @DOXYGEN_PAPER_TYPE@
EXTRA_PACKAGES = @DOXYGEN_EXTRA_PACKAGES@
LATEX_HEADER = @DOXYGEN_LATEX_HEADER@
LATEX_FOOTER = @DOXYGEN_LATEX_FOOTER@
LATEX_EXTRA_STYLESHEET = @DOXYGEN_LATEX_EXTRA_STYLESHEET@
LATEX_EXTRA_FILES = @DOXYGEN_LATEX_EXTRA_FILES@
PDF_HYPERLINKS = @DOXYGEN_PDF_HYPERLINKS@
USE_PDFLATEX = @DOXYGEN_USE_PDFLATEX@
LATEX_BATCHMODE = @DOXYGEN_LATEX_BATCHMODE@
LATEX_HIDE_INDICES = @DOXYGEN_LATEX_HIDE_INDICES@
LATEX_SOURCE_CODE = @DOXYGEN_LATEX_SOURCE_CODE@
LATEX_BIB_STYLE = @DOXYGEN_LATEX_BIB_STYLE@
LATEX_TIMESTAMP = @DOXYGEN_LATEX_TIMESTAMP@
GENERATE_RTF = @DOXYGEN_GENERATE_RTF@
RTF_OUTPUT = @DOXYGEN_RTF_OUTPUT@
COMPACT_RTF = @DOXYGEN_COMPACT_RTF@
RTF_HYPERLINKS = @DOXYGEN_RTF_HYPERLINKS@
RTF_STYLESHEET_FILE = @DOXYGEN_RTF_STYLESHEET_FILE@
RTF_EXTENSIONS_FILE = @DOXYGEN_RTF_EXTENSIONS_FILE@
RTF_SOURCE_CODE = @DOXYGEN_RTF_SOURCE_CODE@
GENERATE_MAN = @DOXYGEN_GENERATE_MAN@
MAN_OUTPUT = @DOXYGEN_MAN_OUTPUT@
MAN_EXTENSION = @DOXYGEN_MAN_EXTENSION@
MAN_SUBDIR = @DOXYGEN_MAN_SUBDIR@
MAN_LINKS = @DOXYGEN_MAN_LINKS@
GENERATE_XML = @DOXYGEN_GENERATE_XML@
XML_OUTPUT = @DOXYGEN_XML_OUTPUT@
XML_PROGRAMLISTING = @DOXYGEN_XML_PROGRAMLISTING@
GENERATE_DOCBOOK = @DOXYGEN_GENERATE_DOCBOOK@
DOCBOOK_OUTPUT = @DOXYGEN_DOCBOOK_OUTPUT@
DOCBOOK_PROGRAMLISTING = @DOXYGEN_DOCBOOK_PROGRAMLISTING@
GENERATE_AUTOGEN_DEF = @DOXYGEN_GENERATE_AUTOGEN_DEF@
GENERATE_PERLMOD = @DOXYGEN_GENERATE_PERLMOD@
PERLMOD_LATEX = @DOXYGEN_PERLMOD_LATEX@
PERLMOD_PRETTY = @DOXYGEN_PERLMOD_PRETTY@
PERLMOD_MAKEVAR_PREFIX = @DOXYGEN_PERLMOD_MAKEVAR_PREFIX@
ENABLE_PREPROCESSING = @DOXYGEN_ENABLE_PREPROCESSING@
MACRO_EXPANSION = @DOXYGEN_MACRO_EXPANSION@
EXPAND_ONLY_PREDEF = @DOXYGEN_EXPAND_ONLY_PREDEF@
SEARCH_INCLUDES = @DOXYGEN_SEARCH_INCLUDES@
INCLUDE_PATH = @DOXYGEN_INCLUDE_PATH@
INCLUDE_FILE_PATTERNS = @DOXYGEN_INCLUDE_FILE_PATTERNS@
PREDEFINED = @DOXYGEN_PREDEFINED@
EXPAND_AS_DEFINED = @DOXYGEN_EXPAND_AS_DEFINED@
SKIP_FUNCTION_MACROS = @DOXYGEN_SKIP_FUNCTION_MACROS@
TAGFILES = @DOXYGEN_TAGFILES@
GENERATE_TAGFILE = @DOXYGEN_GENERATE_TAGFILE@
ALLEXTERNALS = @DOXYGEN_ALLEXTERNALS@
EXTERNAL_GROUPS = @DOXYGEN_EXTERNAL_GROUPS@
EXTERNAL_PAGES = @DOXYGEN_EXTERNAL_PAGES@
PERL_PATH = @DOXYGEN_PERL_PATH@
CLASS_DIAGRAMS = @DOXYGEN_CLASS_DIAGRAMS@
MSCGEN_PATH = @DOXYGEN_MSCGEN_PATH@
DIA_PATH = @DOXYGEN_DIA_PATH@
HIDE_UNDOC_RELATIONS = @DOXYGEN_HIDE_UNDOC_RELATIONS@
HAVE_DOT = @DOXYGEN_HAVE_DOT@
DOT_NUM_THREADS = @DOXYGEN_DOT_NUM_THREADS@
DOT_FONTNAME = @DOXYGEN_DOT_FONTNAME@
DOT_FONTSIZE = @DOXYGEN_DOT_FONTSIZE@
DOT_FONTPATH = @DOXYGEN_DOT_FONTPATH@
CLASS_GRAPH = @DOXYGEN_CLASS_GRAPH@
COLLABORATION_GRAPH = @DOXYGEN_COLLABORATION_GRAPH@
GROUP_GRAPHS = @DOXYGEN_GROUP_GRAPHS@
UML_LOOK = @DOXYGEN_UML_LOOK@
UML_LIMIT_NUM_FIELDS = @DOXYGEN_UML_LIMIT_NUM_FIELDS@
TEMPLATE_RELATIONS = @DOXYGEN_TEMPLATE_RELATIONS@
INCLUDE_GRAPH = @DOXYGEN_INCLUDE_GRAPH@
INCLUDED_BY_GRAPH = @DOXYGEN_INCLUDED_BY_GRAPH@
CALL_GRAPH = @DOXYGEN_CALL_GRAPH@
CALLER_GRAPH = @DOXYGEN_CALLER_GRAPH@
GRAPHICAL_HIERARCHY = @DOXYGEN_GRAPHICAL_HIERARCHY@
DIRECTORY_GRAPH = @DOXYGEN_DIRECTORY_GRAPH@
DOT_IMAGE_FORMAT = @DOXYGEN_DOT_IMAGE_FORMAT@
INTERACTIVE_SVG = @DOXYGEN_INTERACTIVE_SVG@
DOT_PATH = @DOXYGEN_DOT_PATH@
DOTFILE_DIRS = @DOXYGEN_DOTFILE_DIRS@
MSCFILE_DIRS = @DOXYGEN_MSCFILE_DIRS@
DIAFILE_DIRS = @DOXYGEN_DIAFILE_DIRS@
PLANTUML_JAR_PATH = @DOXYGEN_PLANTUML_JAR_PATH@
PLANTUML_CFG_FILE = @DOXYGEN_PLANTUML_CFG_FILE@
PLANTUML_INCLUDE_PATH = @DOXYGEN_PLANTUML_INCLUDE_PATH@
DOT_GRAPH_MAX_NODES = @DOXYGEN_DOT_GRAPH_MAX_NODES@
MAX_DOT_GRAPH_DEPTH = @DOXYGEN_MAX_DOT_GRAPH_DEPTH@
DOT_TRANSPARENT = @DOXYGEN_DOT_TRANSPARENT@
DOT_MULTI_TARGETS = @DOXYGEN_DOT_MULTI_TARGETS@
GENERATE_LEGEND = @DOXYGEN_GENERATE_LEGEND@
DOT_CLEANUP = @DOXYGEN_DOT_CLEANUP@

654
CMakeDoxygenDefaults.cmake Normal file
View File

@ -0,0 +1,654 @@
#
# DO NOT EDIT! THIS FILE WAS GENERATED BY CMAKE!
#
if(NOT DEFINED DOXYGEN_DOXYFILE_ENCODING)
set(DOXYGEN_DOXYFILE_ENCODING UTF-8)
endif()
if(NOT DEFINED DOXYGEN_PROJECT_NAME)
set(DOXYGEN_PROJECT_NAME "My Project")
endif()
if(NOT DEFINED DOXYGEN_CREATE_SUBDIRS)
set(DOXYGEN_CREATE_SUBDIRS NO)
endif()
if(NOT DEFINED DOXYGEN_ALLOW_UNICODE_NAMES)
set(DOXYGEN_ALLOW_UNICODE_NAMES NO)
endif()
if(NOT DEFINED DOXYGEN_OUTPUT_LANGUAGE)
set(DOXYGEN_OUTPUT_LANGUAGE English)
endif()
if(NOT DEFINED DOXYGEN_BRIEF_MEMBER_DESC)
set(DOXYGEN_BRIEF_MEMBER_DESC YES)
endif()
if(NOT DEFINED DOXYGEN_REPEAT_BRIEF)
set(DOXYGEN_REPEAT_BRIEF YES)
endif()
if(NOT DEFINED DOXYGEN_ABBREVIATE_BRIEF)
set(DOXYGEN_ABBREVIATE_BRIEF "The $name class"
"The $name widget"
"The $name file"
is
provides
specifies
contains
represents
a
an
the)
endif()
if(NOT DEFINED DOXYGEN_ALWAYS_DETAILED_SEC)
set(DOXYGEN_ALWAYS_DETAILED_SEC NO)
endif()
if(NOT DEFINED DOXYGEN_INLINE_INHERITED_MEMB)
set(DOXYGEN_INLINE_INHERITED_MEMB NO)
endif()
if(NOT DEFINED DOXYGEN_FULL_PATH_NAMES)
set(DOXYGEN_FULL_PATH_NAMES YES)
endif()
if(NOT DEFINED DOXYGEN_SHORT_NAMES)
set(DOXYGEN_SHORT_NAMES NO)
endif()
if(NOT DEFINED DOXYGEN_JAVADOC_AUTOBRIEF)
set(DOXYGEN_JAVADOC_AUTOBRIEF NO)
endif()
if(NOT DEFINED DOXYGEN_QT_AUTOBRIEF)
set(DOXYGEN_QT_AUTOBRIEF NO)
endif()
if(NOT DEFINED DOXYGEN_MULTILINE_CPP_IS_BRIEF)
set(DOXYGEN_MULTILINE_CPP_IS_BRIEF NO)
endif()
if(NOT DEFINED DOXYGEN_INHERIT_DOCS)
set(DOXYGEN_INHERIT_DOCS YES)
endif()
if(NOT DEFINED DOXYGEN_SEPARATE_MEMBER_PAGES)
set(DOXYGEN_SEPARATE_MEMBER_PAGES NO)
endif()
if(NOT DEFINED DOXYGEN_TAB_SIZE)
set(DOXYGEN_TAB_SIZE 4)
endif()
if(NOT DEFINED DOXYGEN_OPTIMIZE_OUTPUT_FOR_C)
set(DOXYGEN_OPTIMIZE_OUTPUT_FOR_C NO)
endif()
if(NOT DEFINED DOXYGEN_OPTIMIZE_OUTPUT_JAVA)
set(DOXYGEN_OPTIMIZE_OUTPUT_JAVA NO)
endif()
if(NOT DEFINED DOXYGEN_OPTIMIZE_FOR_FORTRAN)
set(DOXYGEN_OPTIMIZE_FOR_FORTRAN NO)
endif()
if(NOT DEFINED DOXYGEN_OPTIMIZE_OUTPUT_VHDL)
set(DOXYGEN_OPTIMIZE_OUTPUT_VHDL NO)
endif()
if(NOT DEFINED DOXYGEN_MARKDOWN_SUPPORT)
set(DOXYGEN_MARKDOWN_SUPPORT YES)
endif()
if(NOT DEFINED DOXYGEN_TOC_INCLUDE_HEADINGS)
set(DOXYGEN_TOC_INCLUDE_HEADINGS 0)
endif()
if(NOT DEFINED DOXYGEN_AUTOLINK_SUPPORT)
set(DOXYGEN_AUTOLINK_SUPPORT YES)
endif()
if(NOT DEFINED DOXYGEN_BUILTIN_STL_SUPPORT)
set(DOXYGEN_BUILTIN_STL_SUPPORT NO)
endif()
if(NOT DEFINED DOXYGEN_CPP_CLI_SUPPORT)
set(DOXYGEN_CPP_CLI_SUPPORT NO)
endif()
if(NOT DEFINED DOXYGEN_SIP_SUPPORT)
set(DOXYGEN_SIP_SUPPORT NO)
endif()
if(NOT DEFINED DOXYGEN_IDL_PROPERTY_SUPPORT)
set(DOXYGEN_IDL_PROPERTY_SUPPORT YES)
endif()
if(NOT DEFINED DOXYGEN_DISTRIBUTE_GROUP_DOC)
set(DOXYGEN_DISTRIBUTE_GROUP_DOC NO)
endif()
if(NOT DEFINED DOXYGEN_GROUP_NESTED_COMPOUNDS)
set(DOXYGEN_GROUP_NESTED_COMPOUNDS NO)
endif()
if(NOT DEFINED DOXYGEN_SUBGROUPING)
set(DOXYGEN_SUBGROUPING YES)
endif()
if(NOT DEFINED DOXYGEN_INLINE_GROUPED_CLASSES)
set(DOXYGEN_INLINE_GROUPED_CLASSES NO)
endif()
if(NOT DEFINED DOXYGEN_INLINE_SIMPLE_STRUCTS)
set(DOXYGEN_INLINE_SIMPLE_STRUCTS NO)
endif()
if(NOT DEFINED DOXYGEN_TYPEDEF_HIDES_STRUCT)
set(DOXYGEN_TYPEDEF_HIDES_STRUCT NO)
endif()
if(NOT DEFINED DOXYGEN_LOOKUP_CACHE_SIZE)
set(DOXYGEN_LOOKUP_CACHE_SIZE 0)
endif()
if(NOT DEFINED DOXYGEN_EXTRACT_ALL)
set(DOXYGEN_EXTRACT_ALL NO)
endif()
if(NOT DEFINED DOXYGEN_EXTRACT_PRIVATE)
set(DOXYGEN_EXTRACT_PRIVATE NO)
endif()
if(NOT DEFINED DOXYGEN_EXTRACT_PACKAGE)
set(DOXYGEN_EXTRACT_PACKAGE NO)
endif()
if(NOT DEFINED DOXYGEN_EXTRACT_STATIC)
set(DOXYGEN_EXTRACT_STATIC NO)
endif()
if(NOT DEFINED DOXYGEN_EXTRACT_LOCAL_CLASSES)
set(DOXYGEN_EXTRACT_LOCAL_CLASSES YES)
endif()
if(NOT DEFINED DOXYGEN_EXTRACT_LOCAL_METHODS)
set(DOXYGEN_EXTRACT_LOCAL_METHODS NO)
endif()
if(NOT DEFINED DOXYGEN_EXTRACT_ANON_NSPACES)
set(DOXYGEN_EXTRACT_ANON_NSPACES NO)
endif()
if(NOT DEFINED DOXYGEN_HIDE_UNDOC_MEMBERS)
set(DOXYGEN_HIDE_UNDOC_MEMBERS NO)
endif()
if(NOT DEFINED DOXYGEN_HIDE_UNDOC_CLASSES)
set(DOXYGEN_HIDE_UNDOC_CLASSES NO)
endif()
if(NOT DEFINED DOXYGEN_HIDE_FRIEND_COMPOUNDS)
set(DOXYGEN_HIDE_FRIEND_COMPOUNDS NO)
endif()
if(NOT DEFINED DOXYGEN_HIDE_IN_BODY_DOCS)
set(DOXYGEN_HIDE_IN_BODY_DOCS NO)
endif()
if(NOT DEFINED DOXYGEN_INTERNAL_DOCS)
set(DOXYGEN_INTERNAL_DOCS NO)
endif()
if(NOT DEFINED DOXYGEN_CASE_SENSE_NAMES)
set(DOXYGEN_CASE_SENSE_NAMES YES)
endif()
if(NOT DEFINED DOXYGEN_HIDE_SCOPE_NAMES)
set(DOXYGEN_HIDE_SCOPE_NAMES NO)
endif()
if(NOT DEFINED DOXYGEN_HIDE_COMPOUND_REFERENCE)
set(DOXYGEN_HIDE_COMPOUND_REFERENCE NO)
endif()
if(NOT DEFINED DOXYGEN_SHOW_INCLUDE_FILES)
set(DOXYGEN_SHOW_INCLUDE_FILES YES)
endif()
if(NOT DEFINED DOXYGEN_SHOW_GROUPED_MEMB_INC)
set(DOXYGEN_SHOW_GROUPED_MEMB_INC NO)
endif()
if(NOT DEFINED DOXYGEN_FORCE_LOCAL_INCLUDES)
set(DOXYGEN_FORCE_LOCAL_INCLUDES NO)
endif()
if(NOT DEFINED DOXYGEN_INLINE_INFO)
set(DOXYGEN_INLINE_INFO YES)
endif()
if(NOT DEFINED DOXYGEN_SORT_MEMBER_DOCS)
set(DOXYGEN_SORT_MEMBER_DOCS YES)
endif()
if(NOT DEFINED DOXYGEN_SORT_BRIEF_DOCS)
set(DOXYGEN_SORT_BRIEF_DOCS NO)
endif()
if(NOT DEFINED DOXYGEN_SORT_MEMBERS_CTORS_1ST)
set(DOXYGEN_SORT_MEMBERS_CTORS_1ST NO)
endif()
if(NOT DEFINED DOXYGEN_SORT_GROUP_NAMES)
set(DOXYGEN_SORT_GROUP_NAMES NO)
endif()
if(NOT DEFINED DOXYGEN_SORT_BY_SCOPE_NAME)
set(DOXYGEN_SORT_BY_SCOPE_NAME NO)
endif()
if(NOT DEFINED DOXYGEN_STRICT_PROTO_MATCHING)
set(DOXYGEN_STRICT_PROTO_MATCHING NO)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_TODOLIST)
set(DOXYGEN_GENERATE_TODOLIST YES)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_TESTLIST)
set(DOXYGEN_GENERATE_TESTLIST YES)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_BUGLIST)
set(DOXYGEN_GENERATE_BUGLIST YES)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_DEPRECATEDLIST)
set(DOXYGEN_GENERATE_DEPRECATEDLIST YES)
endif()
if(NOT DEFINED DOXYGEN_MAX_INITIALIZER_LINES)
set(DOXYGEN_MAX_INITIALIZER_LINES 30)
endif()
if(NOT DEFINED DOXYGEN_SHOW_USED_FILES)
set(DOXYGEN_SHOW_USED_FILES YES)
endif()
if(NOT DEFINED DOXYGEN_SHOW_FILES)
set(DOXYGEN_SHOW_FILES YES)
endif()
if(NOT DEFINED DOXYGEN_SHOW_NAMESPACES)
set(DOXYGEN_SHOW_NAMESPACES YES)
endif()
if(NOT DEFINED DOXYGEN_QUIET)
set(DOXYGEN_QUIET NO)
endif()
if(NOT DEFINED DOXYGEN_WARNINGS)
set(DOXYGEN_WARNINGS YES)
endif()
if(NOT DEFINED DOXYGEN_WARN_IF_UNDOCUMENTED)
set(DOXYGEN_WARN_IF_UNDOCUMENTED YES)
endif()
if(NOT DEFINED DOXYGEN_WARN_IF_DOC_ERROR)
set(DOXYGEN_WARN_IF_DOC_ERROR YES)
endif()
if(NOT DEFINED DOXYGEN_WARN_NO_PARAMDOC)
set(DOXYGEN_WARN_NO_PARAMDOC NO)
endif()
if(NOT DEFINED DOXYGEN_WARN_AS_ERROR)
set(DOXYGEN_WARN_AS_ERROR NO)
endif()
if(NOT DEFINED DOXYGEN_WARN_FORMAT)
set(DOXYGEN_WARN_FORMAT "$file:$line: $text")
endif()
if(NOT DEFINED DOXYGEN_INPUT_ENCODING)
set(DOXYGEN_INPUT_ENCODING UTF-8)
endif()
if(NOT DEFINED DOXYGEN_FILE_PATTERNS)
set(DOXYGEN_FILE_PATTERNS *.c
*.cc
*.cxx
*.cpp
*.c++
*.java
*.ii
*.ixx
*.ipp
*.i++
*.inl
*.idl
*.ddl
*.odl
*.h
*.hh
*.hxx
*.hpp
*.h++
*.cs
*.d
*.php
*.php4
*.php5
*.phtml
*.inc
*.m
*.markdown
*.md
*.mm
*.dox
*.py
*.pyw
*.f90
*.f95
*.f03
*.f08
*.f
*.for
*.tcl
*.vhd
*.vhdl
*.ucf
*.qsf)
endif()
if(NOT DEFINED DOXYGEN_RECURSIVE)
set(DOXYGEN_RECURSIVE NO)
endif()
if(NOT DEFINED DOXYGEN_EXCLUDE_SYMLINKS)
set(DOXYGEN_EXCLUDE_SYMLINKS NO)
endif()
if(NOT DEFINED DOXYGEN_EXAMPLE_PATTERNS)
set(DOXYGEN_EXAMPLE_PATTERNS *)
endif()
if(NOT DEFINED DOXYGEN_EXAMPLE_RECURSIVE)
set(DOXYGEN_EXAMPLE_RECURSIVE NO)
endif()
if(NOT DEFINED DOXYGEN_FILTER_SOURCE_FILES)
set(DOXYGEN_FILTER_SOURCE_FILES NO)
endif()
if(NOT DEFINED DOXYGEN_SOURCE_BROWSER)
set(DOXYGEN_SOURCE_BROWSER NO)
endif()
if(NOT DEFINED DOXYGEN_INLINE_SOURCES)
set(DOXYGEN_INLINE_SOURCES NO)
endif()
if(NOT DEFINED DOXYGEN_STRIP_CODE_COMMENTS)
set(DOXYGEN_STRIP_CODE_COMMENTS YES)
endif()
if(NOT DEFINED DOXYGEN_REFERENCED_BY_RELATION)
set(DOXYGEN_REFERENCED_BY_RELATION NO)
endif()
if(NOT DEFINED DOXYGEN_REFERENCES_RELATION)
set(DOXYGEN_REFERENCES_RELATION NO)
endif()
if(NOT DEFINED DOXYGEN_REFERENCES_LINK_SOURCE)
set(DOXYGEN_REFERENCES_LINK_SOURCE YES)
endif()
if(NOT DEFINED DOXYGEN_SOURCE_TOOLTIPS)
set(DOXYGEN_SOURCE_TOOLTIPS YES)
endif()
if(NOT DEFINED DOXYGEN_USE_HTAGS)
set(DOXYGEN_USE_HTAGS NO)
endif()
if(NOT DEFINED DOXYGEN_VERBATIM_HEADERS)
set(DOXYGEN_VERBATIM_HEADERS YES)
endif()
if(NOT DEFINED DOXYGEN_CLANG_ASSISTED_PARSING)
set(DOXYGEN_CLANG_ASSISTED_PARSING NO)
endif()
if(NOT DEFINED DOXYGEN_ALPHABETICAL_INDEX)
set(DOXYGEN_ALPHABETICAL_INDEX YES)
endif()
if(NOT DEFINED DOXYGEN_COLS_IN_ALPHA_INDEX)
set(DOXYGEN_COLS_IN_ALPHA_INDEX 5)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_HTML)
set(DOXYGEN_GENERATE_HTML YES)
endif()
if(NOT DEFINED DOXYGEN_HTML_OUTPUT)
set(DOXYGEN_HTML_OUTPUT html)
endif()
if(NOT DEFINED DOXYGEN_HTML_FILE_EXTENSION)
set(DOXYGEN_HTML_FILE_EXTENSION .html)
endif()
if(NOT DEFINED DOXYGEN_HTML_COLORSTYLE_HUE)
set(DOXYGEN_HTML_COLORSTYLE_HUE 220)
endif()
if(NOT DEFINED DOXYGEN_HTML_COLORSTYLE_SAT)
set(DOXYGEN_HTML_COLORSTYLE_SAT 100)
endif()
if(NOT DEFINED DOXYGEN_HTML_COLORSTYLE_GAMMA)
set(DOXYGEN_HTML_COLORSTYLE_GAMMA 80)
endif()
if(NOT DEFINED DOXYGEN_HTML_TIMESTAMP)
set(DOXYGEN_HTML_TIMESTAMP NO)
endif()
if(NOT DEFINED DOXYGEN_HTML_DYNAMIC_SECTIONS)
set(DOXYGEN_HTML_DYNAMIC_SECTIONS NO)
endif()
if(NOT DEFINED DOXYGEN_HTML_INDEX_NUM_ENTRIES)
set(DOXYGEN_HTML_INDEX_NUM_ENTRIES 100)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_DOCSET)
set(DOXYGEN_GENERATE_DOCSET NO)
endif()
if(NOT DEFINED DOXYGEN_DOCSET_FEEDNAME)
set(DOXYGEN_DOCSET_FEEDNAME "Doxygen generated docs")
endif()
if(NOT DEFINED DOXYGEN_DOCSET_BUNDLE_ID)
set(DOXYGEN_DOCSET_BUNDLE_ID org.doxygen.Project)
endif()
if(NOT DEFINED DOXYGEN_DOCSET_PUBLISHER_ID)
set(DOXYGEN_DOCSET_PUBLISHER_ID org.doxygen.Publisher)
endif()
if(NOT DEFINED DOXYGEN_DOCSET_PUBLISHER_NAME)
set(DOXYGEN_DOCSET_PUBLISHER_NAME Publisher)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_HTMLHELP)
set(DOXYGEN_GENERATE_HTMLHELP NO)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_CHI)
set(DOXYGEN_GENERATE_CHI NO)
endif()
if(NOT DEFINED DOXYGEN_BINARY_TOC)
set(DOXYGEN_BINARY_TOC NO)
endif()
if(NOT DEFINED DOXYGEN_TOC_EXPAND)
set(DOXYGEN_TOC_EXPAND NO)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_QHP)
set(DOXYGEN_GENERATE_QHP NO)
endif()
if(NOT DEFINED DOXYGEN_QHP_NAMESPACE)
set(DOXYGEN_QHP_NAMESPACE org.doxygen.Project)
endif()
if(NOT DEFINED DOXYGEN_QHP_VIRTUAL_FOLDER)
set(DOXYGEN_QHP_VIRTUAL_FOLDER doc)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_ECLIPSEHELP)
set(DOXYGEN_GENERATE_ECLIPSEHELP NO)
endif()
if(NOT DEFINED DOXYGEN_ECLIPSE_DOC_ID)
set(DOXYGEN_ECLIPSE_DOC_ID org.doxygen.Project)
endif()
if(NOT DEFINED DOXYGEN_DISABLE_INDEX)
set(DOXYGEN_DISABLE_INDEX NO)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_TREEVIEW)
set(DOXYGEN_GENERATE_TREEVIEW NO)
endif()
if(NOT DEFINED DOXYGEN_ENUM_VALUES_PER_LINE)
set(DOXYGEN_ENUM_VALUES_PER_LINE 4)
endif()
if(NOT DEFINED DOXYGEN_TREEVIEW_WIDTH)
set(DOXYGEN_TREEVIEW_WIDTH 250)
endif()
if(NOT DEFINED DOXYGEN_EXT_LINKS_IN_WINDOW)
set(DOXYGEN_EXT_LINKS_IN_WINDOW NO)
endif()
if(NOT DEFINED DOXYGEN_FORMULA_FONTSIZE)
set(DOXYGEN_FORMULA_FONTSIZE 10)
endif()
if(NOT DEFINED DOXYGEN_FORMULA_TRANSPARENT)
set(DOXYGEN_FORMULA_TRANSPARENT YES)
endif()
if(NOT DEFINED DOXYGEN_USE_MATHJAX)
set(DOXYGEN_USE_MATHJAX NO)
endif()
if(NOT DEFINED DOXYGEN_MATHJAX_FORMAT)
set(DOXYGEN_MATHJAX_FORMAT HTML-CSS)
endif()
if(NOT DEFINED DOXYGEN_MATHJAX_RELPATH)
set(DOXYGEN_MATHJAX_RELPATH http://cdn.mathjax.org/mathjax/latest)
endif()
if(NOT DEFINED DOXYGEN_SEARCHENGINE)
set(DOXYGEN_SEARCHENGINE YES)
endif()
if(NOT DEFINED DOXYGEN_SERVER_BASED_SEARCH)
set(DOXYGEN_SERVER_BASED_SEARCH NO)
endif()
if(NOT DEFINED DOXYGEN_EXTERNAL_SEARCH)
set(DOXYGEN_EXTERNAL_SEARCH NO)
endif()
if(NOT DEFINED DOXYGEN_SEARCHDATA_FILE)
set(DOXYGEN_SEARCHDATA_FILE searchdata.xml)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_LATEX)
set(DOXYGEN_GENERATE_LATEX YES)
endif()
if(NOT DEFINED DOXYGEN_LATEX_OUTPUT)
set(DOXYGEN_LATEX_OUTPUT latex)
endif()
if(NOT DEFINED DOXYGEN_LATEX_CMD_NAME)
set(DOXYGEN_LATEX_CMD_NAME latex)
endif()
if(NOT DEFINED DOXYGEN_MAKEINDEX_CMD_NAME)
set(DOXYGEN_MAKEINDEX_CMD_NAME makeindex)
endif()
if(NOT DEFINED DOXYGEN_COMPACT_LATEX)
set(DOXYGEN_COMPACT_LATEX NO)
endif()
if(NOT DEFINED DOXYGEN_PAPER_TYPE)
set(DOXYGEN_PAPER_TYPE a4)
endif()
if(NOT DEFINED DOXYGEN_PDF_HYPERLINKS)
set(DOXYGEN_PDF_HYPERLINKS YES)
endif()
if(NOT DEFINED DOXYGEN_USE_PDFLATEX)
set(DOXYGEN_USE_PDFLATEX YES)
endif()
if(NOT DEFINED DOXYGEN_LATEX_BATCHMODE)
set(DOXYGEN_LATEX_BATCHMODE NO)
endif()
if(NOT DEFINED DOXYGEN_LATEX_HIDE_INDICES)
set(DOXYGEN_LATEX_HIDE_INDICES NO)
endif()
if(NOT DEFINED DOXYGEN_LATEX_SOURCE_CODE)
set(DOXYGEN_LATEX_SOURCE_CODE NO)
endif()
if(NOT DEFINED DOXYGEN_LATEX_BIB_STYLE)
set(DOXYGEN_LATEX_BIB_STYLE plain)
endif()
if(NOT DEFINED DOXYGEN_LATEX_TIMESTAMP)
set(DOXYGEN_LATEX_TIMESTAMP NO)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_RTF)
set(DOXYGEN_GENERATE_RTF NO)
endif()
if(NOT DEFINED DOXYGEN_RTF_OUTPUT)
set(DOXYGEN_RTF_OUTPUT rtf)
endif()
if(NOT DEFINED DOXYGEN_COMPACT_RTF)
set(DOXYGEN_COMPACT_RTF NO)
endif()
if(NOT DEFINED DOXYGEN_RTF_HYPERLINKS)
set(DOXYGEN_RTF_HYPERLINKS NO)
endif()
if(NOT DEFINED DOXYGEN_RTF_SOURCE_CODE)
set(DOXYGEN_RTF_SOURCE_CODE NO)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_MAN)
set(DOXYGEN_GENERATE_MAN NO)
endif()
if(NOT DEFINED DOXYGEN_MAN_OUTPUT)
set(DOXYGEN_MAN_OUTPUT man)
endif()
if(NOT DEFINED DOXYGEN_MAN_EXTENSION)
set(DOXYGEN_MAN_EXTENSION .3)
endif()
if(NOT DEFINED DOXYGEN_MAN_LINKS)
set(DOXYGEN_MAN_LINKS NO)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_XML)
set(DOXYGEN_GENERATE_XML NO)
endif()
if(NOT DEFINED DOXYGEN_XML_OUTPUT)
set(DOXYGEN_XML_OUTPUT xml)
endif()
if(NOT DEFINED DOXYGEN_XML_PROGRAMLISTING)
set(DOXYGEN_XML_PROGRAMLISTING YES)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_DOCBOOK)
set(DOXYGEN_GENERATE_DOCBOOK NO)
endif()
if(NOT DEFINED DOXYGEN_DOCBOOK_OUTPUT)
set(DOXYGEN_DOCBOOK_OUTPUT docbook)
endif()
if(NOT DEFINED DOXYGEN_DOCBOOK_PROGRAMLISTING)
set(DOXYGEN_DOCBOOK_PROGRAMLISTING NO)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_AUTOGEN_DEF)
set(DOXYGEN_GENERATE_AUTOGEN_DEF NO)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_PERLMOD)
set(DOXYGEN_GENERATE_PERLMOD NO)
endif()
if(NOT DEFINED DOXYGEN_PERLMOD_LATEX)
set(DOXYGEN_PERLMOD_LATEX NO)
endif()
if(NOT DEFINED DOXYGEN_PERLMOD_PRETTY)
set(DOXYGEN_PERLMOD_PRETTY YES)
endif()
if(NOT DEFINED DOXYGEN_ENABLE_PREPROCESSING)
set(DOXYGEN_ENABLE_PREPROCESSING YES)
endif()
if(NOT DEFINED DOXYGEN_MACRO_EXPANSION)
set(DOXYGEN_MACRO_EXPANSION NO)
endif()
if(NOT DEFINED DOXYGEN_EXPAND_ONLY_PREDEF)
set(DOXYGEN_EXPAND_ONLY_PREDEF NO)
endif()
if(NOT DEFINED DOXYGEN_SEARCH_INCLUDES)
set(DOXYGEN_SEARCH_INCLUDES YES)
endif()
if(NOT DEFINED DOXYGEN_SKIP_FUNCTION_MACROS)
set(DOXYGEN_SKIP_FUNCTION_MACROS YES)
endif()
if(NOT DEFINED DOXYGEN_ALLEXTERNALS)
set(DOXYGEN_ALLEXTERNALS NO)
endif()
if(NOT DEFINED DOXYGEN_EXTERNAL_GROUPS)
set(DOXYGEN_EXTERNAL_GROUPS YES)
endif()
if(NOT DEFINED DOXYGEN_EXTERNAL_PAGES)
set(DOXYGEN_EXTERNAL_PAGES YES)
endif()
if(NOT DEFINED DOXYGEN_PERL_PATH)
set(DOXYGEN_PERL_PATH /usr/bin/perl)
endif()
if(NOT DEFINED DOXYGEN_CLASS_DIAGRAMS)
set(DOXYGEN_CLASS_DIAGRAMS YES)
endif()
if(NOT DEFINED DOXYGEN_HIDE_UNDOC_RELATIONS)
set(DOXYGEN_HIDE_UNDOC_RELATIONS YES)
endif()
if(NOT DEFINED DOXYGEN_HAVE_DOT)
set(DOXYGEN_HAVE_DOT YES)
endif()
if(NOT DEFINED DOXYGEN_DOT_NUM_THREADS)
set(DOXYGEN_DOT_NUM_THREADS 0)
endif()
if(NOT DEFINED DOXYGEN_DOT_FONTNAME)
set(DOXYGEN_DOT_FONTNAME Helvetica)
endif()
if(NOT DEFINED DOXYGEN_DOT_FONTSIZE)
set(DOXYGEN_DOT_FONTSIZE 10)
endif()
if(NOT DEFINED DOXYGEN_CLASS_GRAPH)
set(DOXYGEN_CLASS_GRAPH YES)
endif()
if(NOT DEFINED DOXYGEN_COLLABORATION_GRAPH)
set(DOXYGEN_COLLABORATION_GRAPH YES)
endif()
if(NOT DEFINED DOXYGEN_GROUP_GRAPHS)
set(DOXYGEN_GROUP_GRAPHS YES)
endif()
if(NOT DEFINED DOXYGEN_UML_LOOK)
set(DOXYGEN_UML_LOOK NO)
endif()
if(NOT DEFINED DOXYGEN_UML_LIMIT_NUM_FIELDS)
set(DOXYGEN_UML_LIMIT_NUM_FIELDS 10)
endif()
if(NOT DEFINED DOXYGEN_TEMPLATE_RELATIONS)
set(DOXYGEN_TEMPLATE_RELATIONS NO)
endif()
if(NOT DEFINED DOXYGEN_INCLUDE_GRAPH)
set(DOXYGEN_INCLUDE_GRAPH YES)
endif()
if(NOT DEFINED DOXYGEN_INCLUDED_BY_GRAPH)
set(DOXYGEN_INCLUDED_BY_GRAPH YES)
endif()
if(NOT DEFINED DOXYGEN_CALL_GRAPH)
set(DOXYGEN_CALL_GRAPH NO)
endif()
if(NOT DEFINED DOXYGEN_CALLER_GRAPH)
set(DOXYGEN_CALLER_GRAPH NO)
endif()
if(NOT DEFINED DOXYGEN_GRAPHICAL_HIERARCHY)
set(DOXYGEN_GRAPHICAL_HIERARCHY YES)
endif()
if(NOT DEFINED DOXYGEN_DIRECTORY_GRAPH)
set(DOXYGEN_DIRECTORY_GRAPH YES)
endif()
if(NOT DEFINED DOXYGEN_DOT_IMAGE_FORMAT)
set(DOXYGEN_DOT_IMAGE_FORMAT png)
endif()
if(NOT DEFINED DOXYGEN_INTERACTIVE_SVG)
set(DOXYGEN_INTERACTIVE_SVG NO)
endif()
if(NOT DEFINED DOXYGEN_DOT_GRAPH_MAX_NODES)
set(DOXYGEN_DOT_GRAPH_MAX_NODES 50)
endif()
if(NOT DEFINED DOXYGEN_MAX_DOT_GRAPH_DEPTH)
set(DOXYGEN_MAX_DOT_GRAPH_DEPTH 0)
endif()
if(NOT DEFINED DOXYGEN_DOT_TRANSPARENT)
set(DOXYGEN_DOT_TRANSPARENT NO)
endif()
if(NOT DEFINED DOXYGEN_DOT_MULTI_TARGETS)
set(DOXYGEN_DOT_MULTI_TARGETS NO)
endif()
if(NOT DEFINED DOXYGEN_GENERATE_LEGEND)
set(DOXYGEN_GENERATE_LEGEND YES)
endif()
if(NOT DEFINED DOXYGEN_DOT_CLEANUP)
set(DOXYGEN_DOT_CLEANUP YES)
endif()

1059
CMakeLists.txt Normal file → Executable file
View File

File diff suppressed because it is too large Load Diff

26
CXX/CMakeLists.txt
View File

@ -7,30 +7,24 @@ set(SO_PATCH 0)
set (CXX_SOURCES
yapi.cpp
)
set (CXX_HEADERS
yapa.hh
yapdb.hh
yapi.h
yapie.hh
yapq.hh
- yapt.hh
-)
list(APPEND LIBYAP_SOURCES ${CXX_SOURCES} PARENT_SCOPE)
if ( WIN32)
if ( WIN32 OR ANDROID)
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_external (YAP++ ${CXX_SOURCES} )
MY_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 ${libdir}
RUNTIME DESTINATION ${dlls}
ARCHIVE DESTINATION ${libdir}
LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}
RUNTIME DESTINATION ${YAP_INSTALL_DLLDIR}
ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR}
)
endif()

23
CXX/yapa.hh
View File

@ -24,7 +24,7 @@
*
* In a nutshell:
* - YAPAtom serves as the gateway to the data-base;
*
*
* - YAProp abstracts most data-base objects.
*
* - PropTag allows distinguishing the different classes of YAPProp.
@ -41,12 +41,12 @@ enum PropTag {
ARITHMETIC_PROPERTY_TAG = ExpProperty, // 0xFFE0,
/// map the atom to an integer
TRANSLATION_TAG = TranslationProperty, // 0xFFF4,
/// ensure the atom may not be garbafe colected
HOLD_TAG = HoldProperty, // 0xFFF6
/// ensure the atom may not be garbafe colected
HOLD_TAG = HoldProperty, // 0xFFF6
/// named mutEX
MUTEX_TAG = MutexProperty, // 0xFFF6,
/// A typed array, may be in-db or in-stack deped
ARRAY_TAG = ArrayProperty, // 0xFFF7,
ARRAY_TAG = ArrayProperty, // 0xFFF7,
/// module
MODULE_TAG = ModProperty, // 0xFFFA,
/// the original SICStus blackboard
@ -57,8 +57,8 @@ enum PropTag {
GLOBAL_VAR_TAG = GlobalProperty, // 0xFFFD
/// SWI-STYLE ATOM Extension
BLOB_TAG = BlobProperty, // 0xFFFE,
/// Prolog operator,
OPERATOR_TAG = OpProperty, // 0xFFFF,
/// Prolog operator,
OPERATOR_TAG = OpProperty, // 0xFFFF,
};
/**
@ -68,7 +68,7 @@ enum PropTag {
* predicates, operators, modules, almost everything.
*
*/
class YAPAtom {
class X_API YAPAtom {
friend class YAPEngine;
friend class YAPModuleProp;
friend class YAPPredicate;
@ -94,7 +94,7 @@ public:
/// get name of (other way)
inline const char *text(void) { return getName(); } ;
/// get prop of type
Prop getProp( PropTag tag ) { return Yap_GetAProp( a , (PropFlags)tag ); }
Prop getProp( PropTag tag ) { return Yap_GetAProp( a , (PropFlags)tag ); }
};
/**
@ -104,7 +104,7 @@ public:
* predicates, operators, modules, almost everything.
*
*/
class YAPProp {
class X_API YAPProp {
friend class YAPModuleProp;
friend class YAPFunctor;
/// does nothing, p is defined by the subclass
@ -115,10 +115,9 @@ public:
/// get name of property
// virtual YAPAtom name();
virtual ~YAPProp() {};
};
#endif /* YAPA_HH */
#endif /* YAPA_HH */
/// @}

174
CXX/yapdb.hh
View File

@ -2,12 +2,12 @@
///
/// @brief C++ Interface to generated code.
#ifndef _YAPDB_H
#define _YAPDB_H
#define YAP_CPP_DB_INTERFACE 1
#include <YapInterface.h>
#define YAP_CPP_DB_INTERFACE 1
/**
*
@ -43,16 +43,18 @@ class YAPModule;
* Info about the module is in YAPModuleProp
*
*/
class YAPModule : protected YAPAtomTerm {
class X_API YAPModule : protected YAPAtomTerm {
friend class YAPPredicate;
friend class YAPModuleProp;
YAPModule(Term t) : YAPAtomTerm(t){};
Term t() { return gt(); }
Term curModule() { CACHE_REGS return Yap_CurrentModule(); }
public:
YAPModule(YAP_Term t) : YAPAtomTerm(t){};
YAPModule() : YAPAtomTerm(curModule()){};
YAPModule(YAPAtom t) : YAPAtomTerm(t){};
YAPModule(YAPStringTerm t) : YAPAtomTerm(t.getString()){};
Term term() { return gt(); };
};
/**
@ -60,7 +62,7 @@ public:
* A YAPModuleProp controls access to a module property.
*
*/
class YAPModuleProp : public YAPProp {
class X_API YAPModuleProp : public YAPProp {
friend class YAPPredicate;
ModEntry *m;
@ -69,64 +71,16 @@ class YAPModuleProp : public YAPProp {
public:
YAPModuleProp(YAPModule tmod) { m = Yap_GetModuleEntry(tmod.gt()); };
YAPModuleProp() { CACHE_REGS m = Yap_GetModuleEntry(Yap_CurrentModule()); };
YAPModuleProp() { m = Yap_GetModuleEntry(Yap_CurrentModule()); };
virtual YAPModule module() { return YAPModule(m->AtomOfME); };
};
/**
* @brief YAPFunctor represents Prolog functors Name/Arity
*/
class YAPFunctor : public YAPProp {
friend class YAPApplTerm;
friend class YAPTerm;
friend class YAPPredicate;
friend class YAPQuery;
Functor f;
/// Constructor: receives Prolog functor and casts it to YAPFunctor
///
/// Notice that this is designed for internal use only.
inline YAPFunctor(Functor ff) { f = ff; }
public:
/// Constructor: receives name as an atom, plus arity
///
/// This is the default method, and the most popular
YAPFunctor(YAPAtom at, uintptr_t arity) { f = Yap_MkFunctor(at.a, arity); }
/// Constructor: receives name as a string plus arity
///
/// Notice that this is designed for ISO-LATIN-1 right now
/// Note: Python confuses the 3 constructors,
/// use YAPFunctorFromString
inline YAPFunctor(const char *s, uintptr_t arity, bool isutf8 = true) {
f = Yap_MkFunctor(Yap_LookupAtom(s), arity);
}
/// Constructor: receives name as a wide string plus arity
///
/// Notice that this is designed for UNICODE right now
///
/// Note: Python confuses the 3 constructors,
/// use YAPFunctorFromWideString
inline YAPFunctor(const wchar_t *s, uintptr_t arity) {
CACHE_REGS f = Yap_MkFunctor(UTF32ToAtom(s PASS_REGS), arity);
}
/// Getter: extract name of functor as an atom
///
/// this is for external usage.
YAPAtom name(void) { return YAPAtom(NameOfFunctor(f)); }
/// Getter: extract arity of functor as an unsigned integer
///
/// this is for external usage.
uintptr_t arity(void) { return ArityOfFunctor(f); }
};
/**
* @brief Predicates
*
* This class interfaces with PredEntry in Yatom.
*/
class YAPPredicate : public YAPModuleProp {
class X_API YAPPredicate : public YAPModuleProp {
friend class YAPQuery;
friend class YAPEngine;
@ -134,46 +88,48 @@ protected:
PredEntry *ap;
/// auxiliary routine to find a predicate in the current module.
PredEntry *getPred(YAPTerm &t, Term *&outp);
/// auxiliary routine to find a predicate in the current module.
PredEntry *getPred(Term &t, Term &tm, CELL *&outp);
PredEntry *asPred() { return ap; };
/// String constructor for predicates
/// Empty constructor for predicates
///
/// It also communicates the array of arguments t[]
/// and the array of variables
/// back to yapquery
YAPPredicate(const char *s0, Term &tout, Term &tnames) {
CACHE_REGS
Term *modp = NULL;
const unsigned char *us = (const unsigned char *)s0;
tnames = MkVarTerm();
tout =
Yap_BufferToTermWithPrioBindings(us, strlen(s0), TermNil, 1200, tnames);
// fprintf(stderr,"ap=%p arity=%d text=%s", ap, ap->ArityOfPE, s);
// Yap_DebugPlWrite(out);
if (tout == 0L) {
Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, MkStringTerm(s0), "YAPPredicate");
}
YAPTerm tt = YAPTerm(tout);
ap = getPred(tt, modp);
}
/// Just do nothing.
inline YAPPredicate() {}
YAPPredicate(Term &to, Term &tmod, CELL *&ts, const char *pname);
/// Term constructor for predicates
///
/// It is just a call to getPred
inline YAPPredicate(Term t, CELL *&v) {
if (t) {
Term tm = Yap_CurrentModule();
ap = getPred(t, tm, v);
}
}
inline YAPPredicate(Term t) {
CELL *v = NULL;
YAPTerm tt = YAPTerm(t);
ap = getPred(tt, v);
if (t) {
CELL *v = nullptr;
Term tm = Yap_CurrentModule();
ap = getPred(t, tm, v);
}
}
/// Term constructor for predicates
///
/// It is just a call to getPred
inline YAPPredicate(YAPTerm t, CELL *&v) {
Term tp = t.term(), tm = Yap_CurrentModule();
ap = getPred(tp, tm, v);
}
inline YAPPredicate(YAPTerm t) {
Term *v = nullptr;
ap = getPred(t, v);
CELL *v = nullptr;
Term tp = t.term();
Term tm = Yap_CurrentModule();
ap = getPred(tp, tm, v);
}
/// Cast constructor for predicates,
@ -181,14 +137,42 @@ protected:
///
inline YAPPredicate(PredEntry *pe) { ap = pe; }
/// Functor constructor for predicates, is given a specific module.
/// This version avoids manufacturing objects
inline YAPPredicate(Functor f, Term mod) {
ap = RepPredProp(PredPropByFunc(f, mod));
}
public:
/// String constructor for predicates
///
/// It also communicates the array of arguments t[]
/// and the array of variables
/// back to yapquery
YAPPredicate(const char *s0, Term &tout, YAPPairTerm &names, CELL *&nts) {
CACHE_REGS
const char *s = (const char *)s0;
Term tnames = MkVarTerm();
tout =
Yap_BufferToTermWithPrioBindings(s, TermNil, tnames, strlen(s0), 1200);
// fprintf(stderr,"ap=%p arity=%d text=%s", ap, ap->ArityOfPE, s);
// Yap_DebugPlWrite(out);
if (tout == 0L) {
return;
throw YAPError();
}
Term tm = Yap_CurrentModule();
ap = getPred(tout, tm, nts);
tout = Yap_SaveTerm(tout);
names = YAPPairTerm(tnames);
}
/// Functor constructor for predicates
///
/// Asssumes that we use the current module.
YAPPredicate(YAPFunctor f) {
CACHE_REGS
ap = RepPredProp(PredPropByFunc(f.f, Yap_CurrentModule()));
ap = RepPredProp(PredPropByFunc(f.f, Yap_CurrentModule()));
}
/// Functor constructor for predicates, is given a specific module.
@ -226,14 +210,14 @@ public:
///
inline YAPPredicate(const char *at, uintptr_t arity) {
ap = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom(at), arity),
CurrentModule));
Yap_CurrentModule()));
};
/// char */module constructor for predicates.
///
inline YAPPredicate(const char *at, uintptr_t arity, YAPTerm mod) {
ap = RepPredProp(
PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom(at), arity), mod.term()));
PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom(at), arity), mod.term()));
};
/// char */module constructor for predicates.
@ -268,7 +252,8 @@ public:
YAPFunctor functor() {
if (ap->ArityOfPE)
return YAPFunctor(ap->FunctorOfPred);
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, MkIntTerm(0), "YAPFunctor::functor");
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, MkIntTerm(0),
"YAPFunctor::functor");
}
/// arity of predicate
@ -276,6 +261,7 @@ Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, MkIntTerm(0), "YAPFunctor::functor");
/// we return a positive number.
uintptr_t getArity() { return ap->ArityOfPE; }
arity_t arity() { return ap->ArityOfPE; }
PredEntry *predEntry() { return ap; }
};
/**
@ -283,13 +269,14 @@ Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, MkIntTerm(0), "YAPFunctor::functor");
*
* This class interfaces with Predicates Implemented in Prolog.
*/
class YAPPrologPredicate : public YAPPredicate {
class X_API YAPPrologPredicate : public YAPPredicate {
public:
YAPPrologPredicate(YAPTerm t) : YAPPredicate(t){};
YAPPrologPredicate(const char *s, arity_t arity) : YAPPredicate(s, arity){};
YAPPrologPredicate(YAPAtom s, arity_t arity) : YAPPredicate(s, arity){};
/// add a new clause
bool assertClause(YAPTerm clause, bool last = true,
YAPTerm source = YAPTerm());
YAPTerm source = YAPTerm());
/// add a new tuple
bool assertFact(YAPTerm *tuple, bool last = true);
/// retract at least the first clause matching the predicate.
@ -305,15 +292,14 @@ public:
*
* This class interfaces with Predicates Implemented in Prolog.
*/
class YAPFLIP : public YAPPredicate {
class X_API YAPFLIP : public YAPPredicate {
public:
YAPFLIP(CPredicate call, YAPAtom name, uintptr_t arity,
YAPModule module = YAPModule(), CPredicate retry = 0,
CPredicate cut = 0, size_t extra = 0, bool test = false)
: YAPPredicate(name, arity, module) {
YAPFLIP(YAP_UserCPred call, YAPAtom name, YAP_Arity arity,
YAPModule module = YAPModule(), YAP_UserCPred retry = 0,
YAP_UserCPred cut = 0, YAP_Arity extra = 0, bool test = false)
: YAPPredicate(name, arity, module) {
if (retry) {
Yap_InitCPredBackCut(name.getName(), arity, extra, call, retry, cut,
UserCPredFlag);
YAP_UserBackCutCPredicate(name.getName(), call, retry, cut, arity, extra);
} else {
if (test) {
YAP_UserCPredicate(name.getName(), call, arity);
@ -324,7 +310,7 @@ public:
};
YAPFLIP(const char *name, uintptr_t arity, YAPModule module = YAPModule(),
bool backtrackable = false)
: YAPPredicate(YAPAtom(name), arity, module) {
: YAPPredicate(YAPAtom(name), arity, module) {
if (backtrackable) {
Yap_InitCPredBackCut(name, arity, 0, 0, 0, 0, UserCPredFlag);
} else {

1249
CXX/yapi.cpp
View File

File diff suppressed because it is too large Load Diff

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

@ -1,24 +1,33 @@
/**
@file yapi,hh
@file yapi.hh
@brief entry file for the YAP C++ interface
*/
#define YAP_CPP_INTERFACE 1
#include <gmpxx.h>
#include <vector>
#include <string>
#include <iostream>
#include <string>
#include <vector>
extern "C"{
#include "config.h"
}
#if HAVE_GMPXX_H
#include <gmpxx.h>
#elif HAVE_GMP_H
#include <gmp.h>
#endif
/*!
*
* @ingroup fli_c_cx
* @ingroup fli_c_cxx
* @defgroup yap-cplus-interface An object oriented interface for YAP.
*
* @{
* @{
*
*
* @brief C++ wrapper to terms, predicates and queries
@ -29,18 +38,27 @@
* interface.
*
*/
#include <stdlib.h>
#include <string>
extern "C" {
#include <stdlib.h>
// Bad export from Python
#include <config.h>
extern "C" {
#include <stddef.h>
#if YAP_PYTHON
#include <Python.h>
extern bool python_in_python;
#endif
#include "Yap.h"
#include "Yatom.h"
@ -70,21 +88,35 @@ extern "C" {
#endif
#if _MSC_VER || defined(__MINGW32__)
//#include <windows.h>
//#include <windows.h>
#endif
// taken from yap_structs.h
// taken from yap_structs.h
#include "iopreds.h"
X_API void YAP_UserCPredicate(const char *, YAP_UserCPred, YAP_Arity arity);
X_API extern void YAP_UserCPredicate(const char *, YAP_UserCPred,
YAP_Arity arity);
/* void UserCPredicateWithArgs(const char *name, int *fn(), unsigned int arity)
*/
X_API void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, YAP_Arity,
YAP_Term);
/* extern void UserCPredicateWithArgs(const char *name, int *fn(), unsigned int
* arity)
*/
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_UserBackCutCPredicate(const char *name,
YAP_UserCPred init,
YAP_UserCPred cont,
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);
X_API void UserBackCPredicate(const char *name, int *init(), int *cont(), int
arity, int extra);
}
@ -98,6 +130,7 @@ class YAPModule;
class YAPError;
class YAPPredicate;
#include "yapa.hh"
#include "yapie.hh"

69
CXX/yapie.hh
View File

@ -1,12 +1,12 @@
/**
/**
* @file yapie.hh
*
* @defgroup yap-cplus-error-hanadlinge Errir Handling in the YAP interface.
* @defgroup yap-cplus-error-hanadlinge Error Handling in the YAP interface.
*
* @brief this is an attempt at supporting error
* @brief error handling in C++ and OO languages
*
* @ingroup yap-cplus-interface
* @tableofcontents
*
*
* @{
*
@ -15,7 +15,7 @@
* YAP itself. One can also define one's own error objects.
*
* Errors will be thrown from the `C++` code, and may be processed in
* very different ways. The error object should provide as much data asa
* very different ways. The error object should provide as much data as
* possible.
*/
@ -23,35 +23,66 @@
#ifndef YAPIE_HH
#define YAPIE_HH
class YAPPPredicate;
class YAPTerm;
class X_API YAPPPredicate;
/// take information on a Prolog error:
class YAPError {
yap_error_number ID;
std::string goal, info;
class X_API YAPError {
int swigcode;
yap_error_descriptor_t *info;
public:
YAPError(){
//ID = LOCAL_ActiveError->errorNo;
/// wraps the default error descriptor
YAPError() {
info = LOCAL_ActiveError;
if (!info)
LOCAL_ActiveError = info = (yap_error_descriptor_t *)calloc( sizeof( yap_error_descriptor_t ), 1);
// if (info->errorNo != YAP_NO_ERROR) {};
//std::cerr << "Error detected" << info->errorNo << "\n";
}
/// if des != nullptr, wrap a preexisting error descriptor;
/// otherwise, generate a new one
YAPError(yap_error_descriptor_t *des) {
if (des)
info= des;
else info = (yap_error_descriptor_t *)calloc( sizeof( yap_error_descriptor_t ), 1);
// if (info->errorNo != YAP_NO_ERROR) {};
//std::cerr << "Error detected" << info->errorNo << "\n";
}
/// error handler object with initial data when receiving the error term
YAPError(yap_error_number id, YAPTerm culprit, std::string txt);
// YAPError( std::string file, std::string function, int lineno,
// yap_error_number id, YAPTerm culprit, std::string txt) {
// info = new yap_error_descriptor_t;
// Yap_MkErrorRecord(info, file.c_str(), function.c_str(), lineno, id, culprit.term(), txt.c_str());
//}
/// error handler object with initial data when receiving the error term
YAPError( const char * file, const char * function, int lineno,
yap_error_number id, YAP_Term culprit, const char * txt) {
info = (yap_error_descriptor_t *)calloc( sizeof( yap_error_descriptor_t ), 1);
Yap_MkErrorRecord(info, file, function, lineno, id, culprit, txt);
}
/// short version
#define SOURCE() __FILE__, __FUNCTION__, __LINE__
/// we just know the error number
/// exact error ID
yap_error_number getID() { return LOCAL_ActiveError->errorNo; };
yap_error_number getID() { return info->errorNo; };
/// class of error
yap_error_class_number getErrorClass() {
return Yap_errorClass(LOCAL_ActiveError->errorNo);
return Yap_errorClass(info->errorNo);
};
/// where in the code things happened;
const char *getFile() { return LOCAL_ActiveError->errorFile; };
const char *getFile() { return info->errorFile; };
/// predicate things happened;
Int getLine() { return LOCAL_ActiveError->errorLine; };
Int getLine() { return info->errorLine; };
/// the term that caused the bug
// YAPTerm getCulprit(LOCAL_ActiveError->errorFile){};
// YAPTerm getCulprit(info->errorFile){};
/// text describing the Error
std::string text();
};

380
CXX/yapq.hh
View File

@ -2,15 +2,15 @@
/**
* @file yapq.hh
*
* @defgroup yap-cplus-query-hanadlinge Query Handling in the YAP interface.
* @defgroup yap-cplus-query-handling Query Handling in the YAP interface.
* @brief Engine and Query Management
*
* @ingroup yap-cplus-interface
*
* @{
*
* These classes wrap engine and query. An engine is an environment where we can rum
* Prolog, that is, where we can run queries.
* These classes wrap engine and query. An engine is an environment where we
* can rum Prolog, that is, where we can run queries.
*
* Also, supports callbacks and engine configuration.
*
@ -19,36 +19,57 @@
#ifndef YAPQ_HH
#define YAPQ_HH 1
class YAPPredicate;
class X_API YAPPredicate;
/**
Queries and engines
*/
#if __ANDROID__
#endif
/**
* @brief Queries
*
* interface to a YAP Query;
* uses an SWI-like status info internally.
*/
class YAPQuery : public YAPPredicate
{
class X_API YAPQuery : public YAPPredicate {
bool q_open;
int q_state;
yhandle_t q_g, q_handles;
yhandle_t q_handles;
struct yami *q_p, *q_cp;
sigjmp_buf q_env;
int q_flags;
YAP_dogoalinfo q_h;
YAPQuery *oq;
YAPPairTerm names;
YAPTerm goal;
Term goal;
CELL *nts;
// temporaries
Term tnames, tgoal ;
YAPError *e;
void openQuery(Term t);
inline void setNext() { // oq = LOCAL_execution;
// LOCAL_execution = this;
q_open = true;
q_state = 0;
q_flags = true; // PL_Q_PASS_EXCEPTION;
q_p = P;
q_cp = CP;
// make sure this is safe
q_handles = LOCAL_CurSlot;
};
void openQuery();
PredEntry *rewriteUndefQuery();
public:
YAPQuery() {
goal = TermTrue;
openQuery();
};
inline ~YAPQuery() { close(); }
/// main constructor, uses a predicate and an array of terms
///
/// It is given a YAPPredicate _p_ , and an array of terms that must have at
@ -66,34 +87,39 @@ public:
///
/// It is given a functor, and an array of terms that must have at least
/// the same arity as the functor. Works within the current module.
//YAPQuery(YAPFunctor f, YAPTerm t[]);
// YAPQuery(YAPFunctor f, YAPTerm t[]);
/// string constructor without varnames
///
/// It is given a string, calls the parser and obtains a Prolog term that
/// should be a callable
/// goal.
inline YAPQuery(const char *s) : YAPPredicate(s, tgoal, tnames)
{
inline YAPQuery(const char *s) : YAPPredicate(s, goal, names, (nts = &ARG1)) {
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "got game %ld",
LOCAL_CurSlot);
if (!ap)
return;
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "%s", vnames.text());
goal = YAPTerm(tgoal);
names = YAPPairTerm(tnames);
openQuery(tgoal);
openQuery();
};
// inline YAPQuery() : YAPPredicate(s, tgoal, tnames)
// {
// __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "got game %ld",
// if (!ap)
// return;
// __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "%s", vnames.text());
// goal = YAPTerm(tgoal);
// names = YAPPairTerm(tnames);
// openQuery(tgoal);
// };
/// string constructor with just an atom
///
/// It is given an atom, and a Prolog term that should be a callable
/// goal, say `main`, `init`, `live`.
inline YAPQuery(YAPAtom g) : YAPPredicate(g)
{
goal = YAPAtomTerm(g);
names = YAPPairTerm( );
openQuery(goal.term());
};
/// It i;
///};
/// build a query from a term
YAPQuery(YAPTerm t) : YAPPredicate((goal = t.term()), (nts = &ARG1)) {
BACKUP_MACHINE_REGS();
openQuery();
names = YAPPairTerm(TermNil);
RECOVER_MACHINE_REGS();
}
/// set flags for query execution, currently only for exception handling
void setFlag(int flag) { q_flags |= flag; }
/// reset flags for query execution, currently only for exception handling
@ -116,17 +142,16 @@ public:
void close();
/// query variables.
void cut();
Term namedVars() {return names.term(); };
Term namedVars() { return names.term(); };
YAPPairTerm namedVarTerms() { return names; };
/// query variables, but copied out
std::vector<Term> namedVarsVector() {
return names.listToArray(); };
std::vector<Term> namedVarsVector() { return names.listToArray(); };
/// convert a ref to a binding.
YAPTerm getTerm(yhandle_t t);
/// simple YAP Query;
/// just calls YAP and reports success or failure, Useful when we just
/// want things done, eg YAPCommand("load_files(library(lists), )")
inline bool command()
{
inline bool command() {
bool rc = next();
close();
return rc;
@ -138,178 +163,113 @@ public:
/// This class implements a callback Prolog-side. It will be inherited by the
/// Java or Python
/// class that actually implements the callback.
class YAPCallback
{
class X_API YAPCallback {
public:
virtual ~YAPCallback() {}
virtual void run() { LOG("callback"); }
virtual void run(char *s) {}
};
class YAPEngine;
/// @brief Setup all arguments to a new engine
class YAPEngineArgs {
struct X_API YAPEngineArgs : YAP_init_args {
friend class YAPEngine;
YAP_init_args init_args;
void fetch_defaults();
public:
YAPEngineArgs() {
// const std::string *s = new std::string("startup.yss");
Embedded = true;
install = false;
inline void setEmbedded( bool fl )
{
init_args.Embedded = fl;
Yap_InitDefaults(this, nullptr, 0, nullptr);
#if YAP_PYTHON
Embedded = true;
python_in_python = Py_IsInitialized();
#endif
#if __ANDROID__
#endif
};
inline bool getEmbedded( )
{
return init_args.Embedded;
inline void setEmbedded(bool fl) { Embedded = fl; };
inline bool getEmbedded() { return Embedded; };
inline void setStackSize(bool fl) { StackSize = fl; };
inline bool getStackSize() { return StackSize; };
inline void setTrailSize(bool fl) { TrailSize = fl; };
inline bool getTrailSize() { return TrailSize; };
inline bool getMStackSize() { return StackSize; };
inline void setMaxTrailSize(bool fl) { MaxTrailSize = fl; };
inline bool getMaxTrailSize() { return MaxTrailSize; };
inline void createSavedState(bool fl) { install = fl; };
inline bool creatingSavedState() { return install; };
inline void setPLDIR(const char *fl) {
LIBDIR = (const char *)malloc(strlen(fl) + 1);
strcpy((char *)LIBDIR, fl);
};
inline void setSavedState( char *fl )
{
init_args.SavedState = fl;
inline const char *getPLDIR() { return PLDIR; };
inline void setINPUT_STARTUP(const char *fl) {
INPUT_STARTUP = (const char *)malloc(strlen(fl) + 1);
strcpy((char *)INPUT_STARTUP, fl);
};
inline const char * getSavedState( )
{
return init_args.SavedState;
inline const char *getINPUT_STARTUP() { return INPUT_STARTUP; };
inline void setOUTPUT_RESTORE(const char *fl) {
OUTPUT_STARTUP = (const char *)malloc(strlen(fl) + 1);
strcpy((char *)OUTPUT_STARTUP, fl);
};
inline void setStackSize( bool fl )
{
init_args.StackSize = fl;
inline const char *getOUTPUT_STARTUP() { return OUTPUT_STARTUP; };
inline void setBOOTFILE(const char *fl) {
BOOTFILE = (const char *)malloc(strlen(fl) + 1);
strcpy((char *)BOOTFILE, fl);
};
inline bool getStackSize( )
{
return init_args.StackSize;
inline const char *getBOOTFILE() { return BOOTFILE; };
inline void setPrologBOOTSTRAP(const char *fl) {
BOOTSTRAP = (const char *)malloc(strlen(fl) + 1);
strcpy((char *)BOOTSTRAP, fl);
};
inline void setTrailSize( bool fl )
{
init_args.TrailSize = fl;
inline const char *getBOOTSTRAP() { return BOOTSTRAP; };
inline void setPrologGoal(const char *fl) { PrologGoal = fl; };
inline const char *getPrologGoal() { return PrologGoal; };
inline void setPrologTopLevelGoal(const char *fl) {
PrologTopLevelGoal = fl;
};
inline bool getTrailSize( )
{
return init_args.TrailSize;
};
inline const char *getPrologTopLevelGoal() { return PrologTopLevelGoal; };
inline bool getMStackSize( )
{
return init_args.StackSize;
};
inline void setHaltAfterBoot(bool fl) { HaltAfterBoot = fl; };
inline void setMaxTrailSize( bool fl )
{
init_args.MaxTrailSize = fl;
};
inline bool getHaltAfterBoot() { return HaltAfterBoot; };
inline bool getMaxTrailSize( )
{
return init_args.MaxTrailSize;
};
inline void setFastBoot(bool fl) { FastBoot = fl; };
inline void setYapLibDir( const char * fl )
{
init_args.YapLibDir = fl;
};
inline bool getFastBoot() { return FastBoot; };
inline const char * getYapLibDir( )
{
return init_args.YapLibDir;
};
inline void setArgc(int fl) { Argc = fl; };
inline void setYapShareDir( const char * fl )
{
init_args.YapShareDir = fl;
};
inline int getArgc() { return Argc; };
inline const char * getYapShareDir( )
{
return init_args.YapShareDir;
};
inline void setYapPrologBootFile( const char * fl )
{
init_args.YapPrologBootFile = fl;
};
inline const char * getYapPrologBootFile( )
{
return init_args.YapPrologBootFile;
};
inline void setYapPrologGoal( const char * fl )
{
init_args.YapPrologGoal = fl;
};
inline const char * getYapPrologGoal( )
{
return init_args.YapPrologGoal;
};
inline void setYapPrologTopLevelGoal( const char * fl )
{
init_args.YapPrologTopLevelGoal = fl;
};
inline const char * getYapPrologTopLevelGoal( )
{
return init_args.YapPrologTopLevelGoal;
};
inline void setHaltAfterConsult( bool fl )
{
init_args.HaltAfterConsult = fl;
};
inline bool getHaltAfterConsult( )
{
return init_args.HaltAfterConsult;
};
inline void setFastBoot( bool fl )
{
init_args.FastBoot = fl;
};
inline bool getFastBoot( )
{
return init_args.FastBoot;
};
inline void setArgc( int fl )
{
init_args.Argc = fl;
};
inline int getArgc( )
{
return init_args.Argc;
};
inline void setArgv( char ** fl )
{
init_args.Argv = fl;
};
inline char ** getArgv( )
{
return init_args.Argv;
};
YAPEngineArgs() {
fetch_defaults();
};
inline void setArgv(char **fl) { Argv = fl; };
inline char **getArgv() { return Argv; };
};
/**
@ -318,36 +278,39 @@ public:
*
*
*/
class YAPEngine
{
class YAPEngine {
private:
YAPEngineArgs engine_args;
YAPEngineArgs *engine_args;
YAPCallback *_callback;
YAPError yerror;
void doInit(YAP_file_type_t BootMode);
void doInit(YAP_file_type_t BootMode, YAPEngineArgs *cargs);
YAP_dogoalinfo q;
YAPError e;
PredEntry *rewriteUndefEngineQuery(PredEntry *ap, Term &t, Term tmod);
public:
/// construct a new engine; may use a variable number of arguments
YAPEngine(YAPEngineArgs &cargs); /// construct a new engine, including aaccess to callbacks
/// construct a new engine using argc/argv list of arguments
YAPEngine(YAPEngineArgs *cargs) {
engine_args = cargs;
// doInit(cargs->boot_file_type);
doInit(YAP_QLY, cargs);
}; /// construct a new engine, including aaccess to callbacks
/// construct a new engine using argc/argv list of arguments
YAPEngine(int argc, char *argv[],
YAPCallback *callback = (YAPCallback *)NULL);
/// kill engine
~YAPEngine() { delYAPCallback(); }
~YAPEngine() { delYAPCallback(); };
/// remove current callback
void delYAPCallback() { _callback = 0; }
void delYAPCallback() { _callback = 0; };
/// set a new callback
void setYAPCallback(YAPCallback *cb)
{
void setYAPCallback(YAPCallback *cb) {
delYAPCallback();
_callback = cb;
}
};
/// execute the callback.
////void run() { if (_callback) _callback.run(); }
/// execute the callback with a text argument.
void run(char *s)
{
void run(char *s) {
if (_callback)
_callback->run(s);
}
@ -358,21 +321,30 @@ public:
bool hasError() { return LOCAL_Error_TYPE != YAP_NO_ERROR; }
/// build a query on the engine
YAPQuery *query(const char *s) { return new YAPQuery(s); };
/// build a query from a term
YAPQuery *query(YAPTerm t) { return new YAPQuery(t); };
/// build a query from a Prolog term (internal)
YAPQuery *qt(Term t) { return new YAPQuery(YAPTerm(t)); };
/// current module for the engine
YAPModule currentModule() { return YAPModule(); }
Term Yap_CurrentModule() { return CurrentModule; }
/// given a handle, fetch a term from the engine
inline YAPTerm getTerm(yhandle_t h) { return YAPTerm(h); }
/// current directory for the engine
bool call(YAPPredicate ap, YAPTerm ts[]);
/// current directory for the engine
bool goalt(YAPTerm Yt) { return Yt.term(); };
/// current directory for the engine
bool mgoal(Term t, Term tmod);
bool goal(YAPTerm Yt, YAPModule module, bool release = false) {
return mgoal(Yt.term(), module.term(), release);
};
/// ru1n a goal in a module.
///
/// By default, memory will only be fully
/// recovered on backtracking. The release option ensures
/// backtracking is called at the very end.
bool mgoal(Term t, Term tmod, bool release = false);
/// current directory for the engine
bool goal(Term t)
{
return mgoal(t, CurrentModule);
bool goal(Term t, bool release = false) {
return mgoal(t, Yap_CurrentModule(), release);
}
/// reset Prolog state
void reSet();
@ -380,23 +352,31 @@ public:
// for last execution
void release();
const char *currentDir()
{
const char *currentDir() {
char dir[1024];
std::string s = Yap_getcwd(dir, 1024 - 1);
return s.c_str();
};
/// report YAP version as a string
const char *version()
{
const char *version() {
std::string s = Yap_version();
return s.c_str();
};
//> call a deterninistic predicate: the user will construct aterm of
//> arity N-1. YAP adds an extra variable which will have the
//> output.
YAPTerm fun(YAPTerm t);
YAPTerm funCall(YAPTerm t) { return YAPTerm(fun(t.term())); };
Term fun(Term t);
//Term fun(YAPTerm t) { return fun(t.term()); };
//> set a StringFlag, usually a path
//>
bool setStringFlag(std::string arg, std::string path) {
return setYapFlag(MkAtomTerm(Yap_LookupAtom(arg.data())),
MkAtomTerm(Yap_LookupAtom(path.data())));
};
Term top_level(std::string s);
Term next_answer(YAPQuery *&Q);
};
#endif /* YAPQ_HH */

300
CXX/yapt.hh
View File

@ -25,16 +25,17 @@
#ifndef YAPT_HH
#define YAPT_HH 1
extern "C" {
Term YAP_ReadBuffer(const char *s, Term *tp);
}
class YAPError;
extern "C" {
X_API extern Term YAP_MkCharPTerm(char *n);
}
/**
* @brief Generic Prolog Term
*/
class YAPTerm {
class X_API YAPTerm {
friend class YAPPredicate;
friend class YAPPrologPredicate;
friend class YAPQuery;
@ -49,9 +50,9 @@ protected:
public:
Term gt() {
CACHE_REGS
// fprintf(stderr,"?%d,%lx,%p\n",t,LOCAL_HandleBase[t], HR);
// Yap_DebugPlWriteln(LOCAL_HandleBase[t]);
return Yap_GetFromSlot(t);
// fprintf(stderr,"?%d,%lx,%p\n",t,LOCAL_HandleBase[t], HR);
// Yap_DebugPlWriteln(LOCAL_HandleBase[t]);
return Yap_GetFromSlot(t);
};
void mk(Term t0) {
@ -66,36 +67,36 @@ public:
YAPTerm(Term tn) { mk(tn); };
#ifdef SWIGPYTHON
// YAPTerm(struct _object *inp) {
// Term tinp = pythonToYAP(inp);
// t = Yap_InitSlot(tinp);
//}
// YAPTerm(struct _object *inp) {
// Term tinp = pythonToYAP(inp);
// t = Yap_InitSlot(tinp);
//}
#endif
/// private method to convert from Term (internal YAP representation) to
/// YAPTerm
// do nothing constructor
YAPTerm() { t=0; };
YAPTerm() { t = 0; };
// YAPTerm(yhandle_t i) { t = i; };
/// pointer to term
YAPTerm(void *ptr);
/// parse string s and construct a term.
YAPTerm(char *s) {
Term tp;
Term tp = 0;
mk(YAP_ReadBuffer(s, &tp));
}
#if 1
/// Term destructor, tries to recover slot
virtual ~YAPTerm() {
// fprintf(stderr,"-%d,%lx,%p ",t,LOCAL_HandleBase[t] ,HR);
/* if (!t)
return;
Yap_DebugPlWriteln(LOCAL_HandleBase[t]);
LOCAL_HandleBase[t] = TermFreeTerm;
while (LOCAL_HandleBase[LOCAL_CurSlot - 1] == TermFreeTerm) {
LOCAL_CurSlot--;
}
*/
virtual ~YAPTerm(){
// fprintf(stderr,"-%d,%lx,%p ",t,LOCAL_HandleBase[t] ,HR);
/* if (!t)
return;
// Yap_DebugPlWriteln(LOCAL_HandleBase[t]);
LOCAL_HandleBase[t] = TermFreeTerm;
while (LOCAL_HandleBase[LOCAL_CurSlot - 1] == TermFreeTerm) {
LOCAL_CurSlot--;
}
*/
};
#endif
@ -114,8 +115,19 @@ public:
/// numbervars ( int start, bool process=false )
intptr_t numberVars(intptr_t start, bool skip_singletons = false);
inline Term term() {
return gt();
return Deref(gt());
} /// from YAPTerm to Term (internal YAP representation)
YAPTerm arg(int i) {
BACKUP_MACHINE_REGS();
Term t0 = gt();
YAPTerm tf;
if (!IsApplTerm(t0) && !IsPairTerm(t))
return (Term)0;
tf = YAPTerm(ArgOfTerm(i, t0));
RECOVER_MACHINE_REGS();
return tf;
};
inline void bind(Term b) { LOCAL_HandleBase[t] = b; }
inline void bind(YAPTerm *b) { LOCAL_HandleBase[t] = b->term(); }
/// from YAPTerm to Term (internal YAP representation)
@ -187,28 +199,9 @@ public:
virtual bool isGround() { return Yap_IsGroundTerm(gt()); } /// term is ground
virtual bool isList() { return Yap_IsListTerm(gt()); } /// term is a list
/// extract the argument i of the term, where i in 1...arity
virtual Term getArg(arity_t i) {
BACKUP_MACHINE_REGS();
Term tf = 0;
Term t0 = gt();
if (IsApplTerm(t0)) {
if (i > t) YAPError(DOMAIN_ERROR_OUT_OF_RANGE, t0, "t0.getArg()");
tf = (ArgOfTerm(i, t0));
} else if (IsPairTerm(t0)) {
if (i == 1)
tf = (HeadOfTerm(t0));
else if (i == 2)
tf = (TailOfTerm(t0));
else
YAPError(DOMAIN_ERROR_OUT_OF_RANGE, t0, "t0.getArg()");
} else {
YAPError(TYPE_ERROR_COMPOUND , t0, "t0.getArg()");
}
RECOVER_MACHINE_REGS();
return tf;
}
/// extract the argument i of the term, where i in 1...arityvoid
/// *Yap_RepStreamFromId(int sno)
virtual Term getArg(arity_t i);
/// extract the arity of the term
/// variables have arity 0
@ -229,21 +222,15 @@ public:
/// return a string with a textual representation of the term
virtual const char *text() {
CACHE_REGS
size_t length = 0;
encoding_t enc = LOCAL_encoding;
char *os;
BACKUP_MACHINE_REGS();
if (!(os = Yap_TermToString(Yap_GetFromSlot(t), &length, enc,
Handle_vars_f))) {
if (!(os = Yap_TermToBuffer(Yap_GetFromSlot(t), Handle_vars_f))) {
RECOVER_MACHINE_REGS();
return 0;
}
RECOVER_MACHINE_REGS();
length = strlen(os) + 1;
char *sm = (char *)malloc(length + 1);
strcpy(sm, os);
return sm;
return os;
};
/// return a handle to the term
@ -254,53 +241,83 @@ public:
};
/**
* @brief Variable Term
* @brief YAPFunctor represents Prolog functors Name/Arity
*/
class YAPVarTerm : public YAPTerm {
YAPVarTerm(Term t) {
if (IsVarTerm(t)) {
mk(t);
}
}
class X_API YAPFunctor : public YAPProp {
friend class YAPApplTerm;
friend class YAPTerm;
friend class YAPPredicate;
friend class YAPQuery;
Functor f;
/// Constructor: receives Prolog functor and casts it to YAPFunctor
///
/// Notice that this is designed for internal use only.
inline YAPFunctor(Functor ff) { f = ff; }
public:
/// constructor
YAPVarTerm();
/// get the internal representation
CELL *getVar() { return VarOfTerm(gt()); }
/// is the variable bound to another one
bool unbound() { return IsUnboundVar(VarOfTerm(gt())); }
virtual bool isVar() { return true; } /// type check for unbound
virtual bool isAtom() { return false; } /// type check for atom
virtual bool isInteger() { return false; } /// type check for integer
virtual bool isFloat() { return false; } /// type check for floating-point
virtual bool isString() { return false; } /// type check for a string " ... "
virtual bool isCompound() { return false; } /// is a primitive term
virtual bool isAppl() { return false; } /// is a structured term
virtual bool isPair() { return false; } /// is a pair term
virtual bool isGround() { return false; } /// term is ground
virtual bool isList() { return false; } /// term is a list
/// Constructor: receives name as an atom, plus arity
///
/// This is the default method, and the most popular
YAPFunctor(YAPAtom at, uintptr_t arity) { f = Yap_MkFunctor(at.a, arity); }
/// Constructor: receives name as a string plus arity
///
/// Notice that this is designed for ISO-LATIN-1 right now
/// Note: Python confuses the 3 constructors,
/// use YAPFunctorFromString
inline YAPFunctor(const char *s, uintptr_t arity, bool isutf8 = true) {
f = Yap_MkFunctor(Yap_LookupAtom(s), arity);
}
/// Constructor: receives name as a wide string plus arity
///
/// Notice that this is designed for UNICODE right now
///
/// Note: Python confuses the 3 constructors,
/// use YAPFunctorFromWideString
inline YAPFunctor(const wchar_t *s, uintptr_t arity) {
CACHE_REGS f = Yap_MkFunctor(UTF32ToAtom(s PASS_REGS), arity);
}
/// Getter: extract name of functor as an atom
///
/// this is for external usage.
YAPAtom name(void) { return YAPAtom(NameOfFunctor(f)); }
/// Getter: extract arity of functor as an unsigned integer
///
/// this is for external usage.
uintptr_t arity(void) { return ArityOfFunctor(f); }
};
/**
* @brief Compound Term
*/
class YAPApplTerm : public YAPTerm {
class X_API YAPApplTerm : public YAPTerm {
friend class YAPTerm;
public:
YAPApplTerm(Term t0) { mk(t0); }
YAPApplTerm(Functor f, Term ts[]) {
YAPApplTerm(Term t0) { mk(t0); }
YAPApplTerm(Functor f, Term ts[]) {
BACKUP_MACHINE_REGS();
Term t0 = Yap_MkApplTerm(f, f->ArityOfFE, ts);
mk(t0);
RECOVER_MACHINE_REGS();
};
YAPApplTerm(YAPFunctor f, YAPTerm ts[]);
YAPApplTerm(const std::string s, std::vector<YAPTerm> ts);
YAPApplTerm(const std::string s, unsigned int arity) {
mk(Yap_MkNewApplTerm(Yap_MkFunctor(Yap_LookupAtom(s.c_str()), arity),
arity));
};
YAPApplTerm(const std::string s, std::vector<Term> ts);
YAPApplTerm(const std::string s, std::vector<YAPTerm> ts);
YAPApplTerm(YAPFunctor f);
YAPFunctor getFunctor();
Term getArg(arity_t i) {
inline Functor functor() { return FunctorOfTerm(gt()); }
inline YAPFunctor getFunctor() { return YAPFunctor(FunctorOfTerm(gt())); }
YAPApplTerm(const std::string f, YAPTerm a1);
YAPApplTerm(const std::string f, YAPTerm a1, YAPTerm a2);
YAPApplTerm(const std::string f, YAPTerm a1, YAPTerm a2, YAPTerm a3);
YAPApplTerm(const std::string f, YAPTerm a1, YAPTerm a2, YAPTerm a3, YAPTerm a4);
Term getArg(arity_t i) {
BACKUP_MACHINE_REGS();
Term t0 = gt();
Term tf;
@ -308,6 +325,18 @@ public:
RECOVER_MACHINE_REGS();
return tf;
};
void putArg(int i, Term targ) {
// BACKUP_MACHINE_REGS();
Term t0 = gt();
RepAppl(t0)[i] = Deref(targ);
// RECOVER_MACHINE_REGS();
};
void putArg(int i, YAPTerm t) {
// BACKUP_MACHINE_REGS();
Term t0 = gt();
RepAppl(t0)[i] = t.term();
// RECOVER_MACHINE_REGS();
};
virtual bool isVar() { return false; } /// type check for unbound
virtual bool isAtom() { return false; } /// type check for atom
virtual bool isInteger() { return false; } /// type check for integer
@ -323,45 +352,32 @@ public:
/**
* @brief List Constructor Term
*/
class YAPPairTerm : public YAPTerm {
class X_API YAPPairTerm : public YAPTerm {
friend class YAPTerm;
public:
YAPPairTerm(Term t0) {
t0 = Deref(t0);
if (IsPairTerm(t0) || t0 == TermNil)
mk(t0);
else
Yap_ThrowError(TYPE_ERROR_LIST, t0, "YAPPairTerms");
}
YAPPairTerm(YAPTerm hd, YAPTerm tl);
YAPPairTerm(Term t0) {
t0 = Deref(t0);
if (IsPairTerm(t0) || t0 == TermNil)
mk(t0);
else
Yap_ThrowError(TYPE_ERROR_LIST, t0, "YAPPairTerms");
}
YAPPairTerm(YAPTerm hd, YAPTerm tl);
YAPPairTerm();
Term getHead() { return (HeadOfTerm(gt())); }
Term getTail() { return (TailOfTerm(gt())); }
std::vector<Term> listToArray() {
Term *tailp;
Term t1 = gt();
Int l = Yap_SkipList(&t1, &tailp);
if (l < 0) {
throw YAPError(TYPE_ERROR_LIST, YAPTerm(t), "");
}
std::vector<Term> o = std::vector<Term>(l);
int i = 0;
Term t = gt();
while (t != TermNil) {
o[i++] = HeadOfTerm(t);
t = TailOfTerm(t);
}
return o;
}
YAPTerm car() { return YAPTerm(HeadOfTerm(gt())); }
bool nil() { return gt() == TermNil; }
YAPPairTerm cdr() { return YAPPairTerm(TailOfTerm(gt())); }
std::vector<Term> listToArray();
};
/**
* @brief Number Term
*/
class YAPNumberTerm : public YAPTerm {
class X_API YAPNumberTerm : public YAPTerm {
public:
YAPNumberTerm(){};
bool isTagged() { return IsIntTerm(gt()); }
@ -371,7 +387,7 @@ public:
* @brief Integer Term
*/
class YAPIntegerTerm : public YAPNumberTerm {
class X_API YAPIntegerTerm : public YAPNumberTerm {
public:
YAPIntegerTerm(intptr_t i);
intptr_t getInteger() { return IntegerOfTerm(gt()); };
@ -381,14 +397,14 @@ public:
* @brief Floating Point Term
*/
class YAPFloatTerm : public YAPNumberTerm {
class X_API YAPFloatTerm : public YAPNumberTerm {
public:
YAPFloatTerm(double dbl) { mk(MkFloatTerm(dbl)); };
double getFl() { return FloatOfTerm(gt()); };
};
class YAPListTerm : public YAPTerm {
class X_API YAPListTerm : public YAPTerm {
public:
/// Create a list term out of a standard term. Check if a valid operation.
///
@ -419,15 +435,7 @@ public:
/// Extract the tail elements of a list.
///
/// @param[in] the list
Term cdr() {
Term to = gt();
if (IsPairTerm(to))
return (TailOfTerm(to));
else if (to == TermNil)
return TermNil;
/* error */
throw YAPError(TYPE_ERROR_LIST, YAPTerm(to), "");
}
Term cdr();
/// copy a list.
///
/// @param[in] the list
@ -446,7 +454,7 @@ public:
/**
* @brief String Term
*/
class YAPStringTerm : public YAPTerm {
class X_API YAPStringTerm : public YAPTerm {
public:
/// your standard constructor
YAPStringTerm(char *s);
@ -463,23 +471,26 @@ public:
* @brief Atom Term
* Term Representation of an Atom
*/
class YAPAtomTerm : public YAPTerm {
class X_API YAPAtomTerm : public YAPTerm {
friend class YAPModule;
// Constructor: receives a C-atom;
YAPAtomTerm(Atom a) { mk(MkAtomTerm(a)); }
YAPAtomTerm(Term t) : YAPTerm(t) { IsAtomTerm(t); }
public:
// Constructor: receives an atom;
YAPAtomTerm(Atom a) { mk(MkAtomTerm(a)); }
//> Constructor: receives an atom;
YAPAtomTerm(YAPAtom a) : YAPTerm() { mk(MkAtomTerm(a.a)); }
// Constructor: receives a sequence of ISO-LATIN1 codes;
//> Constructor: receives a sequence of UTF-8 codes;
YAPAtomTerm(char s[]);
// Constructor: receives a sequence of up to n ISO-LATIN1 codes;
// Constructor: receives a sequence of up to n UTF-8 codes;
YAPAtomTerm(char *s, size_t len);
// Constructor: receives a sequence of wchar_ts, whatever they may be;
YAPAtomTerm(wchar_t *s);
// Constructor: receives a sequence of n wchar_ts, whatever they may be;
YAPAtomTerm(wchar_t *s, size_t len);
// Constructor: receives a std::string;
// YAPAtomTerm(std::string s) { mk(MkAtomTerm(Yap_LookupAtom(s.c_str())));
// };
bool isVar() { return false; } /// type check for unbound
bool isAtom() { return true; } /// type check for atom
bool isInteger() { return false; } /// type check for integer
@ -497,4 +508,35 @@ public:
};
#endif /* YAPT_HH */
/**
* @brief Variable Term
*/
class X_API YAPVarTerm : public YAPTerm {
friend class YAPTerm;
public:
/// constructor
YAPVarTerm() { mk(MkVarTerm()); };
/// get the internal representation
CELL *getVar() { return VarOfTerm(gt()); }
/// is the variable bound to another one
YAPVarTerm(Term t) {
if (IsVarTerm(t)) {
mk(t);
}
}
/// type check for unbound
bool unbound() { return IsUnboundVar(VarOfTerm(gt())); }
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
inline bool isString() { return false; } /// type check for a string " ... "
inline bool isCompound() { return false; } /// is a primitive term
inline bool isAppl() { return false; } /// is a structured term
inline bool isPair() { return false; } /// is a pair term
inline bool isGround() { return false; } /// term is ground
inline bool isList() { return false; } /// term is a list
};
/// @}

28
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"
@ -20,7 +21,7 @@ A AltNot N "not"
A Answer N "answer"
A Any N "any"
A Append N "append"
A Arg N "arg"
A Arg N "arg"
A Array F "$array"
A ArrayAccess F "$array_arg"
A ArrayOverflow N "array_overflow"
@ -37,6 +38,7 @@ A BeginCurlyBracket N "{"
A EndCurlyBracket N "}"
A EmptyBrackets N "()"
A EmptySquareBrackets N "[]"
A As N "as"
A Asserta N "asserta"
A AssertaStatic N "asserta_static"
A Assertz N "assertz"
@ -134,6 +136,7 @@ A Eq N "="
A Error N "error"
A Exception N "exception"
A Extensions N "extensions"
A ExternalException N "external_exception"
A Evaluable N "evaluable"
A EvaluationError N "evaluation_error"
A Executable N "executable"
@ -170,6 +173,7 @@ A Full N "full"
A Functor N "functor"
A GT N ">"
A GVar N "var"
A g N "g"
A Gc F "$gc"
A GcMargin F "$gc_margin"
A GcTrace F "$gc_trace"
@ -184,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"
@ -221,7 +226,7 @@ A Least N "least"
A Length F "length"
A List N "list"
A Line N "line"
A Live F "$live"
A Live F "live"
A LoadAnswers N "load_answers"
A Local N "local"
A LocalSp N "local_sp"
@ -267,7 +272,7 @@ A NotLessThanZero N "not_less_than_zero"
A NotNewline N "not_newline"
A NotZero N "not_zero"
A Number N "number"
A Obj N "o__bj__"
A Obj N "__obj__"
A Off N "off"
A Offline N "offline"
A On N "on"
@ -288,15 +293,15 @@ A OutOfStackError N "out_of_stack_error"
A OutOfTrailError N "out_of_trail_error"
A Output N "output"
A Parameter N "parameter"
A PrologCommonsDir N "prolog_commons_directory"
A Past N "past"
A PastEndOfStream N "past_end_of_stream"
A PermissionError N "permission_error"
A Pi N "pi"
A Pipe N "pipe"
A Priority N "priority"
A Priority N "priority"
A Plus N "+"
A Pointer N "pointer"
A Popen N "popen"
A Portray F "portray"
A PredicateIndicator N "predicate_indicator"
A Primitive N "primitive"
@ -305,6 +310,7 @@ A PrivateProcedure N "private_procedure"
A Procedure N "procedure"
A Profile F "$profile"
A Prolog N "prolog"
A PrologCommonsDir N "prolog_commons_directory"
A ProtectStack F "$protect_stack"
A Qly N "qly"
A Query N "?-"
@ -322,6 +328,7 @@ A Reconsult N "reconsult"
A RecordedP F "$recordep"
A RecordedWithKey F "$recorded_with_key"
A RedefineWarnings N "redefine_warnings"
A Redo F "redo"
A RedoFreeze F "$redo_freeze"
A RefoundVar F "$I_FOUND_THE_VARIABLE_AGAIN"
A RelativeTo F "relative_to"
@ -395,6 +402,7 @@ A SystemLibraryDir N "system_library_directory"
A T N "t"
A Term N "term"
A TermExpansion N "term_expansion"
A TermPosition N "term_position"
A Terms N "terms"
A Text N "text"
A TextStream N "text_stream"
@ -414,6 +422,7 @@ A Tuple N "tuple"
A Txt N "txt"
A TypeError N "type_error"
A Undefined N "undefined"
A UndefinedQuery N "undefined_query"
A Undefp F "$undefp"
A Undefp0 F "$undefp0"
A Underflow N "underflow"
@ -425,6 +434,7 @@ A User N "user"
A UserErr N "user_error"
A UserIn N "user_input"
A UserOut N "user_output"
A UTF8 N "utf8"
A DollarVar N "$VAR"
A VBar N "|"
A VarBranches N "var_branches"
@ -451,8 +461,11 @@ F Arg Arg 3
F ArrayEntry ArrayAccess 3
F Arrow Arrow 2
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
@ -500,6 +513,7 @@ F Dot9 Dot 9
F DoubleArrow DoubleArrow 2
F DoubleSlash DoubleSlash 2
F EmptySquareBrackets EmptySquareBrackets 2
F Encoding Encoding 1
F Eq Eq 2
F Error Error 2
F EvaluationError EvaluationError 1
@ -509,6 +523,7 @@ F ExecuteInMod ExecuteInMod 2
F ExecuteWithin ExecuteWithin 1
F ExistenceError ExistenceError 2
F ExoClause ExoClause 2
F ExternalException ExternalException 1
F Functor Functor 3
F GAtom Atom 1
F GAtomic Atomic 1
@ -524,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
@ -550,6 +566,7 @@ F Or Semic 2
F Output Output 1
F PermissionError PermissionError 3
F Plus Plus 2
F Popen Popen 1
F Portray Portray 1
F PrintMessage PrintMessage 2
F Procedure Procedure 5
@ -583,6 +600,7 @@ F TimeoutError TimeoutError 2
F TraceMetaCall TraceMetaCall 3
F TypeError TypeError 2
F UMinus Minus 1
F UndefinedQuery UndefinedQuery 3
F UPlus Plus 1
F VBar VBar 2
F WriteTerm WriteTerm 2

2
H/Atoms.h
View File

@ -96,7 +96,7 @@ typedef struct ExtraAtomEntryStruct {
#define USE_OFFSETS_IN_PROPS 0
#endif
typedef SFLAGS PropFlags;
typedef CELL PropFlags;
/* basic property entry structure */
typedef struct PropEntryStruct {

21
H/CMakeLists.txt Normal file
View File

@ -0,0 +1,21 @@
file( STRINGS locals.h tmp )
if (WITH_THREADS)
Foreach(i ${tmp})
string(REGEX REPLACE "^LOCAL[^(]*[(][^,]+,[^_a-zA-Z0-9]*([_a-zA-Z0-9]+)[^_a-zA-Z0-9,]*,[^_a-zA-Z0-9]*([_a-zA-Z0-9]+)[^)]*.*$" "#define LOCAL_\\0 (Yap_regs.worker_local->\\1)\\n#define REMOTE_\\1(wid) (REMOTE(wid)->\\1)\\n" i2 ${i})
list( APPEND tmp2 ${i2} "\n")
endforeach()
else()
Foreach(i ${tmp})
string(REGEX REPLACE "^LOCAL[^(]*[(][ \t]*([^,]+)[ \t]*,[ \t]*([^),]+).*" "#define LOCAL_\\2 (Yap_local.\\2)\\n#define REMOTE_\\2(wid) (REMOTE(wid)->\\2)\\n" i2 ${i})
list( APPEND tmp2 ${i2} "\n")
endforeach()
endif()
file( WRITE ${CMAKE_TOP_BINARY_DIR}/dlocals.h ${tmp2})
add_custom_command( OUTPUT ${CMAKE_TOP_BINARY_DIR}/dlocals.h
COMMAND ${CMAKE_COMMAND} -E COPY ${CMAKE_TOP_BINARY_DIR}/deflocals.h ${CMAKE_TOP_BINARY_DIR}/dlocals.h
DEPENDS locals.h )

66
H/Foreign.h
View File

@ -1,23 +1,23 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-97 *
* *
**************************************************************************
* *
* File: Foreign.h *
* comments: header file for dynamic loading routines *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-97 *
* *
**************************************************************************
* *
* File: Foreign.h *
* comments: header file for dynamic loading routines *
*************************************************************************/
#define NO_DYN 1
#ifndef FOREIGN_H
#define FOREIGN_H
/**
/**
@:
@file Foreign.h
@ -25,27 +25,30 @@
load_foreign_files/3 has works for the following configurations:
- linux: should work both for a.out (untested by me) and ELF;
- WIN32: works (notice that symbols are not exported by default)
- OSX: works using Mach dynamic libs.
- osf: should work, but isn't working yet.
- sunos4: should work, using A.OUT format;
- svr4, eg solaris: should work, using ELF format;
- AIX: should work for 3.2 and 4.1 at least, using ECOFF;
YAP should be able to load on most BSD Unixes, but you will need to
say that here.
YAP also supports COFF loading (pretty much the same technique as
used for A.OUT loading) but that is untested so far.
used for A.OUT loading) but that is untested so far.
*/
#include "Yap.h"
#include "YapHeap.h"
#ifdef _AIX
#undef NO_DYN
#endif /* __AIX */
@ -96,8 +99,8 @@
#endif
#endif /* LOAD_DYLD */
#define LOAD_SUCCEEDED 0
#define LOAD_FAILLED -1
#define LOAD_SUCCEEDED 0
#define LOAD_FAILLED -1
typedef struct StringListItem {
Atom name;
@ -115,16 +118,21 @@ typedef struct ForeignLoadItem {
typedef void (*YapInitProc)(void);
void *Yap_LoadForeignFile(char *, int);
int Yap_CallForeignFile(void *, char *);
int Yap_CloseForeignFile(void *);
Int Yap_LoadForeign(StringList, StringList, char *, YapInitProc *);
Int Yap_ReLoadForeign(StringList, StringList, char *, YapInitProc *);
void Yap_ReOpenLoadForeign(void);
void Yap_ShutdownLoadForeign(void);
void *Yap_LoadForeignFile(char *, int);
int Yap_CallForeignFile(void *, char *);
int Yap_CloseForeignFile(void *);
Int Yap_LoadForeign(StringList, StringList, char *, YapInitProc *);
Int Yap_ReLoadForeign(StringList, StringList, char *, YapInitProc *);
void Yap_ReOpenLoadForeign(void);
void Yap_ShutdownLoadForeign(void);
#define EAGER_LOADING 1
#define EAGER_LOADING 1
#define GLOBAL_LOADING 2
/**
* stub can always be called at DLL loading.
*
*/
X_API bool load_none(void);
#endif

4
H/GLOBALS
View File

@ -116,7 +116,7 @@ char Executable[YAP_FILENAME_MAX] void
#endif
int OpaqueHandlersCount =0
struct opaque_handler_struct* OpaqueHandlers =NULL
struct YAP_opaque_handler_struct* OpaqueHandlers =NULL
#if __simplescalar__
char pwd[YAP_FILENAME_MAX] void
@ -169,4 +169,6 @@ int SzOfFileAliases void
struct vfs* VFS =Yap_InitAssetManager()
char* cwd =NULL
END_GLOBAL_DATA

13
H/HEAPFIELDS
View File

@ -90,7 +90,6 @@ ATOMS
#ifdef EUROTRA
Term TermDollarU MkAT AtomDollarU
#endif
Term TermAnswer MkAT AtomAnswer
//modules
Term USER_MODULE MkAT AtomUser
@ -122,7 +121,7 @@ Prop HIDDEN_PREDICATES =NULL RestoreHiddenPredicates()
// make sure we have the streams set at this point.
// don't actually want to define a field
void void Yap_InitPlIO() void
void void Yap_InitPlIO(yapi) void
union flagTerm* GLOBAL_Flags =0 void
UInt GLOBAL_flagCount Yap_InitFlags(true) RestoreFlags(GLOBAL_flagCount)
@ -141,7 +140,7 @@ rwlock_t PredHashRWLock void
/* Well-Known Predicates */
struct pred_entry *CreepCode MkPred AtomCreep 1 PROLOG_MODULE
struct pred_entry *UndefCode MkPred AtomUndefp0 2 PROLOG_MODULE
struct pred_entry *UndefCode MkPred AtomUndefp 2 PROLOG_MODULE
struct pred_entry *SpyCode MkPred AtomSpy 1 PROLOG_MODULE
struct pred_entry *PredFail MkPred AtomFail 0 PROLOG_MODULE
struct pred_entry *PredTrue MkPred AtomTrue 0 PROLOG_MODULE
@ -158,6 +157,7 @@ struct pred_entry *PredIs MkPred FunctorIs PROLOG_MODULE
struct pred_entry *PredLogUpdClause MkPred FunctorDoLogUpdClause PROLOG_MODULE
struct pred_entry *PredLogUpdClauseErase MkPred FunctorDoLogUpdClauseErase PROLOG_MODULE
struct pred_entry *PredLogUpdClause0 MkPred FunctorDoLogUpdClause PROLOG_MODULE
struct pred_entry *PredCall MkPred FunctorCall PROLOG_MODULE
struct pred_entry *PredMetaCall MkPred FunctorMetaCall PROLOG_MODULE
struct pred_entry *PredProtectStack MkPred FunctorProtectStack PROLOG_MODULE
struct pred_entry *PredRecordedWithKey MkPred FunctorRecordedWithKey PROLOG_MODULE
@ -168,6 +168,8 @@ struct pred_entry *PredThrow MkPred FunctorThrow PROLOG_MODULE
struct pred_entry *PredTraceMetaCall MkPred FunctorTraceMetaCall PROLOG_MODULE
struct pred_entry *PredCommentHook MkPred FunctorCommentHook PROLOG_MODULE
struct pred_entry *PredProcedure MkLogPred FunctorProcedure PROLOG_MODULE
struct pred_entry *PredUndefinedQuery MkPred FunctorUndefinedQuery PROLOG_MODULE
/* low-level tracer */
#ifdef LOW_LEVEL_TRACER
@ -306,6 +308,9 @@ int NUM_OF_ATTS =1 void
UInt Yap_AttsSize void void
#endif
/** opaque terms used to wake up on cut of call catcher meta-goal */
UInt setup_call_catcher_cleanup_tag void void
/* Operators */
struct operator_entry *OpList =NULL OpListAdjust
@ -322,7 +327,7 @@ Atom EmptyWakeups[MAX_EMPTY_WAKEUPS] InitEmptyWakeups() RestoreEmptyWakeups()
int MaxEmptyWakeups =0
/* SWI blobs */
struct YAP_blob_t *BlobTypes =NULL RestoreBlobTypes()
struct _PL_blob_t *BlobTypes =NULL RestoreBlobTypes()
struct AtomEntryStruct *Blobs =NULL RestoreBlobs()
UInt NOfBlobs =0
UInt NOfBlobsMax =256

323
H/LOCALS
View File

@ -1,323 +0,0 @@
// Stuff that must be considered local to a thread or worker
START_WORKER_LOCAL
// Streams
int c_input_stream =0
int c_output_stream =1
int c_error_stream =2
bool sockets_io =false
bool within_print_message =false
//
// Used by the prompts to check if they are after a newline, and then a
// prompt should be output, or if we are in the middle of a line.
//
bool newline =true
Atom AtPrompt =AtomNil
char Prompt[MAX_PROMPT+1] void
encoding_t encoding =Yap_DefaultEncoding()
bool quasi_quotations =false
UInt default_priority =1200
bool eot_before_eof =false
UInt max_depth =0
UInt max_list =0
UInt max_write_args =0
// Restore info
CELL* OldASP =NULL
CELL* OldLCL0 =NULL
tr_fr_ptr OldTR =NULL
CELL* OldGlobalBase =NULL
CELL* OldH =NULL
CELL* OldH0 =NULL
ADDR OldTrailBase =NULL
ADDR OldTrailTop =NULL
ADDR OldHeapBase =NULL
ADDR OldHeapTop =NULL
Int ClDiff =0L
Int GDiff =0L
Int HDiff =0L
Int GDiff0 =0L
CELL* GSplit =NULL
Int LDiff =0L
Int TrDiff =0L
Int XDiff =0L
Int DelayDiff =0L
Int BaseDiff =0L
// Reduction counters
YAP_ULONG_LONG ReductionsCounter =0L
YAP_ULONG_LONG PredEntriesCounter =0L
YAP_ULONG_LONG RetriesCounter =0L
int ReductionsCounterOn =0L
int PredEntriesCounterOn =0L
int RetriesCounterOn =0L
// support for consulting files
/* current consult stack */
union CONSULT_OBJ* ConsultSp =NULL
/* current maximum number of cells in consult stack */
UInt ConsultCapacity void
/* top of consult stack */
union CONSULT_OBJ* ConsultBase =NULL
/* low-water mark for consult */
union CONSULT_OBJ* ConsultLow =NULL
Term VarNames =((Term)0)
Atom SourceFileName =NULL
UInt SourceFileLineno =0
//global variables
Term GlobalArena =0L TermToGlobalOrAtomAdjust
UInt GlobalArenaOverflows =0L
Int ArenaOverflows =0L
Int DepthArenas =0
struct pred_entry* LastAssertedPred =NULL
struct pred_entry* TmpPred =NULL
char* ScannerStack =NULL
struct scanner_extra_alloc* ScannerExtraBlocks =NULL
/// worker control information
/// stack limit after which the stack is managed by C-code.
Int CBorder =0
/// max number of signals (uint64_t)
UInt MaxActiveSignals =64L
/// actual life signals
uint64_t Signals =0L
/// indexing help data?
UInt IPredArity =0L
yamop* ProfEnd =NULL
int DoingUndefp =FALSE
Int StartCharCount =0L
Int StartLineCount =0L
Int StartLinePos =0L
scratch_block ScratchPad InitScratchPad(wid)
#ifdef COROUTINING
Term WokenGoals =0L TermToGlobalAdjust
Term AttsMutableList =0L TermToGlobalAdjust
#endif
// gc_stuff
Term GcGeneration =0L TermToGlobalAdjust
Term GcPhase =0L TermToGlobalAdjust
UInt GcCurrentPhase =0L
UInt GcCalls =0L
Int TotGcTime =0L
YAP_ULONG_LONG TotGcRecovered =0L
Int LastGcTime =0L
Int LastSSTime =0L
CELL* OpenArray =NULL
/* in a single gc */
Int total_marked =0L
Int total_oldies =0L
struct choicept* current_B =NULL
CELL* prev_HB =NULL
CELL* HGEN =NULL
CELL** iptop =NULL
#if defined(GC_NO_TAGS)
char* bp =NULL
#endif
tr_fr_ptr sTR =NULL
tr_fr_ptr sTR0 =NULL
tr_fr_ptr new_TR =NULL
struct gc_mark_continuation* cont_top0 =NULL
struct gc_mark_continuation* cont_top =NULL
int discard_trail_entries =0
gc_ma_hash_entry gc_ma_hash_table[GC_MAVARS_HASH_SIZE] void
gc_ma_hash_entry* gc_ma_h_top =NULL
gc_ma_hash_entry* gc_ma_h_list =NULL
UInt gc_timestamp =0L
ADDR db_vec =NULL
ADDR db_vec0 =NULL
struct RB_red_blk_node* db_root =NULL
struct RB_red_blk_node* db_nil =NULL
sigjmp_buf* gc_restore void
CELL* extra_gc_cells void
CELL* extra_gc_cells_base void
CELL* extra_gc_cells_top void
UInt extra_gc_cells_size =256
struct array_entry* DynamicArrays =NULL PtoArrayEAdjust
struct static_array_entry* StaticArrays =NULL PtoArraySAdjust
struct global_entry* GlobalVariables =NULL PtoGlobalEAdjust
int AllowRestart =FALSE
// Thread Local Area for Fast Storage of Intermediate Compiled Code
struct mem_blk* CMemFirstBlock =NULL
UInt CMemFirstBlockSz =0L
// Variable used by the compiler to store number of permanent vars in a clause
int nperm =0
int jMP =0
// Thread Local Area for Labels
Int* LabelFirstArray =NULL
UInt LabelFirstArraySz =0L
// Thread Local Area for SWI-Prolog emulation routines.
// struct PL_local_data* PL_local_data_p =Yap_InitThreadIO(wid)
#ifdef THREADS
struct thandle ThreadHandle InitThreadHandle(wid)
#endif /* THREADS */
#if defined(YAPOR) || defined(TABLING)
struct local_optyap_data optyap_data Yap_init_local_optyap_data(wid)
UInt TabMode =0L
#endif /* YAPOR || TABLING */
int InterruptsDisabled =FALSE
struct open_query_struct* execution =NULL
#if LOW_LEVEL_TRACER
Int total_choicepoints =0
#endif
int consult_level =0
// Variables related to memory allocation
ADDR LocalBase void
ADDR GlobalBase void
ADDR TrailBase void
ADDR TrailTop void
/* error handling info, designed to be easy to pass to the foreign world */
yap_error_descriptor_t* ActiveError =calloc(sizeof(yap_error_descriptor_t),1)
/// pointer to an exception term, from throw
jmp_buf* IOBotch void
TokEntry* tokptr void
TokEntry* toktide void
VarEntry* VarTable void
VarEntry* AnonVarTable void
Term Comments void
CELL* CommentsTail void
CELL* CommentsNextChar void
wchar_t* CommentsBuff void
size_t CommentsBuffPos void
size_t CommentsBuffLim void
sigjmp_buf* RestartEnv void
char FileNameBuf[YAP_FILENAME_MAX+1] void
char FileNameBuf2[YAP_FILENAME_MAX+1] void
struct TextBuffer_manager* TextBuffer =Yap_InitTextAllocator()
// Prolog State
UInt BreakLevel =0
Int PrologMode =BootMode
int CritLocks =0
// Prolog execution and state flags
union flagTerm* Flags void
UInt flagCount void
//analyst.c
/* used to find out how many instructions of each kind are executed */
#ifdef ANALYST
YAP_ULONG_LONG opcount[_std_top+1] void
YAP_ULONG_LONG 2opcount[_std_top+1][_std_top+1] void
#endif /* ANALYST */
//dbase.c
struct db_globs* s_dbg void
//eval.c
Term mathtt void
char* mathstring =NULL
//grow.c
int heap_overflows =0
Int total_heap_overflow_time =0
int stack_overflows =0
Int total_stack_overflow_time =0
int delay_overflows =0
Int total_delay_overflow_time =0
int trail_overflows =0
Int total_trail_overflow_time =0
int atom_table_overflows =0
Int total_atom_table_overflow_time =0
//load_dyld
#ifdef LOAD_DYLD
int dl_errno =0
#endif
//tracer.c
#ifdef LOW_LEVEL_TRACER
int do_trace_primitives =TRUE
#endif
//quick loader
struct export_atom_hash_entry_struct *ExportAtomHashChain =NULL
UInt ExportAtomHashTableSize =0
UInt ExportAtomHashTableNum =0
struct export_functor_hash_entry_struct *ExportFunctorHashChain =NULL
UInt ExportFunctorHashTableSize =0
UInt ExportFunctorHashTableNum =0
struct export_pred_entry_hash_entry_struct *ExportPredEntryHashChain =NULL
UInt ExportPredEntryHashTableSize =0
UInt ExportPredEntryHashTableNum =0
struct export_dbref_hash_entry_struct *ExportDBRefHashChain =NULL
UInt ExportDBRefHashTableSize =0
UInt ExportDBRefHashTableNum =0
struct import_atom_hash_entry_struct **ImportAtomHashChain =NULL
UInt ImportAtomHashTableSize =0
UInt ImportAtomHashTableNum =0
struct import_functor_hash_entry_struct **ImportFunctorHashChain =NULL
UInt ImportFunctorHashTableSize =0
UInt ImportFunctorHashTableNum =0
struct import_opcode_hash_entry_struct **ImportOPCODEHashChain =NULL
UInt ImportOPCODEHashTableSize =0
struct import_pred_entry_hash_entry_struct **ImportPredEntryHashChain =NULL
UInt ImportPredEntryHashTableSize =0
UInt ImportPredEntryHashTableNum =0
struct import_dbref_hash_entry_struct **ImportDBRefHashChain =NULL
UInt ImportDBRefHashTableSize =0
UInt ImportDBRefHashTableNum =0
yamop *ImportFAILCODE =NULL
// exo indexing
UInt ibnds[256] void
struct index_t* exo_it =NULL
CELL* exo_base =NULL
UInt exo_arity =0
UInt exo_arg =0
// atom completion
struct scan_atoms* search_atoms void
struct pred_entry* SearchPreds void
/// Slots Status
yhandle_t CurSlot =0
yhandle_t FrozenHandles =0
yhandle_t NSlots =0
CELL* SlotBase =InitHandles(wid)
// Mutexes
struct swi_mutex* Mutexes =NULL
Term SourceModule =0
Term Including =TermNil
size_t MAX_SIZE =1024L
/* last call to walltime. */
uint64_t LastWTime =0
void* shared =NULL
END_WORKER_LOCAL

105
H/Regs.h
View File

@ -24,32 +24,31 @@
#define MaxTemps 512
#define MaxArithms 32
#ifdef i386
#define PUSH_REGS 1
#undef PUSH_X
#endif
#if defined(__x86_64__)
#ifdef sparc
#define PUSH_REGS 1
#undef PUSH_X
#endif
#ifdef __x86_64__
#define PUSH_REGS 1
#undef PUSH_X
#endif
#ifdef __alpha
#elif defined(i386)
#undef PUSH_REGS
#undef PUSH_X
#elif defined(sparc)
#define PUSH_REGS 1
#undef PUSH_X
#elif defined(__alpha)
#undef PUSH_REGS
#undef PUSH_X
#endif
#if defined(_POWER) || defined(__POWERPC__)
#elif defined(_POWER) || defined(__POWERPC__)
#undef PUSH_REGS
#undef PUSH_X
#endif
#ifdef hppa
#elif defined( hppa )
#undef PUSH_REGS
#undef PUSH_X
#endif
@ -72,12 +71,12 @@
#include "inline-only.h"
INLINE_ONLY inline EXTERN void restore_machine_regs(void);
INLINE_ONLY inline EXTERN void save_machine_regs(void);
INLINE_ONLY inline EXTERN void restore_H(void);
INLINE_ONLY inline EXTERN void save_H(void);
INLINE_ONLY inline EXTERN void restore_B(void);
INLINE_ONLY inline EXTERN void save_B(void);
INLINE_ONLY void restore_machine_regs(void);
INLINE_ONLY void save_machine_regs(void);
INLINE_ONLY void restore_H(void);
INLINE_ONLY void save_H(void);
INLINE_ONLY void restore_B(void);
INLINE_ONLY void save_B(void);
#define CACHE_REGS
#define REFRESH_CACHE_REGS
@ -160,7 +159,7 @@ extern REGSTORE *Yap_regp;
#ifdef PUSH_X
#define XREGS (Yap_REGS.XTERMS)
#define XREGS (Yapregp->XTERMS)
#else
@ -243,7 +242,7 @@ register CELL CreepFlag asm ("$15");
/* Interface with foreign code, make sure the foreign code sees all the
registers the way they used to be */
INLINE_ONLY EXTERN inline void save_machine_regs(void) {
INLINE_ONLY void save_machine_regs(void) {
Yap_REGS.H_ = HR;
Yap_REGS.HB_ = HB;
Yap_REGS.B_ = B;
@ -254,7 +253,7 @@ INLINE_ONLY EXTERN inline void save_machine_regs(void) {
Yap_REGS.TR_ = TR;
}
INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
INLINE_ONLY void restore_machine_regs(void) {
HR = Yap_REGS.H_;
HB = Yap_REGS.HB_;
B = Yap_REGS.B_;
@ -283,11 +282,11 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
CP = BK_CP; \
TR = BK_TR
INLINE_ONLY EXTERN inline void save_H(void) {
INLINE_ONLY void save_H(void) {
Yap_REGS.H_ = HR;
}
INLINE_ONLY EXTERN inline void restore_H(void) {
INLINE_ONLY void restore_H(void) {
HR = Yap_REGS.H_;
}
@ -295,11 +294,11 @@ INLINE_ONLY EXTERN inline void restore_H(void) {
#define RECOVER_H() save_H(); HR = BK_H
INLINE_ONLY EXTERN inline void save_B(void) {
INLINE_ONLY void save_B(void) {
Yap_REGS.B_ = B;
}
INLINE_ONLY EXTERN inline void restore_B(void) {
INLINE_ONLY void restore_B(void) {
B = Yap_REGS.B_;
}
@ -310,11 +309,11 @@ INLINE_ONLY EXTERN inline void restore_B(void) {
INLINE_ONLY EXTERN void restore_TR(void);
INLINE_ONLY EXTERN void save_TR(void);
INLINE_ONLY EXTERN inline void save_TR(void) {
INLINE_ONLY void save_TR(void) {
Yap_REGS.TR_ = TR;
}
INLINE_ONLY EXTERN inline void restore_TR(void) {
INLINE_ONLY void restore_TR(void) {
TR = Yap_REGS.TR_;
}
@ -330,7 +329,7 @@ register CELL *S asm ("r16");
register CELL CreepFlag asm ("r17");
register tr_fr_ptr TR asm ("r18");
INLINE_ONLY EXTERN inline void save_machine_regs(void) {
INLINE_ONLY void save_machine_regs(void) {
Yap_REGS.H_ = HR;
Yap_REGS.HB_ = HB;
Yap_REGS.B_ = B;
@ -339,7 +338,7 @@ INLINE_ONLY EXTERN inline void save_machine_regs(void) {
Yap_REGS.TR_ = TR;
}
INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
INLINE_ONLY void restore_machine_regs(void) {
HR = Yap_REGS.H_;
HB = Yap_REGS.HB_;
B = Yap_REGS.B_;
@ -366,11 +365,11 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
CP = BK_CP; \
TR = BK_TR
INLINE_ONLY EXTERN inline void save_H(void) {
INLINE_ONLY void save_H(void) {
Yap_REGS.H_ = HR;
}
INLINE_ONLY EXTERN inline void restore_H(void) {
INLINE_ONLY void restore_H(void) {
HR = Yap_REGS.H_;
}
@ -378,11 +377,11 @@ INLINE_ONLY EXTERN inline void restore_H(void) {
#define RECOVER_H() save_H(); HR = BK_H
INLINE_ONLY EXTERN inline void save_B(void) {
INLINE_ONLY void save_B(void) {
Yap_REGS.B_ = B;
}
INLINE_ONLY EXTERN inline void restore_B(void) {
INLINE_ONLY void restore_B(void) {
B = Yap_REGS.B_;
}
@ -393,11 +392,11 @@ INLINE_ONLY EXTERN inline void restore_B(void) {
INLINE_ONLY EXTERN void restore_TR(void);
INLINE_ONLY EXTERN void save_TR(void);
INLINE_ONLY EXTERN inline void save_TR(void) {
INLINE_ONLY void save_TR(void) {
Yap_REGS.TR_ = TR;
}
INLINE_ONLY EXTERN inline void restore_TR(void) {
INLINE_ONLY void restore_TR(void) {
TR = Yap_REGS.TR_;
}
@ -442,7 +441,7 @@ register CELL *YENV asm ("r19");
INLINE_ONLY EXTERN inline void save_machine_regs(void) {
INLINE_ONLY void save_machine_regs(void) {
Yap_REGS.H_ = HR;
Yap_REGS.HB_ = HB;
Yap_REGS.B_ = B;
@ -451,7 +450,7 @@ INLINE_ONLY EXTERN inline void save_machine_regs(void) {
Yap_REGS.TR_ = TR;
}
INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
INLINE_ONLY void restore_machine_regs(void) {
HR = Yap_REGS.H_;
HB = Yap_REGS.HB_;
B = Yap_REGS.B_;
@ -476,11 +475,11 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
CP = BK_CP; \
TR = BK_TR
INLINE_ONLY EXTERN inline void save_H(void) {
INLINE_ONLY void save_H(void) {
Yap_REGS.H_ = HR;
}
INLINE_ONLY EXTERN inline void restore_H(void) {
INLINE_ONLY void restore_H(void) {
HR = Yap_REGS.H_;
}
@ -488,11 +487,11 @@ INLINE_ONLY EXTERN inline void restore_H(void) {
#define RECOVER_H() save_H(); HR = BK_H
INLINE_ONLY EXTERN inline void save_B(void) {
INLINE_ONLY void save_B(void) {
Yap_REGS.B_ = B;
}
INLINE_ONLY EXTERN inline void restore_B(void) {
INLINE_ONLY void restore_B(void) {
B = Yap_REGS.B_;
}
@ -503,11 +502,11 @@ INLINE_ONLY EXTERN inline void restore_B(void) {
INLINE_ONLY EXTERN void restore_TR(void);
INLINE_ONLY EXTERN void save_TR(void);
INLINE_ONLY EXTERN inline void save_TR(void) {
INLINE_ONLY void save_TR(void) {
Yap_REGS.TR_ = TR;
}
INLINE_ONLY EXTERN inline void restore_TR(void) {
INLINE_ONLY void restore_TR(void) {
TR = Yap_REGS.TR_;
}
@ -524,30 +523,30 @@ INLINE_ONLY EXTERN inline void restore_TR(void) {
#define HB Yap_REGS.HB_ /* heap (global) stack top at time of latest c.p. */
#define CreepFlag Yap_REGS.CreepFlag_
INLINE_ONLY EXTERN inline void save_machine_regs(void) {
INLINE_ONLY void save_machine_regs(void) {
}
INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
INLINE_ONLY void restore_machine_regs(void) {
}
#define BACKUP_MACHINE_REGS()
#define RECOVER_MACHINE_REGS()
INLINE_ONLY EXTERN inline void save_H(void) {
INLINE_ONLY void save_H(void) {
}
INLINE_ONLY EXTERN inline void restore_H(void) {
INLINE_ONLY void restore_H(void) {
}
#define BACKUP_H()
#define RECOVER_H()
INLINE_ONLY EXTERN inline void save_B(void) {
INLINE_ONLY void save_B(void) {
}
INLINE_ONLY EXTERN inline void restore_B(void) {
INLINE_ONLY void restore_B(void) {
}
#define BACKUP_B()

2
H/ScannerTypes.h
View File

@ -13,7 +13,7 @@ typedef enum TokenKinds {
typedef struct TOKEN {
enum TokenKinds Tok;
Term TokInfo;
int TokPos;
intptr_t TokPos, TokLine;
struct TOKEN *TokNext;
} TokEntry;

48
H/Tags_32LowTag.h
View File

@ -79,9 +79,9 @@
#define YAP_PROTECTED_MASK 0xc0000000L
#include "inline-only.h"
INLINE_ONLY inline EXTERN int IsVarTerm (Term);
INLINE_ONLY int IsVarTerm (Term);
INLINE_ONLY inline EXTERN int
INLINE_ONLY int
IsVarTerm (Term t)
{
return (int) (!((t) & LowTagBits));
@ -89,9 +89,9 @@ IsVarTerm (Term t)
INLINE_ONLY inline EXTERN int IsNonVarTerm (Term);
INLINE_ONLY int IsNonVarTerm (Term);
INLINE_ONLY inline EXTERN int
INLINE_ONLY int
IsNonVarTerm (Term t)
{
return (int) (((t) & LowTagBits));
@ -99,9 +99,9 @@ IsNonVarTerm (Term t)
INLINE_ONLY inline EXTERN Term *RepPair (Term);
INLINE_ONLY Term *RepPair (Term);
INLINE_ONLY inline EXTERN Term *
INLINE_ONLY Term *
RepPair (Term t)
{
return (Term *) ((t) - PairBits);
@ -109,9 +109,9 @@ RepPair (Term t)
INLINE_ONLY inline EXTERN Term AbsPair (Term *);
INLINE_ONLY Term AbsPair (Term *);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AbsPair (Term * p)
{
return (Term) (Unsigned (p) + PairBits);
@ -119,9 +119,9 @@ AbsPair (Term * p)
INLINE_ONLY inline EXTERN Int IsPairTerm (Term);
INLINE_ONLY Int IsPairTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IsPairTerm (Term t)
{
return (Int) ((((t) & LowTagBits) == PairBits));
@ -129,9 +129,9 @@ IsPairTerm (Term t)
INLINE_ONLY inline EXTERN Term *RepAppl (Term);
INLINE_ONLY Term *RepAppl (Term);
INLINE_ONLY inline EXTERN Term *
INLINE_ONLY Term *
RepAppl (Term t)
{
return (Term *) (((t) - ApplBit));
@ -139,9 +139,9 @@ RepAppl (Term t)
INLINE_ONLY inline EXTERN Term AbsAppl (Term *);
INLINE_ONLY Term AbsAppl (Term *);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AbsAppl (Term * p)
{
return (Term) (Unsigned (p) + ApplBit);
@ -149,9 +149,9 @@ AbsAppl (Term * p)
INLINE_ONLY inline EXTERN Int IsApplTerm (Term);
INLINE_ONLY Int IsApplTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IsApplTerm (Term t)
{
return (Int) ((((t) & LowTagBits) == ApplBit));
@ -159,9 +159,9 @@ IsApplTerm (Term t)
INLINE_ONLY inline EXTERN Int IsAtomOrIntTerm (Term);
INLINE_ONLY Int IsAtomOrIntTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IsAtomOrIntTerm (Term t)
{
return (Int) ((((t) & LowTagBits) == 2));
@ -170,9 +170,9 @@ IsAtomOrIntTerm (Term t)
INLINE_ONLY inline EXTERN Term AdjustPtr (Term t, Term off);
INLINE_ONLY Term AdjustPtr (Term t, Term off);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AdjustPtr (Term t, Term off)
{
return (Term) ((t) + off);
@ -180,9 +180,9 @@ AdjustPtr (Term t, Term off)
INLINE_ONLY inline EXTERN Term AdjustIDBPtr (Term t, Term off);
INLINE_ONLY Term AdjustIDBPtr (Term t, Term off);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AdjustIDBPtr (Term t, Term off)
{
return (Term) ((t) + off);
@ -191,9 +191,9 @@ AdjustIDBPtr (Term t, Term off)
INLINE_ONLY inline EXTERN Int IntOfTerm (Term);
INLINE_ONLY Int IntOfTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IntOfTerm (Term t)
{
return (Int) (((Int) (t << 1)) >> (SHIFT_LOW_TAG + SHIFT_HIGH_TAG + 1));

80
H/Tags_32Ops.h
View File

@ -104,9 +104,9 @@ are now 1 in compound terms and structures.
/* never forget to surround arguments to a macro by brackets */
#include "inline-only.h"
INLINE_ONLY inline EXTERN int IsVarTerm (Term);
INLINE_ONLY int IsVarTerm (Term);
INLINE_ONLY inline EXTERN int
INLINE_ONLY int
IsVarTerm (Term t)
{
return (int) (Signed (t) >= 0);
@ -114,9 +114,9 @@ IsVarTerm (Term t)
INLINE_ONLY inline EXTERN int IsNonVarTerm (Term);
INLINE_ONLY int IsNonVarTerm (Term);
INLINE_ONLY inline EXTERN int
INLINE_ONLY int
IsNonVarTerm (Term t)
{
return (int) (Signed (t) < 0);
@ -125,9 +125,9 @@ IsNonVarTerm (Term t)
#if UNIQUE_TAG_FOR_PAIRS
INLINE_ONLY inline EXTERN Term *RepPair (Term);
INLINE_ONLY Term *RepPair (Term);
INLINE_ONLY inline EXTERN Term *
INLINE_ONLY Term *
RepPair (Term t)
{
return (Term *) ((~(t)));
@ -135,9 +135,9 @@ RepPair (Term t)
INLINE_ONLY inline EXTERN Term AbsPair (Term *);
INLINE_ONLY Term AbsPair (Term *);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AbsPair (Term * p)
{
return (Term) ((~Unsigned (p)));
@ -145,9 +145,9 @@ AbsPair (Term * p)
INLINE_ONLY inline EXTERN Int IsPairTerm (Term);
INLINE_ONLY Int IsPairTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IsPairTerm (Term t)
{
return (Int) (((t) & PairBit));
@ -155,9 +155,9 @@ IsPairTerm (Term t)
INLINE_ONLY inline EXTERN Term *RepAppl (Term);
INLINE_ONLY Term *RepAppl (Term);
INLINE_ONLY inline EXTERN Term *
INLINE_ONLY Term *
RepAppl (Term t)
{
return (Term *) ((-Signed (t)));
@ -165,9 +165,9 @@ RepAppl (Term t)
INLINE_ONLY inline EXTERN Term AbsAppl (Term *);
INLINE_ONLY Term AbsAppl (Term *);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AbsAppl (Term * p)
{
return (Term) ((-Signed (p)));
@ -175,9 +175,9 @@ AbsAppl (Term * p)
INLINE_ONLY inline EXTERN Int IsApplTerm (Term);
INLINE_ONLY Int IsApplTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IsApplTerm (Term t)
{
return (Int) ((!((t) & LowTagBits)));
@ -186,9 +186,9 @@ IsApplTerm (Term t)
#else
INLINE_ONLY inline EXTERN Term *RepPair (Term);
INLINE_ONLY Term *RepPair (Term);
INLINE_ONLY inline EXTERN Term *
INLINE_ONLY Term *
RepPair (Term t)
{
return (Term *) ((-Signed (t)));
@ -196,9 +196,9 @@ RepPair (Term t)
INLINE_ONLY inline EXTERN Term AbsPair (Term *);
INLINE_ONLY Term AbsPair (Term *);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AbsPair (Term * p)
{
return (Term) (((CELL) (-Signed (p))));
@ -206,9 +206,9 @@ AbsPair (Term * p)
INLINE_ONLY inline EXTERN Int IsPairTerm (Term);
INLINE_ONLY Int IsPairTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IsPairTerm (Term t)
{
return (Int) ((!((t) & LowTagBits)));
@ -216,9 +216,9 @@ IsPairTerm (Term t)
INLINE_ONLY inline EXTERN Term *RepAppl (Term);
INLINE_ONLY Term *RepAppl (Term);
INLINE_ONLY inline EXTERN Term *
INLINE_ONLY Term *
RepAppl (Term t)
{
return (Term *) ((~(t)));
@ -226,9 +226,9 @@ RepAppl (Term t)
INLINE_ONLY inline EXTERN Term AbsAppl (Term *);
INLINE_ONLY Term AbsAppl (Term *);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AbsAppl (Term * p)
{
return (Term) ((~Unsigned (p)));
@ -236,9 +236,9 @@ AbsAppl (Term * p)
INLINE_ONLY inline EXTERN Int IsApplTerm (Term);
INLINE_ONLY Int IsApplTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IsApplTerm (Term t)
{
return (Int) (((t) & ApplBit));
@ -247,9 +247,9 @@ IsApplTerm (Term t)
#endif
INLINE_ONLY inline EXTERN Int IsAtomOrIntTerm (Term);
INLINE_ONLY Int IsAtomOrIntTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IsAtomOrIntTerm (Term t)
{
return (Int) (((Unsigned (t) & LowTagBits) == 0x2));
@ -258,9 +258,9 @@ IsAtomOrIntTerm (Term t)
INLINE_ONLY inline EXTERN Int IntOfTerm (Term);
INLINE_ONLY Int IntOfTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IntOfTerm (Term t)
{
return (Int) ((Int) (Unsigned (t) << 3) >> 5);
@ -270,9 +270,9 @@ IntOfTerm (Term t)
#if UNIQUE_TAG_FOR_PAIRS
INLINE_ONLY inline EXTERN Term AdjustPtr (Term t, Term off);
INLINE_ONLY Term AdjustPtr (Term t, Term off);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AdjustPtr (Term t, Term off)
{
return (Term) (((IsVarTerm (t)
@ -284,9 +284,9 @@ AdjustPtr (Term t, Term off)
INLINE_ONLY inline EXTERN Term AdjustIDBPtr (Term t, Term off);
INLINE_ONLY Term AdjustIDBPtr (Term t, Term off);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AdjustIDBPtr (Term t, Term off)
{
return (Term) (IsVarTerm (t) ? (t) + (off) : (t) - (off));
@ -295,9 +295,9 @@ AdjustIDBPtr (Term t, Term off)
#else
INLINE_ONLY inline EXTERN Term AdjustPtr (Term t, Term off);
INLINE_ONLY Term AdjustPtr (Term t, Term off);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AdjustPtr (Term t, Term off)
{
return (Term) (((IsVarTerm (t)
@ -309,9 +309,9 @@ AdjustPtr (Term t, Term off)
INLINE_ONLY inline EXTERN Term AdjustIDBPtr (Term t, Term off);
INLINE_ONLY Term AdjustIDBPtr (Term t, Term off);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AdjustIDBPtr (Term t, Term off)
{
return (Term) (IsVarTerm (t) ? (t) +

48
H/Tags_32bits.h
View File

@ -71,9 +71,9 @@ property list
#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag)
#include "inline-only.h"
INLINE_ONLY inline EXTERN int IsVarTerm (Term);
INLINE_ONLY int IsVarTerm (Term);
INLINE_ONLY inline EXTERN int
INLINE_ONLY int
IsVarTerm (Term t)
{
return (int) (Signed (t) >= 0);
@ -81,9 +81,9 @@ IsVarTerm (Term t)
INLINE_ONLY inline EXTERN int IsNonVarTerm (Term);
INLINE_ONLY int IsNonVarTerm (Term);
INLINE_ONLY inline EXTERN int
INLINE_ONLY int
IsNonVarTerm (Term t)
{
return (int) (Signed (t) < 0);
@ -91,9 +91,9 @@ IsNonVarTerm (Term t)
INLINE_ONLY inline EXTERN Term *RepPair (Term);
INLINE_ONLY Term *RepPair (Term);
INLINE_ONLY inline EXTERN Term *
INLINE_ONLY Term *
RepPair (Term t)
{
return (Term *) (NonTagPart (t));
@ -101,9 +101,9 @@ RepPair (Term t)
INLINE_ONLY inline EXTERN Term AbsPair (Term *);
INLINE_ONLY Term AbsPair (Term *);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AbsPair (Term * p)
{
return (Term) (TAGGEDA (PairTag, (p)));
@ -111,9 +111,9 @@ AbsPair (Term * p)
INLINE_ONLY inline EXTERN Int IsPairTerm (Term);
INLINE_ONLY Int IsPairTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IsPairTerm (Term t)
{
return (Int) (BitOn (PairBit, (t)));
@ -121,9 +121,9 @@ IsPairTerm (Term t)
INLINE_ONLY inline EXTERN Term *RepAppl (Term);
INLINE_ONLY Term *RepAppl (Term);
INLINE_ONLY inline EXTERN Term *
INLINE_ONLY Term *
RepAppl (Term t)
{
return (Term *) (NonTagPart (t));
@ -131,9 +131,9 @@ RepAppl (Term t)
INLINE_ONLY inline EXTERN Term AbsAppl (Term *);
INLINE_ONLY Term AbsAppl (Term *);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AbsAppl (Term * p)
{
return (Term) (TAGGEDA (ApplTag, (p)));
@ -141,9 +141,9 @@ AbsAppl (Term * p)
INLINE_ONLY inline EXTERN Int IsApplTerm (Term);
INLINE_ONLY Int IsApplTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IsApplTerm (Term t)
{
return (Int) (BitOn (ApplBit, (t)));
@ -151,9 +151,9 @@ IsApplTerm (Term t)
INLINE_ONLY inline EXTERN int IsAtomOrIntTerm (Term);
INLINE_ONLY int IsAtomOrIntTerm (Term);
INLINE_ONLY inline EXTERN int
INLINE_ONLY int
IsAtomOrIntTerm (Term t)
{
return (int) (((Unsigned (t) & LowTagBits) == 0));
@ -162,9 +162,9 @@ IsAtomOrIntTerm (Term t)
INLINE_ONLY inline EXTERN Term AdjustPtr (Term t, Term off);
INLINE_ONLY Term AdjustPtr (Term t, Term off);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AdjustPtr (Term t, Term off)
{
return (Term) ((t) + off);
@ -172,9 +172,9 @@ AdjustPtr (Term t, Term off)
INLINE_ONLY inline EXTERN Term AdjustIDBPtr (Term t, Term off);
INLINE_ONLY Term AdjustIDBPtr (Term t, Term off);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AdjustIDBPtr (Term t, Term off)
{
return (Term) ((t) + off);
@ -183,9 +183,9 @@ AdjustIDBPtr (Term t, Term off)
INLINE_ONLY inline EXTERN Int IntOfTerm (Term);
INLINE_ONLY Int IntOfTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IntOfTerm (Term t)
{
return (Int) (((Int) (t << 3)) >> (3 + 2));

48
H/Tags_64bits.h
View File

@ -69,9 +69,9 @@ property list
#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag)
#include "inline-only.h"
INLINE_ONLY inline EXTERN int IsVarTerm (Term);
INLINE_ONLY int IsVarTerm (Term);
INLINE_ONLY inline EXTERN int
INLINE_ONLY int
IsVarTerm (Term t)
{
return (int) ((!((t) & 0x1)));
@ -79,9 +79,9 @@ IsVarTerm (Term t)
INLINE_ONLY inline EXTERN int IsNonVarTerm (Term);
INLINE_ONLY int IsNonVarTerm (Term);
INLINE_ONLY inline EXTERN int
INLINE_ONLY int
IsNonVarTerm (Term t)
{
return (int) (((t) & 0x1));
@ -89,9 +89,9 @@ IsNonVarTerm (Term t)
INLINE_ONLY inline EXTERN Term *RepPair (Term);
INLINE_ONLY Term *RepPair (Term);
INLINE_ONLY inline EXTERN Term *
INLINE_ONLY Term *
RepPair (Term t)
{
return (Term *) (((t) - PairBits));
@ -99,9 +99,9 @@ RepPair (Term t)
INLINE_ONLY inline EXTERN Term AbsPair (Term *);
INLINE_ONLY Term AbsPair (Term *);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AbsPair (Term * p)
{
return (Term) (((CELL) (p) + PairBits));
@ -109,9 +109,9 @@ AbsPair (Term * p)
INLINE_ONLY inline EXTERN Int IsPairTerm (Term);
INLINE_ONLY Int IsPairTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IsPairTerm (Term t)
{
return (Int) (((t) & 0x2));
@ -119,9 +119,9 @@ IsPairTerm (Term t)
INLINE_ONLY inline EXTERN Term *RepAppl (Term);
INLINE_ONLY Term *RepAppl (Term);
INLINE_ONLY inline EXTERN Term *
INLINE_ONLY Term *
RepAppl (Term t)
{
return (Term *) (((t) - ApplBits));
@ -129,9 +129,9 @@ RepAppl (Term t)
INLINE_ONLY inline EXTERN Term AbsAppl (Term *);
INLINE_ONLY Term AbsAppl (Term *);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AbsAppl (Term * p)
{
return (Term) (((CELL) (p) + ApplBits));
@ -139,9 +139,9 @@ AbsAppl (Term * p)
INLINE_ONLY inline EXTERN Int IsApplTerm (Term);
INLINE_ONLY Int IsApplTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IsApplTerm (Term t)
{
return (Int) ((((t) & 0x4)));
@ -149,9 +149,9 @@ IsApplTerm (Term t)
INLINE_ONLY inline EXTERN Int IsAtomOrIntTerm (Term);
INLINE_ONLY Int IsAtomOrIntTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IsAtomOrIntTerm (Term t)
{
return (Int) ((((t) & LowTagBits) == 0x1));
@ -160,9 +160,9 @@ IsAtomOrIntTerm (Term t)
INLINE_ONLY inline EXTERN Term AdjustPtr (Term t, Term off);
INLINE_ONLY Term AdjustPtr (Term t, Term off);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AdjustPtr (Term t, Term off)
{
return (Term) (((t) + off));
@ -170,9 +170,9 @@ AdjustPtr (Term t, Term off)
INLINE_ONLY inline EXTERN Term AdjustIDBPtr (Term t, Term off);
INLINE_ONLY Term AdjustIDBPtr (Term t, Term off);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
AdjustIDBPtr (Term t, Term off)
{
return (Term) ((t) + off);
@ -181,9 +181,9 @@ AdjustIDBPtr (Term t, Term off)
INLINE_ONLY inline EXTERN Int IntOfTerm (Term);
INLINE_ONLY Int IntOfTerm (Term);
INLINE_ONLY inline EXTERN Int
INLINE_ONLY Int
IntOfTerm (Term t)
{
return (Int) ((Int) (Unsigned (t) << 3) >> 6);

258
H/TermExt.h
View File

@ -71,9 +71,9 @@ typedef enum {
#define IsAttVar(pt) __IsAttVar((pt)PASS_REGS)
INLINE_ONLY inline EXTERN int __IsAttVar(CELL *pt USES_REGS);
INLINE_ONLY int __IsAttVar(CELL *pt USES_REGS);
INLINE_ONLY inline EXTERN int __IsAttVar(CELL *pt USES_REGS) {
INLINE_ONLY int __IsAttVar(CELL *pt USES_REGS) {
#ifdef YAP_H
return (pt)[-1] == (CELL)attvar_e && pt < HR;
#else
@ -81,9 +81,9 @@ INLINE_ONLY inline EXTERN int __IsAttVar(CELL *pt USES_REGS) {
#endif
}
INLINE_ONLY inline EXTERN int GlobalIsAttVar(CELL *pt);
INLINE_ONLY int GlobalIsAttVar(CELL *pt);
INLINE_ONLY inline EXTERN int GlobalIsAttVar(CELL *pt) {
INLINE_ONLY int GlobalIsAttVar(CELL *pt) {
return (pt)[-1] == (CELL)attvar_e;
}
@ -95,14 +95,15 @@ typedef enum {
ARRAY_INT = 0x21,
ARRAY_FLOAT = 0x22,
CLAUSE_LIST = 0x40,
EXTERNAL_BLOB = 0x100, /* generic data */
USER_BLOB_START = 0x1000, /* user defined blob */
USER_BLOB_END = 0x1100 /* end of user defined blob */
EXTERNAL_BLOB = 0x0A0, /* generic data */
GOAL_CUT_POINT = 0x0A1,
USER_BLOB_START = 0x0100, /* user defined blob */
USER_BLOB_END = 0x0200 /* end of user defined blob */
} big_blob_type;
INLINE_ONLY inline EXTERN blob_type BlobOfFunctor(Functor f);
INLINE_ONLY blob_type BlobOfFunctor(Functor f);
INLINE_ONLY inline EXTERN blob_type BlobOfFunctor(Functor f) {
INLINE_ONLY blob_type BlobOfFunctor(Functor f) {
return (blob_type)((CELL)f);
}
@ -160,28 +161,28 @@ typedef struct special_functors_struct {
} special_functors;
#endif /* YAP_H */
INLINE_ONLY inline EXTERN Float CpFloatUnaligned(CELL *ptr);
INLINE_ONLY Float CpFloatUnaligned(CELL *ptr);
#define MkFloatTerm(fl) __MkFloatTerm((fl)PASS_REGS)
INLINE_ONLY inline EXTERN Term __MkFloatTerm(Float USES_REGS);
INLINE_ONLY Term __MkFloatTerm(Float USES_REGS);
INLINE_ONLY inline EXTERN Float FloatOfTerm(Term t);
INLINE_ONLY Float FloatOfTerm(Term t);
#if SIZEOF_DOUBLE == SIZEOF_INT_P
INLINE_ONLY inline EXTERN Term __MkFloatTerm(Float dbl USES_REGS) {
INLINE_ONLY Term __MkFloatTerm(Float dbl USES_REGS) {
return (Term)((HR[0] = (CELL)FunctorDouble, *(Float *)(HR + 1) = dbl,
HR[2] = EndSpecials, HR += 3, AbsAppl(HR - 3)));
}
INLINE_ONLY inline EXTERN Float FloatOfTerm(Term t) {
INLINE_ONLY Float FloatOfTerm(Term t) {
return (Float)(*(Float *)(RepAppl(t) + 1));
}
#define InitUnalignedFloat()
INLINE_ONLY inline EXTERN Float CpFloatUnaligned(CELL *ptr) {
INLINE_ONLY Float CpFloatUnaligned(CELL *ptr) {
return *((Float *)ptr);
}
@ -191,9 +192,9 @@ INLINE_ONLY inline EXTERN Float CpFloatUnaligned(CELL *ptr) {
#define DOUBLE_ALIGNED(ADDR) ((CELL)(ADDR)&0x4)
INLINE_ONLY EXTERN inline void AlignGlobalForDouble(USES_REGS1);
INLINE_ONLY void AlignGlobalForDouble(USES_REGS1);
INLINE_ONLY EXTERN inline void AlignGlobalForDouble(USES_REGS1) {
INLINE_ONLY void AlignGlobalForDouble(USES_REGS1) {
/* Force Alignment for floats. Note that garbage collector may
break the alignment; */
if (!DOUBLE_ALIGNED(HR)) {
@ -203,13 +204,13 @@ INLINE_ONLY EXTERN inline void AlignGlobalForDouble(USES_REGS1) {
}
#ifdef i386
INLINE_ONLY inline EXTERN Float CpFloatUnaligned(CELL *ptr) {
INLINE_ONLY Float CpFloatUnaligned(CELL *ptr) {
return *((Float *)(ptr + 1));
}
#else
/* first, need to address the alignment problem */
INLINE_ONLY inline EXTERN Float CpFloatUnaligned(CELL *ptr) {
INLINE_ONLY Float CpFloatUnaligned(CELL *ptr) {
union {
Float f;
CELL d[2];
@ -221,13 +222,13 @@ INLINE_ONLY inline EXTERN Float CpFloatUnaligned(CELL *ptr) {
#endif
INLINE_ONLY inline EXTERN Term __MkFloatTerm(Float dbl USES_REGS) {
INLINE_ONLY Term __MkFloatTerm(Float dbl USES_REGS) {
return (Term)((AlignGlobalForDouble(PASS_REGS1), HR[0] = (CELL)FunctorDouble,
*(Float *)(HR + 1) = dbl, HR[3] = EndSpecials, HR += 4,
AbsAppl(HR - 4)));
}
INLINE_ONLY inline EXTERN Float FloatOfTerm(Term t) {
INLINE_ONLY Float FloatOfTerm(Term t) {
return (Float)((DOUBLE_ALIGNED(RepAppl(t)) ? *(Float *)(RepAppl(t) + 1)
: CpFloatUnaligned(RepAppl(t))));
}
@ -246,9 +247,9 @@ OOPS
#include <stddef.h>
#endif
INLINE_ONLY inline EXTERN bool IsFloatTerm(Term);
INLINE_ONLY bool IsFloatTerm(Term);
INLINE_ONLY inline EXTERN bool IsFloatTerm(Term t) {
INLINE_ONLY bool IsFloatTerm(Term t) {
return (int)(IsApplTerm(t) && FunctorOfTerm(t) == FunctorDouble);
}
@ -256,9 +257,9 @@ INLINE_ONLY inline EXTERN bool IsFloatTerm(Term t) {
#define MkLongIntTerm(i) __MkLongIntTerm((i)PASS_REGS)
INLINE_ONLY inline EXTERN Term __MkLongIntTerm(Int USES_REGS);
INLINE_ONLY Term __MkLongIntTerm(Int USES_REGS);
INLINE_ONLY inline EXTERN Term __MkLongIntTerm(Int i USES_REGS) {
INLINE_ONLY Term __MkLongIntTerm(Int i USES_REGS) {
HR[0] = (CELL)FunctorLongInt;
HR[1] = (CELL)(i);
HR[2] = EndSpecials;
@ -266,15 +267,15 @@ INLINE_ONLY inline EXTERN Term __MkLongIntTerm(Int i USES_REGS) {
return AbsAppl(HR - 3);
}
INLINE_ONLY inline EXTERN Int LongIntOfTerm(Term t);
INLINE_ONLY Int LongIntOfTerm(Term t);
INLINE_ONLY inline EXTERN Int LongIntOfTerm(Term t) {
INLINE_ONLY Int LongIntOfTerm(Term t) {
return (Int)(RepAppl(t)[1]);
}
INLINE_ONLY inline EXTERN bool IsLongIntTerm(Term);
INLINE_ONLY bool IsLongIntTerm(Term);
INLINE_ONLY inline EXTERN bool IsLongIntTerm(Term t) {
INLINE_ONLY bool IsLongIntTerm(Term t) {
return IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorLongInt;
}
@ -287,53 +288,96 @@ INLINE_ONLY inline EXTERN bool IsLongIntTerm(Term t) {
/* extern Functor FunctorString; */
#define MkStringTerm(i) __MkStringTerm((i)PASS_REGS)
INLINE_ONLY inline EXTERN Term __MkStringTerm(const char *s USES_REGS);
INLINE_ONLY Term __MkStringTerm(const char *s USES_REGS);
INLINE_ONLY inline EXTERN Term __MkStringTerm(const char *s USES_REGS) {
INLINE_ONLY Term __MkStringTerm(const char *s USES_REGS) {
Term t = AbsAppl(HR);
size_t sz = ALIGN_BY_TYPE(strlen((char *)s) + 1, CELL);
HR[0] = (CELL)FunctorString;
HR[1] = (CELL)sz;
strcpy((char *)(HR + 2), (const char *)s);
HR[2 + sz] = EndSpecials;
size_t sz;
if ((s[0] == '\0')) {
sz = sizeof(CELL);
HR[0] = (CELL)FunctorString;
HR[1] = (CELL)sz;
HR[2] = 0;
} else {
sz = ALIGN_BY_TYPE(strlen((char *)s) + 1, CELL);
HR[0] = (CELL)FunctorString;
HR[1] = (CELL)sz;
strcpy((char *)(HR + 2), (const char *)s);
}
HR[2 + sz] = EndSpecials;
HR += 3 + sz;
return t;
}
#define MkUStringTerm(i) __MkUStringTerm((i)PASS_REGS)
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
__MkUStringTerm(const unsigned char *s USES_REGS);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
__MkUStringTerm(const unsigned char *s USES_REGS) {
Term t = AbsAppl(HR);
size_t sz = ALIGN_BY_TYPE(strlen((char *)s) + 1, CELL);
HR[0] = (CELL)FunctorString;
HR[1] = (CELL)sz;
strcpy((char *)(HR + 2), (const char *)s);
size_t sz;
if ((s[0] == '\0')) {
sz = sizeof(CELL);
HR[0] = (CELL)FunctorString;
HR[1] = (CELL)sz;
HR[2] = 0;
} else {
sz = ALIGN_BY_TYPE(strlen((char *)s) + 1, CELL);
HR[0] = (CELL)FunctorString;
HR[1] = (CELL)sz;
strcpy((char *)(HR + 2), (const char *)s);
}
HR[2 + sz] = EndSpecials;
HR += 3 + sz;
return t;
}
#define MkCharPTerm(i) __MkCharPTerm((i)PASS_REGS)
INLINE_ONLY Term __MkCharPTerm(char *s USES_REGS);
INLINE_ONLY Term __MkCharPTerm(char *s USES_REGS) {
Term t = AbsAppl(HR);
size_t sz;
if (s[0] == '\0') {
sz = sizeof(CELL);
HR[0] = (CELL)FunctorString;
HR[1] = (CELL)sz;
HR[2] = 0;
} else {
sz = ALIGN_BY_TYPE(strlen((char *)s) + 1, CELL);
HR[0] = (CELL)FunctorString;
HR[1] = (CELL)sz;
strcpy((char *)(HR + 2), (const char *)s);
}
HR[2 + sz] = EndSpecials;
HR += 3 + sz;
return t;
}
INLINE_ONLY inline EXTERN const unsigned char *UStringOfTerm(Term t);
INLINE_ONLY inline EXTERN const unsigned char *UStringOfTerm(Term t) {
INLINE_ONLY const unsigned char *UStringOfTerm(Term t);
INLINE_ONLY const unsigned char *UStringOfTerm(Term t) {
return (const unsigned char *)(RepAppl(t) + 2);
}
INLINE_ONLY inline EXTERN const char *StringOfTerm(Term t);
INLINE_ONLY const char *StringOfTerm(Term t);
INLINE_ONLY inline EXTERN const char *StringOfTerm(Term t) {
INLINE_ONLY const char *StringOfTerm(Term t) {
return (const char *)(RepAppl(t) + 2);
}
INLINE_ONLY inline EXTERN bool IsStringTerm(Term);
INLINE_ONLY bool IsStringTerm(Term);
INLINE_ONLY inline EXTERN bool IsStringTerm(Term t) {
INLINE_ONLY bool IsStringTerm(Term t) {
return IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorString;
}
@ -344,34 +388,18 @@ INLINE_ONLY inline EXTERN bool IsStringTerm(Term t) {
#include <stdio.h>
#if !defined(__cplusplus)
#include <gmp.h>
#endif
INLINE_ONLY bool IsBigIntTerm(Term);
#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 inline EXTERN bool IsBigIntTerm(Term);
INLINE_ONLY inline EXTERN bool IsBigIntTerm(Term t) {
INLINE_ONLY bool IsBigIntTerm(Term t) {
return IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorBigInt;
}
#ifdef USE_GMP
#if !defined(__cplusplus)
#include <gmp.h>
#endif
Term Yap_MkBigIntTerm(MP_INT *);
MP_INT *Yap_BigIntOfTerm(Term);
@ -379,25 +407,25 @@ MP_INT *Yap_BigIntOfTerm(Term);
Term Yap_MkBigRatTerm(MP_RAT *);
MP_RAT *Yap_BigRatOfTerm(Term);
INLINE_ONLY inline EXTERN void MPZ_SET(mpz_t, MP_INT *);
INLINE_ONLY void MPZ_SET(mpz_t, MP_INT *);
INLINE_ONLY inline EXTERN void MPZ_SET(mpz_t dest, MP_INT *src) {
INLINE_ONLY void MPZ_SET(mpz_t dest, MP_INT *src) {
dest->_mp_size = src->_mp_size;
dest->_mp_alloc = src->_mp_alloc;
dest->_mp_d = src->_mp_d;
}
INLINE_ONLY inline EXTERN bool IsLargeIntTerm(Term);
INLINE_ONLY bool IsLargeIntTerm(Term);
INLINE_ONLY inline EXTERN bool IsLargeIntTerm(Term t) {
INLINE_ONLY bool IsLargeIntTerm(Term t) {
return IsApplTerm(t) &&
((FunctorOfTerm(t) <= FunctorBigInt) &&
(FunctorOfTerm(t) >= FunctorLongInt));
}
INLINE_ONLY inline EXTERN UInt Yap_SizeOfBigInt(Term);
INLINE_ONLY UInt Yap_SizeOfBigInt(Term);
INLINE_ONLY inline EXTERN UInt Yap_SizeOfBigInt(Term t) {
INLINE_ONLY UInt Yap_SizeOfBigInt(Term t) {
CELL *pt = RepAppl(t) + 1;
return 2 +
(sizeof(MP_INT) + (((MP_INT *)pt)->_mp_alloc * sizeof(mp_limb_t))) /
@ -406,9 +434,9 @@ INLINE_ONLY inline EXTERN UInt Yap_SizeOfBigInt(Term t) {
#else
INLINE_ONLY inline EXTERN int IsLargeIntTerm(Term);
INLINE_ONLY int IsLargeIntTerm(Term);
INLINE_ONLY inline EXTERN int IsLargeIntTerm(Term t) {
INLINE_ONLY int IsLargeIntTerm(Term t) {
return (int)(IsApplTerm(t) && FunctorOfTerm(t) == FunctorLongInt);
}
@ -416,59 +444,59 @@ INLINE_ONLY inline EXTERN int IsLargeIntTerm(Term t) {
/* extern Functor FunctorLongInt; */
INLINE_ONLY inline EXTERN bool IsLargeNumTerm(Term);
INLINE_ONLY bool IsLargeNumTerm(Term);
INLINE_ONLY inline EXTERN bool IsLargeNumTerm(Term t) {
INLINE_ONLY bool IsLargeNumTerm(Term t) {
return IsApplTerm(t) &&
((FunctorOfTerm(t) <= FunctorBigInt) &&
(FunctorOfTerm(t) >= FunctorDouble));
}
INLINE_ONLY inline EXTERN bool IsExternalBlobTerm(Term, CELL);
INLINE_ONLY bool IsExternalBlobTerm(Term, CELL);
INLINE_ONLY inline EXTERN bool IsExternalBlobTerm(Term t, CELL tag) {
INLINE_ONLY bool IsExternalBlobTerm(Term t, CELL tag) {
return IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorBigInt &&
RepAppl(t)[1] == tag;
}
INLINE_ONLY inline EXTERN void *ExternalBlobFromTerm(Term);
INLINE_ONLY void *ExternalBlobFromTerm(Term);
INLINE_ONLY inline EXTERN void *ExternalBlobFromTerm(Term t) {
INLINE_ONLY void *ExternalBlobFromTerm(Term t) {
MP_INT *base = (MP_INT *)(RepAppl(t) + 2);
return (void *)(base + 1);
}
INLINE_ONLY inline EXTERN bool IsNumTerm(Term);
INLINE_ONLY bool IsNumTerm(Term);
INLINE_ONLY inline EXTERN bool IsNumTerm(Term t) {
INLINE_ONLY bool IsNumTerm(Term t) {
return (IsIntTerm(t) || IsLargeNumTerm(t));
}
INLINE_ONLY inline EXTERN bool IsAtomicTerm(Term);
INLINE_ONLY bool IsAtomicTerm(Term);
INLINE_ONLY inline EXTERN bool IsAtomicTerm(Term t) {
INLINE_ONLY bool IsAtomicTerm(Term t) {
return IsAtomOrIntTerm(t) ||
IsLargeNumTerm(t) ||
IsStringTerm(t);
}
INLINE_ONLY inline EXTERN bool IsExtensionFunctor(Functor);
INLINE_ONLY bool IsExtensionFunctor(Functor);
INLINE_ONLY inline EXTERN bool IsExtensionFunctor(Functor f) {
INLINE_ONLY bool IsExtensionFunctor(Functor f) {
return f <= FunctorString;
}
INLINE_ONLY inline EXTERN bool IsBlobFunctor(Functor);
INLINE_ONLY bool IsBlobFunctor(Functor);
INLINE_ONLY inline EXTERN bool IsBlobFunctor(Functor f) {
INLINE_ONLY bool IsBlobFunctor(Functor f) {
return (f <= FunctorString &&
f >= FunctorDBRef);
}
INLINE_ONLY inline EXTERN bool IsPrimitiveTerm(Term);
INLINE_ONLY bool IsPrimitiveTerm(Term);
INLINE_ONLY inline EXTERN bool IsPrimitiveTerm(Term t) {
INLINE_ONLY bool IsPrimitiveTerm(Term t) {
return (IsAtomOrIntTerm(t) ||
(IsApplTerm(t) &&
IsBlobFunctor(FunctorOfTerm(t))));
@ -476,61 +504,61 @@ INLINE_ONLY inline EXTERN bool IsPrimitiveTerm(Term t) {
#ifdef TERM_EXTENSIONS
INLINE_ONLY inline EXTERN bool IsAttachFunc(Functor);
INLINE_ONLY bool IsAttachFunc(Functor);
INLINE_ONLY inline EXTERN bool IsAttachFunc(Functor f) { return (Int)(FALSE); }
INLINE_ONLY bool IsAttachFunc(Functor f) { return (Int)(FALSE); }
#define IsAttachedTerm(t) __IsAttachedTerm(t PASS_REGS)
INLINE_ONLY inline EXTERN bool __IsAttachedTerm(Term USES_REGS);
INLINE_ONLY bool __IsAttachedTerm(Term USES_REGS);
INLINE_ONLY inline EXTERN bool __IsAttachedTerm(Term t USES_REGS) {
INLINE_ONLY bool __IsAttachedTerm(Term t USES_REGS) {
return (IsVarTerm(t) &&
IsAttVar(VarOfTerm(t)));
}
INLINE_ONLY inline EXTERN bool GlobalIsAttachedTerm(Term);
INLINE_ONLY bool GlobalIsAttachedTerm(Term);
INLINE_ONLY inline EXTERN bool GlobalIsAttachedTerm(Term t) {
INLINE_ONLY bool GlobalIsAttachedTerm(Term t) {
return (IsVarTerm(t) &&
GlobalIsAttVar(VarOfTerm(t)));
}
#define SafeIsAttachedTerm(t) __SafeIsAttachedTerm((t)PASS_REGS)
INLINE_ONLY inline EXTERN bool __SafeIsAttachedTerm(Term USES_REGS);
INLINE_ONLY bool __SafeIsAttachedTerm(Term USES_REGS);
INLINE_ONLY inline EXTERN bool __SafeIsAttachedTerm(Term t USES_REGS) {
INLINE_ONLY bool __SafeIsAttachedTerm(Term t USES_REGS) {
return IsVarTerm(t) && IsAttVar(VarOfTerm(t));
}
INLINE_ONLY inline EXTERN exts ExtFromCell(CELL *);
INLINE_ONLY exts ExtFromCell(CELL *);
INLINE_ONLY inline EXTERN exts ExtFromCell(CELL *pt) { return attvars_ext; }
INLINE_ONLY exts ExtFromCell(CELL *pt) { return attvars_ext; }
#else
INLINE_ONLY inline EXTERN Int IsAttachFunc(Functor);
INLINE_ONLY Int IsAttachFunc(Functor);
INLINE_ONLY inline EXTERN Int IsAttachFunc(Functor f) { return (Int)(FALSE); }
INLINE_ONLY Int IsAttachFunc(Functor f) { return (Int)(FALSE); }
INLINE_ONLY inline EXTERN Int IsAttachedTerm(Term);
INLINE_ONLY Int IsAttachedTerm(Term);
INLINE_ONLY inline EXTERN Int IsAttachedTerm(Term t) { return (Int)(FALSE); }
INLINE_ONLY Int IsAttachedTerm(Term t) { return (Int)(FALSE); }
#endif
INLINE_ONLY inline EXTERN Int Yap_BlobTag(Term t);
INLINE_ONLY Int Yap_BlobTag(Term t);
INLINE_ONLY inline EXTERN Int Yap_BlobTag(Term t) {
INLINE_ONLY Int Yap_BlobTag(Term t) {
CELL *pt = RepAppl(t);
return pt[1];
}
INLINE_ONLY inline EXTERN void *Yap_BlobInfo(Term t);
INLINE_ONLY void *Yap_BlobInfo(Term t);
INLINE_ONLY inline EXTERN void *Yap_BlobInfo(Term t) {
INLINE_ONLY void *Yap_BlobInfo(Term t) {
MP_INT *blobp;
CELL *pt = RepAppl(t);
@ -540,13 +568,13 @@ INLINE_ONLY inline EXTERN void *Yap_BlobInfo(Term t) {
#ifdef YAP_H
INLINE_ONLY inline EXTERN bool unify_extension(Functor, CELL, CELL *, CELL);
INLINE_ONLY bool unify_extension(Functor, CELL, CELL *, CELL);
EXTERN bool unify_extension(Functor, CELL, CELL *, CELL);
int Yap_gmp_tcmp_big_big(Term, Term);
INLINE_ONLY inline EXTERN bool unify_extension(Functor f, CELL d0, CELL *pt0,
INLINE_ONLY bool unify_extension(Functor f, CELL d0, CELL *pt0,
CELL d1) {
switch (BlobOfFunctor(f)) {
case db_ref_e:

46
H/Yap.h
View File

@ -1,4 +1,4 @@
/*************************************************************************
/*************************************************************************
* *
* YAP Prolog %W% %G% *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
@ -11,7 +11,7 @@
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h,v 1.38 2008-06-18 10:02:27 vsc Exp $ *
*************************************************************************/
********** ***************************************************************/
#ifndef YAP_H
@ -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
@ -151,6 +173,11 @@ typedef void *(*fptr_t)(void);
main exports in YapInterface.h
*************************************************************************************************/
extern const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR,
*Yap_PLDIR, *Yap_COMMONSDIR, *Yap_STARTUP,*Yap_INPUT_STARTUP,*Yap_OUTPUT_STARTUP,
*Yap_BOOTFILE, *Yap_INCLUDEDIR;
/* Basic exports */
#include "YapDefs.h"
@ -183,9 +210,9 @@ typedef void *(*fptr_t)(void);
#endif
#if !defined(HAVE_STRNLEN)
INLINE_ONLY inline EXTERN size_t strnlen(const char *s, size_t maxlen);
INLINE_ONLY size_t strnlen(const char *s, size_t maxlen);
INLINE_ONLY inline EXTERN size_t strnlen(const char *s, size_t maxlen) {
INLINE_ONLY size_t strnlen(const char *s, size_t maxlen) {
size_t i = 0;
while (s[i]) {
if (i == maxlen)
@ -258,6 +285,7 @@ extern size_t Yap_page_size;
#define M1 ((CELL)(1024 * 1024))
#define M2 ((CELL)(2048 * 1024))
typedef YAP_UInt CELL;
#if ALIGN_LONGS
typedef CELL SFLAGS;
#else
@ -447,7 +475,7 @@ extern int Yap_output_msg;
#include <android/log.h>
#include <jni.h>
extern AAssetManager *Yap_assetManager;
extern AAssetManager *Yap_assetManager(void);
extern void *Yap_openAssetFile(const char *path);
extern bool Yap_isAsset(const char *path);
@ -820,8 +848,10 @@ inline static void LOG0(const char *f, int l, const char *fmt, ...) {
#include "GitSHA1.h"
extern bool Yap_embedded, Yap_Server;
extern bool Yap_Embedded, Yap_Server;
#include "YapText.h"
#endif /* YAP_H */
#include "YapText.h"

641
H/YapCompile.h
View File

@ -1,305 +1,245 @@
/*************************************************************************
* *
* 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 *
* *
* *
* 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: YapCompile.h *
* Last rev: *
* mods: *
* comments: compiler data structures and routines *
* *
* *
* File:YapCompile.h *
* Last rev: *
* mods: *
* comments:compiler data structures and routines *
* *
*************************************************************************/
/* consult stack management */
/* virtual machine instruction op-codes */
#define mklist0(f) \
f(nop_op, "nop") f(get_var_op, "get_var\t\t%v,%r") f(put_var_op, "put_" \
"var\t\t%" \
"v,%r") f( \
get_val_op, "get_val\t\t%v,%r") f(put_val_op, \
"put_val\t\t%v,%r") f(get_atom_op, \
"get_atom\t%a,%" \
"r") f(put_atom_op, \
"put_" \
"atom\t%" \
"a,%r") \
f(get_num_op, "get_num\t\t%n,%r") f(put_num_op, "put_num\t\t%n,%r") f( \
get_float_op, \
"get_float\t\t%w,%r") f(put_float_op, \
"put_float\t\t%w,%r") f(get_dbterm_op, \
"get_dbterm\t%w,%r") \
f(put_dbterm_op, "put_dbterm\t%w,%r") f(get_longint_op, "get_" \
"longint\t" \
"\t%w,%r") f( \
put_longint_op, \
"put_longint\t\t%w,%r") f(get_string_op, \
"get_string\t\t%w,%S") f(put_string_op, \
"put_" \
"string\t\t%" \
"w,%S") \
f(get_bigint_op, "get_bigint\t\t%l,%r") f(put_bigint_op, "put_" \
"bigin" \
"t\t\t" \
"%l,%" \
"r") f( \
get_list_op, \
"get_list\t%r") f(put_list_op, \
"put_list\t%r") f(get_struct_op, \
"get_struct\t%f,%r") \
f(put_struct_op, "put_struct\t%f,%r") f(put_unsafe_op, "put" \
"_un" \
"saf" \
"e\t" \
"%v," \
"%r") f( \
unify_var_op, \
"unify_var\t%v") f(write_var_op, \
"write_var\t%v") f(unify_val_op, \
"unify_val\t%v") \
f(write_val_op, "write_val\t%v") f(unify_atom_op, "unif" \
"y_" \
"atom" \
"\t%" \
"a") f( \
write_atom_op, \
"write_atom\t%a") f(unify_num_op, \
"unify_num\t%n") f(write_num_op, \
"write_" \
"num\t%n") \
f(unify_float_op, "unify_float\t%w") f( \
write_float_op, \
"write_float\t%w") f(unify_dbterm_op, \
"unify_dbterm\t%w") \
f(write_dbterm_op, "write_dbterm\t%w") f( \
unify_longint_op, \
"unify_longint\t%w") f(write_longint_op, \
"write_longint\t%w") \
f(unify_string_op, "unify_string\t%S") f( \
write_string_op, \
"write_string\t%S") f(unify_bigint_op, \
"unify_bigint\t%" \
"l") f(write_bigint_op, \
"write_" \
"bigint\t%" \
"l") \
f(unify_list_op, "unify_list") f( \
write_list_op, \
"write_list") f(unify_struct_op, \
"unify_struct\t%f") \
f(write_struct_op, "write_struct\t%" \
"f") f( \
write_unsafe_op, \
"write_unsafe\t%v") f(unify_local_op, \
"unify_" \
"local\t%" \
"v") \
f(write_local_op, "write " \
"local\t%v") f( \
unify_last_list_op, \
"unify_last_list") \
f(write_last_list_op, "writ" \
"e_" \
"last" \
"_lis" \
"t") f( \
unify_last_struct_op, \
"unify_last_struct\t%f") \
f(write_last_struct_op, \
"write_last_struct\t%" \
"f") f(unify_last_var_op, \
"unify_last_" \
"var\t%v") \
f( \
unify_last_val_op, \
"unify_last_" \
"val\t%v") f(unify_last_local_op, \
"u" \
"n" \
"i" \
"f" \
"y" \
"_" \
"l" \
"a" \
"s" \
"t" \
"_" \
"l" \
"o" \
"c" \
"a" \
"l" \
"\t%v") f(unify_last_atom_op, \
"unify_last_atom\t%a") f(unify_last_num_op, "unify_last_num\t%n") f(unify_last_float_op, "unify_last_float\t%w") f(unify_last_dbterm_op, "unify_last_dbterm\t%w") f(unify_last_longint_op, "unify_last_longint\t%w") f(unify_last_string_op, "unify_last_string\t%S") f(unify_last_bigint_op, "unify_last_bigint\t%l") f(ensure_space_op, \
"ensure_space") f(native_op, \
"native_code") f(f_var_op, "function_to_var\t%v,%B") f(f_val_op, "function_to_val\t%v,%B") f(f_0_op, "function_to_0\t%B") f(align_float_op, \
"align_float") f(fail_op, "fail") f(cut_op, "cut") f(cutexit_op, \
"cutexit") f(allocate_op, \
"allocate") f(deallocate_op, \
"deallocate") f(tryme_op, \
"try_me_else\t\t%l\t%x") f(jump_op, \
"jump\t\t%l") f(jumpi_op, \
"jump_in_indexing\t\t%i") f(procceed_op, "proceed") f(call_op, "call\t\t%p,%d,%z") f(execute_op, "execute\t\t%p") f(safe_call_op, "sys\t\t%p") f(label_op, \
"%l:") f(name_op, "name\t\t%m,%d") f(pop_op, \
"pop\t\t%l") f(retryme_op, \
"retry_me_else\t\t%l\t%x") f(trustme_op, \
"trust_me_else_fail\t%x") f(either_op, "either_me\t\t%l,%d,%z") f(orelse_op, "or_else\t\t%l,%z") f(orlast_op, \
"or_last") f(push_or_op, "push_or") f(pushpop_or_op, "pushpop_or") f(pop_or_op, "pop_or") f(save_b_op, "save_by\t\t%v") f(commit_b_op, \
"commit_by\t\t%v") f(patch_b_op, "patch_by\t\t%v") f(try_op, \
"try\t\t%g\t%x") f(retry_op, "retry\t\t%g\t%x") f(trust_op, \
"trust\t\t%g\t%x") f(try_in_op, \
"try_in\t\t%g\t%x") f(jump_v_op, \
"jump_if_var\t\t%g") f(jump_nv_op, "jump_if_nonvar\t\t%g") f(cache_arg_op, "cache_arg\t%r") f(cache_sub_arg_op, "cache_sub_arg\t%d") f(user_switch_op, \
"user_switch") f(switch_on_type_op, "switch_on_type\t%h\t%h\t%h\t%h") f(switch_c_op, \
"switch_on_constant\t%i\n%c") f(if_c_op, \
"if_constant\t%i\n%c") f(switch_f_op, \
"switch_on_functor\t%i\n%e") f(if_f_op, "if_functor\t%i\n%e") f(if_not_op, "if_not_then\t%i\t%h\t%h\t%h") \
f(index_dbref_op, \
"index_on_" \
"dbref") f(index_blob_op, \
"i" \
"n" \
"d" \
"e" \
"x" \
"_" \
"o" \
"n" \
"_" \
"b" \
"l" \
"o" \
"b") f(index_string_op, "index_on_string") \
f(index_long_op, "index_on_blob") f( \
if_nonvar_op, \
"check_" \
"var\t " \
"%r") f(save_pair_op, "save_pair\t%v") \
f(save_appl_op, "save_appl\t%v") f( \
mark_initialized_pvars_op, \
"pv" \
"ar" \
"_b" \
"it" \
"ma" \
"p" \
"\t" \
"%l" \
",%" \
"b") f(mark_live_regs_op, \
"pvar_live_regs\t%l,%b") \
f(fetch_args_vv_op, "fetch_reg1_reg2\t%N,%N") f( \
fetch_args_cv_op, \
"fetch_constant_reg\t%l,%N") f(fetch_args_vc_op, \
"fetch_reg_constant\t%l,%N") \
f(fetch_args_iv_op, "fetch_integer_reg\t%d,%N") f( \
fetch_args_vi_op, \
"fetch_reg_integer\t%d,%N") f(enter_profiling_op, \
"enter_profiling\t\t%g") \
f(retry_profiled_op, "retry_profiled\t\t%g") f( \
count_call_op, \
"count_call_op\t\t%g") f(count_retry_op, \
"count_retry_op\t\t%g") \
f(restore_tmps_op, "restore_temps\t\t%l") f( \
restore_tmps_and_skip_op, \
"restore_temps_and_skip\t\t%l") \
f(enter_lu_op, "enter_lu") f( \
empty_call_op, \
"empty_call\t\t%l,%d") \
f(bccall_op, \
"binary_cfunc\t\t%v,%r,%2") \
f(blob_op, \
"blob\t%O") \
f(string_op, \
"string\t%O") \
f(label_ctl_op, \
"label_control\t")
#ifdef YAPOR
#define mklist1(f) mklist0(f) f(sync_op, "sync")
#undef COMPILER_OPS
#undef COMPILER_OPS_END
#undef f
#ifdef COMPILER_NAMES
#define COMPILER_OPS() char *opDesc[] =
#define COMPILER_OPS_END()
#define f(x,y) y
#else
#define mklist1(f) mklist0(f)
#define COMPILER_OPS() typedef enum compiler_op
#define COMPILER_OPS_END() compiler_vm_op
#define f(x,y) x
#endif
/* virtual machine instruction op-codes*/
COMPILER_OPS() {
f(nop_op, "nop"),
f(get_var_op, "get_var\t\t %v,%r"),
f(put_var_op, "put_var\t\t %v,%r"),
f( get_val_op, "get_val\t\t %v,%r"),
f(put_val_op, "put_val\t\t %v,%r"),
f(get_atom_op, "get_atom\t %a,%r"),
f(put_atom_op, "put_atom\t %a,%r"),
f(get_num_op, "get_num\t\t %n,%r"),
f(put_num_op, "put_num\t\t %n,%r"),
f( get_float_op, "get_float\t\t %w,%r"),
f(put_float_op, "put_float\t\t %w,%r"),
f(get_dbterm_op, "get_dbterm\t %w,%r"),
f(put_dbterm_op, "put_dbterm\t %w,%r"),
f(get_longint_op, "get_longint\t\t %w,%r"),
f( put_longint_op, "put_longint\t\t %w,%r"),
f(get_string_op, "get_string\t\t %w,%S"),
f(put_string_op, "put_string\t\t %w,%S"),
f(get_bigint_op, "get_bigint\t\t %l,%r"),
f(put_bigint_op, "put_bigint\t\t %l,%r"),
f( get_list_op, "get_list\t %r"),
f(put_list_op, "put_list\t %r"),
f(get_struct_op, "get_struct\t %f,%r"),
f(put_struct_op, "put_struct\t %f,%r"),
f(put_unsafe_op, "put_unsafe\t %v,%r"),
f( unify_var_op, "unify_var\t %v"),
f(write_var_op, "write_var\t %v"),
f(unify_val_op, "unify_val\t %v"),
f(write_val_op, "write_val\t %v"),
f(unify_atom_op, "unify_atom\t %a"),
f( write_atom_op, "write_atom\t %a"),
f(unify_num_op, "unify_num\t %n"),
f(write_num_op, "write_num\t %n"),
f(unify_float_op, "unify_float\t %w"),
f( write_float_op, "write_float\t %w"),
f(unify_dbterm_op, "unify_dbterm\t %w"),
f(write_dbterm_op, "write_dbterm\t %w"),
f( unify_longint_op, "unify_longint\t %w"),
f(write_longint_op, "write_longint\t %w"),
f(unify_string_op, "unify_string\t %S"),
f( write_string_op, "write_string\t %S"),
f(unify_bigint_op, "unify_bigint\t %l"),
f(write_bigint_op, "write_bigint\t %l"),
f(unify_list_op, "unify_list"),
f( write_list_op, "write_list"),
f(unify_struct_op, "unify_struct\t %f"),
f(write_struct_op, "write_struct\t %f"),
f( write_unsafe_op, "write_unsafe\t %v"),
f(unify_local_op, "unify_local\t %v"),
f(write_local_op, "write local\t %v"),
f( unify_last_list_op, "unify_last_list"),
f(write_last_list_op, "write_last_list"),
f( unify_last_struct_op, "unify_last_struct\t %f"),
f(write_last_struct_op, "write_last_struct\t %f"),
f(unify_last_var_op, "unify_last_var\t %v"),
f( unify_last_val_op, "unify_last_val\t %v"),
f(unify_last_local_op, "unify_last_local\t %v"),
f(unify_last_atom_op, "unify_last_atom\t %a"),
f(unify_last_num_op, "unify_last_num\t %n"),
f(unify_last_float_op, "unify_last_float\t %w"),
f(unify_last_dbterm_op, "unify_last_dbterm\t %w"),
f(unify_last_longint_op, "unify_last_longint\t %w"),
f(unify_last_string_op, "unify_last_string\t %S"),
f(unify_last_bigint_op, "unify_last_bigint\t %l"),
f(ensure_space_op, "ensure_space"),
f(native_op, "native_code"),
f(f_var_op, "function_to_var\t %v,%B"),
f(f_val_op, "function_to_val\t %v,%B"),
f(f_0_op, "function_to_0\t %B"),
f(align_float_op, "align_float"),
f(fail_op, "fail"),
f(cut_op, "cut"),
f(cutexit_op, "cutexit"),
f(allocate_op, "allocate"),
f(deallocate_op, "deallocate"),
f(tryme_op, "try_me_else\t\t %l\t %x"),
f(jump_op, "jump\t\t %l"),
f(jumpi_op, "jump_in_indexing\t\t %i"),
f(procceed_op, "proceed"),
f(call_op, "call\t\t %p,%d,%z"),
f(execute_op, "execute\t\t %p"),
f(safe_call_op, "sys\t\t %p"),
f(label_op, "%l:"),
f(name_op, "name\t\t %m,%d"),
f(pop_op, "pop\t\t %l"),
f(retryme_op, "retry_me_else\t\t %l\t %x"),
f(trustme_op, "trust_me_else_fail\t %x"),
f(either_op, "either_me\t\t %l,%d,%z"),
f(orelse_op, "or_else\t\t %l,%z"),
f(orlast_op, "or_last"),
f(push_or_op, "push_or"),
f(pushpop_or_op, "pushpop_or"),
f(pop_or_op, "pop_or"),
f(save_b_op, "save_by\t\t %v"),
f(commit_b_op, "commit_by\t\t %v"),
f(patch_b_op, "patch_by\t\t %v"),
f(try_op, "try\t\t %g\t %x"),
f(retry_op, "retry\t\t %g\t %x"),
f(trust_op, "trust\t\t %g\t %x"),
f(try_in_op, "try_in\t\t %g\t %x"),
f(jump_v_op, "jump_if_var\t\t %g"),
f(jump_nv_op, "jump_if_nonvar\t\t %g"),
f(cache_arg_op, "cache_arg\t %r"),
f(cache_sub_arg_op, "cache_sub_arg\t %d"),
f(user_switch_op, "user_switch"),
f(switch_on_type_op, "switch_on_type\t %h\t %h\t %h\t %h"),
f(switch_c_op, "switch_on_constant\t %i,n%c"),
f(if_c_op, "if_constant\t %i,n%c"),
f(switch_f_op, "switch_on_functor\t %i,n%e"),
f(if_f_op, "if_functor\t %i,n%e"),
f(if_not_op, "if_not_then\t %i\t %h\t %h\t %h"),
f(index_dbref_op, "index_on_dbref"),
f(index_blob_op, "index_on_blob"),
f(index_string_op, "index_on_string"),
f(index_long_op, "index_on_blob"),
f( if_nonvar_op, "check_var\t %r"),
f(save_pair_op, "save_pair\t %v"),
f(save_appl_op, "save_appl\t %v"),
f( mark_initialized_pvars_op, "pvar_bitmap\t %l,%b"),
f(mark_live_regs_op, "pvar_live_regs\t %l,%b"),
f(fetch_args_vv_op, "fetch_reg1_reg2\t %N,%N"),
f( fetch_args_cv_op, "fetch_constant_reg\t %l,%N"),
f(fetch_args_vc_op, "fetch_reg_constant\t %l,%N"),
f(fetch_args_iv_op, "fetch_integer_reg\t %d,%N"),
f( fetch_args_vi_op, "fetch_reg_integer\t %d,%N"),
f(enter_profiling_op, "enter_profiling\t\t %g"),
f(retry_profiled_op, "retry_profiled\t\t %g"),
f( count_call_op, "count_call_op\t\t %g"),
f(count_retry_op, "count_retry_op\t\t %g"),
f(restore_tmps_op, "restore_temps\t\t %l"),
f( restore_tmps_and_skip_op, "restore_temps_and_skip\t\t %l"),
f(enter_lu_op, "enter_lu"),
f( empty_call_op, "empty_call\t\t %l,%d"),
f(bccall_op, "binary_cfunc\t\t %v,%r,%2"),
f(blob_op, "blob\t %O"),
f(string_op, "string\t %O"),
f(label_ctl_op, "label_control\t"),
#ifdef YAPOR
f(sync_op, "sync"),
#endif /* YAPOR */
#ifdef TABLING
#define mklist2(f) \
mklist1(f) f(table_new_answer_op, "table_new_answer") \
f(table_try_single_op, "table_try_single\t%g\t%x")
#else
#define mklist2(f) mklist1(f)
#endif /* TABLING */
f(table_new_answer_op, "table_new_answer"),
f(table_try_single_op, "table_try_single\t %g\t %x"),
#ifdef TABLING_INNER_CUTS
#define mklist3(f) mklist2(f) f(clause_with_cut_op, "clause_with_cut")
#else
#define mklist3(f) mklist2(f)
f(clause_with_cut_op, "clause_with_cut"),
#endif /* TABLING_INNER_CUTS */
#endif
#ifdef BEAM
#define mklist4(f) \
mklist3(f) f(run_op, "run_op %1,%4") f(body_op, "body_op %1") f( \
endgoal_op, "endgoal_op") f(try_me_op, "try_me_op %1,%4") \
f(retry_me_op, "retry_me_op %1,%4") f(trust_me_op, "trust_me_op %1,%4") \
f(only_1_clause_op, "only_1_clause_op %1,%4") f( \
create_first_box_op, "create_first_box_op %1,%4") \
f(create_box_op, "create_box_op %1,%4") f( \
create_last_box_op, "create_last_box_op %1,%4") \
f(remove_box_op, "remove_box_op %1,%4") f( \
remove_last_box_op, "remove_last_box_op %1,%4") \
f(prepare_tries, "prepare_tries") f(std_base_op, \
"std_base_op %1,%4") \
f(direct_safe_call_op, "direct_safe_call") \
f(commit_op, ) f(skip_while_var_op, \
"skip_while_var_op") \
f(wait_while_var_op, "wait_while_var_op") \
f(force_wait_op, "force_wait_op") \
f(is_op, "is_op") \
f(write_op, "write_op") \
f(equal_op, "equal_op") \
f(exit_op, "exit")
#else
#define mklist4(f) mklist3(f)
f(run_op, "run_op %1,%4"),
f(body_op, "body_op %1"),
f( endgoal_op, "endgoal_op"),
f(try_me_op, "try_me_op %1,%4"),
f(retry_me_op, "retry_me_op %1,%4"),
f(trust_me_op, "trust_me_op %1,%4"),
f(only_1_clause_op, "only_1_clause_op %1,%4"),
f( create_first_box_op, "create_first_box_op %1,%4"),
f(create_box_op, "create_box_op %1,%4"),
f( create_last_box_op, "create_last_box_op %1,%4"),
f(remove_box_op, "remove_box_op %1,%4"),
f( remove_last_box_op, "remove_last_box_op %1,%4"),
f(prepare_tries, "prepare_tries"),
f(std_base_op, "std_base_op %1,%4"),
f(direct_safe_call_op, "direct_safe_call"),
f(commit_op, ),
f(skip_while_var_op, "skip_while_var_op"),
f(wait_while_var_op, "wait_while_var_op"),
f(force_wait_op, "force_wait_op"),
f(is_op, "is_op"),
f(write_op, "write_op"),
f(equal_op, "equal_op"),
f(exit_op, "exit"),
#endif
#ifdef SFUNC
#define mklist(f) \
mklist4(f) f(get_s_f_op, "get_s_f_op\t%f,%r") \
f(put_s_f_op, "put_s_f_op\t%f,%r") f(unify_s_f_op, "unify_s_f_op\t%f") \
f(write_s_f_op, "write_s_f_op\t%f") \
f(unify_s_var_op, "unify_s_var\t%v,%r") f(write_s_var_op, \
"write_s_var\t%v,%r") \
f(unify_s_val_op, "unify_s_val\t%v,%r") \
f(write_s_val_op, "write_s_val\t%v,%r") \
f(unify_s_a_op, "unify_s_a\t%a,%r") \
f(write_s_a_op, "write_s_a\t%a,%r") \
f(get_s_end_op, "get_s_end") \
f(put_s_end_op, "put_s_end") \
f(unify_s_end_op, "unify_s_end") \
f(write_s_end_op, "write_s_end")
#else
#define mklist(f) mklist4(f)
f(get_s_f_op, "get_s_f_op\t %f,%r"),
f(put_s_f_op, "put_s_f_op\t %f,%r"),
f(unify_s_f_op, "unify_s_f_op\t %f"),
f(write_s_f_op, "write_s_f_op\t %f"),
f(unify_s_var_op, "unify_s_var\t %v,%r"),
f(write_s_var_op, "write_s_var\t %v,%r"),
f(unify_s_val_op, "unify_s_val\t %v,%r"),
f(write_s_val_op, "write_s_val\t %v,%r"),
f(unify_s_a_op, "unify_s_a\t %a,%r"),
f(write_s_a_op, "write_s_a\t %a,%r"),
f(get_s_end_op, "get_s_end"),
f(put_s_end_op, "put_s_end"),
f(unify_s_end_op, "unify_s_end"),
f(write_s_end_op, "write_s_end"),
#endif
} COMPILER_OPS_END();
#define f_enum(x, y) x,
#define f_arr(x, y) y,
enum compiler_op { mklist(f_enum) };
typedef enum compiler_op compiler_vm_op;
#ifndef COMPILER_NAMES
typedef struct PSEUDO {
struct PSEUDO *nextInst;
enum compiler_op op;
CELL rnd1;
union {
Int oprnd2;
struct PSEUDO *nextInst;
enum compiler_op op;
CELL rnd1;
union {
Int oprnd2;
#if MIN_ARRAY == 0
CELL opseqt[MIN_ARRAY];
CELL opseqt[MIN_ARRAY];
#else
CELL opseqt[1];
CELL opseqt[1];
#endif
} ops;
} ops;
} PInstr;
#define arnds ops.opseqt
@ -312,26 +252,26 @@ typedef struct PSEUDO {
#define rnd8 ops.opseqt[6]
typedef struct VENTRY {
CELL SelfOfVE;
Term AdrsOfVE;
Int KindOfVE;
CELL NoOfVE;
PInstr *FirstOpForV;
PInstr *LastOpForV;
BITS16 AgeOfVE;
BITS16 BranchOfVE;
BITS16 LastBranchOfVE;
BITS16 FirstOfVE;
BITS16 RCountOfVE;
BITS16 FlagsOfVE;
struct VENTRY *NextOfVE;
CELL SelfOfVE;
Term AdrsOfVE;
Int KindOfVE;
CELL NoOfVE;
PInstr *FirstOpForV;
PInstr *LastOpForV;
BITS16 AgeOfVE;
BITS16 BranchOfVE;
BITS16 LastBranchOfVE;
BITS16 FirstOfVE;
BITS16 RCountOfVE;
BITS16 FlagsOfVE;
struct VENTRY *NextOfVE;
} Ventry;
typedef struct CEXPENTRY {
Term TermOfCE;
PInstr *CodeOfCE;
Term VarOfCE;
struct CEXPENTRY *NextCE;
Term TermOfCE;
PInstr *CodeOfCE;
Term VarOfCE;
struct CEXPENTRY *NextCE;
} CExpEntry;
#define COMPILER_ERR_BOTCH 1
@ -342,48 +282,48 @@ typedef struct CEXPENTRY {
#define OUT_OF_TRAIL_BOTCH 6
typedef struct intermediates {
char *freep;
char *freep0;
struct mem_blk *blks;
char *blk_cur, *blk_top;
struct PSEUDO *cpc;
struct PSEUDO *CodeStart;
struct PSEUDO *icpc;
struct PSEUDO *BlobsStart;
struct dbterm_list *dbterml;
Int *label_offset;
Int *uses;
Term *contents;
struct pred_entry *CurrentPred;
sigjmp_buf CompilerBotch;
yamop *code_addr;
yamop *expand_block;
UInt i_labelno;
UInt exception_handler, success_handler, failure_handler;
/* for expanding code */
yamop **current_try_lab, **current_trust_lab;
yamop *try_instructions;
struct StructClauseDef *cls;
int clause_has_cut;
UInt term_depth, last_index_at_depth;
UInt last_index_new_depth, last_depth_size;
/* for expanding code */
union {
struct static_index *si;
struct logic_upd_index *lui;
} current_cl;
char *freep;
char *freep0;
struct mem_blk *blks;
char *blk_cur, *blk_top;
struct PSEUDO *cpc;
struct PSEUDO *CodeStart;
struct PSEUDO *icpc;
struct PSEUDO *BlobsStart;
struct dbterm_list *dbterml;
Int *label_offset;
Int *uses;
Term *contents;
struct pred_entry *CurrentPred;
sigjmp_buf CompilerBotch;
yamop *code_addr;
yamop *expand_block;
UInt i_labelno;
UInt exception_handler, success_handler, failure_handler;
/* for expanding code */
yamop **current_try_lab, **current_trust_lab;
yamop *try_instructions;
struct StructClauseDef *cls;
int clause_has_cut;
UInt term_depth, last_index_at_depth;
UInt last_index_new_depth, last_depth_size;
/* for expanding code */
union {
struct static_index *si;
struct logic_upd_index *lui;
} current_cl;
} CIntermediates;
typedef enum special_label_id_enum {
SPECIAL_LABEL_SUCCESS = 0,
SPECIAL_LABEL_FAILURE = 1,
SPECIAL_LABEL_EXCEPTION = 2
SPECIAL_LABEL_SUCCESS = 0,
SPECIAL_LABEL_FAILURE = 1,
SPECIAL_LABEL_EXCEPTION = 2
} special_label_id;
typedef enum special_label_op_enum {
SPECIAL_LABEL_INIT = 0,
SPECIAL_LABEL_SET = 1,
SPECIAL_LABEL_CLEAR = 2
SPECIAL_LABEL_INIT = 0,
SPECIAL_LABEL_SET = 1,
SPECIAL_LABEL_CLEAR = 2
} special_label_op;
#define SafeVar 0x01
@ -415,23 +355,20 @@ typedef enum special_label_op_enum {
#define One 1
#define Two 2
extern yamop *Yap_assemble(int, Term, struct pred_entry *, int,
struct intermediates *, UInt);
void Yap_emit(compiler_vm_op, Int, CELL, struct intermediates *);
void Yap_emit_3ops(compiler_vm_op, CELL, CELL, CELL, struct intermediates *);
void Yap_emit_4ops(compiler_vm_op, CELL, CELL, CELL, CELL,
struct intermediates *);
void Yap_emit_5ops(compiler_vm_op, CELL, CELL, CELL, CELL, CELL,
struct intermediates *);
void Yap_emit_6ops(compiler_vm_op, CELL, CELL, CELL, CELL, CELL, CELL,
struct intermediates *);
void Yap_emit_7ops(compiler_vm_op, CELL, CELL, CELL, CELL, CELL, CELL, CELL,
struct intermediates *);
CELL *Yap_emit_extra_size(compiler_vm_op, CELL, int, struct intermediates *);
char *Yap_AllocCMem(UInt, struct intermediates *);
void Yap_ReleaseCMem(struct intermediates *);
int Yap_is_a_test_pred(Term, Term);
void Yap_bip_name(Int, char *);
extern yamop *Yap_assemble(int, Term, struct pred_entry *, int, struct intermediates *, UInt);
extern void Yap_emit(compiler_vm_op, Int, CELL, struct intermediates *);
extern void Yap_emit_3ops(compiler_vm_op, CELL, CELL, CELL, struct intermediates *);
extern void Yap_emit_4ops(compiler_vm_op, CELL, CELL, CELL, CELL, struct intermediates *);
extern void Yap_emit_5ops(compiler_vm_op, CELL, CELL, CELL, CELL, CELL,struct intermediates *);
extern void Yap_emit_6ops(compiler_vm_op, CELL, CELL, CELL, CELL, CELL, CELL,struct intermediates *);
extern void Yap_emit_7ops(compiler_vm_op, CELL, CELL, CELL, CELL, CELL, CELL, CELL, struct intermediates *);
extern CELL *Yap_emit_extra_size(compiler_vm_op, CELL, int, struct intermediates *);
extern char *Yap_AllocCMem(UInt, struct intermediates *);
extern void Yap_ReleaseCMem(struct intermediates *);
extern int Yap_is_a_test_pred(Term, Term);
extern void Yap_bip_name(Int, char *);
#ifdef DEBUG
void Yap_ShowCode(struct intermediates *);
extern void Yap_ShowCode(struct intermediates *);
#endif /* DEBUG */
#endif

63
H/YapCompoundTerm.h
View File

@ -1,17 +1,17 @@
/*************************************************************************
* *
* YAP Prolog %W% %G% *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2012 *
* *
**************************************************************************
* *
* File: YapCompounTerm.h *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h,v 1.38 2008-06-18 10:02:27 vsc Exp $ *
*************************************************************************/
* *
* YAP Prolog %W% %G% *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2012 *
* *
**************************************************************************
* *
* File: YapCompounTerm.h *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h,v 1.38 2008-06-18 10:02:27 vsc Exp $ *
*************************************************************************/
/*************************************************************************************************
High level macros to access arguments
@ -23,11 +23,11 @@
#include "inline-only.h"
EXTERN Int Yap_unify(Term a, Term b);
EXTERN bool Yap_unify(Term a, Term b);
INLINE_ONLY EXTERN inline Term Deref(Term a);
INLINE_ONLY Term Deref(Term a);
INLINE_ONLY EXTERN inline Term Deref(Term a) {
INLINE_ONLY Term Deref(Term a) {
while (IsVarTerm(a)) {
Term *b = (Term *)a;
a = *b;
@ -37,12 +37,11 @@ INLINE_ONLY EXTERN inline Term Deref(Term a) {
return (a);
}
INLINE_ONLY EXTERN inline CELL *GetTermAdress(Term a);
INLINE_ONLY CELL *GetTermAdress(Term a);
INLINE_ONLY Term Derefa(CELL *b);
INLINE_ONLY EXTERN inline Term Derefa(CELL *b);
INLINE_ONLY EXTERN inline Term Derefa(CELL *b) {
INLINE_ONLY Term Derefa(CELL *b) {
Term a = *b;
restart:
if (!IsVarTerm(a)) {
@ -56,41 +55,41 @@ restart:
}
}
INLINE_ONLY inline EXTERN Term ArgOfTerm(int i, Term t);
INLINE_ONLY Term ArgOfTerm(int i, Term t);
INLINE_ONLY inline EXTERN Term ArgOfTerm(int i, Term t)
INLINE_ONLY Term ArgOfTerm(int i, Term t)
{
return (Term)(Derefa(RepAppl(t) + (i)));
}
INLINE_ONLY inline EXTERN Term HeadOfTerm(Term);
INLINE_ONLY Term HeadOfTerm(Term);
INLINE_ONLY inline EXTERN Term HeadOfTerm(Term t) {
INLINE_ONLY Term HeadOfTerm(Term t) {
return (Term)(Derefa(RepPair(t)));
}
INLINE_ONLY inline EXTERN Term TailOfTerm(Term);
INLINE_ONLY Term TailOfTerm(Term);
INLINE_ONLY inline EXTERN Term TailOfTerm(Term t) {
INLINE_ONLY Term TailOfTerm(Term t) {
return (Term)(Derefa(RepPair(t) + 1));
}
INLINE_ONLY inline EXTERN Term ArgOfTermCell(int i, Term t);
INLINE_ONLY Term ArgOfTermCell(int i, Term t);
INLINE_ONLY inline EXTERN Term ArgOfTermCell(int i, Term t) {
INLINE_ONLY Term ArgOfTermCell(int i, Term t) {
return (Term)((CELL)(RepAppl(t) + (i)));
}
INLINE_ONLY inline EXTERN Term HeadOfTermCell(Term);
INLINE_ONLY Term HeadOfTermCell(Term);
INLINE_ONLY inline EXTERN Term HeadOfTermCell(Term t) {
INLINE_ONLY Term HeadOfTermCell(Term t) {
return (Term)((CELL)(RepPair(t)));
}
INLINE_ONLY inline EXTERN Term TailOfTermCell(Term);
INLINE_ONLY Term TailOfTermCell(Term);
INLINE_ONLY inline EXTERN Term TailOfTermCell(Term t) {
INLINE_ONLY Term TailOfTermCell(Term t) {
return (Term)((CELL)(RepPair(t) + 1));
}

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

@ -1,19 +1,18 @@
/*************************************************************************
* *
* YAP Prolog @(#)YapEval.h 1.2
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: YapEval.h *
* Last rev: *
* mods: *
* comments: arithmetical functions info *
* *
*************************************************************************/
* *
* YAP Prolog @(#)YapEval.h 1.2
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: YapEval.h
** Last rev: * mods:
** comments: arithmetical functions info *
* *
*************************************************************************/
/**
@ -49,7 +48,7 @@ in YAP
When YAP is built using the GNU multiple precision arithmetic library
(GMP), integer arithmetic is unbounded, which means that the size of
integers is only limited by available memory. The type of integer
extern integers is only limited by available memory. The type of integer
support can be detected using the Prolog flags bounded, min_integer
and max_integer. As the use of GMP is default, most of the following
descriptions assume unbounded integer arithmetic.
@ -165,7 +164,7 @@ overflow
* @addtogroup arithmetic_operators
* @enum arith0_op constant operators
* @brief specifies the available unary arithmetic operators
*/
*/
typedef enum {
/** pi [ISO]
@ -259,25 +258,25 @@ typedef enum {
*/
op_log,
/** log10( _X_ ) [ISO]
*
* Decimal logarithm.
*
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* ?- between(1, 10, I), Delta is log10(I*10) + log10(1/(I*10)), format('0
*
* Decimal logarithm.
*
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* ?- between(1, 10, I), Delta is log10(I*10) + log10(1/(I*10)), format('0
* == ~3g~n',[Delta]), fail.
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 2.22e-16
* 0 == 0
* false.
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*/
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 2.22e-16
* 0 == 0
* false.
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*/
op_log10,
op_sqrt,
op_sin,
@ -358,11 +357,11 @@ Functor EvalArg(Term);
#define FlIsInt(X) (FALSE)
#endif
#ifdef M_WILLIAMS
//#if defined(M_WILLIAMS)
#define MkEvalFl(X) MkFloatTerm(X)
#else
#define MkEvalFl(X) (FlIsInt(X) ? MkIntTerm((Int)(X)) : MkFloatTerm(X))
#endif
//#else
//#define MkEvalFl(X) (FlIsInt(X) ? MkIntTerm((Int)(X)) : MkFloatTerm(X))
//#endif
/* Macros used by some of the eval functions */
#define REvalInt(I) \
@ -391,28 +390,48 @@ void Yap_InitConstExps(void);
void Yap_InitUnaryExps(void);
void Yap_InitBinaryExps(void);
int Yap_ReInitConstExps(void);
int Yap_ReInitUnaryExps(void);
int Yap_ReInitBinaryExps(void);
extern int Yap_ReInitConstExps(void);
extern int Yap_ReInitUnaryExps(void);
extern int Yap_ReInitBinaryExps(void);
Term Yap_eval_atom(Int);
Term Yap_eval_unary(Int, Term);
Term Yap_eval_binary(Int, Term, Term);
extern Term Yap_eval_atom(Int);
extern Term Yap_eval_unary(Int, Term);
extern Term Yap_eval_binary(Int, Term, Term);
Term Yap_InnerEval__(Term USES_REGS);
typedef struct eval_context {
Functor f;
CELL *fp;
struct eval_context *p;
} eval_context_t;
extern Term Yap_InnerEval__(Term USES_REGS);
#define Yap_EvalError(id, t, ...) \
Yap_EvalError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
void Yap_EvalError__(const char *, const char *, int, yap_error_number, Term,
...);
{ \
eval_context_t *ctx = LOCAL_ctx; \
LOCAL_ctx = NULL; \
while (ctx) { \
*ctx->fp = (CELL)(ctx->f); \
ctx = ctx->p; \
} \
Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__); \
}
#define Yap_ArithError(id, t, ...) \
Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
#define Yap_BinError(id) \
Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, 0L, "")
#define Yap_AbsmiError(id) \
Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, 0L, "")
{ \
eval_context_t *ctx = LOCAL_ctx; \
LOCAL_ctx = NULL; \
while (ctx) { \
*ctx->fp = (CELL)(ctx->f); \
ctx = ctx->p; \
} \
Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__); \
}
#define Yap_BinError(id) \
Yap_Error__(false, __FILE__, __FUNCTION__, __LINE__, id, 0L, "")
#define Yap_AbsmiError(id) \
Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, 0L, "")
#include "inline-only.h"
@ -420,11 +439,32 @@ void Yap_EvalError__(const char *, const char *, int, yap_error_number, Term,
#define Yap_InnerEval(x) Yap_InnerEval__(x PASS_REGS)
#define Yap_Eval(x) Yap_Eval__(x PASS_REGS)
#define Yap_FoundArithError() Yap_FoundArithError__(PASS_REGS1)
INLINE_ONLY inline EXTERN Term Yap_Eval__(Term t USES_REGS);
static inline bool Yap_CheckArithError(void)
{
bool on = false;
yap_error_number err;
if (LOCAL_Error_TYPE== RESOURCE_ERROR_STACK) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, CP)) {
on = false;
Yap_ThrowError(RESOURCE_ERROR_STACK, ARG2, "while running arithmetic");
} else {
on = true;
}
};
if (trueGlobalPrologFlag(
ARITHMETIC_EXCEPTIONS_FLAG) &&
(err = Yap_MathException())) {
Yap_ThrowError(err,ARG2,"Math Error");
}
return on;
}
INLINE_ONLY inline EXTERN Term Yap_Eval__(Term t USES_REGS) {
INLINE_ONLY Term Yap_Eval__(Term t USES_REGS);
INLINE_ONLY Term Yap_Eval__(Term t USES_REGS) {
if (t == 0L || (!IsVarTerm(t) && IsNumTerm(t)))
return t;
return Yap_InnerEval(t);
@ -436,14 +476,6 @@ inline static void Yap_ClearExs(void) { feclearexcept(FE_ALL_EXCEPT); }
inline static void Yap_ClearExs(void) {}
#endif
inline static yap_error_number Yap_FoundArithError__(USES_REGS1) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR)
return LOCAL_Error_TYPE;
if (trueGlobalPrologFlag(
ARITHMETIC_EXCEPTIONS_FLAG)) // test support for exception
return Yap_MathException();
return YAP_NO_ERROR;
}
static inline Term takeIndicator(Term t) {
Term ts[2];
@ -468,9 +500,7 @@ Atom Yap_NameOfBinaryOp(int i);
#define RFLOAT(v) return (MkFloatTerm(v))
#define RBIG(v) return (Yap_MkBigIntTerm(v))
#define RERROR() \
{ \
return (0L); \
}
{ return (0L); }
static inline blob_type ETypeOfTerm(Term t) {
if (IsIntTerm(t))
@ -489,106 +519,106 @@ static inline blob_type ETypeOfTerm(Term t) {
}
#if USE_GMP
char *Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base);
extern char *Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base);
Term Yap_gmq_rdiv_int_int(Int, Int);
Term Yap_gmq_rdiv_int_big(Int, Term);
Term Yap_gmq_rdiv_big_int(Term, Int);
Term Yap_gmq_rdiv_big_big(Term, Term);
extern Term Yap_gmq_rdiv_int_int(Int, Int);
extern Term Yap_gmq_rdiv_int_big(Int, Term);
extern Term Yap_gmq_rdiv_big_int(Term, Int);
extern Term Yap_gmq_rdiv_big_big(Term, Term);
Term Yap_gmp_add_ints(Int, Int);
Term Yap_gmp_sub_ints(Int, Int);
Term Yap_gmp_mul_ints(Int, Int);
Term Yap_gmp_sll_ints(Int, Int);
Term Yap_gmp_add_int_big(Int, Term);
Term Yap_gmp_sub_int_big(Int, Term);
Term Yap_gmp_sub_big_int(Term, Int);
Term Yap_gmp_mul_int_big(Int, Term);
Term Yap_gmp_div_int_big(Int, Term);
Term Yap_gmp_div_big_int(Term, Int);
Term Yap_gmp_div2_big_int(Term, Int);
Term Yap_gmp_fdiv_int_big(Int, Term);
Term Yap_gmp_fdiv_big_int(Term, Int);
Term Yap_gmp_and_int_big(Int, Term);
Term Yap_gmp_ior_int_big(Int, Term);
Term Yap_gmp_xor_int_big(Int, Term);
Term Yap_gmp_sll_big_int(Term, Int);
Term Yap_gmp_add_big_big(Term, Term);
Term Yap_gmp_sub_big_big(Term, Term);
Term Yap_gmp_mul_big_big(Term, Term);
Term Yap_gmp_div_big_big(Term, Term);
Term Yap_gmp_div2_big_big(Term, Term);
Term Yap_gmp_fdiv_big_big(Term, Term);
Term Yap_gmp_and_big_big(Term, Term);
Term Yap_gmp_ior_big_big(Term, Term);
Term Yap_gmp_xor_big_big(Term, Term);
Term Yap_gmp_mod_big_big(Term, Term);
Term Yap_gmp_mod_big_int(Term, Int);
Term Yap_gmp_mod_int_big(Int, Term);
Term Yap_gmp_rem_big_big(Term, Term);
Term Yap_gmp_rem_big_int(Term, Int);
Term Yap_gmp_rem_int_big(Int, Term);
Term Yap_gmp_exp_int_int(Int, Int);
Term Yap_gmp_exp_int_big(Int, Term);
Term Yap_gmp_exp_big_int(Term, Int);
Term Yap_gmp_exp_big_big(Term, Term);
Term Yap_gmp_gcd_int_big(Int, Term);
Term Yap_gmp_gcd_big_big(Term, Term);
extern Term Yap_gmp_add_ints(Int, Int);
extern Term Yap_gmp_sub_ints(Int, Int);
extern Term Yap_gmp_mul_ints(Int, Int);
extern Term Yap_gmp_sll_ints(Int, Int);
extern Term Yap_gmp_add_int_big(Int, Term);
extern Term Yap_gmp_sub_int_big(Int, Term);
extern Term Yap_gmp_sub_big_int(Term, Int);
extern Term Yap_gmp_mul_int_big(Int, Term);
extern Term Yap_gmp_div_int_big(Int, Term);
extern Term Yap_gmp_div_big_int(Term, Int);
extern Term Yap_gmp_div2_big_int(Term, Int);
extern Term Yap_gmp_fdiv_int_big(Int, Term);
extern Term Yap_gmp_fdiv_big_int(Term, Int);
extern Term Yap_gmp_and_int_big(Int, Term);
extern Term Yap_gmp_ior_int_big(Int, Term);
extern Term Yap_gmp_xor_int_big(Int, Term);
extern Term Yap_gmp_sll_big_int(Term, Int);
extern Term Yap_gmp_add_big_big(Term, Term);
extern Term Yap_gmp_sub_big_big(Term, Term);
extern Term Yap_gmp_mul_big_big(Term, Term);
extern Term Yap_gmp_div_big_big(Term, Term);
extern Term Yap_gmp_div2_big_big(Term, Term);
extern Term Yap_gmp_fdiv_big_big(Term, Term);
extern Term Yap_gmp_and_big_big(Term, Term);
extern Term Yap_gmp_ior_big_big(Term, Term);
extern Term Yap_gmp_xor_big_big(Term, Term);
extern Term Yap_gmp_mod_big_big(Term, Term);
extern Term Yap_gmp_mod_big_int(Term, Int);
extern Term Yap_gmp_mod_int_big(Int, Term);
extern Term Yap_gmp_rem_big_big(Term, Term);
extern Term Yap_gmp_rem_big_int(Term, Int);
extern Term Yap_gmp_rem_int_big(Int, Term);
extern Term Yap_gmp_exp_int_int(Int, Int);
extern Term Yap_gmp_exp_int_big(Int, Term);
extern Term Yap_gmp_exp_big_int(Term, Int);
extern Term Yap_gmp_exp_big_big(Term, Term);
extern Term Yap_gmp_gcd_int_big(Int, Term);
extern Term Yap_gmp_gcd_big_big(Term, Term);
Term Yap_gmp_big_from_64bits(YAP_LONG_LONG);
extern Term Yap_gmp_big_from_64bits(YAP_LONG_LONG);
Term Yap_gmp_float_to_big(Float);
Term Yap_gmp_float_to_rational(Float);
Term Yap_gmp_float_rationalize(Float);
extern Term Yap_gmp_float_to_big(Float);
extern Term Yap_gmp_float_to_rational(Float);
extern Term Yap_gmp_float_rationalize(Float);
Float Yap_gmp_to_float(Term);
Term Yap_gmp_add_float_big(Float, Term);
Term Yap_gmp_sub_float_big(Float, Term);
Term Yap_gmp_sub_big_float(Term, Float);
Term Yap_gmp_mul_float_big(Float, Term);
Term Yap_gmp_fdiv_float_big(Float, Term);
Term Yap_gmp_fdiv_big_float(Term, Float);
extern Term Yap_gmp_add_float_big(Float, Term);
extern Term Yap_gmp_sub_float_big(Float, Term);
extern Term Yap_gmp_sub_big_float(Term, Float);
extern Term Yap_gmp_mul_float_big(Float, Term);
extern Term Yap_gmp_fdiv_float_big(Float, Term);
extern Term Yap_gmp_fdiv_big_float(Term, Float);
int Yap_gmp_cmp_big_int(Term, Int);
int Yap_gmp_cmp_int_big(Int, Term);
int Yap_gmp_cmp_big_float(Term, Float);
extern int Yap_gmp_cmp_big_int(Term, Int);
extern int Yap_gmp_cmp_int_big(Int, Term);
extern int Yap_gmp_cmp_big_float(Term, Float);
#define Yap_gmp_cmp_float_big(D, T) (-Yap_gmp_cmp_big_float(T, D))
int Yap_gmp_cmp_big_big(Term, Term);
extern int Yap_gmp_cmp_big_big(Term, Term);
int Yap_gmp_tcmp_big_int(Term, Int);
int Yap_gmp_tcmp_int_big(Int, Term);
int Yap_gmp_tcmp_big_float(Term, Float);
extern int Yap_gmp_tcmp_big_int(Term, Int);
extern int Yap_gmp_tcmp_int_big(Int, Term);
extern int Yap_gmp_tcmp_big_float(Term, Float);
#define Yap_gmp_tcmp_float_big(D, T) (-Yap_gmp_tcmp_big_float(T, D))
int Yap_gmp_tcmp_big_big(Term, Term);
extern int Yap_gmp_tcmp_big_big(Term, Term);
Term Yap_gmp_neg_int(Int);
Term Yap_gmp_abs_big(Term);
Term Yap_gmp_neg_big(Term);
Term Yap_gmp_unot_big(Term);
Term Yap_gmp_floor(Term);
Term Yap_gmp_ceiling(Term);
Term Yap_gmp_round(Term);
Term Yap_gmp_trunc(Term);
Term Yap_gmp_float_fractional_part(Term);
Term Yap_gmp_float_integer_part(Term);
Term Yap_gmp_sign(Term);
Term Yap_gmp_lsb(Term);
Term Yap_gmp_msb(Term);
Term Yap_gmp_popcount(Term);
extern Term Yap_gmp_neg_int(Int);
extern Term Yap_gmp_abs_big(Term);
extern Term Yap_gmp_neg_big(Term);
extern Term Yap_gmp_unot_big(Term);
extern Term Yap_gmp_floor(Term);
extern Term Yap_gmp_ceiling(Term);
extern Term Yap_gmp_round(Term);
extern Term Yap_gmp_trunc(Term);
extern Term Yap_gmp_float_fractional_part(Term);
extern Term Yap_gmp_float_integer_part(Term);
extern Term Yap_gmp_sign(Term);
extern Term Yap_gmp_lsb(Term);
extern Term Yap_gmp_msb(Term);
extern Term Yap_gmp_popcount(Term);
char *Yap_gmp_to_string(Term, char *, size_t, int);
size_t Yap_gmp_to_size(Term, int);
int Yap_term_to_existing_big(Term, MP_INT *);
int Yap_term_to_existing_rat(Term, MP_RAT *);
extern int Yap_term_to_existing_big(Term, MP_INT *);
extern int Yap_term_to_existing_rat(Term, MP_RAT *);
void Yap_gmp_set_bit(Int i, Term t);
#endif
#define Yap_Mk64IntegerTerm(i) __Yap_Mk64IntegerTerm((i)PASS_REGS)
INLINE_ONLY inline EXTERN Term __Yap_Mk64IntegerTerm(YAP_LONG_LONG USES_REGS);
INLINE_ONLY Term __Yap_Mk64IntegerTerm(YAP_LONG_LONG USES_REGS);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
__Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS) {
if (i <= Int_MAX && i >= Int_MIN) {
return MkIntegerTerm((Int)i);
@ -601,15 +631,20 @@ __Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS) {
}
}
#if __clang__ && FALSE /* not in OSX yet */
#define DO_ADD() \
if (__builtin_sadd_overflow(i1, i2, &z)) { \
goto overflow; \
}
#endif
inline static Term add_int(Int i, Int j USES_REGS) {
#if USE_GMP
#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__) && __GNUC__ > 4
Int w;
if (!__builtin_add_overflow_p(i, j, w))
RINT(w);
return Yap_gmp_add_ints(i, j);
;
#elif USE_GMP
UInt w = (UInt)i + (UInt)j;
if (i > 0) {
if (j > 0 && (Int)w < 0)
@ -628,7 +663,7 @@ overflow:
}
/* calculate the most significant bit for an integer */
Int Yap_msb(Int inp USES_REGS);
extern Int Yap_msb(Int inp USES_REGS);
static inline Term p_plus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {

139
H/YapFlags.h
View File

@ -15,15 +15,17 @@
* *
*************************************************************************/
/** @file YapFlags.h
/**
@file YapFlags.h
@addtogroup Flags
@{
@addtogroup YAPFlags
*/
#ifndef YAP_FLAGS_H
#define YAP_FLAGS_H 1
// INLINE_ONLY inline EXTERN bool nat( Term inp );
// INLINE_ONLY bool nat( Term inp );
#define SYSTEM_OPTION_0 "attributed_variables,rational_trees]"
#if THREADS
@ -101,7 +103,7 @@ static inline Term ro(Term inp) {
return TermZERO;
}
INLINE_ONLY inline EXTERN Term aro(Term inp) {
INLINE_ONLY Term aro(Term inp) {
if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag %s",
"value must be bound");
@ -114,9 +116,12 @@ INLINE_ONLY inline EXTERN Term aro(Term inp) {
return TermZERO;
}
// INLINE_ONLY inline EXTERN Term booleanFlag( Term inp );
// INLINE_ONLY Term booleanFlag( Term inp );
static inline Term booleanFlag(Term inp) {
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (inp == TermTrue || inp == TermOn)
return TermTrue;
if (inp == TermFalse || inp == TermOff)
@ -137,17 +142,20 @@ static inline Term booleanFlag(Term inp) {
}
static Term synerr(Term inp) {
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (inp == TermDec10 || inp == TermFail || inp == TermError ||
inp == TermQuiet)
return inp;
if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag in {dec10,error,fail,quiet}");
return TermZERO;
}
Yap_Error(TYPE_ERROR_ATOM, inp,
"set_prolog_flag in {dec10,error,fail,quiet}");
Yap_ThrowError(TYPE_ERROR_ATOM, inp,
"syntax_error flag must be atom");
return TermZERO;
}
@ -162,20 +170,7 @@ static inline Term list_filler(Term inp) {
return TermZERO;
}
static Term bqs(Term inp) {
if (inp == TermCodes || inp == TermString || inp == TermSymbolChar)
return inp;
if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag in {codes,string}");
return TermZERO;
}
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag in {codes,string}");
return TermZERO;
}
// INLINE_ONLY inline EXTERN Term isatom( Term inp );
// INLINE_ONLY Term isatom( Term inp );
static inline Term isatom(Term inp) {
if (IsVarTerm(inp)) {
@ -183,17 +178,36 @@ static inline Term isatom(Term inp) {
"value must be bound");
return TermZERO;
}
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (IsAtomTerm(inp))
return inp;
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
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;
}
// INLINE_ONLY inline EXTERN Term ok( Term inp );
static inline const char * rootdir(Term inp) {
return Yap_ROOTDIR;
}
// INLINE_ONLY Term ok( Term inp );
static inline Term ok(Term inp) { return inp; }
@ -237,16 +251,35 @@ typedef union flagTerm {
void Yap_InitFlags(bool);
#define YAP_FLAG(x, NAME, WRITABLE, DEF, INIT, HELPER) x
/**
@pred yap_flag( ?Param, ?Value)
typedef enum {
Set or read system properties for _Param_:
*/
#define YAP_FLAG(ITEM, NAME, WRITABLE, DEF, INIT, HELPER) ITEM
#define START_LOCAL_FLAGS enum THREAD_LOCAL_FLAGS {
#define END_LOCAL_FLAGS };
#define START_GLOBAL_FLAGS enum GLOBAL_FLAGS {
#define END_GLOBAL_FLAGS };
/* */
#include "YapGFlagInfo.h"
} global_flag_t;
typedef enum {
/* Local flags */
#include "YapLFlagInfo.h"
} local_flag_t;
#ifndef DOXYGEN
#undef YAP_FLAG
#undef START_LOCAL_FLAGS
#undef END_LOCAL_FLAGS
#undef START_GLOBAL_FLAGS
#undef END_GLOBAL_FLAGS
#endif
bool setYapFlag(Term tflag, Term t2);
Term getYapFlag(Term tflag);
@ -300,7 +333,7 @@ static inline bool trueLocalPrologFlag(int id) {
return LOCAL_Flags[id].at == TermTrue;
}
static inline bool falsePrologFlag(int id) {
static inline bool falseLocalPrologFlag(int id) {
CACHE_REGS
return LOCAL_Flags[id].at == TermFalse;
}
@ -317,8 +350,15 @@ static inline bool silentMode(void) {
return GLOBAL_Flags[VERBOSE_FLAG].at == TermSilent;
}
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) {
@ -334,17 +374,26 @@ static inline Term getSyntaxErrorsFlag(void) {
return LOCAL_Flags[SYNTAX_ERRORS_FLAG].at;
}
static inline bool setBackQuotesFlag(Term val) {
if (!bqs(val))
return false;
if (val == TermSymbolChar)
val = TermString;
GLOBAL_Flags[BACKQUOTED_STRING_FLAG].at = val;
// used to overwrite singletons quoteFunc flag
static inline bool setReadTermBackQuotesFlag(Term val) {
GLOBAL_Flags[BACK_QUOTES_FLAG].at = val;
return true;
}
static inline Term getBackQuotesFlag(void) {
return GLOBAL_Flags[BACKQUOTED_STRING_FLAG].at;
static inline Term getReadTermBackQuotesFlag(void) {
Term val;
unsigned int flags = Yap_GetModuleEntry(CurrentModule)->flags;
if (flags & BCKQ_ATOM) {
val = TermAtom;
} else if (flags & BCKQ_STRING) {
val = TermString;
} else if (flags & BCKQ_CHARS) {
val = TermChars;
} else {
val = TermCodes;
}
return GLOBAL_Flags[BACK_QUOTES_FLAG].at = val;
}
static inline Term indexingMode(void) { return GLOBAL_Flags[INDEX_FLAG].at; }
@ -363,8 +412,20 @@ Term Yap_UnknownFlag(Term mod);
bool rmdot(Term inp);
xarg *Yap_ArgListToVector(Term listl, const param_t *def, int n);
#define Yap_ArgListToVector(l, def, n, e) \
Yap_ArgListToVector__(__FILE__, __FUNCTION__, __LINE__, l, def, n, e)
xarg *Yap_ArgList2ToVector(Term listl, const param2_t *def, int n);
extern xarg *Yap_ArgListToVector__(const char *file, const char *function, int lineno,Term listl, const param_t *def, int n,
yap_error_number e);
#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
/// @}

839
H/YapGFlagInfo.h
View File

File diff suppressed because it is too large Load Diff

70
H/YapHandles.h
View File

@ -16,7 +16,7 @@
#ifndef YAP_HANDLES_H
#define YAP_HANDLES_H 1
#include "Regs.h"
#include "inline-only.h"
#include "Yatom.h"
#define LOCAL_CurHandle LOCAL_CurSlot
@ -71,7 +71,7 @@ functions are then exported through corresponding FLI C-functions
#define Yap_RebootHandles(wid) Yap_RebootHandles__(wid PASS_REGS)
#define Yap_RebootSlots(wid) Yap_RebootHandles__(wid PASS_REGS)
static inline void Yap_RebootHandles__(int wid USES_REGS) {
INLINE_ONLY void Yap_RebootHandles__(int wid USES_REGS) {
// fprintf(stderr, " StartHandles = %ld", LOCAL_CurHandle);
REMOTE_CurHandle(wid) = 1;
}
@ -85,8 +85,8 @@ static inline void Yap_RebootHandles__(int wid USES_REGS) {
#define Yap_StartHandles() Yap_StartHandles__(PASS_REGS1)
#define Yap_StartSlots() Yap_StartHandles__(PASS_REGS1)
INLINE_ONLY inline EXTERN yhandle_t Yap_StartHandles__(USES_REGS1);
INLINE_ONLY inline EXTERN yhandle_t Yap_StartHandles__(USES_REGS1) {
INLINE_ONLY yhandle_t Yap_StartHandles__(USES_REGS1);
INLINE_ONLY yhandle_t Yap_StartHandles__(USES_REGS1) {
// // fprintf(stderr, " StartHandles = %ld", LOCAL_CurHandle);
// fprintf(stderr,"SS %s:%d\n", __FILE__, __LINE__);;
if (LOCAL_CurHandle < 0) {
@ -105,8 +105,8 @@ INLINE_ONLY inline EXTERN yhandle_t Yap_StartHandles__(USES_REGS1) {
#define Yap_CloseHandles(slot) Yap_CloseHandles__(slot PASS_REGS)
#define Yap_CloseSlots(slot) Yap_CloseHandles__(slot PASS_REGS)
INLINE_ONLY inline EXTERN void Yap_CloseHandles__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN void Yap_CloseHandles__(yhandle_t slot USES_REGS) {
INLINE_ONLY void Yap_CloseHandles__(yhandle_t slot USES_REGS);
INLINE_ONLY void Yap_CloseHandles__(yhandle_t slot USES_REGS) {
// fprintf(stderr,"CS %s:%d\n", __FILE__, __LINE__);
LOCAL_CurHandle = slot;
}
@ -116,8 +116,8 @@ INLINE_ONLY inline EXTERN void Yap_CloseHandles__(yhandle_t slot USES_REGS) {
/// @brief report the current position of the slots, assuming that they occupy
/// the top of the stack.
INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentHandle__(USES_REGS1);
INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentHandle__(USES_REGS1) {
INLINE_ONLY yhandle_t Yap_CurrentHandle__(USES_REGS1);
INLINE_ONLY yhandle_t Yap_CurrentHandle__(USES_REGS1) {
return LOCAL_CurHandle;
}
@ -125,8 +125,8 @@ INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentHandle__(USES_REGS1) {
#define Yap_GetFromSlot(slot) Yap_GetFromHandle__(slot PASS_REGS)
/// @brief read from a slot.
INLINE_ONLY inline EXTERN Term Yap_GetFromHandle__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN Term Yap_GetFromHandle__(yhandle_t slot USES_REGS) {
INLINE_ONLY Term Yap_GetFromHandle__(yhandle_t slot USES_REGS);
INLINE_ONLY Term Yap_GetFromHandle__(yhandle_t slot USES_REGS) {
// fprintf(stderr, "GS %s:%d\n", __FILE__, __LINE__);
return Deref(LOCAL_HandleBase[slot]);
}
@ -136,9 +136,9 @@ INLINE_ONLY inline EXTERN Term Yap_GetFromHandle__(yhandle_t slot USES_REGS) {
#define Yap_GetDerefedFromSlot(slot) Yap_GetDerefedFromHandle__(slot PASS_REGS)
/// @brief read from a slot. but does not try to dereference the slot.
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
Yap_GetDerefedFromHandle__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN Term
INLINE_ONLY Term
Yap_GetDerefedFromHandle__(yhandle_t slot USES_REGS) {
// fprintf(stderr,"GDS %s:%d\n", __FILE__, __LINE__);
return LOCAL_HandleBase[slot];
@ -148,9 +148,9 @@ Yap_GetDerefedFromHandle__(yhandle_t slot USES_REGS) {
#define Yap_GetPtrFromSlot(slot) Yap_GetPtrFromHandle__(slot PASS_REGS)
/// @brief read the object in a slot. but do not try to dereference the slot.
INLINE_ONLY inline EXTERN Term *
INLINE_ONLY Term *
Yap_GetPtrFromHandle__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN Term *
INLINE_ONLY Term *
Yap_GetPtrFromHandle__(yhandle_t slot USES_REGS) {
// fprintf(stderr,"GPS %s:%d\n", __FILE__, __LINE__);
return (Term *)LOCAL_HandleBase[slot];
@ -159,9 +159,9 @@ Yap_GetPtrFromHandle__(yhandle_t slot USES_REGS) {
#define Yap_AddressFromHandle(slot) Yap_AddressFromHandle__(slot PASS_REGS)
#define Yap_AddressFromSlot(slot) Yap_AddressFromHandle__(slot PASS_REGS)
INLINE_ONLY inline EXTERN CELL *
INLINE_ONLY CELL *
Yap_AddressFromHandle__(yhandle_t slot USES_REGS);
INLINE_ONLY inline EXTERN CELL *
INLINE_ONLY CELL *
Yap_AddressFromHandle__(yhandle_t slot USES_REGS) {
/// @brief get the memory address of a slot
@ -171,23 +171,23 @@ Yap_AddressFromHandle__(yhandle_t slot USES_REGS) {
#define Yap_PutInSlot(slot, t) Yap_PutInHandle__(slot, t PASS_REGS)
#define Yap_PutInHandle(slot, t) Yap_PutInHandle__(slot, t PASS_REGS)
/// @brief store term in a slot
INLINE_ONLY inline EXTERN void Yap_PutInHandle__(yhandle_t slot,
INLINE_ONLY void Yap_PutInHandle__(yhandle_t slot,
Term t USES_REGS);
INLINE_ONLY inline EXTERN void Yap_PutInHandle__(yhandle_t slot,
INLINE_ONLY void Yap_PutInHandle__(yhandle_t slot,
Term t USES_REGS) {
// fprintf(stderr,"PS %s:%d\n", __FILE__, __LINE__);
LOCAL_HandleBase[slot] = t;
}
#ifndef max
#define max(X, Y) (X > Y ? X : Y)
#ifndef Yap_Max
#define Yap_Max(X, Y) (X > Y ? X : Y)
#endif
#define ensure_handles ensure_slots
INLINE_ONLY inline EXTERN void ensure_slots(int N USES_REGS) {
INLINE_ONLY void ensure_slots(int N USES_REGS) {
if (LOCAL_CurHandle + N >= LOCAL_NHandles) {
size_t inc = max(16 * 1024, LOCAL_NHandles / 2); // measured in cells
inc = max(inc, (size_t)N + 16); // measured in cells
size_t inc = Yap_Max(16 * 1024, LOCAL_NHandles / 2); // measured in cells
inc = Yap_Max(inc, (size_t)N + 16); // measured in cells
LOCAL_HandleBase = (CELL *)realloc(LOCAL_HandleBase,
(inc + LOCAL_NHandles) * sizeof(CELL));
LOCAL_NHandles += inc;
@ -211,15 +211,17 @@ INLINE_ONLY inline EXTERN void ensure_slots(int N USES_REGS) {
#define Yap_PushHandle(t) Yap_InitHandle__(t PASS_REGS)
#define Yap_InitSlot(t) Yap_InitHandle__(t PASS_REGS)
INLINE_ONLY inline EXTERN yhandle_t Yap_InitHandle__(Term t USES_REGS);
INLINE_ONLY inline EXTERN yhandle_t Yap_InitHandle__(Term t USES_REGS) {
INLINE_ONLY yhandle_t Yap_InitHandle__(Term t USES_REGS);
INLINE_ONLY yhandle_t Yap_InitHandle__(Term t USES_REGS) {
yhandle_t old_slots = LOCAL_CurHandle;
ensure_slots(1 PASS_REGS);
if (IsVarTerm(t) && (H0 > (CELL*)t || (CELL*)t > HR)) {
RESET_VARIABLE(HR);
Yap_unify(t,(CELL)HR); t = (CELL)HR++;
}
if (t==0) {
t = MkVarTerm();
} else if (IsVarTerm(t) ) {
Term tg = MkVarTerm();
Bind_Global( VarOfTerm(t), tg);
}
LOCAL_HandleBase[old_slots] = t;
LOCAL_CurHandle++;
return old_slots;
@ -231,8 +233,8 @@ INLINE_ONLY inline EXTERN yhandle_t Yap_InitHandle__(Term t USES_REGS) {
#define Yap_NewHandles(n) Yap_NewHandles__(n PASS_REGS)
#define Yap_NewSlots(n) Yap_NewHandles__(n PASS_REGS)
INLINE_ONLY inline EXTERN yhandle_t Yap_NewHandles__(int n USES_REGS);
INLINE_ONLY inline EXTERN yhandle_t Yap_NewHandles__(int n USES_REGS) {
INLINE_ONLY yhandle_t Yap_NewHandles__(int n USES_REGS);
INLINE_ONLY yhandle_t Yap_NewHandles__(int n USES_REGS) {
yhandle_t old_slots = LOCAL_CurHandle;
int i;
// fprintf(stderr, "NS %s:%d\n", __FILE__, __LINE__);
@ -254,9 +256,9 @@ INLINE_ONLY inline EXTERN yhandle_t Yap_NewHandles__(int n USES_REGS) {
#define Yap_InitSlots(n, ts) Yap_InitHandles__(n, ts PASS_REGS)
/// @brief create n new slots with terms ts[]
INLINE_ONLY inline EXTERN yhandle_t Yap_InitHandles__(int n,
INLINE_ONLY yhandle_t Yap_InitHandles__(int n,
Term *ts USES_REGS);
INLINE_ONLY inline EXTERN yhandle_t Yap_InitHandles__(int n,
INLINE_ONLY yhandle_t Yap_InitHandles__(int n,
Term *ts USES_REGS) {
yhandle_t old_slots = LOCAL_CurHandle;
int i;
@ -283,7 +285,7 @@ static inline bool Yap_RecoverHandles__(int n, yhandle_t topHandle USES_REGS) {
return false;
}
#endif
LOCAL_CurHandle -= n;
LOCAL_CurHandle = topHandle;
// fprintf(stderr,"RS %ld %s:%d\n", LOCAL_CurHandle, __FILE__, __LINE__);
return true;
}

55
H/YapHeap.h
View File

@ -18,6 +18,9 @@
#ifndef HEAP_H
#define HEAP_H 1
#include "Atoms.h"
#include "Yap.h"
#if LOW_PROF
#include <stdio.h>
#endif
@ -31,24 +34,6 @@ typedef int (*SWI_FlushFunction)(void *);
typedef int (*SWI_PLGetStreamFunction)(void *);
typedef int (*SWI_PLGetStreamPositionFunction)(void *);
typedef int (*Opaque_CallOnFail)(void *);
typedef int (*Opaque_CallOnWrite)(FILE *, int, void *, int);
typedef Int (*Opaque_CallOnGCMark)(int, void *, Term *, Int);
typedef int (*Opaque_CallOnGCRelocate)(int, void *, Term *, Int);
typedef struct opaque_handler_struct {
Opaque_CallOnFail fail_handler;
Opaque_CallOnWrite write_handler;
Opaque_CallOnGCMark gc_mark_handler;
Opaque_CallOnGCRelocate gc_relocate_handler;
} opaque_handler_t;
extern Opaque_CallOnWrite Yap_blob_write_handler_from_slot(Int slot);
extern Opaque_CallOnGCMark Yap_blob_gc_mark_handler(Term t);
extern Opaque_CallOnGCRelocate Yap_blob_gc_relocate_handler(Term t);
extern Int Yap_blob_tag_from_slot(Int slot);
extern void *Yap_blob_info_from_slot(Int slot);
#ifndef INT_KEYS_DEFAULT_SIZE
#define INT_KEYS_DEFAULT_SIZE 256
#endif
@ -171,10 +156,10 @@ typedef struct various_codes {
} all_heap_codes;
#include "hglobals.h"
#include "generated/hglobals.h"
#include "dhstruct.h"
#include "dglobals.h"
#include "generated/dhstruct.h"
#include "generated/dglobals.h"
#else
typedef struct various_codes {
/* memory allocation and management */
@ -184,17 +169,15 @@ typedef struct various_codes {
} all_heap_codes;
#include "tatoms.h"
#include "generated/tatoms.h"
#include "h0struct.h"
#include "generated/h0struct.h"
#include "h0globals.h"
#include "generated/h0globals.h"
#endif
#include "hlocals.h"
#include "generated/hlocals.h"
#include "dlocals.h"
@ -231,7 +214,13 @@ extern struct various_codes *Yap_heap_regs;
*/
static inline yamop *gc_P(yamop *p, yamop *cp) {
return (p && p->opc == EXECUTE_CPRED_OPCODE ? cp : p);
yamop *n= (p && p->opc == EXECUTE_CPRED_OPCODE ? cp : p);
if (p->opc == Yap_opcode(_try_c) ||
p->opc == Yap_opcode(_try_userc) ||
p->opc == Yap_opcode(_retry_c) ||
p->opc == Yap_opcode(_retry_userc))
return cp;
return n;
}
/**
@ -241,9 +230,9 @@ static inline yamop *gc_P(yamop *p, yamop *cp) {
#define Yap_CurrentModule() Yap_CurrentModule__(PASS_REGS1)
INLINE_ONLY inline EXTERN Term Yap_CurrentModule__(USES_REGS1);
INLINE_ONLY Term Yap_CurrentModule__(USES_REGS1);
INLINE_ONLY inline EXTERN Term Yap_CurrentModule__(USES_REGS1) {
INLINE_ONLY Term Yap_CurrentModule__(USES_REGS1) {
if (CurrentModule)
return CurrentModule;
return TermProlog;
@ -270,11 +259,11 @@ extern ADDR Yap_ExpandPreAllocCodeSpace(UInt, void *, int);
extern ADDR Yap_InitPreAllocCodeSpace(int);
#include "inline-only.h"
INLINE_ONLY EXTERN inline ADDR Yap_PreAllocCodeSpace(void);
INLINE_ONLY ADDR Yap_PreAllocCodeSpace(void);
INLINE_ONLY EXTERN inline ADDR Yap_PreAllocCodeSpace(void) {
INLINE_ONLY ADDR Yap_PreAllocCodeSpace(void) {
CACHE_REGS
return AuxBase;
return AuxBase;
}
#endif /* HEAP_H */

175
H/YapLFlagInfo.h
View File

@ -1,91 +1,114 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- *
* *
**************************************************************************
* *
* File: YapLFlagInfo.h *
* Last rev: *
* mods: *
* comments: local flag enumeration. *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- *
* *
**************************************************************************
* *
* File: YapLFlagInfo.h * Last rev:
** mods: * comments: local flag enumeration. *
* *
*************************************************************************/
/** @file YapLFlagInfo.h
@addtogroup Flags
@addtogroup YAPFlags
@ingroup builtins
@{
@enum THREAD_LOCAL_FLAGS Local Flags supported by YAP
@brief local flags and their values.
*/
YAP_FLAG( AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false" , NULL ),
YAP_FLAG( BREAK_LEVEL_FLAG, "break_level", true, nat, "0" , NULL ),
YAP_FLAG( CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true" , NULL ), /** + `call_counting`
START_LOCAL_FLAGS
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 counters are available:
/** + `autoload`: set the system to look for undefined procedures */
YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL),
calls: number of predicate calls since execution started or since system was reset;
retries: number of retries for predicates called since execution started or since counters were reset;
calls_and_retries: count both on predicate calls and retries.
These counters can be used to find out how many calls a certain goal takes to execute. They can also be force the computatiom yp
stopping.
/** + `read-only flag, that tells if Prolog is in an inner top-level */
YAP_FLAG(BREAK_LEVEL_FLAG, "break_level", true, nat, "0", 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`
/** + `call_counting`
If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled.
*/
YAP_FLAG( LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap" , NULL ), /** + `language_mode`
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
counters are available:
wweter native mode or trying to emulate a different Prolog.
*/
YAP_FLAG( REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, booleanFlag, "true" , NULL ), /** + `redefine_warnings `
calls: number of predicate calls since execution started or
since system was reset; retries: number of retries for predicates
called since execution started or since counters were reset;
calls_and_retries: count both on predicate calls and
retries. These counters can be used to find out how many calls a
certain goal takes to execute. They can also be force the
computatiom yp stopping.
If _Value_ is unbound, tell whether warnings for procedures defined
in several different files are `on` or
`off`. If _Value_ is bound to `on` enable these warnings,
and if it is bound to `off` disable them. The default for YAP is
`off`, unless we are in `sicstus` or `iso` mode.
If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled.
*/
YAP_FLAG(CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true",
NULL),
/** + support for coding systens, YAP relies on UTF-8 internally.
*/
YAP_FLAG( SINGLE_VAR_WARNINGS_FLAG, "single_var_warnings", true, booleanFlag, "true" , NULL ), /** + `single_var_warnings`
If `true` (default `true`) YAP checks for singleton variables when loading files. A singleton variable is a variable that appears ony once in a clause. The name must start with a capital letter, variables whose name starts with underscore are never considered singleton.
YAP_FLAG(ENCODING_FLAG, "encoding", true, isatom, "utf-8", getenc),
*/
YAP_FLAG( STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, booleanFlag, "false" , NULL ), /** + `stack_dump_on_error `
/** + what to do if opening a file fails.
If `true` show a stack dump when YAP finds an error. The default is
*/
YAP_FLAG(FILEERRORS_FLAG, "fileerrors", true, booleanFlag, "true",
NULL), /** + `fileerrors`
If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled.
*/
/** + `language_mode`
wweter 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), /** + `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" , NULL ),
YAP_FLAG( SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error" , NULL ), /** + `syntax_errors`
*/
YAP_FLAG(STREAM_TYPE_CHECK_FLAG, "stream_type_check", true, isatom, "loose",
NULL),
YAP_FLAG(SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error",
NULL), /** + `syntax_errors`
Control action to be taken after syntax errors while executing read/1,
Control action to be taken after syntax errors while executing read/1,
`read/2`, or `read_term/3`:
+ `dec10`
+ `dec10`
Report the syntax error and retry reading the term.
+ `fail`
+ `fail`
Report the syntax error and fail.
+ `error`
+ `error`
Report the syntax error and generate an error (default).
+ `quiet`
+ `quiet`
Just fail
*/
YAP_FLAG( TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user" , typein ), /** + `typein_module `
*/
YAP_FLAG(TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user",
typein), /** + `typein_module `
If bound, set the current working or type-in module to the argument,
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(USER_ERROR_FLAG, "user_error", true, stream, "user_error",
set_error_stream), /** + `user_error1`
If the second argument is bound to a stream, set user_error to
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
the current user_error stream.
By default, the user_error stream is set to a stream
@ -93,26 +116,32 @@ corresponding to the Unix `stderr` stream.
The next example shows how to use this flag:
~~~{.prolog}
?- open( '/dev/null', append, Error,
[alias(mauri_tripa)] ).
?- open( '/dev/null', append, Error,
[alias(mauri_tripa)] ).
Error = '$stream'(3) ? ;
Error = '$stream'(3) ? ;
no
?- set_prolog_flag(user_error, mauri_tripa).
no
?- set_prolog_flag(user_error, mauri_tripa).
close(mauri_tripa).
close(mauri_tripa).
yes
?-
yes
?-
~~~
We execute three commands. First, we open a stream in write mode and
We execute three commands. First, we open a stream in write mode and
give it an alias, in this case `mauri_tripa`. Next, we set
user_error to the stream via the alias. Note that after we did so
prompts from the system were redirected to the stream
`mauri_tripa`. Last, we close the stream. At this point, YAP
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_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
/// @}

296
H/YapOpcodes.h
View File

@ -6,6 +6,26 @@
OPCODE(Nstop ,e),
#ifdef YAP_JIT
OPCODE(jit_handler ,J),
#endif
OPCODE(cut ,s),
OPCODE(cut_t ,s),
OPCODE(cut_e ,s),
OPCODE(save_b_x ,x),
OPCODE(save_b_y ,y),
OPCODE(commit_b_x ,xps),
OPCODE(commit_b_y ,yps),
OPCODE(execute ,Osbpp),
OPCODE(dexecute ,Osbpp),
OPCODE(fcall ,Osbpp),
OPCODE(call ,Osbpp),
OPCODE(procceed ,p),
OPCODE(allocate ,e),
OPCODE(deallocate ,p),
#ifdef BEAM
OPCODE(retry_eam ,e),
#endif
#ifdef BEAM
OPCODE(run_eam ,os),
#endif
OPCODE(try_me ,Otapl),
OPCODE(retry_me ,Otapl),
@ -43,6 +63,44 @@
OPCODE(retry4 ,l),
OPCODE(trust ,Otapl),
OPCODE(try_in ,l),
OPCODE(trust_fail ,e),
OPCODE(op_fail ,e),
OPCODE(call_cpred ,Osbpp),
OPCODE(execute_cpred ,Osbpp),
OPCODE(call_usercpred ,Osbpp),
OPCODE(call_c_wfail ,slpp),
OPCODE(try_c ,OtapFs),
OPCODE(retry_c ,OtapFs),
OPCODE(cut_c ,OtapFs),
OPCODE(try_userc ,OtapFs),
OPCODE(retry_userc ,OtapFs),
OPCODE(cut_userc ,OtapFs),
OPCODE(lock_pred ,e),
OPCODE(index_pred ,e),
#ifdef THREADS
OPCODE(thread_local ,e),
#endif
OPCODE(expand_index ,e),
OPCODE(expand_clauses ,sssllp),
OPCODE(undef_p ,e),
OPCODE(spy_pred ,e),
OPCODE(user_switch ,lp),
OPCODE(switch_on_type ,llll),
OPCODE(switch_list_nl ,ollll),
OPCODE(switch_on_arg_type ,xllll),
OPCODE(switch_on_sub_arg_type ,sllll),
OPCODE(jump_if_var ,l),
OPCODE(jump_if_nonvar ,xll),
OPCODE(if_not_then ,clll),
OPCODE(switch_on_func ,sssl),
OPCODE(switch_on_cons ,sssl),
OPCODE(go_on_func ,sssl),
OPCODE(go_on_cons ,sssl),
OPCODE(if_func ,sssl),
OPCODE(if_cons ,sssl),
OPCODE(index_dbref ,e),
OPCODE(index_blob ,e),
OPCODE(index_long ,e),
OPCODE(enter_lu_pred ,Illss),
OPCODE(profiled_retry_logical ,OtaLl),
OPCODE(profiled_trust_logical ,OtILl),
@ -56,28 +114,94 @@
OPCODE(alloc_for_logical_pred ,L),
OPCODE(copy_idb_term ,e),
OPCODE(unify_idb_term ,e),
OPCODE(trust_fail ,e),
OPCODE(op_fail ,e),
OPCODE(cut ,s),
OPCODE(cut_t ,s),
OPCODE(cut_e ,s),
OPCODE(save_b_x ,x),
OPCODE(save_b_y ,y),
OPCODE(commit_b_x ,xps),
OPCODE(commit_b_y ,yps),
OPCODE(execute ,pp),
OPCODE(dexecute ,pp),
OPCODE(fcall ,Osbpp),
OPCODE(call ,Osbpp),
OPCODE(procceed ,p),
OPCODE(allocate ,e),
OPCODE(deallocate ,p),
#ifdef BEAM
OPCODE(retry_eam ,e),
#endif
#ifdef BEAM
OPCODE(run_eam ,os),
#endif
OPCODE(p_execute_tail ,Osbmp),
OPCODE(p_execute2 ,Osbpp),
OPCODE(p_execute ,Osbmp),
OPCODE(jump ,l),
OPCODE(move_back ,l),
OPCODE(skip ,l),
OPCODE(either ,Osblp),
OPCODE(or_else ,Osblp),
OPCODE(pop_n ,s),
OPCODE(pop ,e),
OPCODE(p_plus_vv ,xxx),
OPCODE(p_plus_vc ,xxn),
OPCODE(p_plus_y_vv ,yxx),
OPCODE(p_plus_y_vc ,yxn),
OPCODE(p_minus_vv ,xxx),
OPCODE(p_minus_cv ,xxn),
OPCODE(p_minus_y_vv ,yxx),
OPCODE(p_minus_y_cv ,yxn),
OPCODE(p_times_vv ,xxx),
OPCODE(p_times_vc ,xxn),
OPCODE(p_times_y_vv ,yxx),
OPCODE(p_times_y_vc ,yxn),
OPCODE(p_div_vv ,xxx),
OPCODE(p_div_vc ,xxn),
OPCODE(p_div_cv ,xxn),
OPCODE(p_div_y_vv ,yxx),
OPCODE(p_div_y_vc ,yxn),
OPCODE(p_div_y_cv ,yxn),
OPCODE(p_and_vv ,xxx),
OPCODE(p_and_vc ,xxn),
OPCODE(p_and_y_vv ,yxx),
OPCODE(p_and_y_vc ,yxn),
OPCODE(p_or_vv ,xxx),
OPCODE(p_or_vc ,xxn),
OPCODE(p_or_y_vv ,yxx),
OPCODE(p_or_y_vc ,yxn),
OPCODE(p_sll_vv ,xxx),
OPCODE(p_sll_vc ,xxn),
OPCODE(p_sll_cv ,xxn),
OPCODE(p_sll_y_vv ,yxx),
OPCODE(p_sll_y_vc ,yxn),
OPCODE(p_sll_y_cv ,yxn),
OPCODE(p_slr_vv ,xxx),
OPCODE(p_slr_vc ,xxn),
OPCODE(p_slr_cv ,xxn),
OPCODE(p_slr_y_vv ,yxx),
OPCODE(p_slr_y_vc ,yxn),
OPCODE(p_slr_y_cv ,yxn),
OPCODE(call_bfunc_xx ,plxxs),
OPCODE(call_bfunc_yx ,plxys),
OPCODE(call_bfunc_xy ,plxys),
OPCODE(call_bfunc_yy ,plyys),
OPCODE(p_equal ,e),
OPCODE(p_arg_vv ,xxx),
OPCODE(p_arg_cv ,xxn),
OPCODE(p_arg_y_vv ,yxx),
OPCODE(p_arg_y_cv ,yxn),
OPCODE(p_func2s_vv ,xxx),
OPCODE(p_func2s_cv ,xxc),
OPCODE(p_func2s_vc ,xxn),
OPCODE(p_func2s_y_vv ,yxx),
OPCODE(p_func2s_y_cv ,yxc),
OPCODE(p_func2s_y_vc ,yxn),
OPCODE(p_func2f_xx ,xxx),
OPCODE(p_func2f_xy ,xxy),
OPCODE(p_func2f_yx ,yxx),
OPCODE(p_func2f_yy ,yyx),
OPCODE(p_functor ,e),
OPCODE(p_atom_x ,xl),
OPCODE(p_atom_y ,yl),
OPCODE(p_atomic_x ,xl),
OPCODE(p_atomic_y ,yl),
OPCODE(p_integer_x ,xl),
OPCODE(p_integer_y ,yl),
OPCODE(p_nonvar_x ,xl),
OPCODE(p_nonvar_y ,yl),
OPCODE(p_number_x ,xl),
OPCODE(p_number_y ,yl),
OPCODE(p_var_x ,xl),
OPCODE(p_var_y ,yl),
OPCODE(p_db_ref_x ,xl),
OPCODE(p_db_ref_y ,yl),
OPCODE(p_primitive_x ,xl),
OPCODE(p_primitive_y ,yl),
OPCODE(p_compound_x ,xl),
OPCODE(p_compound_y ,yl),
OPCODE(p_float_x ,xl),
OPCODE(p_float_y ,yl),
OPCODE(get_x_var ,xx),
OPCODE(get_y_var ,yx),
OPCODE(get_yy_var ,yyxx),
@ -207,134 +331,6 @@
OPCODE(save_appl_x_write ,ox),
OPCODE(save_appl_y ,oy),
OPCODE(save_appl_y_write ,oy),
OPCODE(call_cpred ,Osbpp),
OPCODE(execute_cpred ,pp),
OPCODE(call_usercpred ,Osbpp),
OPCODE(call_c_wfail ,slpp),
OPCODE(try_c ,OtapFs),
OPCODE(retry_c ,OtapFs),
OPCODE(cut_c ,OtapFs),
OPCODE(try_userc ,OtapFs),
OPCODE(retry_userc ,OtapFs),
OPCODE(cut_userc ,OtapFs),
OPCODE(lock_pred ,e),
OPCODE(index_pred ,e),
#ifdef THREADS
OPCODE(thread_local ,e),
#endif
OPCODE(expand_index ,e),
OPCODE(expand_clauses ,sssllp),
OPCODE(undef_p ,e),
OPCODE(spy_pred ,e),
OPCODE(jump ,l),
OPCODE(move_back ,l),
OPCODE(skip ,l),
OPCODE(either ,Osblp),
OPCODE(or_else ,Osblp),
OPCODE(pop_n ,s),
OPCODE(pop ,e),
OPCODE(user_switch ,lp),
OPCODE(switch_on_type ,llll),
OPCODE(switch_list_nl ,ollll),
OPCODE(switch_on_arg_type ,xllll),
OPCODE(switch_on_sub_arg_type ,sllll),
OPCODE(jump_if_var ,l),
OPCODE(jump_if_nonvar ,xll),
OPCODE(if_not_then ,clll),
OPCODE(switch_on_func ,sssl),
OPCODE(switch_on_cons ,sssl),
OPCODE(go_on_func ,sssl),
OPCODE(go_on_cons ,sssl),
OPCODE(if_func ,sssl),
OPCODE(if_cons ,sssl),
OPCODE(index_dbref ,e),
OPCODE(index_blob ,e),
OPCODE(index_long ,e),
OPCODE(p_atom_x ,xl),
OPCODE(p_atom_y ,yl),
OPCODE(p_atomic_x ,xl),
OPCODE(p_atomic_y ,yl),
OPCODE(p_integer_x ,xl),
OPCODE(p_integer_y ,yl),
OPCODE(p_nonvar_x ,xl),
OPCODE(p_nonvar_y ,yl),
OPCODE(p_number_x ,xl),
OPCODE(p_number_y ,yl),
OPCODE(p_var_x ,xl),
OPCODE(p_var_y ,yl),
OPCODE(p_db_ref_x ,xl),
OPCODE(p_db_ref_y ,yl),
OPCODE(p_primitive_x ,xl),
OPCODE(p_primitive_y ,yl),
OPCODE(p_compound_x ,xl),
OPCODE(p_compound_y ,yl),
OPCODE(p_float_x ,xl),
OPCODE(p_float_y ,yl),
OPCODE(p_plus_vv ,xxx),
OPCODE(p_plus_vc ,xxn),
OPCODE(p_plus_y_vv ,yxx),
OPCODE(p_plus_y_vc ,yxn),
OPCODE(p_minus_vv ,xxx),
OPCODE(p_minus_cv ,xxn),
OPCODE(p_minus_y_vv ,yxx),
OPCODE(p_minus_y_cv ,yxn),
OPCODE(p_times_vv ,xxx),
OPCODE(p_times_vc ,xxn),
OPCODE(p_times_y_vv ,yxx),
OPCODE(p_times_y_vc ,yxn),
OPCODE(p_div_vv ,xxx),
OPCODE(p_div_vc ,xxn),
OPCODE(p_div_cv ,xxn),
OPCODE(p_div_y_vv ,yxx),
OPCODE(p_div_y_vc ,yxn),
OPCODE(p_div_y_cv ,yxn),
OPCODE(p_and_vv ,xxx),
OPCODE(p_and_vc ,xxn),
OPCODE(p_and_y_vv ,yxx),
OPCODE(p_and_y_vc ,yxn),
OPCODE(p_or_vv ,xxx),
OPCODE(p_or_vc ,xxn),
OPCODE(p_or_y_vv ,yxx),
OPCODE(p_or_y_vc ,yxn),
OPCODE(p_sll_vv ,xxx),
OPCODE(p_sll_vc ,xxn),
OPCODE(p_sll_cv ,xxn),
OPCODE(p_sll_y_vv ,yxx),
OPCODE(p_sll_y_vc ,yxn),
OPCODE(p_sll_y_cv ,yxn),
OPCODE(p_slr_vv ,xxx),
OPCODE(p_slr_vc ,xxn),
OPCODE(p_slr_cv ,xxn),
OPCODE(p_slr_y_vv ,yxx),
OPCODE(p_slr_y_vc ,yxn),
OPCODE(p_slr_y_cv ,yxn),
OPCODE(call_bfunc_xx ,plxxs),
OPCODE(call_bfunc_yx ,plxys),
OPCODE(call_bfunc_xy ,plxys),
OPCODE(call_bfunc_yy ,plyys),
OPCODE(p_equal ,e),
#if INLINE_BIG_COMPARISONS
OPCODE(p_dif ,l),
OPCODE(p_eq ,l),
#endif
OPCODE(p_arg_vv ,xxx),
OPCODE(p_arg_cv ,xxn),
OPCODE(p_arg_y_vv ,yxx),
OPCODE(p_arg_y_cv ,yxn),
OPCODE(p_func2s_vv ,xxx),
OPCODE(p_func2s_cv ,xxc),
OPCODE(p_func2s_vc ,xxn),
OPCODE(p_func2s_y_vv ,yxx),
OPCODE(p_func2s_y_cv ,yxc),
OPCODE(p_func2s_y_vc ,yxn),
OPCODE(p_func2f_xx ,xxx),
OPCODE(p_func2f_xy ,xxy),
OPCODE(p_func2f_yx ,yxx),
OPCODE(p_func2f_yy ,yyx),
OPCODE(p_functor ,e),
OPCODE(p_execute_tail ,Osbmp),
OPCODE(p_execute2 ,Osbpp),
OPCODE(p_execute ,Osbmp),
#ifdef YAPOR
OPCODE(getwork_first_time ,e),
OPCODE(getwork ,Otapl),

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