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

Merge branch 'master' of git.dcc.fc.up.pt:yap-6.3

Browse Source
This commit is contained in:
Vitor Santos Costa 2014-02-22 22:57:01 +00:00
commit d9fce3935b
272 changed files with 28065 additions and 10796 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitmodules vendored
View File

@ -36,7 +36,7 @@
url = git://git.code.sf.net/p/yap/pldoc url = git://git.code.sf.net/p/yap/pldoc
[submodule "packages/real"] [submodule "packages/real"]
path = packages/real path = packages/real
url = git://www.swi-prolog.org/home/pl/git/packages/real.git url = git://git.code.sf.net/p/yap/real
[submodule "packages/archive"] [submodule "packages/archive"]
path = packages/archive path = packages/archive
url = git://git.code.sf.net/p/yap/archive url = git://git.code.sf.net/p/yap/archive
@ -51,4 +51,4 @@
url = git://git.code.sf.net/p/yap/ltx2htm url = git://git.code.sf.net/p/yap/ltx2htm
[submodule "packages/raptor"] [submodule "packages/raptor"]
path = packages/raptor path = packages/raptor
url = https://github.com/davidvaz/yap-raptor.git url = git://git.code.sf.net/p/yap/raptor

2010
C/absmi.c
View File

File diff suppressed because it is too large Load Diff

302
C/adtdefs.c
View File

@ -30,6 +30,7 @@ static Prop PredPropByFunc(Functor, Term);
static Prop PredPropByAtom(Atom, Term); static Prop PredPropByAtom(Atom, Term);
#include "Yatom.h" #include "Yatom.h"
#include "yapio.h" #include "yapio.h"
#include "pl-shared.h"
#include <stdio.h> #include <stdio.h>
#include <wchar.h> #include <wchar.h>
#if HAVE_STRING_H #if HAVE_STRING_H
@ -301,45 +302,61 @@ Yap_LookupMaybeWideAtom(wchar_t *atom)
} }
Atom Atom
Yap_LookupMaybeWideAtomWithLength(wchar_t *atom, size_t len) Yap_LookupMaybeWideAtomWithLength(wchar_t *atom, size_t len0)
{ /* lookup atom in atom table */ { /* lookup atom in atom table */
wchar_t *p = atom, c; wchar_t *p = atom, c;
size_t len0 = 0; size_t len = 0;
Atom at; Atom at;
int wide = FALSE; int wide = FALSE;
while ((c = *p++)) { while ((c = *p++)) {
if (c > 255) wide = TRUE; if (c > 255) wide = TRUE;
len0++; len++;
if (len0 == len) break; if (len == len0) break;
} }
if (p[0] == '\0' && wide) return LookupWideAtom(atom); if (wide) {
else if (wide) { wchar_t *ptr0;
wchar_t *ptr, *ptr0; ptr0 = (wchar_t *)Yap_AllocCodeSpace(sizeof(wchar_t)*(len0+1));
p = atom; if (!ptr0)
ptr0 = ptr = (wchar_t *)Yap_AllocCodeSpace(sizeof(wchar_t)*(len+1));
if (!ptr)
return NIL; return NIL;
while (len--) {*ptr++ = *p++;} memcpy(ptr0, atom, len0*sizeof(wchar_t));
ptr[0] = '\0'; ptr0[len0] = '\0';
at = LookupWideAtom(ptr0); at = LookupWideAtom(ptr0);
Yap_FreeCodeSpace((char *)ptr0); Yap_FreeCodeSpace((char *)ptr0);
return at; return at;
} else { } else {
char *ptr, *ptr0; char *ptr0;
/* not really a wide atom */ Int i;
p = atom; ptr0 = (char *)Yap_AllocCodeSpace((len0+1));
ptr0 = ptr = Yap_AllocCodeSpace(len+1); if (!ptr0)
if (!ptr)
return NIL; return NIL;
while (len--) {*ptr++ = *p++;} for (i=0; i < len0; i++) ptr0[i] = atom[i];
ptr[0] = '\0'; ptr0[len0] = '\0';
at = LookupAtom(ptr0); at = LookupAtom(ptr0);
Yap_FreeCodeSpace(ptr0); Yap_FreeCodeSpace(ptr0);
return at; return at;
} }
} }
Atom
Yap_LookupAtomWithLength(char *atom, size_t len0)
{ /* lookup atom in atom table */
char *p = atom;
Atom at;
char *ptr, *ptr0;
size_t len = 0;
/* not really a wide atom */
p = atom;
ptr0 = ptr = Yap_AllocCodeSpace(len0+1);
if (!ptr)
return NIL;
while (len++ < len0) {int ch = *ptr++ = *p++; if (ch == '\0') break;}
ptr[0] = '\0';
at = LookupAtom(ptr0);
Yap_FreeCodeSpace(ptr0);
return at;
}
Atom Atom
Yap_LookupAtom(char *atom) Yap_LookupAtom(char *atom)
{ /* lookup atom in atom table */ { /* lookup atom in atom table */
@ -770,7 +787,7 @@ ExpandPredHash(void)
/* fe is supposed to be locked */ /* fe is supposed to be locked */
Prop Prop
Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod) Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
{ { GET_LD
PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p)); PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
if (p == NULL) { if (p == NULL) {
@ -821,6 +838,9 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL; p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
p->cs.p_code.NOfClauses = 0; p->cs.p_code.NOfClauses = 0;
p->PredFlags = 0L; p->PredFlags = 0L;
#if SIZEOF_INT_P==4
p->ExtraPredFlags = 0L;
#endif
p->src.OwnerFile = AtomNil; p->src.OwnerFile = AtomNil;
p->OpcodeOfPred = UNDEF_OPCODE; p->OpcodeOfPred = UNDEF_OPCODE;
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
@ -849,6 +869,9 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
p->PredFlags |= GoalExPredFlag; p->PredFlags |= GoalExPredFlag;
} }
} }
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
p->ExtraPredFlags |= NoDebugPredFlag;
}
p->FunctorOfPred = fe; p->FunctorOfPred = fe;
WRITE_UNLOCK(fe->FRWLock); WRITE_UNLOCK(fe->FRWLock);
{ {
@ -863,7 +886,7 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
#if THREADS #if THREADS
Prop Prop
Yap_NewThreadPred(PredEntry *ap USES_REGS) Yap_NewThreadPred(PredEntry *ap USES_REGS)
{ { LD_FROM_REGS
PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p)); PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
if (p == NULL) { if (p == NULL) {
@ -875,6 +898,9 @@ Yap_NewThreadPred(PredEntry *ap USES_REGS)
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL; p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
p->cs.p_code.NOfClauses = 0; p->cs.p_code.NOfClauses = 0;
p->PredFlags = ap->PredFlags & ~(IndexedPredFlag|SpiedPredFlag); p->PredFlags = ap->PredFlags & ~(IndexedPredFlag|SpiedPredFlag);
#if SIZEOF_INT_P==4
p->ExtraPredFlags = 0L;
#endif
p->src.OwnerFile = ap->src.OwnerFile; p->src.OwnerFile = ap->src.OwnerFile;
p->OpcodeOfPred = UNDEF_OPCODE; p->OpcodeOfPred = UNDEF_OPCODE;
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
@ -898,6 +924,9 @@ Yap_NewThreadPred(PredEntry *ap USES_REGS)
LOCAL_ThreadHandle.local_preds = p; LOCAL_ThreadHandle.local_preds = p;
p->FunctorOfPred = ap->FunctorOfPred; p->FunctorOfPred = ap->FunctorOfPred;
Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_THREAD); Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_THREAD);
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
p->ExtraPredFlags |= NoDebugPredFlag;
}
if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) { if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), &(p->cs.p_code.ExpandCode)+1, p, GPROF_NEW_PRED_THREAD); Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), &(p->cs.p_code.ExpandCode)+1, p, GPROF_NEW_PRED_THREAD);
} }
@ -907,7 +936,7 @@ Yap_NewThreadPred(PredEntry *ap USES_REGS)
Prop Prop
Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod) Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
{ { GET_LD
Prop p0; Prop p0;
PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p)); PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
@ -923,6 +952,9 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL; p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
p->cs.p_code.NOfClauses = 0; p->cs.p_code.NOfClauses = 0;
p->PredFlags = 0L; p->PredFlags = 0L;
#if SIZEOF_INT_P==4
p->ExtraPredFlags = 0L;
#endif
p->src.OwnerFile = AtomNil; p->src.OwnerFile = AtomNil;
p->OpcodeOfPred = UNDEF_OPCODE; p->OpcodeOfPred = UNDEF_OPCODE;
p->cs.p_code.ExpandCode = EXPAND_OP_CODE; p->cs.p_code.ExpandCode = EXPAND_OP_CODE;
@ -963,6 +995,9 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
AddPropToAtom(ae, (PropEntry *)p); AddPropToAtom(ae, (PropEntry *)p);
p0 = AbsPredProp(p); p0 = AbsPredProp(p);
p->FunctorOfPred = (Functor)AbsAtom(ae); p->FunctorOfPred = (Functor)AbsAtom(ae);
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
p->ExtraPredFlags |= NoDebugPredFlag;
}
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
{ {
Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_ATOM); Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_ATOM);
@ -1060,6 +1095,9 @@ Yap_GetValue(Atom a)
} else if (f == FunctorLongInt) { } else if (f == FunctorLongInt) {
CACHE_REGS CACHE_REGS
out = MkLongIntTerm(LongIntOfTerm(out)); out = MkLongIntTerm(LongIntOfTerm(out));
} else if (f == FunctorString) {
CACHE_REGS
out = MkStringTerm(StringOfTerm(out));
} }
#ifdef USE_GMP #ifdef USE_GMP
else { else {
@ -1167,6 +1205,21 @@ Yap_PutValue(Atom a, Term v)
memcpy((void *)pt, (void *)ap, sz); memcpy((void *)pt, (void *)ap, sz);
p->ValueOfVE = AbsAppl(pt); p->ValueOfVE = AbsAppl(pt);
#endif #endif
} else if (IsStringTerm(v)) {
CELL *ap = RepAppl(v);
Int sz =
sizeof(CELL)*(3+ap[1]);
CELL *pt = (CELL *) Yap_AllocAtomSpace(sz);
if (pt == NULL) {
WRITE_UNLOCK(ae->ARWLock);
return;
}
if (IsApplTerm(t0)) {
Yap_FreeCodeSpace((char *) RepAppl(t0));
}
memcpy((void *)pt, (void *)ap, sz);
p->ValueOfVE = AbsAppl(pt);
} else { } else {
if (IsApplTerm(t0)) { if (IsApplTerm(t0)) {
/* recover space */ /* recover space */
@ -1201,209 +1254,6 @@ Yap_PutAtomTranslation(Atom a, Int i)
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
} }
Term
Yap_StringToList(char *s)
{
CACHE_REGS
register Term t;
register unsigned char *cp = (unsigned char *)s + strlen(s);
t = MkAtomTerm(AtomNil);
while (cp > (unsigned char *)s) {
t = MkPairTerm(MkIntTerm(*--cp), t);
}
return (t);
}
Term
Yap_NStringToList(char *s, size_t len)
{
CACHE_REGS
Term t;
unsigned char *cp = (unsigned char *)s + len;
t = MkAtomTerm(AtomNil);
while (cp > (unsigned char *)s) {
t = MkPairTerm(MkIntegerTerm(*--cp), t);
}
return t;
}
Term
Yap_WideStringToList(wchar_t *s)
{
CACHE_REGS
Term t;
wchar_t *cp = s + wcslen(s);
t = MkAtomTerm(AtomNil);
while (cp > s) {
if (ASP < H+1024)
return (CELL)0;
t = MkPairTerm(MkIntegerTerm(*--cp), t);
}
return t;
}
Term
Yap_NWideStringToList(wchar_t *s, size_t len)
{
CACHE_REGS
Term t;
wchar_t *cp = s + len;
t = MkAtomTerm(AtomNil);
while (cp > s) {
if (ASP < H+1024)
return (CELL)0;
t = MkPairTerm(MkIntegerTerm(*--cp), t);
}
return t;
}
Term
Yap_StringToDiffList(char *s, Term t USES_REGS)
{
register unsigned char *cp = (unsigned char *)s + strlen(s);
t = Yap_Globalise(t);
while (cp > (unsigned char *)s) {
if (ASP < H+1024)
return (CELL)0;
t = MkPairTerm(MkIntTerm(*--cp), t);
}
return t;
}
Term
Yap_NStringToDiffList(char *s, Term t, size_t len)
{
CACHE_REGS
register unsigned char *cp = (unsigned char *)s + len;
t = Yap_Globalise(t);
while (cp > (unsigned char *)s) {
t = MkPairTerm(MkIntTerm(*--cp), t);
}
return t;
}
Term
Yap_WideStringToDiffList(wchar_t *s, Term t)
{
CACHE_REGS
wchar_t *cp = s + wcslen(s);
t = Yap_Globalise(t);
while (cp > s) {
t = MkPairTerm(MkIntegerTerm(*--cp), t);
}
return t;
}
Term
Yap_NWideStringToDiffList(wchar_t *s, Term t, size_t len)
{
CACHE_REGS
wchar_t *cp = s + len;
t = Yap_Globalise(t);
while (cp > s) {
t = MkPairTerm(MkIntegerTerm(*--cp), t);
}
return t;
}
Term
Yap_StringToListOfAtoms(char *s)
{
CACHE_REGS
register Term t;
char so[2];
register unsigned char *cp = (unsigned char *)s + strlen(s);
so[1] = '\0';
t = MkAtomTerm(AtomNil);
while (cp > (unsigned char *)s) {
so[0] = *--cp;
t = MkPairTerm(MkAtomTerm(LookupAtom(so)), t);
}
return t;
}
Term
Yap_NStringToListOfAtoms(char *s, size_t len)
{
CACHE_REGS
register Term t;
char so[2];
register unsigned char *cp = (unsigned char *)s + len;
so[1] = '\0';
t = MkAtomTerm(AtomNil);
while (cp > (unsigned char *)s) {
so[0] = *--cp;
t = MkPairTerm(MkAtomTerm(LookupAtom(so)), t);
}
return t;
}
Term
Yap_WideStringToListOfAtoms(wchar_t *s)
{
CACHE_REGS
register Term t;
wchar_t so[2];
wchar_t *cp = s + wcslen(s);
so[1] = '\0';
t = MkAtomTerm(AtomNil);
while (cp > s) {
so[0] = *--cp;
if (ASP < H+1024)
return (CELL)0;
t = MkPairTerm(MkAtomTerm(LookupWideAtom(so)), t);
}
return t;
}
Term
Yap_NWideStringToListOfAtoms(wchar_t *s, size_t len)
{
CACHE_REGS
register Term t;
wchar_t so[2];
wchar_t *cp = s + len;
so[1] = '\0';
t = MkAtomTerm(AtomNil);
while (cp > s) {
if (ASP < H+1024)
return (CELL)0;
so[0] = *--cp;
t = MkPairTerm(MkAtomTerm(LookupWideAtom(so)), t);
}
return t;
}
Term
Yap_NWideStringToDiffListOfAtoms(wchar_t *s, Term t0, size_t len)
{
CACHE_REGS
register Term t;
wchar_t so[2];
wchar_t *cp = s + len;
so[1] = '\0';
t = Yap_Globalise(t0);
while (cp > s) {
so[0] = *--cp;
t = MkPairTerm(MkAtomTerm(LookupWideAtom(so)), t);
}
return t;
}
Term Term
Yap_ArrayToList(register Term *tp, int nof) Yap_ArrayToList(register Term *tp, int nof)
{ {

8
C/agc.c
View File

@ -220,7 +220,7 @@ static void init_reg_copies(USES_REGS1)
LOCAL_OldLCL0 = LCL0; LOCAL_OldLCL0 = LCL0;
LOCAL_OldTR = TR; LOCAL_OldTR = TR;
LOCAL_OldGlobalBase = (CELL *)LOCAL_GlobalBase; LOCAL_OldGlobalBase = (CELL *)LOCAL_GlobalBase;
LOCAL_OldH = H; LOCAL_OldH = HR;
LOCAL_OldH0 = H0; LOCAL_OldH0 = H0;
LOCAL_OldTrailBase = LOCAL_TrailBase; LOCAL_OldTrailBase = LOCAL_TrailBase;
LOCAL_OldTrailTop = LOCAL_TrailTop; LOCAL_OldTrailTop = LOCAL_TrailTop;
@ -319,11 +319,13 @@ mark_global_cell(CELL *pt)
/* skip bitmaps */ /* skip bitmaps */
switch(reg) { switch(reg) {
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
return pt + 4; return pt + 4;
#else #else
return pt + 3; return pt + 3;
#endif #endif
case (CELL)FunctorString:
return pt + 3 + pt[1];
case (CELL)FunctorBigInt: case (CELL)FunctorBigInt:
{ {
Int sz = 3 + Int sz = 3 +
@ -376,7 +378,7 @@ mark_global(USES_REGS1)
* the code * the code
*/ */
pt = H0; pt = H0;
while (pt < H) { while (pt < HR) {
pt = mark_global_cell(pt); pt = mark_global_cell(pt);
} }
} }

82
C/amasm.c
View File

@ -283,8 +283,6 @@ static void a_fetch_cv(cmp_op_info *, int, struct intermediates *);
static void a_fetch_vc(cmp_op_info *, int, struct intermediates *); static void a_fetch_vc(cmp_op_info *, int, struct intermediates *);
static yamop *a_f2(cmp_op_info *, yamop *, int, struct intermediates *); static yamop *a_f2(cmp_op_info *, yamop *, int, struct intermediates *);
#define CELLSIZE sizeof(CELL)
#define GONEXT(TYPE) code_p = ((yamop *)(&(code_p->u.TYPE.next))) #define GONEXT(TYPE) code_p = ((yamop *)(&(code_p->u.TYPE.next)))
inline static yslot inline static yslot
@ -1144,6 +1142,21 @@ a_ublob(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blobs
return code_p; return code_p;
} }
// strings are blobs
inline static yamop *
a_ustring(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.ou.opcw = emit_op(opcode_w);
code_p->u.ou.u =
AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[rnd1]));
}
*clause_has_blobsp = TRUE;
GONEXT(ou);
return code_p;
}
inline static yamop * inline static yamop *
a_udbt(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_dbtermp, yamop *code_p, int pass_no, struct intermediates *cip) a_udbt(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_dbtermp, yamop *code_p, int pass_no, struct intermediates *cip)
{ {
@ -1384,6 +1397,19 @@ a_rb(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, stru
return code_p; return code_p;
} }
inline static yamop *
a_rstring(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.xu.x = emit_x(cip->cpc->rnd2);
code_p->u.xu.u = AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1]));
}
*clause_has_blobsp = TRUE;
GONEXT(xu);
return code_p;
}
inline static yamop * inline static yamop *
a_dbt(op_numbers opcode, int *clause_has_dbtermp, yamop *code_p, int pass_no, struct intermediates *cip) a_dbt(op_numbers opcode, int *clause_has_dbtermp, yamop *code_p, int pass_no, struct intermediates *cip)
{ {
@ -2421,6 +2447,16 @@ copy_blob(yamop *code_p, int pass_no, struct PSEUDO *cpc)
return code_p; return code_p;
} }
static yamop *
copy_string(yamop *code_p, int pass_no, struct PSEUDO *cpc)
{
/* copy the blob to code space, making no effort to align if a double */
int max = cpc->rnd1, i;
for (i = 0; i < max; i++)
code_p = fill_a(cpc->arnds[i], code_p, pass_no);
return code_p;
}
static void static void
a_fetch_vv(cmp_op_info *cmp_info, int pass_no, struct intermediates *cip) a_fetch_vv(cmp_op_info *cmp_info, int pass_no, struct intermediates *cip)
@ -3240,6 +3276,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case get_bigint_op: case get_bigint_op:
code_p = a_rb(_get_bigint, clause_has_blobsp, code_p, pass_no, cip); code_p = a_rb(_get_bigint, clause_has_blobsp, code_p, pass_no, cip);
break; break;
case get_string_op:
code_p = a_rstring(_get_string, clause_has_blobsp, code_p, pass_no, cip);
break;
case get_dbterm_op: case get_dbterm_op:
code_p = a_dbt(_get_dbterm, clause_has_dbtermp, code_p, pass_no, cip); code_p = a_dbt(_get_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
break; break;
@ -3258,6 +3297,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case put_bigint_op: case put_bigint_op:
code_p = a_rb(_put_bigint, clause_has_blobsp, code_p, pass_no, cip); code_p = a_rb(_put_bigint, clause_has_blobsp, code_p, pass_no, cip);
break; break;
case put_string_op:
code_p = a_rstring(_put_bigint, clause_has_blobsp, code_p, pass_no, cip);
break;
case put_dbterm_op: case put_dbterm_op:
code_p = a_dbt(_put_dbterm, clause_has_dbtermp, code_p, pass_no, cip); code_p = a_dbt(_put_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
break; break;
@ -3318,6 +3360,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case unify_bigint_op: case unify_bigint_op:
code_p = a_ublob(cip->cpc->rnd1, _unify_bigint, _unify_atom_write, clause_has_blobsp, code_p, pass_no, cip); code_p = a_ublob(cip->cpc->rnd1, _unify_bigint, _unify_atom_write, clause_has_blobsp, code_p, pass_no, cip);
break; break;
case unify_string_op:
code_p = a_ustring(cip->cpc->rnd1, _unify_string, _unify_atom_write, clause_has_blobsp, code_p, pass_no, cip);
break;
case unify_dbterm_op: case unify_dbterm_op:
code_p = a_udbt(cip->cpc->rnd1, _unify_dbterm, _unify_atom_write, clause_has_dbtermp, code_p, pass_no, cip); code_p = a_udbt(cip->cpc->rnd1, _unify_dbterm, _unify_atom_write, clause_has_dbtermp, code_p, pass_no, cip);
break; break;
@ -3336,6 +3381,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case unify_last_bigint_op: case unify_last_bigint_op:
code_p = a_ublob(cip->cpc->rnd1, _unify_l_bigint, _unify_l_atom_write, clause_has_blobsp, code_p, pass_no, cip); code_p = a_ublob(cip->cpc->rnd1, _unify_l_bigint, _unify_l_atom_write, clause_has_blobsp, code_p, pass_no, cip);
break; break;
case unify_last_string_op:
code_p = a_ustring(cip->cpc->rnd1, _unify_l_bigint, _unify_l_atom_write, clause_has_blobsp, code_p, pass_no, cip);
break;
case unify_last_dbterm_op: case unify_last_dbterm_op:
code_p = a_udbt(cip->cpc->rnd1, _unify_l_dbterm, _unify_l_atom_write, clause_has_dbtermp, code_p, pass_no, cip); code_p = a_udbt(cip->cpc->rnd1, _unify_l_dbterm, _unify_l_atom_write, clause_has_dbtermp, code_p, pass_no, cip);
break; break;
@ -3354,6 +3402,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case write_bigint_op: case write_bigint_op:
code_p = a_wblob(cip->cpc->rnd1, _write_bigint, clause_has_blobsp, code_p, pass_no, cip); code_p = a_wblob(cip->cpc->rnd1, _write_bigint, clause_has_blobsp, code_p, pass_no, cip);
break; break;
case write_string_op:
code_p = a_wblob(cip->cpc->rnd1, _write_bigint, clause_has_blobsp, code_p, pass_no, cip);
break;
case write_dbterm_op: case write_dbterm_op:
code_p = a_wdbt(cip->cpc->rnd1, _write_dbterm, clause_has_dbtermp, code_p, pass_no, cip); code_p = a_wdbt(cip->cpc->rnd1, _write_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
break; break;
@ -3540,14 +3591,15 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
cip->cpc->nextInst != NULL && cip->cpc->nextInst != NULL &&
(cip->cpc->nextInst->op == mark_initialised_pvars_op || (cip->cpc->nextInst->op == mark_initialised_pvars_op ||
cip->cpc->nextInst->op == mark_live_regs_op || cip->cpc->nextInst->op == mark_live_regs_op ||
cip->cpc->nextInst->op == blob_op)) { cip->cpc->nextInst->op == blob_op ||
cip->cpc->nextInst->op == string_op)) {
ystop_found = TRUE; ystop_found = TRUE;
code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip); code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip);
} }
if (!pass_no) { if (!pass_no) {
#if !USE_SYSTEM_MALLOC #if !USE_SYSTEM_MALLOC
if (CellPtr(cip->label_offset+cip->cpc->rnd1) > ASP-256) { if (CellPtr(cip->label_offset+cip->cpc->rnd1) > ASP-256) {
LOCAL_Error_Size = 256+((char *)(cip->label_offset+cip->cpc->rnd1) - (char *)H); LOCAL_Error_Size = 256+((char *)(cip->label_offset+cip->cpc->rnd1) - (char *)HR);
save_machine_regs(); save_machine_regs();
siglongjmp(cip->CompilerBotch, 3); siglongjmp(cip->CompilerBotch, 3);
} }
@ -3737,7 +3789,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
break; break;
case align_float_op: case align_float_op:
/* install a blob */ /* install a blob */
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
if (!((CELL)code_p & 0x4)) if (!((CELL)code_p & 0x4))
GONEXT(e); GONEXT(e);
#endif #endif
@ -3746,6 +3798,10 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
/* install a blob */ /* install a blob */
code_p = copy_blob(code_p, pass_no, cip->cpc); code_p = copy_blob(code_p, pass_no, cip->cpc);
break; break;
case string_op:
/* install a blob */
code_p = copy_string(code_p, pass_no, cip->cpc);
break;
case empty_call_op: case empty_call_op:
/* create an empty call */ /* create an empty call */
code_p = a_empty_call(&clinfo, code_p, pass_no, cip); code_p = a_empty_call(&clinfo, code_p, pass_no, cip);
@ -3784,18 +3840,18 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
static DBTerm * static DBTerm *
fetch_clause_space(Term* tp, UInt size, struct intermediates *cip, UInt *osizep USES_REGS) fetch_clause_space(Term* tp, UInt size, struct intermediates *cip, UInt *osizep USES_REGS)
{ {
CELL *h0 = H; CELL *h0 = HR;
DBTerm *x; DBTerm *x;
/* This stuff should be just about fetching the space from the data-base, /* This stuff should be just about fetching the space from the data-base,
unfortunately we have to do all sorts of error handling :-( */ unfortunately we have to do all sorts of error handling :-( */
H = (CELL *)cip->freep; HR = (CELL *)cip->freep;
while ((x = Yap_StoreTermInDBPlusExtraSpace(*tp, size, osizep)) == NULL) { while ((x = Yap_StoreTermInDBPlusExtraSpace(*tp, size, osizep)) == NULL) {
H = h0; HR = h0;
switch (LOCAL_Error_TYPE) { switch (LOCAL_Error_TYPE) {
case OUT_OF_STACK_ERROR: case OUT_OF_STACK_ERROR:
LOCAL_Error_Size = 256+((char *)cip->freep - (char *)H); LOCAL_Error_Size = 256+((char *)cip->freep - (char *)HR);
save_machine_regs(); save_machine_regs();
siglongjmp(cip->CompilerBotch,3); siglongjmp(cip->CompilerBotch,3);
case OUT_OF_TRAIL_ERROR: case OUT_OF_TRAIL_ERROR:
@ -3827,10 +3883,10 @@ fetch_clause_space(Term* tp, UInt size, struct intermediates *cip, UInt *osizep
default: default:
return NULL; return NULL;
} }
h0 = H; h0 = HR;
H = (CELL *)cip->freep; HR = (CELL *)cip->freep;
} }
H = h0; HR = h0;
return x; return x;
} }
@ -3915,6 +3971,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
} }
cl = (LogUpdClause *)((CODEADDR)x-(UInt)size); cl = (LogUpdClause *)((CODEADDR)x-(UInt)size);
cl->lusl.ClSource = x; cl->lusl.ClSource = x;
cl->ClFlags |= SrcMask;
x->ag.line_number = Yap_source_line_no(); x->ag.line_number = Yap_source_line_no();
cl->ClSize = osize; cl->ClSize = osize;
cip->code_addr = (yamop *)cl; cip->code_addr = (yamop *)cl;
@ -3933,6 +3990,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
code_p = do_pass(1, &entry_code, mode, &clause_has_blobs, &clause_has_dbterm, cip, size PASS_REGS); code_p = do_pass(1, &entry_code, mode, &clause_has_blobs, &clause_has_dbterm, cip, size PASS_REGS);
/* make sure we copy after second pass */ /* make sure we copy after second pass */
cl->usc.ClSource = x; cl->usc.ClSource = x;
cl->ClFlags |= SrcMask;
x->ag.line_number = Yap_source_line_no(); x->ag.line_number = Yap_source_line_no();
cl->ClSize = osize; cl->ClSize = osize;
LOCAL_ProfEnd=code_p; LOCAL_ProfEnd=code_p;

6
C/arith0.c
View File

@ -138,12 +138,12 @@ eval0(Int fi) {
RINT(((CELL *)TR)-LCL0); RINT(((CELL *)TR)-LCL0);
#endif #endif
case op_stackfree: case op_stackfree:
RINT(Unsigned(ASP) - Unsigned(H)); RINT(Unsigned(ASP) - Unsigned(HR));
case op_globalsp: case op_globalsp:
#if YAPOR_SBA #if YAPOR_SBA
RINT((Int)H); RINT((Int)HR);
#else #else
RINT(H - H0); RINT(HR - H0);
#endif #endif
} }
RERROR(); RERROR();

8
C/arith1.c
View File

@ -152,7 +152,7 @@ lsb(Int inp USES_REGS) /* calculate the least significant bit for an integer */
} }
if (inp==0) if (inp==0)
return 0L; return 0L;
#if SIZEOF_LONG_INT == 8 #if SIZEOF_INT_P == 8
if (!(inp & 0xffffffffLL)) {inp >>= 32; out += 32;} if (!(inp & 0xffffffffLL)) {inp >>= 32; out += 32;}
#endif #endif
if (!(inp & 0xffffL)) {inp >>= 16; out += 16;} if (!(inp & 0xffffL)) {inp >>= 16; out += 16;}
@ -373,10 +373,10 @@ eval1(Int fi, Term t USES_REGS) {
} }
case op_lgamma: case op_lgamma:
{ {
#if HAVE_LGAMMA
Float dbl; Float dbl;
dbl = get_float(t); dbl = get_float(t);
#if HAVE_LGAMMA
RFLOAT(lgamma(dbl)); RFLOAT(lgamma(dbl));
#else #else
RERROR(); RERROR();
@ -384,8 +384,8 @@ eval1(Int fi, Term t USES_REGS) {
} }
case op_erf: case op_erf:
{ {
Float dbl = get_float(t), out;
#if HAVE_ERF #if HAVE_ERF
Float dbl = get_float(t), out;
out = erf(dbl); out = erf(dbl);
RFLOAT(out); RFLOAT(out);
#else #else
@ -394,8 +394,8 @@ eval1(Int fi, Term t USES_REGS) {
} }
case op_erfc: case op_erfc:
{ {
Float dbl = get_float(t), out;
#if HAVE_ERF #if HAVE_ERF
Float dbl = get_float(t), out;
out = erfc(dbl); out = erfc(dbl);
RFLOAT(out); RFLOAT(out);
#else #else

201
C/arrays.c
View File

@ -330,7 +330,7 @@ AccessNamedArray(Atom a, Int indx USES_REGS)
StaticArrayEntry *ptr = (StaticArrayEntry *)pp; StaticArrayEntry *ptr = (StaticArrayEntry *)pp;
READ_LOCK(ptr->ArRWLock); READ_LOCK(ptr->ArRWLock);
if (-(pp->ArrayEArity) <= indx || indx < 0) { if (pp->ArrayEArity <= indx || indx < 0) {
/* Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, MkIntegerTerm(indx), "access_array");*/ /* Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, MkIntegerTerm(indx), "access_array");*/
READ_UNLOCK(ptr->ArRWLock); READ_UNLOCK(ptr->ArRWLock);
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
@ -545,14 +545,14 @@ InitNamedArray(ArrayEntry * p, Int dim USES_REGS)
/* Leave a pointer so that we can reclaim array space when /* Leave a pointer so that we can reclaim array space when
* we backtrack or when we abort */ * we backtrack or when we abort */
/* place terms in reverse order */ /* place terms in reverse order */
Bind_Global(&(p->ValueOfVE),AbsAppl(H)); Bind_Global(&(p->ValueOfVE),AbsAppl(HR));
tp = H; tp = HR;
tp[0] = (CELL)Yap_MkFunctor(AtomArray, dim); tp[0] = (CELL)Yap_MkFunctor(AtomArray, dim);
tp++; tp++;
p->ArrayEArity = dim; p->ArrayEArity = dim;
/* Initialise the array as a set of variables */ /* Initialise the array as a set of variables */
H = tp+dim; HR = tp+dim;
for (; tp < H; tp++) { for (; tp < HR; tp++) {
RESET_VARIABLE(tp); RESET_VARIABLE(tp);
} }
WRITE_UNLOCK(p->ArRWLock); WRITE_UNLOCK(p->ArRWLock);
@ -566,6 +566,7 @@ CreateNamedArray(PropEntry * pp, Int dim, AtomEntry *ae USES_REGS)
p = (ArrayEntry *) Yap_AllocAtomSpace(sizeof(*p)); p = (ArrayEntry *) Yap_AllocAtomSpace(sizeof(*p));
p->KindOfPE = ArrayProperty; p->KindOfPE = ArrayProperty;
p->TypeOfAE = DYNAMIC_ARRAY;
AddPropToAtom(ae, (PropEntry *)p); AddPropToAtom(ae, (PropEntry *)p);
INIT_RWLOCK(p->ArRWLock); INIT_RWLOCK(p->ArRWLock);
#if THREADS #if THREADS
@ -578,9 +579,9 @@ CreateNamedArray(PropEntry * pp, Int dim, AtomEntry *ae USES_REGS)
} }
static void static void
AllocateStaticArraySpace(StaticArrayEntry *p, static_array_types atype, Int array_size USES_REGS) AllocateStaticArraySpace(StaticArrayEntry *p, static_array_types atype, void *old, size_t array_size USES_REGS)
{ {
Int asize = 0; size_t asize = 0;
switch (atype) { switch (atype) {
case array_of_doubles: case array_of_doubles:
asize = array_size*sizeof(Float); asize = array_size*sizeof(Float);
@ -606,22 +607,33 @@ AllocateStaticArraySpace(StaticArrayEntry *p, static_array_types atype, Int arra
asize = array_size*sizeof(DBRef); asize = array_size*sizeof(DBRef);
break; break;
} }
while ((p->ValueOfVE.floats = (Float *) Yap_AllocAtomSpace(asize) ) == NULL) { if (old == NULL) {
YAPLeaveCriticalSection(); while ((p->ValueOfVE.floats = (Float *) Yap_AllocCodeSpace(asize) ) == NULL) {
if (!Yap_growheap(FALSE, asize, NULL)) { YAPLeaveCriticalSection();
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); if (!Yap_growheap(FALSE, asize, NULL)) {
return; Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
return;
}
YAPEnterCriticalSection();
}
} else {
while ((p->ValueOfVE.floats = (Float *) Yap_ReallocCodeSpace(old, asize) ) == NULL) {
YAPLeaveCriticalSection();
if (!Yap_growheap(FALSE, asize, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
return;
}
YAPEnterCriticalSection();
} }
YAPEnterCriticalSection();
} }
} }
/* ae and p are assumed to be locked, if they exist */ /* ae and p are assumed to be locked, if they exist */
static StaticArrayEntry * static StaticArrayEntry *
CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR start_addr, StaticArrayEntry *p USES_REGS) CreateStaticArray(AtomEntry *ae, size_t dim, static_array_types type, CODEADDR start_addr, StaticArrayEntry *p USES_REGS)
{ {
if (EndOfPAEntr(p)) { if (EndOfPAEntr(p)) {
while ((p = (StaticArrayEntry *) Yap_AllocAtomSpace(sizeof(*p))) == NULL) { while ((p = (StaticArrayEntry *) Yap_AllocCodeSpace(sizeof(*p))) == NULL) {
if (!Yap_growheap(FALSE, sizeof(*p), NULL)) { if (!Yap_growheap(FALSE, sizeof(*p), NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
return NULL; return NULL;
@ -634,12 +646,13 @@ CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR star
LOCAL_StaticArrays = p; LOCAL_StaticArrays = p;
} }
WRITE_LOCK(p->ArRWLock); WRITE_LOCK(p->ArRWLock);
p->ArrayEArity = -dim; p->ArrayEArity = dim;
p->ArrayType = type; p->ArrayType = type;
p->TypeOfAE = STATIC_ARRAY;
if (start_addr == NULL) { if (start_addr == NULL) {
Int i; Int i;
AllocateStaticArraySpace(p, type, dim PASS_REGS); AllocateStaticArraySpace(p, type, NULL, dim PASS_REGS);
if (p->ValueOfVE.ints == NULL) { if (p->ValueOfVE.ints == NULL) {
WRITE_UNLOCK(p->ArRWLock); WRITE_UNLOCK(p->ArRWLock);
return p; return p;
@ -683,6 +696,7 @@ CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR star
} }
} else { } else {
/* external array */ /* external array */
p->TypeOfAE |= MMAP_ARRAY;
p->ValueOfVE.chars = (char *)start_addr; p->ValueOfVE.chars = (char *)start_addr;
} }
WRITE_UNLOCK(p->ArRWLock); WRITE_UNLOCK(p->ArRWLock);
@ -690,86 +704,64 @@ CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR star
} }
static void static void
ResizeStaticArray(StaticArrayEntry *pp, Int dim USES_REGS) ResizeStaticArray(StaticArrayEntry *pp, size_t dim USES_REGS)
{ {
statarray_elements old_v = pp->ValueOfVE; statarray_elements old_v = pp->ValueOfVE;
static_array_types type = pp->ArrayType; static_array_types type = pp->ArrayType;
Int old_dim = - pp->ArrayEArity; size_t old_dim = pp->ArrayEArity;
Int mindim = (dim < old_dim ? dim : old_dim), i; size_t mindim = (dim < old_dim ? dim : old_dim), i;
/* change official size */ /* change official size */
if (pp->ArrayEArity >= 0){ if (pp->ArrayEArity == 0){
return; return;
} }
WRITE_LOCK(pp->ArRWLock); WRITE_LOCK(pp->ArRWLock);
pp->ArrayEArity = -dim; pp->ArrayEArity = dim;
#if HAVE_MMAP #if HAVE_MMAP
if (pp->ValueOfVE.chars < (char *)Yap_HeapBase || if (pp->TypeOfAE & MMAP_ARRAY) {
pp->ValueOfVE.chars > (char *)HeapTop) {
ResizeMmappedArray(pp, dim, (void *)(pp->ValueOfVE.chars) PASS_REGS); ResizeMmappedArray(pp, dim, (void *)(pp->ValueOfVE.chars) PASS_REGS);
WRITE_UNLOCK(pp->ArRWLock); WRITE_UNLOCK(pp->ArRWLock);
return; return;
} }
#endif #endif
AllocateStaticArraySpace(pp, type, dim PASS_REGS); AllocateStaticArraySpace(pp, type, old_v.chars, dim PASS_REGS);
switch(type) { switch(type) {
case array_of_ints: case array_of_ints:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.ints[i] = old_v.ints[i];
for (i = mindim; i<dim; i++) for (i = mindim; i<dim; i++)
pp->ValueOfVE.ints[i] = 0; pp->ValueOfVE.ints[i] = 0;
break; break;
case array_of_chars: case array_of_chars:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.chars[i] = old_v.chars[i];
for (i = mindim; i<dim; i++) for (i = mindim; i<dim; i++)
pp->ValueOfVE.chars[i] = '\0'; pp->ValueOfVE.chars[i] = '\0';
break; break;
case array_of_uchars: case array_of_uchars:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.uchars[i] = old_v.uchars[i];
for (i = mindim; i<dim; i++) for (i = mindim; i<dim; i++)
pp->ValueOfVE.uchars[i] = '\0'; pp->ValueOfVE.uchars[i] = '\0';
break; break;
case array_of_doubles: case array_of_doubles:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.floats[i] = old_v.floats[i];
for (i = mindim; i<dim; i++) for (i = mindim; i<dim; i++)
pp->ValueOfVE.floats[i] = 0.0; pp->ValueOfVE.floats[i] = 0.0;
break; break;
case array_of_ptrs: case array_of_ptrs:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.ptrs[i] = old_v.ptrs[i];
for (i = mindim; i<dim; i++) for (i = mindim; i<dim; i++)
pp->ValueOfVE.ptrs[i] = NULL; pp->ValueOfVE.ptrs[i] = NULL;
break; break;
case array_of_atoms: case array_of_atoms:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.atoms[i] = old_v.atoms[i];
for (i = mindim; i<dim; i++) for (i = mindim; i<dim; i++)
pp->ValueOfVE.atoms[i] = TermNil; pp->ValueOfVE.atoms[i] = TermNil;
break; break;
case array_of_dbrefs: case array_of_dbrefs:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.dbrefs[i] = old_v.dbrefs[i];
for (i = mindim; i<dim; i++) for (i = mindim; i<dim; i++)
pp->ValueOfVE.dbrefs[i] = 0L; pp->ValueOfVE.dbrefs[i] = 0L;
break; break;
case array_of_terms: case array_of_terms:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.terms[i] = old_v.terms[i];
for (i = mindim; i<dim; i++) for (i = mindim; i<dim; i++)
pp->ValueOfVE.terms[i] = NULL; pp->ValueOfVE.terms[i] = NULL;
break; break;
case array_of_nb_terms: case array_of_nb_terms:
for (i = 0; i <mindim; i++) { for (i = mindim; i <dim; i++) {
Term tlive = pp->ValueOfVE.lterms[i].tlive; RESET_VARIABLE(&(pp->ValueOfVE.lterms[i].tlive));
if (IsVarTerm(tlive) && IsUnboundVar(&(pp->ValueOfVE.lterms[i].tlive))) { pp->ValueOfVE.lterms[i].tstore = TermNil;
RESET_VARIABLE(&(pp->ValueOfVE.lterms[i].tlive));
} else {
pp->ValueOfVE.lterms[i].tlive = tlive;
}
pp->ValueOfVE.lterms[i].tstore = old_v.lterms[i].tstore;
} }
break; break;
} }
@ -781,10 +773,10 @@ ClearStaticArray(StaticArrayEntry *pp)
{ {
statarray_elements old_v = pp->ValueOfVE; statarray_elements old_v = pp->ValueOfVE;
static_array_types type = pp->ArrayType; static_array_types type = pp->ArrayType;
Int dim = - pp->ArrayEArity, i; Int dim = pp->ArrayEArity, i;
/* change official size */ /* change official size */
if (pp->ArrayEArity >= 0){ if (pp->ArrayEArity == 0){
return; return;
} }
WRITE_LOCK(pp->ArRWLock); WRITE_LOCK(pp->ArRWLock);
@ -895,13 +887,13 @@ p_create_array( USES_REGS1 )
Functor farray; Functor farray;
farray = Yap_MkFunctor(AtomArray, size); farray = Yap_MkFunctor(AtomArray, size);
if (H+1+size > ASP-1024) { if (HR+1+size > ASP-1024) {
if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage);
return(FALSE); return(FALSE);
} else { } else {
if (H+1+size > ASP-1024) { if (HR+1+size > ASP-1024) {
if (!Yap_growstack( sizeof(CELL) * (size+1-(H-ASP-1024)))) { if (!Yap_growstack( sizeof(CELL) * (size+1-(HR-ASP-1024)))) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
return FALSE; return FALSE;
} }
@ -909,11 +901,11 @@ p_create_array( USES_REGS1 )
} }
goto restart; goto restart;
} }
t = AbsAppl(H); t = AbsAppl(HR);
*H++ = (CELL) farray; *HR++ = (CELL) farray;
for (; size >= 0; size--) { for (; size >= 0; size--) {
RESET_VARIABLE(H); RESET_VARIABLE(HR);
H++; HR++;
} }
return (Yap_unify(t, ARG1)); return (Yap_unify(t, ARG1));
} }
@ -932,7 +924,7 @@ p_create_array( USES_REGS1 )
) )
pp = RepProp(pp->NextOfPE); pp = RepProp(pp->NextOfPE);
if (EndOfPAEntr(pp)) { if (EndOfPAEntr(pp)) {
if (H+1+size > ASP-1024) { if (HR+1+size > ASP-1024) {
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage);
@ -949,13 +941,12 @@ p_create_array( USES_REGS1 )
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
if (!IsVarTerm(app->ValueOfVE) if (!IsVarTerm(app->ValueOfVE)
|| !IsUnboundVar(&app->ValueOfVE)) { || !IsUnboundVar(&app->ValueOfVE)) {
if (size == app->ArrayEArity || if (size == app->ArrayEArity)
size == -app->ArrayEArity)
return TRUE; return TRUE;
Yap_Error(PERMISSION_ERROR_CREATE_ARRAY,t,"create_array", Yap_Error(PERMISSION_ERROR_CREATE_ARRAY,t,"create_array",
ae->StrOfAE); ae->StrOfAE);
} else { } else {
if (H+1+size > ASP-1024) { if (HR+1+size > ASP-1024) {
if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage);
return(FALSE); return(FALSE);
@ -1064,7 +1055,7 @@ p_create_static_array( USES_REGS1 )
return FALSE; return FALSE;
} }
} else { } else {
if (pp->ArrayEArity == -size && if (pp->ArrayEArity == size &&
pp->ArrayType == props) { pp->ArrayType == props) {
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
return TRUE; return TRUE;
@ -1101,7 +1092,7 @@ p_static_array_properties( USES_REGS1 )
return (FALSE); return (FALSE);
} else { } else {
static_array_types tp = pp->ArrayType; static_array_types tp = pp->ArrayType;
Int dim = -pp->ArrayEArity; Int dim = pp->ArrayEArity;
READ_UNLOCK(ae->ARWLock); READ_UNLOCK(ae->ARWLock);
if (dim <= 0 || !Yap_unify(ARG2,MkIntegerTerm(dim))) if (dim <= 0 || !Yap_unify(ARG2,MkIntegerTerm(dim)))
@ -1169,7 +1160,7 @@ p_resize_static_array( USES_REGS1 )
Yap_Error(PERMISSION_ERROR_RESIZE_ARRAY,t,"resize a static array"); Yap_Error(PERMISSION_ERROR_RESIZE_ARRAY,t,"resize a static array");
return(FALSE); return(FALSE);
} else { } else {
Int osize = - pp->ArrayEArity; size_t osize = pp->ArrayEArity;
ResizeStaticArray(pp, size PASS_REGS); ResizeStaticArray(pp, size PASS_REGS);
return(Yap_unify(ARG2,MkIntegerTerm(osize))); return(Yap_unify(ARG2,MkIntegerTerm(osize)));
} }
@ -1237,14 +1228,14 @@ p_close_static_array( USES_REGS1 )
StaticArrayEntry *ptr = (StaticArrayEntry *)pp; StaticArrayEntry *ptr = (StaticArrayEntry *)pp;
if (ptr->ValueOfVE.ints != NULL) { if (ptr->ValueOfVE.ints != NULL) {
#if HAVE_MMAP #if HAVE_MMAP
if (ptr->ValueOfVE.chars < (char *)Yap_HeapBase || Int val = CloseMmappedArray(ptr, (void *)ptr->ValueOfVE.chars PASS_REGS);
ptr->ValueOfVE.chars > (char *)HeapTop) {
Int val = CloseMmappedArray(ptr, (void *)ptr->ValueOfVE.chars PASS_REGS);
#if USE_SYSTEM_MALLOC #if USE_SYSTEM_MALLOC
if (val) if (val) {
#endif #endif
return(val); return(val);
#if USE_SYSTEM_MALLOC
} }
#endif
#endif #endif
Yap_FreeAtomSpace((char *)(ptr->ValueOfVE.ints)); Yap_FreeAtomSpace((char *)(ptr->ValueOfVE.ints));
ptr->ValueOfVE.ints = NULL; ptr->ValueOfVE.ints = NULL;
@ -1422,7 +1413,7 @@ loop:
} }
else if (IsPairTerm(d0)) { else if (IsPairTerm(d0)) {
/* store the terms to visit */ /* store the terms to visit */
*ptn++ = AbsPair(H); *ptn++ = AbsPair(HR);
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
to_visit[0] = pt0; to_visit[0] = pt0;
to_visit[1] = pt0_end; to_visit[1] = pt0_end;
@ -1441,8 +1432,8 @@ loop:
pt0 = RepPair(d0) - 1; pt0 = RepPair(d0) - 1;
pt0_end = RepPair(d0) + 1; pt0_end = RepPair(d0) + 1;
/* write the head and tail of the list */ /* write the head and tail of the list */
ptn = H; ptn = HR;
H += 2; HR += 2;
} }
else if (IsApplTerm(d0)) { else if (IsApplTerm(d0)) {
register Functor f; register Functor f;
@ -1455,7 +1446,7 @@ loop:
continue; continue;
} }
} }
*ptn++ = AbsAppl(H); *ptn++ = AbsAppl(HR);
/* store the terms to visit */ /* store the terms to visit */
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
to_visit[0] = pt0; to_visit[0] = pt0;
@ -1476,9 +1467,9 @@ loop:
d0 = ArityOfFunctor(f); d0 = ArityOfFunctor(f);
pt0_end = pt0 + d0; pt0_end = pt0 + d0;
/* start writing the compound term */ /* start writing the compound term */
ptn = H; ptn = HR;
*ptn++ = (CELL) f; *ptn++ = (CELL) f;
H += d0 + 1; HR += d0 + 1;
} }
else { /* AtomOrInt */ else { /* AtomOrInt */
*ptn++ = d0; *ptn++ = d0;
@ -1527,19 +1518,19 @@ replace_array_references(Term t0 USES_REGS)
return (MkPairTerm(t, TermNil)); return (MkPairTerm(t, TermNil));
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
Term VList = MkVarTerm(); Term VList = MkVarTerm();
CELL *h0 = H; CELL *h0 = HR;
H += 2; HR += 2;
replace_array_references_complex(RepPair(t) - 1, RepPair(t) + 1, h0, replace_array_references_complex(RepPair(t) - 1, RepPair(t) + 1, h0,
VList PASS_REGS); VList PASS_REGS);
return MkPairTerm(AbsPair(h0), VList); return MkPairTerm(AbsPair(h0), VList);
} else { } else {
Term VList = MkVarTerm(); Term VList = MkVarTerm();
CELL *h0 = H; CELL *h0 = HR;
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
*H++ = (CELL) (f); *HR++ = (CELL) (f);
H += ArityOfFunctor(f); HR += ArityOfFunctor(f);
replace_array_references_complex(RepAppl(t), replace_array_references_complex(RepAppl(t),
RepAppl(t) + ArityOfFunctor(FunctorOfTerm(t)), h0 + 1, RepAppl(t) + ArityOfFunctor(FunctorOfTerm(t)), h0 + 1,
VList PASS_REGS); VList PASS_REGS);
@ -1651,7 +1642,7 @@ p_assign_static( USES_REGS1 )
WRITE_LOCK(ptr->ArRWLock); WRITE_LOCK(ptr->ArRWLock);
READ_UNLOCK(ae->ARWLock); READ_UNLOCK(ae->ARWLock);
/* a static array */ /* a static array */
if (indx < 0 || indx >= - ptr->ArrayEArity) { if (indx < 0 || indx >= ptr->ArrayEArity) {
WRITE_UNLOCK(ptr->ArRWLock); WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static"); Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
return FALSE; return FALSE;
@ -1980,7 +1971,7 @@ p_assign_dynamic( USES_REGS1 )
WRITE_LOCK(ptr->ArRWLock); WRITE_LOCK(ptr->ArRWLock);
/* a static array */ /* a static array */
if (indx < 0 || indx >= - ptr->ArrayEArity) { if (indx < 0 || indx >= ptr->ArrayEArity) {
WRITE_UNLOCK(ptr->ArRWLock); WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static"); Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
return FALSE; return FALSE;
@ -2179,7 +2170,7 @@ p_add_to_array_element( USES_REGS1 )
WRITE_LOCK(ptr->ArRWLock); WRITE_LOCK(ptr->ArRWLock);
/* a static array */ /* a static array */
if (indx < 0 || indx >= - ptr->ArrayEArity) { if (indx < 0 || indx >= ptr->ArrayEArity) {
WRITE_UNLOCK(ptr->ArRWLock); WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"add_to_array_element"); Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"add_to_array_element");
return FALSE; return FALSE;
@ -2271,16 +2262,16 @@ p_static_array_to_term( USES_REGS1 )
return (FALSE); return (FALSE);
} else { } else {
static_array_types tp = pp->ArrayType; static_array_types tp = pp->ArrayType;
Int dim = -pp->ArrayEArity, indx; Int dim = pp->ArrayEArity, indx;
CELL *base; CELL *base;
while (H+1+dim > ASP-1024) { while (HR+1+dim > ASP-1024) {
if (!Yap_gcl((1+dim)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { if (!Yap_gcl((1+dim)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage);
return(FALSE); return(FALSE);
} else { } else {
if (H+1+dim > ASP-1024) { if (HR+1+dim > ASP-1024) {
if (!Yap_growstack( sizeof(CELL) * (dim+1-(H-ASP-1024)))) { if (!Yap_growstack( sizeof(CELL) * (dim+1-(HR-ASP-1024)))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return FALSE; return FALSE;
} }
@ -2289,13 +2280,13 @@ p_static_array_to_term( USES_REGS1 )
} }
READ_LOCK(pp->ArRWLock); READ_LOCK(pp->ArRWLock);
READ_UNLOCK(ae->ARWLock); READ_UNLOCK(ae->ARWLock);
base = H; base = HR;
*H++ = (CELL)Yap_MkFunctor(AbsAtom(ae),dim); *HR++ = (CELL)Yap_MkFunctor(AbsAtom(ae),dim);
switch(tp) { switch(tp) {
case array_of_ints: case array_of_ints:
{ {
CELL *sptr = H; CELL *sptr = HR;
H += dim; HR += dim;
for (indx=0; indx < dim; indx++) { for (indx=0; indx < dim; indx++) {
*sptr++ = MkIntegerTerm(pp->ValueOfVE.ints[indx]); *sptr++ = MkIntegerTerm(pp->ValueOfVE.ints[indx]);
} }
@ -2322,13 +2313,13 @@ p_static_array_to_term( USES_REGS1 )
} else { } else {
TRef = TermNil; TRef = TermNil;
} }
*H++ = TRef; *HR++ = TRef;
} }
break; break;
case array_of_doubles: case array_of_doubles:
{ {
CELL *sptr = H; CELL *sptr = HR;
H += dim; HR += dim;
for (indx=0; indx < dim; indx++) { for (indx=0; indx < dim; indx++) {
*sptr++ = MkEvalFl(pp->ValueOfVE.floats[indx]); *sptr++ = MkEvalFl(pp->ValueOfVE.floats[indx]);
} }
@ -2336,8 +2327,8 @@ p_static_array_to_term( USES_REGS1 )
break; break;
case array_of_ptrs: case array_of_ptrs:
{ {
CELL *sptr = H; CELL *sptr = HR;
H += dim; HR += dim;
for (indx=0; indx < dim; indx++) { for (indx=0; indx < dim; indx++) {
*sptr++ = MkIntegerTerm((Int)(pp->ValueOfVE.ptrs[indx])); *sptr++ = MkIntegerTerm((Int)(pp->ValueOfVE.ptrs[indx]));
} }
@ -2345,8 +2336,8 @@ p_static_array_to_term( USES_REGS1 )
break; break;
case array_of_chars: case array_of_chars:
{ {
CELL *sptr = H; CELL *sptr = HR;
H += dim; HR += dim;
for (indx=0; indx < dim; indx++) { for (indx=0; indx < dim; indx++) {
*sptr++ = MkIntegerTerm((Int)(pp->ValueOfVE.chars[indx])); *sptr++ = MkIntegerTerm((Int)(pp->ValueOfVE.chars[indx]));
} }
@ -2354,8 +2345,8 @@ p_static_array_to_term( USES_REGS1 )
break; break;
case array_of_uchars: case array_of_uchars:
{ {
CELL *sptr = H; CELL *sptr = HR;
H += dim; HR += dim;
for (indx=0; indx < dim; indx++) { for (indx=0; indx < dim; indx++) {
*sptr++ = MkIntegerTerm((Int)(pp->ValueOfVE.uchars[indx])); *sptr++ = MkIntegerTerm((Int)(pp->ValueOfVE.uchars[indx]));
} }
@ -2363,8 +2354,8 @@ p_static_array_to_term( USES_REGS1 )
break; break;
case array_of_terms: case array_of_terms:
{ {
CELL *sptr = H; CELL *sptr = HR;
H += dim; HR += dim;
for (indx=0; indx < dim; indx++) { for (indx=0; indx < dim; indx++) {
/* The object is now in use */ /* The object is now in use */
DBTerm *ref = pp->ValueOfVE.terms[indx]; DBTerm *ref = pp->ValueOfVE.terms[indx];
@ -2381,8 +2372,8 @@ p_static_array_to_term( USES_REGS1 )
break; break;
case array_of_nb_terms: case array_of_nb_terms:
{ {
CELL *sptr = H; CELL *sptr = HR;
H += dim; HR += dim;
for (indx=0; indx < dim; indx++) { for (indx=0; indx < dim; indx++) {
/* The object is now in use */ /* The object is now in use */
Term To = GetNBTerm(pp->ValueOfVE.lterms, indx PASS_REGS); Term To = GetNBTerm(pp->ValueOfVE.lterms, indx PASS_REGS);
@ -2401,7 +2392,7 @@ p_static_array_to_term( USES_REGS1 )
out = pp->ValueOfVE.atoms[indx]; out = pp->ValueOfVE.atoms[indx];
if (out == 0L) if (out == 0L)
out = TermNil; out = TermNil;
*H++ = out; *HR++ = out;
} }
break; break;
} }

1938
C/atomic.c Normal file
View File

File diff suppressed because it is too large Load Diff

2447
C/atoms.c
View File

File diff suppressed because it is too large Load Diff

85
C/attvar.c
View File

@ -73,8 +73,8 @@ BuildNewAttVar( USES_REGS1 )
attvar_record *newv; attvar_record *newv;
/* add a new attributed variable */ /* add a new attributed variable */
newv = (attvar_record *)H; newv = (attvar_record *)HR;
H = (CELL *)(newv+1); HR = (CELL *)(newv+1);
newv->AttFunc = FunctorAttVar; newv->AttFunc = FunctorAttVar;
RESET_VARIABLE(&(newv->Value)); RESET_VARIABLE(&(newv->Value));
RESET_VARIABLE(&(newv->Done)); RESET_VARIABLE(&(newv->Done));
@ -97,9 +97,9 @@ CopyAttVar(CELL *orig, struct cp_frame **to_visit_ptr, CELL *res USES_REGS)
to_visit->start_cp = vt-1; to_visit->start_cp = vt-1;
to_visit->end_cp = vt; to_visit->end_cp = vt;
if (IsVarTerm(attv->Atts)) { if (IsVarTerm(attv->Atts)) {
Bind_Global_NonAtt(&newv->Atts, (CELL)H); Bind_Global_NonAtt(&newv->Atts, (CELL)HR);
to_visit->to = H; to_visit->to = HR;
H++; HR++;
} else { } else {
to_visit->to = &(newv->Atts); to_visit->to = &(newv->Atts);
} }
@ -156,7 +156,7 @@ WakeAttVar(CELL* pt1, CELL reg2 USES_REGS)
/* if bound to someone else, follow until we find the last one */ /* if bound to someone else, follow until we find the last one */
attvar_record *attv = RepAttVar(pt1); attvar_record *attv = RepAttVar(pt1);
CELL *myH = H; CELL *myH = HR;
CELL *bind_ptr; CELL *bind_ptr;
if (IsVarTerm(Deref(attv->Atts))) { if (IsVarTerm(Deref(attv->Atts))) {
@ -201,9 +201,9 @@ WakeAttVar(CELL* pt1, CELL reg2 USES_REGS)
bind_ptr = AddToQueue(attv PASS_REGS); bind_ptr = AddToQueue(attv PASS_REGS);
if (IsNonVarTerm(reg2)) { if (IsNonVarTerm(reg2)) {
if (IsPairTerm(reg2) && RepPair(reg2) == myH) if (IsPairTerm(reg2) && RepPair(reg2) == myH)
reg2 = AbsPair(H); reg2 = AbsPair(HR);
else if (IsApplTerm(reg2) && RepAppl(reg2) == myH) else if (IsApplTerm(reg2) && RepAppl(reg2) == myH)
reg2 = AbsAppl(H); reg2 = AbsAppl(HR);
} }
*bind_ptr = reg2; *bind_ptr = reg2;
Bind_Global_NonAtt(&(attv->Value), reg2); Bind_Global_NonAtt(&(attv->Value), reg2);
@ -227,19 +227,19 @@ mark_attvar(CELL *orig)
static Term static Term
BuildAttTerm(Functor mfun, UInt ar USES_REGS) BuildAttTerm(Functor mfun, UInt ar USES_REGS)
{ {
CELL *h0 = H; CELL *h0 = HR;
UInt i; UInt i;
if (H+(1024+ar) > ASP) { if (HR+(1024+ar) > ASP) {
LOCAL_Error_Size=ar*sizeof(CELL); LOCAL_Error_Size=ar*sizeof(CELL);
return 0L; return 0L;
} }
H[0] = (CELL)mfun; HR[0] = (CELL)mfun;
RESET_VARIABLE(H+1); RESET_VARIABLE(HR+1);
H += 2; HR += 2;
for (i = 1; i< ar; i++) { for (i = 1; i< ar; i++) {
*H = TermVoidAtt; *HR = TermVoidAtt;
H++; HR++;
} }
return AbsAppl(h0); return AbsAppl(h0);
} }
@ -390,7 +390,7 @@ DelAtts(attvar_record *attv, Term oatt USES_REGS)
static void static void
PutAtt(Int pos, Term atts, Term att USES_REGS) PutAtt(Int pos, Term atts, Term att USES_REGS)
{ {
if (IsVarTerm(att) && VarOfTerm(att) > H && VarOfTerm(att) < LCL0) { if (IsVarTerm(att) && VarOfTerm(att) > HR && VarOfTerm(att) < LCL0) {
/* globalise locals */ /* globalise locals */
Term tnew = MkVarTerm(); Term tnew = MkVarTerm();
Bind_NonAtt(VarOfTerm(att), tnew); Bind_NonAtt(VarOfTerm(att), tnew);
@ -850,23 +850,23 @@ p_modules_with_atts( USES_REGS1 ) {
if (IsVarTerm(inp)) { if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) { if (IsAttachedTerm(inp)) {
attvar_record *attv = RepAttVar(VarOfTerm(inp)); attvar_record *attv = RepAttVar(VarOfTerm(inp));
CELL *h0 = H; CELL *h0 = HR;
Term tatt; Term tatt;
if (IsVarTerm(tatt = attv->Atts)) if (IsVarTerm(tatt = attv->Atts))
return Yap_unify(ARG2,TermNil); return Yap_unify(ARG2,TermNil);
while (!IsVarTerm(tatt)) { while (!IsVarTerm(tatt)) {
Functor f = FunctorOfTerm(tatt); Functor f = FunctorOfTerm(tatt);
if (H != h0) if (HR != h0)
H[-1] = AbsPair(H); HR[-1] = AbsPair(HR);
if (ActiveAtt(tatt, ArityOfFunctor(f))) { if (ActiveAtt(tatt, ArityOfFunctor(f))) {
*H = MkAtomTerm(NameOfFunctor(f)); *HR = MkAtomTerm(NameOfFunctor(f));
H+=2; HR+=2;
} }
tatt = ArgOfTerm(1,tatt); tatt = ArgOfTerm(1,tatt);
} }
if (h0 != H) { if (h0 != HR) {
H[-1] = TermNil; HR[-1] = TermNil;
return Yap_unify(ARG2,AbsPair(h0)); return Yap_unify(ARG2,AbsPair(h0));
} }
} }
@ -887,7 +887,7 @@ p_swi_all_atts( USES_REGS1 ) {
if (IsVarTerm(inp)) { if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) { if (IsAttachedTerm(inp)) {
attvar_record *attv = RepAttVar(VarOfTerm(inp)); attvar_record *attv = RepAttVar(VarOfTerm(inp));
CELL *h0 = H; CELL *h0 = HR;
Term tatt; Term tatt;
if (IsVarTerm(tatt = attv->Atts)) if (IsVarTerm(tatt = attv->Atts))
@ -896,21 +896,21 @@ p_swi_all_atts( USES_REGS1 ) {
Functor f = FunctorOfTerm(tatt); Functor f = FunctorOfTerm(tatt);
UInt ar = ArityOfFunctor(f); UInt ar = ArityOfFunctor(f);
if (H != h0) if (HR != h0)
H[-1] = AbsAppl(H); HR[-1] = AbsAppl(HR);
H[0] = (CELL) attf; HR[0] = (CELL) attf;
H[1] = MkAtomTerm(NameOfFunctor(f)); HR[1] = MkAtomTerm(NameOfFunctor(f));
/* SWI */ /* SWI */
if (ar == 2) if (ar == 2)
H[2] = ArgOfTerm(2,tatt); HR[2] = ArgOfTerm(2,tatt);
else else
H[2] = tatt; HR[2] = tatt;
H += 4; HR += 4;
H[-1] = AbsAppl(H); HR[-1] = AbsAppl(HR);
tatt = ArgOfTerm(1,tatt); tatt = ArgOfTerm(1,tatt);
} }
if (h0 != H) { if (h0 != HR) {
H[-1] = TermNil; HR[-1] = TermNil;
return Yap_unify(ARG2,AbsAppl(h0)); return Yap_unify(ARG2,AbsAppl(h0));
} }
} }
@ -925,17 +925,17 @@ p_swi_all_atts( USES_REGS1 ) {
static Term static Term
AllAttVars( USES_REGS1 ) { AllAttVars( USES_REGS1 ) {
CELL *pt = H0; CELL *pt = H0;
CELL *myH = H; CELL *myH = HR;
while (pt < myH) { while (pt < myH) {
switch(*pt) { switch(*pt) {
case (CELL)FunctorAttVar: case (CELL)FunctorAttVar:
if (IsUnboundVar(pt+1)) { if (IsUnboundVar(pt+1)) {
if (ASP - myH < 1024) { if (ASP - myH < 1024) {
LOCAL_Error_Size = (ASP-H)*sizeof(CELL); LOCAL_Error_Size = (ASP-HR)*sizeof(CELL);
return 0L; return 0L;
} }
if (myH != H) { if (myH != HR) {
myH[-1] = AbsPair(myH); myH[-1] = AbsPair(myH);
} }
myH[0] = AbsAttVar((attvar_record *)pt); myH[0] = AbsAttVar((attvar_record *)pt);
@ -944,12 +944,15 @@ AllAttVars( USES_REGS1 ) {
pt += (1+ATT_RECORD_ARITY); pt += (1+ATT_RECORD_ARITY);
break; break;
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
pt += 4; pt += 4;
#else #else
pt += 3; pt += 3;
#endif #endif
break; break;
case (CELL)FunctorString:
pt += 3+pt[1];
break;
case (CELL)FunctorBigInt: case (CELL)FunctorBigInt:
{ {
Int sz = 3 + Int sz = 3 +
@ -965,10 +968,10 @@ AllAttVars( USES_REGS1 ) {
pt++; pt++;
} }
} }
if (myH != H) { if (myH != HR) {
Term out = AbsPair(H); Term out = AbsPair(HR);
myH[-1] = TermNil; myH[-1] = TermNil;
H = myH; HR = myH;
return out; return out;
} else { } else {
return TermNil; return TermNil;

273
C/bignum.c
View File

@ -26,6 +26,7 @@ static char SccsId[] = "%W% %G%";
#endif #endif
#include "YapHeap.h" #include "YapHeap.h"
#include "pl-utf8.h"
#ifdef USE_GMP #ifdef USE_GMP
@ -37,8 +38,8 @@ Yap_MkBigIntTerm(MP_INT *big)
{ {
CACHE_REGS CACHE_REGS
Int nlimbs; Int nlimbs;
MP_INT *dst = (MP_INT *)(H+2); MP_INT *dst = (MP_INT *)(HR+2);
CELL *ret = H; CELL *ret = HR;
Int bytes; Int bytes;
if (mpz_fits_slong_p(big)) { if (mpz_fits_slong_p(big)) {
@ -53,15 +54,15 @@ Yap_MkBigIntTerm(MP_INT *big)
if (nlimbs > (ASP-ret)-1024) { if (nlimbs > (ASP-ret)-1024) {
return TermNil; return TermNil;
} }
H[0] = (CELL)FunctorBigInt; HR[0] = (CELL)FunctorBigInt;
H[1] = BIG_INT; HR[1] = BIG_INT;
dst->_mp_size = big->_mp_size; dst->_mp_size = big->_mp_size;
dst->_mp_alloc = nlimbs*(CellSize/sizeof(mp_limb_t)); dst->_mp_alloc = nlimbs*(CellSize/sizeof(mp_limb_t));
memmove((void *)(dst+1), (const void *)(big->_mp_d), bytes); memmove((void *)(dst+1), (const void *)(big->_mp_d), bytes);
H = (CELL *)(dst+1)+nlimbs; HR = (CELL *)(dst+1)+nlimbs;
H[0] = EndSpecials; HR[0] = EndSpecials;
H++; HR++;
return AbsAppl(ret); return AbsAppl(ret);
} }
@ -80,19 +81,19 @@ Yap_MkBigRatTerm(MP_RAT *big)
{ {
CACHE_REGS CACHE_REGS
Int nlimbs; Int nlimbs;
MP_INT *dst = (MP_INT *)(H+2); MP_INT *dst = (MP_INT *)(HR+2);
MP_INT *num = mpq_numref(big); MP_INT *num = mpq_numref(big);
MP_INT *den = mpq_denref(big); MP_INT *den = mpq_denref(big);
MP_RAT *rat; MP_RAT *rat;
CELL *ret = H; CELL *ret = HR;
if (mpz_cmp_si(den, 1) == 0) if (mpz_cmp_si(den, 1) == 0)
return Yap_MkBigIntTerm(num); 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; return TermNil;
} }
H[0] = (CELL)FunctorBigInt; HR[0] = (CELL)FunctorBigInt;
H[1] = BIG_RATIONAL; HR[1] = BIG_RATIONAL;
dst->_mp_size = 0; 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_size = num->_mp_size;
@ -101,13 +102,13 @@ Yap_MkBigRatTerm(MP_RAT *big)
memmove((void *)(rat+1), (const void *)(num->_mp_d), nlimbs*CellSize); memmove((void *)(rat+1), (const void *)(num->_mp_d), nlimbs*CellSize);
rat->_mp_den._mp_size = den->_mp_size; rat->_mp_den._mp_size = den->_mp_size;
rat->_mp_den._mp_alloc = den->_mp_alloc; rat->_mp_den._mp_alloc = den->_mp_alloc;
H = (CELL *)(rat+1)+nlimbs; HR = (CELL *)(rat+1)+nlimbs;
nlimbs = (den->_mp_alloc)*(sizeof(mp_limb_t)/CellSize); nlimbs = (den->_mp_alloc)*(sizeof(mp_limb_t)/CellSize);
memmove((void *)(H), (const void *)(den->_mp_d), nlimbs*CellSize); memmove((void *)(HR), (const void *)(den->_mp_d), nlimbs*CellSize);
H += nlimbs; HR += nlimbs;
dst->_mp_alloc = (H-(CELL *)(dst+1)); dst->_mp_alloc = (HR-(CELL *)(dst+1));
H[0] = EndSpecials; HR[0] = EndSpecials;
H++; HR++;
return AbsAppl(ret); return AbsAppl(ret);
} }
@ -141,20 +142,20 @@ Yap_AllocExternalDataInStack(CELL tag, size_t bytes)
{ {
CACHE_REGS CACHE_REGS
Int nlimbs; Int nlimbs;
MP_INT *dst = (MP_INT *)(H+2); MP_INT *dst = (MP_INT *)(HR+2);
CELL *ret = H; CELL *ret = HR;
nlimbs = ALIGN_YAPTYPE(bytes,CELL)/CellSize; nlimbs = ALIGN_YAPTYPE(bytes,CELL)/CellSize;
if (nlimbs > (ASP-ret)-1024) { if (nlimbs > (ASP-ret)-1024) {
return TermNil; return TermNil;
} }
H[0] = (CELL)FunctorBigInt; HR[0] = (CELL)FunctorBigInt;
H[1] = tag; HR[1] = tag;
dst->_mp_size = 0; dst->_mp_size = 0;
dst->_mp_alloc = nlimbs; dst->_mp_alloc = nlimbs;
H = (CELL *)(dst+1)+nlimbs; HR = (CELL *)(dst+1)+nlimbs;
H[0] = EndSpecials; HR[0] = EndSpecials;
H++; HR++;
if (tag != EXTERNAL_BLOB) { if (tag != EXTERNAL_BLOB) {
TrailTerm(TR) = AbsPair(ret); TrailTerm(TR) = AbsPair(ret);
TR++; TR++;
@ -332,6 +333,82 @@ Yap_MkULLIntTerm(YAP_ULONG_LONG n)
#endif #endif
} }
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);
} else { /* string */
sz = sizeof(CELL)*(2+ptr[1]);
}
new = Yap_AllocCodeSpace(sz);
if (!new) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "subgoal_search_loop: no space for %s", StringOfTerm(t) );
} else {
if (ptr[0] == (CELL)FunctorBigInt) {
MP_INT *new = (MP_INT *)(RepAppl(t)+2);
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 str_index = 0;
CELL * li = RepAppl(t);
if (li[0] == (CELL)FunctorString) {
str_index += sprintf(& str[str_index], "\"");
do {
int chr;
char *ptr = (char *)StringOfTerm(AbsAppl(li));
ptr = utf8_get_char(ptr, &chr);
if (chr == '\0') break;
str_index += sprintf(& str[str_index], "%C", chr);
} while (TRUE);
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], "{...}");
#ifdef USE_GMP
} else if (big_tag == BIG_INT) {
MP_INT *big = Yap_BigIntOfTerm(AbsAppl(li));
char *s = mpz_get_str(&str[str_index], 10, big);
str_index += strlen(&s[str_index]);
} else if (big_tag == BIG_RATIONAL) {
MP_RAT *big = Yap_BigRatOfTerm(AbsAppl(li));
char *s = mpq_get_str(&str[str_index], 10, big);
str_index += strlen(&s[str_index]);
#endif
}
/*
else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) {
Opaque_CallOnWrite f;
CELL blob_info;
blob_info = big_tag - USER_BLOB_START;
if (GLOBAL_OpaqueHandlers &&
(f= GLOBAL_OpaqueHandlers[blob_info].write_handler)) {
(f)(wglb->stream, big_tag, ExternalBlobFromTerm(t), 0);
return;
}
} */
str_index += sprintf(& str[str_index], "0");
}
return str_index;
}
static Int static Int
p_is_bignum( USES_REGS1 ) p_is_bignum( USES_REGS1 )
{ {
@ -348,6 +425,17 @@ p_is_bignum( USES_REGS1 )
#endif #endif
} }
static Int
p_is_string( USES_REGS1 )
{
Term t = Deref(ARG1);
return(
IsNonVarTerm(t) &&
IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorString
);
}
static Int static Int
p_nb_set_bit( USES_REGS1 ) p_nb_set_bit( USES_REGS1 )
{ {
@ -469,142 +557,6 @@ p_rational( USES_REGS1 )
#endif #endif
} }
int
Yap_IsStringTerm(Term t)
{
CELL fl;
if (IsVarTerm(t))
return FALSE;
if (!IsApplTerm(t))
return FALSE;
if (FunctorOfTerm(t) != FunctorBigInt)
return FALSE;
fl = RepAppl(t)[1];
return fl == BLOB_STRING || fl == BLOB_WIDE_STRING;
}
int
Yap_IsWideStringTerm(Term t)
{
CELL fl;
if (IsVarTerm(t))
return FALSE;
if (!IsApplTerm(t))
return FALSE;
if (FunctorOfTerm(t) != FunctorBigInt)
return FALSE;
fl = RepAppl(t)[1];
return fl == BLOB_WIDE_STRING;
}
Term
Yap_MkBlobStringTerm(const char *s, size_t len)
{
CACHE_REGS
CELL *ret = H;
size_t sz;
MP_INT *dst = (MP_INT *)(H+2);
blob_string_t *sp;
size_t siz;
char *dest;
sz = strlen(s);
if (len > 0 && sz > len) sz = len;
if (len/sizeof(CELL) > (ASP-ret)-1024) {
return TermNil;
}
H[0] = (CELL)FunctorBigInt;
H[1] = BLOB_STRING;
siz = ALIGN_YAPTYPE((len+1+sizeof(blob_string_t)),CELL);
dst->_mp_size = 0L;
dst->_mp_alloc = siz/sizeof(mp_limb_t);
sp = (blob_string_t *)(dst+1);
sp->len = sz;
dest = (char *)(sp+1);
strncpy(dest, s, sz);
dest[sz] = '\0';
H += (siz + 2*sizeof(CELL)+sizeof(MP_INT)+sizeof(Functor))/sizeof(CELL);
H[-1] = EndSpecials;
return AbsAppl(ret);
}
Term
Yap_MkBlobWideStringTerm(const wchar_t *s, size_t len)
{
CACHE_REGS
CELL *ret = H;
size_t sz;
MP_INT *dst = (MP_INT *)(H+2);
blob_string_t *sp = (blob_string_t *)(dst+1);
size_t siz, i = 0;
H[0] = (CELL)FunctorBigInt;
dst->_mp_size = 0L;
sz = wcslen(s);
if (len > 0 && sz > len) {
sz = len;
}
if ((len/sizeof(CELL)) > (ASP-ret)-1024) {
return TermNil;
}
while (i < sz) {
if (s[i++] >= 255) break;
}
if (i == sz) {
/* we have a standard ascii string */
char *target;
size_t i = 0;
H[1] = BLOB_STRING;
siz = ALIGN_YAPTYPE((sz+1+sizeof(blob_string_t)),CELL);
dst->_mp_alloc = siz/sizeof(mp_limb_t);
sp->len = sz;
target = (char *)(sp+1);
for (i = 0 ; i < sz; i++) {
target[i] = s[i];
}
target[sz] = '\0';
H += (siz+2*sizeof(CELL)+sizeof(MP_INT)+sizeof(Functor))/sizeof(CELL);
} else {
wchar_t * target;
H[1] = BLOB_WIDE_STRING;
siz = ALIGN_YAPTYPE((sz+1)*sizeof(wchar_t)+sizeof(blob_string_t),CELL);
dst->_mp_alloc = siz/sizeof(mp_limb_t);
sp->len = sz;
target = (wchar_t *)(sp+1);
wcsncpy(target, s, sz);
target[sz] = '\0';
H += (siz + 2*sizeof(CELL)+sizeof(MP_INT)+sizeof(Functor))/sizeof(CELL);
}
H[-1] = EndSpecials;
return AbsAppl(ret);
}
char *
Yap_BlobStringOfTerm(Term t)
{
blob_string_t *new = (blob_string_t *)(RepAppl(t)+2+sizeof(MP_INT)/sizeof(CELL));
return (char *)(new+1);
}
wchar_t *
Yap_BlobWideStringOfTerm(Term t)
{
blob_string_t *new = (blob_string_t *)(RepAppl(t)+2+sizeof(MP_INT)/sizeof(CELL));
return (wchar_t *)(new+1);
}
char *
Yap_BlobStringOfTermAndLength(Term t, size_t *sp)
{
blob_string_t *new = (blob_string_t *)(RepAppl(t)+2+sizeof(MP_INT)/sizeof(CELL));
*sp = new->len;
return (char *)(new+1);
}
void void
Yap_InitBigNums(void) Yap_InitBigNums(void)
{ {
@ -612,6 +564,7 @@ Yap_InitBigNums(void)
Yap_InitCPred("$bignum", 1, p_is_bignum, SafePredFlag); Yap_InitCPred("$bignum", 1, p_is_bignum, SafePredFlag);
Yap_InitCPred("rational", 3, p_rational, 0); Yap_InitCPred("rational", 3, p_rational, 0);
Yap_InitCPred("rational", 1, p_is_rational, SafePredFlag); Yap_InitCPred("rational", 1, p_is_rational, SafePredFlag);
Yap_InitCPred("string", 1, p_is_string, SafePredFlag);
Yap_InitCPred("opaque", 1, p_is_opaque, SafePredFlag); Yap_InitCPred("opaque", 1, p_is_opaque, SafePredFlag);
Yap_InitCPred("nb_set_bit", 2, p_nb_set_bit, SafePredFlag); Yap_InitCPred("nb_set_bit", 2, p_nb_set_bit, SafePredFlag);
} }

321
C/c_interface.c
View File

@ -354,6 +354,7 @@
#include "yap_structs.h" #include "yap_structs.h"
#define _yap_c_interface_h 1 #define _yap_c_interface_h 1
#include "pl-shared.h" #include "pl-shared.h"
#include "YapText.h"
#include "pl-read.h" #include "pl-read.h"
#ifdef TABLING #ifdef TABLING
#include "tab.macros.h" #include "tab.macros.h"
@ -362,9 +363,7 @@
#include "or.macros.h" #include "or.macros.h"
#endif /* YAPOR */ #endif /* YAPOR */
#include "threads.h" #include "threads.h"
#ifdef CUT_C
#include "cut_c.h" #include "cut_c.h"
#endif /* CUT_C */
#if HAVE_MALLOC_H #if HAVE_MALLOC_H
#include <malloc.h> #include <malloc.h>
#endif #endif
@ -378,8 +377,6 @@
#if defined(_MSC_VER) && defined(YAP_EXPORTS) #if defined(_MSC_VER) && defined(YAP_EXPORTS)
#define X_API __declspec(dllexport) #define X_API __declspec(dllexport)
#else
#define X_API
#endif #endif
X_API Term YAP_A(int); X_API Term YAP_A(int);
@ -516,10 +513,8 @@ X_API void YAP_PredicateInfo(void *,Atom *,UInt *,Term *);
X_API void YAP_UserCPredicate(char *,CPredicate,UInt); X_API void YAP_UserCPredicate(char *,CPredicate,UInt);
X_API void YAP_UserBackCPredicate(char *,CPredicate,CPredicate,UInt,unsigned int); X_API void YAP_UserBackCPredicate(char *,CPredicate,CPredicate,UInt,unsigned int);
X_API void YAP_UserCPredicateWithArgs(char *,CPredicate,UInt,Term); X_API void YAP_UserCPredicateWithArgs(char *,CPredicate,UInt,Term);
#ifdef CUT_C
X_API void YAP_UserBackCutCPredicate(char *,CPredicate,CPredicate,CPredicate,UInt,unsigned int); X_API void YAP_UserBackCutCPredicate(char *,CPredicate,CPredicate,CPredicate,UInt,unsigned int);
X_API void *YAP_ExtraSpaceCut(void); X_API void *YAP_ExtraSpaceCut(void);
#endif
X_API Term YAP_SetCurrentModule(Term); X_API Term YAP_SetCurrentModule(Term);
X_API Term YAP_CurrentModule(void); X_API Term YAP_CurrentModule(void);
X_API Term YAP_CreateModule(Atom); X_API Term YAP_CreateModule(Atom);
@ -566,6 +561,7 @@ X_API void *YAP_ExternalDataInStackFromTerm(Term);
X_API int YAP_NewOpaqueType(void *); X_API int YAP_NewOpaqueType(void *);
X_API Term YAP_NewOpaqueObject(int, size_t); X_API Term YAP_NewOpaqueObject(int, size_t);
X_API void *YAP_OpaqueObjectFromTerm(Term); X_API void *YAP_OpaqueObjectFromTerm(Term);
X_API CELL *YAP_HeapStoreOpaqueTerm(Term t);
X_API int YAP_Argv(char *** argvp); X_API int YAP_Argv(char *** argvp);
X_API YAP_tag_t YAP_TagOfTerm(Term); X_API YAP_tag_t YAP_TagOfTerm(Term);
X_API size_t YAP_ExportTerm(Term, char *, size_t); X_API size_t YAP_ExportTerm(Term, char *, size_t);
@ -800,21 +796,21 @@ YAP_MkBlobTerm(unsigned int sz)
MP_INT *dst; MP_INT *dst;
BACKUP_H(); BACKUP_H();
while (H+(sz+sizeof(MP_INT)/sizeof(CELL)+2) > ASP-1024) { while (HR+(sz+sizeof(MP_INT)/sizeof(CELL)+2) > ASP-1024) {
if (!doexpand((sz+sizeof(MP_INT)/sizeof(CELL)+2)*sizeof(CELL))) { if (!doexpand((sz+sizeof(MP_INT)/sizeof(CELL)+2)*sizeof(CELL))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, "YAP failed to grow the stack while constructing a blob: %s", LOCAL_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, "YAP failed to grow the stack while constructing a blob: %s", LOCAL_ErrorMessage);
return TermNil; return TermNil;
} }
} }
I = AbsAppl(H); I = AbsAppl(HR);
H[0] = (CELL)FunctorBigInt; HR[0] = (CELL)FunctorBigInt;
H[1] = ARRAY_INT; HR[1] = ARRAY_INT;
dst = (MP_INT *)(H+2); dst = (MP_INT *)(HR+2);
dst->_mp_size = 0L; dst->_mp_size = 0L;
dst->_mp_alloc = sz; dst->_mp_alloc = sz;
H += (2+sizeof(MP_INT)/sizeof(CELL)); HR += (2+sizeof(MP_INT)/sizeof(CELL));
H[sz] = EndSpecials; HR[sz] = EndSpecials;
H += sz+1; HR += sz+1;
RECOVER_H(); RECOVER_H();
return I; return I;
@ -980,7 +976,7 @@ YAP_MkPairTerm(Term t1, Term t2)
Term t; Term t;
BACKUP_H(); BACKUP_H();
while (H > ASP-1024) { while (HR > ASP-1024) {
Int sl1 = Yap_InitSlot(t1 PASS_REGS); Int sl1 = Yap_InitSlot(t1 PASS_REGS);
Int sl2 = Yap_InitSlot(t2 PASS_REGS); Int sl2 = Yap_InitSlot(t2 PASS_REGS);
RECOVER_H(); RECOVER_H();
@ -1006,7 +1002,7 @@ YAP_MkListFromTerms(Term *ta, Int sz)
if (sz == 0) if (sz == 0)
return TermNil; return TermNil;
BACKUP_H(); BACKUP_H();
while (H+sz*2 > ASP-1024) { while (HR+sz*2 > ASP-1024) {
Int sl1 = Yap_InitSlot((CELL)ta PASS_REGS); Int sl1 = Yap_InitSlot((CELL)ta PASS_REGS);
RECOVER_H(); RECOVER_H();
if (!Yap_dogc( 0, NULL PASS_REGS )) { if (!Yap_dogc( 0, NULL PASS_REGS )) {
@ -1016,7 +1012,7 @@ YAP_MkListFromTerms(Term *ta, Int sz)
ta = (CELL *)Yap_GetFromSlot(sl1 PASS_REGS); ta = (CELL *)Yap_GetFromSlot(sl1 PASS_REGS);
Yap_RecoverSlots(1 PASS_REGS); Yap_RecoverSlots(1 PASS_REGS);
} }
h = H; h = HR;
t = AbsPair(h); t = AbsPair(h);
while (sz--) { while (sz--) {
Term ti = *ta++; Term ti = *ta++;
@ -1030,7 +1026,7 @@ YAP_MkListFromTerms(Term *ta, Int sz)
h += 2; h += 2;
} }
h[-1] = TermNil; h[-1] = TermNil;
H = h; HR = h;
RECOVER_H(); RECOVER_H();
return t; return t;
} }
@ -1042,7 +1038,7 @@ YAP_MkNewPairTerm()
Term t; Term t;
BACKUP_H(); BACKUP_H();
if (H > ASP-1024) if (HR > ASP-1024)
t = TermNil; t = TermNil;
else else
t = Yap_MkNewPairTerm(); t = Yap_MkNewPairTerm();
@ -1100,7 +1096,7 @@ YAP_MkApplTerm(Functor f,UInt arity, Term args[])
Term t; Term t;
BACKUP_H(); BACKUP_H();
if (H+arity > ASP-1024) if (HR+arity > ASP-1024)
t = TermNil; t = TermNil;
else else
t = Yap_MkApplTerm(f, arity, args); t = Yap_MkApplTerm(f, arity, args);
@ -1116,7 +1112,7 @@ YAP_MkNewApplTerm(Functor f,UInt arity)
Term t; Term t;
BACKUP_H(); BACKUP_H();
if (H+arity > ASP-1024) if (HR+arity > ASP-1024)
t = TermNil; t = TermNil;
else else
t = Yap_MkNewApplTerm(f, arity); t = Yap_MkNewApplTerm(f, arity);
@ -1166,7 +1162,6 @@ YAP_ArityOfFunctor(Functor f)
return (ArityOfFunctor(f)); return (ArityOfFunctor(f));
} }
#ifdef CUT_C
X_API void * X_API void *
YAP_ExtraSpaceCut(void) YAP_ExtraSpaceCut(void)
{ {
@ -1179,7 +1174,6 @@ YAP_ExtraSpaceCut(void)
RECOVER_B(); RECOVER_B();
return(ptr); return(ptr);
} }
#endif /*CUT_C*/
X_API void * X_API void *
YAP_ExtraSpace(void) YAP_ExtraSpace(void)
@ -1191,7 +1185,7 @@ YAP_ExtraSpace(void)
/* find a pointer to extra space allocable */ /* find a pointer to extra space allocable */
ptr = (void *)((CELL *)(B+1)+P->u.OtapFs.s); ptr = (void *)((CELL *)(B+1)+P->u.OtapFs.s);
B->cp_h = H; B->cp_h = HR;
RECOVER_H(); RECOVER_H();
RECOVER_B(); RECOVER_B();
@ -1203,14 +1197,12 @@ YAP_cut_up(void)
{ {
CACHE_REGS CACHE_REGS
BACKUP_B(); BACKUP_B();
#ifdef CUT_C
{ {
while (POP_CHOICE_POINT(B->cp_b)) while (POP_CHOICE_POINT(B->cp_b))
{ {
POP_EXECUTE(); POP_EXECUTE();
} }
} }
#endif /* CUT_C */
/* This is complicated: make sure we can restore the ASP /* This is complicated: make sure we can restore the ASP
pointer back to where cut_up called it. Slots depend on it. */ pointer back to where cut_up called it. Slots depend on it. */
if (ENV > B->cp_env) { if (ENV > B->cp_env) {
@ -1644,7 +1636,7 @@ complete_fail(choiceptr ptr, int has_cp USES_REGS)
static int static int
complete_exit(choiceptr ptr, int has_cp, int cut_all USES_REGS) complete_exit(choiceptr ptr, int has_cp, int cut_all USES_REGS)
{ {
// the user often leaves open frames, especially in forward execuryion // the user often leaves open frames, especially in forward execution
while (B && (!ptr || B < ptr)) { while (B && (!ptr || B < ptr)) {
if (cut_all || B->cp_ap == NOCODE) {/* separator */ if (cut_all || B->cp_ap == NOCODE) {/* separator */
do_cut( TRUE ); // pushes B up do_cut( TRUE ); // pushes B up
@ -1780,6 +1772,7 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
} }
} else { } else {
Int ret = (exec_code)( PASS_REGS1 ); Int ret = (exec_code)( PASS_REGS1 );
LOCAL_CurSlot = CurSlot;
if (!ret) { if (!ret) {
Term t; Term t;
@ -1907,6 +1900,7 @@ YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
return TRUE; return TRUE;
} else { } else {
Int ret = (exec_code)( PASS_REGS1 ); Int ret = (exec_code)( PASS_REGS1 );
LOCAL_CurSlot = CurSlot;
if (!ret) { if (!ret) {
Term t; Term t;
@ -1984,42 +1978,16 @@ YAP_FreeSpaceFromYap(void *ptr)
X_API int X_API int
YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize)
{ {
unsigned int j = 0; CACHE_REGS
seq_tv_t inp, out;
while (t != TermNil) { inp.val.t = t;
register Term Head; inp.type = YAP_STRING_CODES|YAP_STRING_TRUNC;
register Int i; inp.max = bufsize;
out.type = YAP_STRING_CHARS;
Head = HeadOfTerm(t); out.val.c = buf;
if (IsVarTerm(Head)) { if (!Yap_CVT_Text(&inp, &out PASS_REGS))
Yap_Error(INSTANTIATION_ERROR,Head,"user defined procedure"); return FALSE;
return(FALSE); return TRUE;
} else if (!IsIntTerm(Head)) {
Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure");
return FALSE;
}
i = IntOfTerm(Head);
if (i < 0 || i > 255) {
Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure");
return FALSE;
}
if (j == bufsize) {
buf[bufsize-1] = '\0';
return FALSE;
} else {
buf[j++] = i;
}
t = TailOfTerm(t);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t,"user defined procedure");
return FALSE;
} else if (!IsPairTerm(t) && t != TermNil) {
Yap_Error(TYPE_ERROR_LIST, t, "user defined procedure");
return FALSE;
}
}
buf[j] = '\0';
return(TRUE);
} }
@ -2030,7 +1998,14 @@ YAP_BufferToString(char *s)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = Yap_StringToList(s); CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H(); RECOVER_H();
return t; return t;
@ -2043,7 +2018,16 @@ YAP_NBufferToString(char *s, size_t len)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = Yap_NStringToList(s, len); CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
out.max = len;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H(); RECOVER_H();
return t; return t;
@ -2056,7 +2040,14 @@ YAP_WideBufferToString(wchar_t *s)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = Yap_WideStringToList(s); CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H(); RECOVER_H();
return t; return t;
@ -2069,7 +2060,16 @@ YAP_NWideBufferToString(wchar_t *s, size_t len)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = Yap_NWideStringToList(s, len); CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
out.max = len;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H(); RECOVER_H();
return t; return t;
@ -2131,7 +2131,14 @@ YAP_BufferToAtomList(char *s)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = Yap_StringToListOfAtoms(s); CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOMS;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H(); RECOVER_H();
return t; return t;
@ -2144,7 +2151,16 @@ YAP_NBufferToAtomList(char *s, size_t len)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = Yap_NStringToListOfAtoms(s, len); CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
out.max = len;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H(); RECOVER_H();
return t; return t;
@ -2157,7 +2173,14 @@ YAP_WideBufferToAtomList(wchar_t *s)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = Yap_WideStringToListOfAtoms(s); CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_ATOMS;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H(); RECOVER_H();
return t; return t;
@ -2170,7 +2193,16 @@ YAP_NWideBufferToAtomList(wchar_t *s, size_t len)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = Yap_NWideStringToListOfAtoms(s, len); CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
out.max = len;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H(); RECOVER_H();
return t; return t;
@ -2183,7 +2215,17 @@ YAP_NWideBufferToAtomDiffList(wchar_t *s, Term t0, size_t len)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = Yap_NWideStringToDiffListOfAtoms(s, t0, len); CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
out.sz = len;
out.max = len;
out.dif = t0;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H(); RECOVER_H();
return t; return t;
@ -2193,11 +2235,18 @@ YAP_NWideBufferToAtomDiffList(wchar_t *s, Term t0, size_t len)
X_API Term X_API Term
YAP_BufferToDiffList(char *s, Term t0) YAP_BufferToDiffList(char *s, Term t0)
{ {
CACHE_REGS
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = Yap_StringToDiffList(s, t0 PASS_REGS); CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES|YAP_STRING_DIFF;
out.dif = t0;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H(); RECOVER_H();
return t; return t;
@ -2210,7 +2259,17 @@ YAP_NBufferToDiffList(char *s, Term t0, size_t len)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = Yap_NStringToDiffList(s, t0, len); CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
out.sz = len;
out.max = len;
out.dif = t0;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H(); RECOVER_H();
return t; return t;
@ -2223,7 +2282,15 @@ YAP_WideBufferToDiffList(wchar_t *s, Term t0)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = Yap_WideStringToDiffList(s, t0); CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES|YAP_STRING_DIFF;
out.dif = t0;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H(); RECOVER_H();
return t; return t;
@ -2236,7 +2303,17 @@ YAP_NWideBufferToDiffList(wchar_t *s, Term t0, size_t len)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = Yap_NWideStringToDiffList(s, t0, len); CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
out.sz = len;
out.max = len;
out.dif = t0;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H(); RECOVER_H();
return t; return t;
@ -2300,9 +2377,9 @@ run_emulator(YAP_dogoalinfo *dgi USES_REGS)
{ {
int out; int out;
LOCAL_PrologMode = UserMode; LOCAL_PrologMode &= ~(UserCCallMode|CCallMode);
out = Yap_absmi(0); out = Yap_absmi(0);
LOCAL_PrologMode = UserCCallMode; LOCAL_PrologMode |= UserCCallMode;
return out; return out;
} }
@ -2313,6 +2390,7 @@ YAP_EnterGoal(PredEntry *pe, Term *ptr, YAP_dogoalinfo *dgi)
int out; int out;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
LOCAL_PrologMode = UserMode;
dgi->p = P; dgi->p = P;
dgi->cp = CP; dgi->cp = CP;
dgi->CurSlot = LOCAL_CurSlot; dgi->CurSlot = LOCAL_CurSlot;
@ -2380,7 +2458,7 @@ YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi)
P = FAILCODE; P = FAILCODE;
Yap_exec_absmi(TRUE); Yap_exec_absmi(TRUE);
/* recover stack space */ /* recover stack space */
H = B->cp_h; HR = B->cp_h;
TR = B->cp_tr; TR = B->cp_tr;
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
DEPTH = B->cp_depth; DEPTH = B->cp_depth;
@ -2506,6 +2584,12 @@ YAP_OpaqueObjectFromTerm(Term t)
return ExternalBlobFromTerm (t); return ExternalBlobFromTerm (t);
} }
X_API CELL *
YAP_HeapStoreOpaqueTerm(Term t)
{
return Yap_HeapStoreOpaqueTerm(t);
}
X_API Int X_API Int
YAP_RunGoalOnce(Term t) YAP_RunGoalOnce(Term t)
{ {
@ -2610,7 +2694,7 @@ YAP_ShutdownGoal(int backtrack)
P = FAILCODE; P = FAILCODE;
Yap_exec_absmi(TRUE); Yap_exec_absmi(TRUE);
/* recover stack space */ /* recover stack space */
H = cut_pt->cp_h; HR = cut_pt->cp_h;
TR = cut_pt->cp_tr; TR = cut_pt->cp_tr;
} }
/* we can always recover the stack */ /* we can always recover the stack */
@ -2767,7 +2851,7 @@ YAP_Read(IOSTREAM *inp)
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp, FALSE, &tpos); tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp, FALSE, &tpos, &rd);
if (LOCAL_ErrorMessage) if (LOCAL_ErrorMessage)
{ {
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
@ -3087,7 +3171,11 @@ YAP_Init(YAP_init_args *yap_init)
#endif /* YAPOR || TABLING */ #endif /* YAPOR || TABLING */
#ifdef YAPOR #ifdef YAPOR
Yap_init_yapor_workers(); Yap_init_yapor_workers();
#if YAPOR_THREADS
if (Yap_thread_self() != 0) {
#else
if (worker_id != 0) { if (worker_id != 0) {
#endif
#if defined(YAPOR_COPY) || defined(YAPOR_SBA) #if defined(YAPOR_COPY) || defined(YAPOR_SBA)
/* /*
In the SBA we cannot just happily inherit registers In the SBA we cannot just happily inherit registers
@ -3131,21 +3219,6 @@ YAP_Init(YAP_init_args *yap_init)
*/ */
yap_flags[HALT_AFTER_CONSULT_FLAG] = yap_init->HaltAfterConsult; yap_flags[HALT_AFTER_CONSULT_FLAG] = yap_init->HaltAfterConsult;
} }
#ifdef MYDDAS_MYSQL
if (yap_init->myddas) {
Yap_PutValue(AtomMyddasGoal,MkIntegerTerm(yap_init->myddas));
/* Mandatory Fields */
Yap_PutValue(AtomMyddasUser,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_user)));
Yap_PutValue(AtomMyddasDB,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_db)));
/* Non-Mandatory Fields */
if (yap_init->myddas_pass != NULL)
Yap_PutValue(AtomMyddasPass,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_pass)));
if (yap_init->myddas_host != NULL)
Yap_PutValue(AtomMyddasHost,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_host)));
}
#endif
if (yap_init->YapPrologTopLevelGoal) { if (yap_init->YapPrologTopLevelGoal) {
Yap_PutValue(AtomTopLevelGoal, MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologTopLevelGoal))); Yap_PutValue(AtomTopLevelGoal, MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologTopLevelGoal)));
} }
@ -3168,12 +3241,13 @@ YAP_Init(YAP_init_args *yap_init)
Yap_AttsSize = Atts*1024; Yap_AttsSize = Atts*1024;
else else
Yap_AttsSize = 2048*sizeof(CELL); Yap_AttsSize = 2048*sizeof(CELL);
/* reset stacks */
// Yap_StartSlots( PASS_REGS1 );
if (restore_result == DO_ONLY_CODE) { if (restore_result == DO_ONLY_CODE) {
/* first, initialise the saved state */ /* first, initialise the saved state */
Term t_goal = MkAtomTerm(AtomInitProlog); Term t_goal = MkAtomTerm(AtomInitProlog);
YAP_RunGoalOnce(t_goal); YAP_RunGoalOnce(t_goal);
// Yap_InitYaamRegs( 0 ); Yap_InitYaamRegs( 0 );
/* reset stacks */
return YAP_BOOT_FROM_SAVED_CODE; return YAP_BOOT_FROM_SAVED_CODE;
} else { } else {
return YAP_BOOT_FROM_SAVED_STACKS; return YAP_BOOT_FROM_SAVED_STACKS;
@ -3284,9 +3358,6 @@ YAP_Reset(void)
{ {
CACHE_REGS CACHE_REGS
int res = TRUE; int res = TRUE;
#if !defined(YAPOR) && !defined(THREADS)
int worker_id = 0;
#endif
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
YAP_ClearExceptions(); YAP_ClearExceptions();
@ -3304,6 +3375,9 @@ YAP_Reset(void)
/* the first real choice-point will also have AP=FAIL */ /* the first real choice-point will also have AP=FAIL */
/* always have an empty slots for people to use */ /* always have an empty slots for people to use */
P = CP = YESCODE; P = CP = YESCODE;
// ensure that we have slots where we need them
LOCAL_CurSlot = 0;
Yap_StartSlots( PASS_REGS1 );
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return res; return res;
} }
@ -3423,23 +3497,16 @@ X_API void
YAP_UserBackCPredicate(char *name, CPredicate init, CPredicate cont, YAP_UserBackCPredicate(char *name, CPredicate init, CPredicate cont,
UInt arity, unsigned int extra) UInt arity, unsigned int extra)
{ {
#ifdef CUT_C
Yap_InitCPredBackCut(name, arity, extra, init, cont, NULL ,UserCPredFlag); Yap_InitCPredBackCut(name, arity, extra, init, cont, NULL ,UserCPredFlag);
#else
Yap_InitCPredBack(name, arity, extra, init, cont, UserCPredFlag);
#endif
} }
#ifdef CUT_C
X_API void X_API void
YAP_UserBackCutCPredicate(char *name, CPredicate init, CPredicate cont, CPredicate cut, YAP_UserBackCutCPredicate(char *name, CPredicate init, CPredicate cont, CPredicate cut,
UInt arity, unsigned int extra) UInt arity, unsigned int extra)
{ {
Yap_InitCPredBackCut(name, arity, extra, init, cont, cut, UserCPredFlag); Yap_InitCPredBackCut(name, arity, extra, init, cont, cut, UserCPredFlag);
} }
#endif
X_API void X_API void
YAP_UserCPredicateWithArgs(char *a, CPredicate f, UInt arity, Term mod) YAP_UserCPredicateWithArgs(char *a, CPredicate f, UInt arity, Term mod)
@ -3607,8 +3674,8 @@ YAP_FloatsToList(double *dblp, size_t sz)
if (!sz) if (!sz)
return TermNil; return TermNil;
while (ASP-1024 < H + sz*(2+2+SIZEOF_DOUBLE/SIZEOF_LONG_INT)) { while (ASP-1024 < HR + sz*(2+2+SIZEOF_DOUBLE/SIZEOF_INT_P)) {
if ((CELL *)dblp > H0 && (CELL *)dblp < H) { if ((CELL *)dblp > H0 && (CELL *)dblp < HR) {
/* we are in trouble */ /* we are in trouble */
LOCAL_OpenArray = (CELL *)dblp; LOCAL_OpenArray = (CELL *)dblp;
} }
@ -3619,12 +3686,12 @@ YAP_FloatsToList(double *dblp, size_t sz)
dblp = (double *)LOCAL_OpenArray; dblp = (double *)LOCAL_OpenArray;
LOCAL_OpenArray = NULL; LOCAL_OpenArray = NULL;
} }
t = AbsPair(H); t = AbsPair(HR);
while (sz) { while (sz) {
oldH = H; oldH = HR;
H +=2; HR +=2;
oldH[0] = MkFloatTerm(*dblp++); oldH[0] = MkFloatTerm(*dblp++);
oldH[1] = AbsPair(H); oldH[1] = AbsPair(HR);
sz--; sz--;
} }
oldH[1] = TermNil; oldH[1] = TermNil;
@ -3679,8 +3746,8 @@ YAP_IntsToList(Int *dblp, size_t sz)
if (!sz) if (!sz)
return TermNil; return TermNil;
while (ASP-1024 < H + sz*3) { while (ASP-1024 < HR + sz*3) {
if ((CELL *)dblp > H0 && (CELL *)dblp < H) { if ((CELL *)dblp > H0 && (CELL *)dblp < HR) {
/* we are in trouble */ /* we are in trouble */
LOCAL_OpenArray = (CELL *)dblp; LOCAL_OpenArray = (CELL *)dblp;
} }
@ -3691,12 +3758,12 @@ YAP_IntsToList(Int *dblp, size_t sz)
dblp = (Int *)LOCAL_OpenArray; dblp = (Int *)LOCAL_OpenArray;
LOCAL_OpenArray = NULL; LOCAL_OpenArray = NULL;
} }
t = AbsPair(H); t = AbsPair(HR);
while (sz) { while (sz) {
oldH = H; oldH = HR;
H +=2; HR +=2;
oldH[0] = MkIntegerTerm(*dblp++); oldH[0] = MkIntegerTerm(*dblp++);
oldH[1] = AbsPair(H); oldH[1] = AbsPair(HR);
sz--; sz--;
} }
oldH[1] = TermNil; oldH[1] = TermNil;
@ -3735,14 +3802,14 @@ YAP_OpenList(int n)
Term t; Term t;
BACKUP_H(); BACKUP_H();
while (H+2*n > ASP-1024) { while (HR+2*n > ASP-1024) {
if (!Yap_dogc( 0, NULL PASS_REGS )) { if (!Yap_dogc( 0, NULL PASS_REGS )) {
RECOVER_H(); RECOVER_H();
return FALSE; return FALSE;
} }
} }
t = AbsPair(H); t = AbsPair(HR);
H += 2*n; HR += 2*n;
RECOVER_H(); RECOVER_H();
return t; return t;
@ -3955,7 +4022,7 @@ YAP_SetYAPFlag(yap_flag_t flag, int val)
Int YAP_VarSlotToNumber(Int s) { Int YAP_VarSlotToNumber(Int s) {
CACHE_REGS CACHE_REGS
Term *t = (CELL *)Deref(Yap_GetFromSlot(s PASS_REGS)); Term *t = (CELL *)Deref(Yap_GetFromSlot(s PASS_REGS));
if (t < H) if (t < HR)
return t-H0; return t-H0;
return t-LCL0; return t-LCL0;
} }
@ -4165,11 +4232,11 @@ YAP_RequiresExtraStack(size_t sz) {
if (sz < 16*1024) if (sz < 16*1024)
sz = 16*1024; sz = 16*1024;
if (H <= ASP-sz) { if (HR <= ASP-sz) {
return FALSE; return FALSE;
} }
BACKUP_H(); BACKUP_H();
while (H > ASP-sz) { while (HR > ASP-sz) {
CACHE_REGS CACHE_REGS
RECOVER_H(); RECOVER_H();
if (!Yap_dogc( 0, NULL PASS_REGS )) { if (!Yap_dogc( 0, NULL PASS_REGS )) {

429
C/cdmgr.c
View File

@ -515,7 +515,6 @@ static Int p_call_count_info( USES_REGS1 );
static Int p_call_count_set( USES_REGS1 ); static Int p_call_count_set( USES_REGS1 );
static Int p_call_count_reset( USES_REGS1 ); static Int p_call_count_reset( USES_REGS1 );
static Int p_toggle_static_predicates_in_use( USES_REGS1 ); static Int p_toggle_static_predicates_in_use( USES_REGS1 );
static Atom YapConsultingFile( USES_REGS1 );
static Int PredForCode(yamop *, Atom *, UInt *, Term *); static Int PredForCode(yamop *, Atom *, UInt *, Term *);
static void kill_first_log_iblock(LogUpdIndex *, LogUpdIndex *, PredEntry *); static void kill_first_log_iblock(LogUpdIndex *, LogUpdIndex *, PredEntry *);
static LogUpdIndex *find_owner_log_index(LogUpdIndex *, yamop *); static LogUpdIndex *find_owner_log_index(LogUpdIndex *, yamop *);
@ -523,7 +522,6 @@ static StaticIndex *find_owner_static_index(StaticIndex *, yamop *);
#define PredArity(p) (p->ArityOfPE) #define PredArity(p) (p->ArityOfPE)
#define TRYCODE(G,F,N) ( (N)<5 ? (op_numbers)((int)F+(N)*3) : G) #define TRYCODE(G,F,N) ( (N)<5 ? (op_numbers)((int)F+(N)*3) : G)
#define NEXTOP(V,TYPE) ((yamop *)(&((V)->u.TYPE.next)))
#define IN_BLOCK(P,B,SZ) ((CODEADDR)(P) >= (CODEADDR)(B) && \ #define IN_BLOCK(P,B,SZ) ((CODEADDR)(P) >= (CODEADDR)(B) && \
(CODEADDR)(P) < (CODEADDR)(B)+(SZ)) (CODEADDR)(P) < (CODEADDR)(B)+(SZ))
@ -2033,7 +2031,7 @@ not_was_reconsulted(PredEntry *p, Term t, int mode)
!(p->PredFlags & MultiFileFlag)) /* we are in reconsult mode */ { !(p->PredFlags & MultiFileFlag)) /* we are in reconsult mode */ {
retract_all(p, static_in_use(p,TRUE)); retract_all(p, static_in_use(p,TRUE));
} }
p->src.OwnerFile = YapConsultingFile( PASS_REGS1 ); p->src.OwnerFile = Yap_ConsultingFile( PASS_REGS1 );
} }
return TRUE; /* careful */ return TRUE; /* careful */
} }
@ -2363,7 +2361,7 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
if (pflags & MultiFileFlag) { if (pflags & MultiFileFlag) {
/* add Info on new clause for multifile predicates to the DB */ /* add Info on new clause for multifile predicates to the DB */
Term t[5], tn; Term t[5], tn;
t[0] = MkAtomTerm(YapConsultingFile( PASS_REGS1 )); t[0] = MkAtomTerm(Yap_ConsultingFile( PASS_REGS1 ));
t[1] = MkAtomTerm(at); t[1] = MkAtomTerm(at);
t[2] = MkIntegerTerm(Arity); t[2] = MkIntegerTerm(Arity);
t[3] = mod; t[3] = mod;
@ -2571,8 +2569,8 @@ p_compile_dynamic( USES_REGS1 )
return TRUE; return TRUE;
} }
static Atom Atom
YapConsultingFile ( USES_REGS1 ) Yap_ConsultingFile ( USES_REGS1 )
{ {
if (LOCAL_consult_level == 0) { if (LOCAL_consult_level == 0) {
return(AtomUser); return(AtomUser);
@ -2581,13 +2579,6 @@ YapConsultingFile ( USES_REGS1 )
} }
} }
Atom
Yap_ConsultingFile ( void )
{
CACHE_REGS
return YapConsultingFile( PASS_REGS1 );
}
/* consult file *file*, *mode* may be one of either consult or reconsult */ /* consult file *file*, *mode* may be one of either consult or reconsult */
static void static void
init_consult(int mode, char *file) init_consult(int mode, char *file)
@ -2735,6 +2726,57 @@ p_purge_clauses( USES_REGS1 )
******************************************************************/ ******************************************************************/
static Int
p_is_no_trace( USES_REGS1 )
{ /* '$undefined'(P,Mod) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
if (EndOfPAEntr(pe))
return TRUE;
PELOCK(36,pe);
if (pe->ExtraPredFlags & NoTracePredFlag) {
UNLOCKPE(57,pe);
return TRUE;
}
UNLOCKPE(59,pe);
return FALSE;
}
static Int
p_set_no_trace( USES_REGS1 )
{ /* '$set_no_trace'(+Fun,+M) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(36,pe);
pe->ExtraPredFlags |= NoTracePredFlag;
UNLOCKPE(57,pe);
return TRUE;
}
int
Yap_SetNoTrace(char *name, UInt arity, Term tmod)
{
PredEntry *pe;
if (arity == 0) {
pe = get_pred(MkAtomTerm(Yap_LookupAtom(name)), tmod, "no_trace");
} else {
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom(name), arity),tmod));
}
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(36,pe);
pe->ExtraPredFlags |= NoTracePredFlag;
UNLOCKPE(57,pe);
return TRUE;
}
static Int static Int
p_setspy( USES_REGS1 ) p_setspy( USES_REGS1 )
{ /* '$set_spy'(+Fun,+M) */ { /* '$set_spy'(+Fun,+M) */
@ -2941,6 +2983,7 @@ p_new_multifile( USES_REGS1 )
/* static */ /* static */
pe->PredFlags |= (SourcePredFlag|CompiledPredFlag); pe->PredFlags |= (SourcePredFlag|CompiledPredFlag);
} }
pe->src.OwnerFile = Yap_ConsultingFile( PASS_REGS1 );
UNLOCKPE(43,pe); UNLOCKPE(43,pe);
return (TRUE); return (TRUE);
} }
@ -3049,7 +3092,7 @@ p_mk_d( USES_REGS1 )
if (pe->OpcodeOfPred == UNDEF_OPCODE) { if (pe->OpcodeOfPred == UNDEF_OPCODE) {
pe->OpcodeOfPred = FAIL_OPCODE; pe->OpcodeOfPred = FAIL_OPCODE;
} }
pe->src.OwnerFile = YapConsultingFile( PASS_REGS1 ); pe->src.OwnerFile = Yap_ConsultingFile( PASS_REGS1 );
UNLOCKPE(50,pe); UNLOCKPE(50,pe);
return TRUE; return TRUE;
} }
@ -3468,26 +3511,26 @@ Yap_find_owner_index(yamop *ipc, PredEntry *ap)
static Term static Term
all_envs(CELL *env_ptr USES_REGS) all_envs(CELL *env_ptr USES_REGS)
{ {
Term tf = AbsPair(H); Term tf = AbsPair(HR);
CELL *start = H; CELL *start = HR;
CELL *bp = NULL; CELL *bp = NULL;
/* walk the environment chain */ /* walk the environment chain */
while (env_ptr) { while (env_ptr) {
bp = H; bp = HR;
H += 2; HR += 2;
/* notice that MkIntegerTerm may increase the Heap */ /* notice that MkIntegerTerm may increase the Heap */
bp[0] = MkIntegerTerm(LCL0-env_ptr); bp[0] = MkIntegerTerm(LCL0-env_ptr);
if (H >= ASP-1024) { if (HR >= ASP-1024) {
H = start; HR = start;
LOCAL_Error_Size = (ASP-1024)-H; LOCAL_Error_Size = (ASP-1024)-HR;
while (env_ptr) { while (env_ptr) {
LOCAL_Error_Size += 2; LOCAL_Error_Size += 2;
env_ptr = (CELL *)(env_ptr[E_E]); env_ptr = (CELL *)(env_ptr[E_E]);
} }
return 0L; return 0L;
} else { } else {
bp[1] = AbsPair(H); bp[1] = AbsPair(HR);
} }
env_ptr = (CELL *)(env_ptr[E_E]); env_ptr = (CELL *)(env_ptr[E_E]);
} }
@ -3499,24 +3542,24 @@ static Term
all_cps(choiceptr b_ptr USES_REGS) all_cps(choiceptr b_ptr USES_REGS)
{ {
CELL *bp = NULL; CELL *bp = NULL;
CELL *start = H; CELL *start = HR;
Term tf = AbsPair(H); Term tf = AbsPair(HR);
while (b_ptr) { while (b_ptr) {
bp = H; bp = HR;
H += 2; HR += 2;
/* notice that MkIntegerTerm may increase the Heap */ /* notice that MkIntegerTerm may increase the Heap */
bp[0] = MkIntegerTerm((Int)(LCL0-(CELL *)b_ptr)); bp[0] = MkIntegerTerm((Int)(LCL0-(CELL *)b_ptr));
if (H >= ASP-1024) { if (HR >= ASP-1024) {
H = start; HR = start;
LOCAL_Error_Size = (ASP-1024)-H; LOCAL_Error_Size = (ASP-1024)-HR;
while (b_ptr) { while (b_ptr) {
LOCAL_Error_Size += 2; LOCAL_Error_Size += 2;
b_ptr = b_ptr->cp_b; b_ptr = b_ptr->cp_b;
} }
return 0L; return 0L;
} else { } else {
bp[1] = AbsPair(H); bp[1] = AbsPair(HR);
} }
b_ptr = b_ptr->cp_b; b_ptr = b_ptr->cp_b;
} }
@ -4940,7 +4983,7 @@ Yap_UpdateTimestamps(PredEntry *ap)
if (bptr->cp_ap->u.OtaLl.d->ClPred == ap) { if (bptr->cp_ap->u.OtaLl.d->ClPred == ap) {
UInt ts = IntegerOfTerm(bptr->cp_args[ar]); UInt ts = IntegerOfTerm(bptr->cp_args[ar]);
if (ts != arp[0]) { if (ts != arp[0]) {
if (arp-H < 1024) { if (arp-HR < 1024) {
goto overflow; goto overflow;
} }
/* be thrifty, have this in case there is a hole */ /* be thrifty, have this in case there is a hole */
@ -4958,7 +5001,7 @@ Yap_UpdateTimestamps(PredEntry *ap)
((PredEntry *)IntegerOfTerm(bptr->cp_args[0]) == ap)) { ((PredEntry *)IntegerOfTerm(bptr->cp_args[0]) == ap)) {
UInt ts = IntegerOfTerm(bptr->cp_args[5]); UInt ts = IntegerOfTerm(bptr->cp_args[5]);
if (ts != arp[0]) { if (ts != arp[0]) {
if (arp-H < 1024) { if (arp-HR < 1024) {
goto overflow; goto overflow;
} }
if (ts != arp[0]-1) { if (ts != arp[0]-1) {
@ -5197,79 +5240,6 @@ p_static_clause( USES_REGS1 )
return fetch_next_static_clause(pe, pe->CodeOfPred, ARG1, ARG3, ARG4, new_cp, TRUE); return fetch_next_static_clause(pe, pe->CodeOfPred, ARG1, ARG3, ARG4, new_cp, TRUE);
} }
static Int /* $hidden_predicate(P) */
p_nth_clause( USES_REGS1 )
{
PredEntry *pe;
Term t1 = Deref(ARG1);
Term tn = Deref(ARG3);
LogUpdClause *cl;
Int ncls;
Int CurSlot, sl;
if (!IsIntegerTerm(tn))
return FALSE;
ncls = IntegerOfTerm(tn);
pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
PELOCK(47,pe);
if (!(pe->PredFlags & (SourcePredFlag|LogUpdatePredFlag))) {
UNLOCK(pe->PELock);
return FALSE;
}
CurSlot = Yap_StartSlots( PASS_REGS1 );
sl = Yap_InitSlot( ARG4 PASS_REGS );
/* in case we have to index or to expand code */
if (pe->ModuleOfPred != IDB_MODULE) {
UInt i;
for (i = 1; i <= pe->ArityOfPE; i++) {
XREGS[i] = MkVarTerm();
}
} else {
XREGS[2] = MkVarTerm();
}
if(pe->OpcodeOfPred == INDEX_OPCODE) {
IPred(pe, 0, CP);
}
cl = Yap_NthClause(pe, ncls);
ARG4 = Yap_GetFromSlot( sl PASS_REGS );
LOCAL_CurSlot = CurSlot;
if (cl == NULL) {
UNLOCK(pe->PELock);
return FALSE;
}
if (pe->PredFlags & LogUpdatePredFlag) {
#if MULTIPLE_STACKS
TRAIL_CLREF(cl); /* So that fail will erase it */
INC_CLREF_COUNT(cl);
#else
if (!(cl->ClFlags & InUseMask)) {
cl->ClFlags |= InUseMask;
TRAIL_CLREF(cl); /* So that fail will erase it */
}
#endif
UNLOCK(pe->PELock);
return Yap_unify(MkDBRefTerm((DBRef)cl), ARG4);
} else if (pe->PredFlags & MegaClausePredFlag) {
MegaClause *mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
if (mcl->ClFlags & ExoMask) {
Term tf[2];
tf[0] = pe->ModuleOfPred;
tf[1] = Yap_MkApplTerm(pe->FunctorOfPred, pe->ArityOfPE, (CELL *)((char *)mcl->ClCode+(ncls-1)*mcl->ClItemSize));
UNLOCK(pe->PELock);
return Yap_unify(Yap_MkApplTerm(FunctorExoClause, 2, tf), ARG4);
}
/* fast access to nth element, all have same size */
UNLOCK(pe->PELock);
return Yap_unify(Yap_MkMegaRefTerm(pe,(yamop *)cl), ARG4);
} else {
UNLOCK(pe->PELock);
return Yap_unify(Yap_MkStaticRefTerm((StaticClause *)cl, pe), ARG4);
}
}
static Int /* $hidden_predicate(P) */ static Int /* $hidden_predicate(P) */
p_continue_static_clause( USES_REGS1 ) p_continue_static_clause( USES_REGS1 )
{ {
@ -5583,7 +5553,7 @@ BuildActivePred(PredEntry *ap, CELL *vect)
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
CELL *pt = VarOfTerm(t); CELL *pt = VarOfTerm(t);
/* one stack */ /* one stack */
if (pt > H) { if (pt > HR) {
Term nt = MkVarTerm(); Term nt = MkVarTerm();
Yap_unify(t, nt); Yap_unify(t, nt);
} }
@ -6154,6 +6124,42 @@ p_instance_property( USES_REGS1 )
return Yap_unify(ARG3, MkIntTerm(cl->usc.ClSource->ag.line_number)); return Yap_unify(ARG3, MkIntTerm(cl->usc.ClSource->ag.line_number));
} }
} }
} else if (FunctorOfTerm(t1) == FunctorMegaClause) {
PredEntry *ap = (PredEntry *)IntegerOfTerm(ArgOfTerm(1, t1));
MegaClause *mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
if (op == CL_PROP_ERASED) {
return FALSE;
}
if (op == CL_PROP_PRED || op == CL_PROP_FILE || op == CL_PROP_STREAM) {
if (op == CL_PROP_FILE) {
if (ap->src.OwnerFile)
return Yap_unify(ARG3,MkAtomTerm(ap->src.OwnerFile));
else
return FALSE;
} else {
Functor nf = ap->FunctorOfPred;
UInt arity = ArityOfFunctor(nf);
Atom name = NameOfFunctor(nf);
Term t[2];
t[0] = MkAtomTerm(name);
t[1] = MkIntegerTerm(arity);
t[1] = Yap_MkApplTerm(FunctorSlash, 2, t);
if (ap->ModuleOfPred == PROLOG_MODULE) {
t[0] = MkAtomTerm(AtomProlog);
} else {
t[0] = ap->ModuleOfPred;
}
return Yap_unify( ARG3, Yap_MkApplTerm(FunctorModule, 2, t) );
}
}
if (op == CL_PROP_FACT) {
return Yap_unify(ARG3, MkAtomTerm(AtomTrue));
}
if (op == CL_PROP_LINE) {
return Yap_unify(ARG3, MkIntTerm(mcl->ClLine));
}
} }
} }
} else if ((dbr = DBRefOfTerm(t1))->Flags & LogUpdMask) { } else if ((dbr = DBRefOfTerm(t1))->Flags & LogUpdMask) {
@ -6214,6 +6220,213 @@ p_instance_property( USES_REGS1 )
return FALSE; return FALSE;
} }
static Int
p_nth_instance( USES_REGS1 )
{
PredEntry *pe;
UInt pred_arity;
Functor pred_f;
Term pred_module;
Term t4 = Deref(ARG4);
if (IsVarTerm(t4)) {
// we must know I or count;
Term TCount;
Int Count;
TCount = Deref(ARG3);
if (IsVarTerm(TCount)) {
return FALSE; // backtrack?
}
if (!IsIntegerTerm(TCount)) {
Yap_Error(TYPE_ERROR_INTEGER, TCount, "nth_instance/3");
return FALSE;
}
Count = IntegerOfTerm(TCount);
if (Count <= 0) {
if (Count)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, TCount, "nth_clause/3");
else
Yap_Error(DOMAIN_ERROR_NOT_ZERO, TCount, "nth_clause/3");
return FALSE;
}
pe = get_pred(Deref(ARG1), Deref(ARG2), "nth_clause/3");
if (pe) {
PELOCK(47,pe);
}
if (Deref(ARG2) == IDB_MODULE) {
return Yap_db_nth_recorded( pe, Count PASS_REGS );
} else {
Int CurSlot, sl4;
UInt i;
void *cl0;
if (!pe)
return FALSE;
if (!(pe->PredFlags & (SourcePredFlag|LogUpdatePredFlag))) {
UNLOCK(pe->PELock);
return FALSE;
}
CurSlot = Yap_StartSlots( PASS_REGS1 );
/* I have pe and n */
sl4 = Yap_InitSlot( ARG4 PASS_REGS );
/* in case we have to index or to expand code */
for (i = 1; i <= pe->ArityOfPE; i++) {
XREGS[i] = MkVarTerm();
}
if(pe->OpcodeOfPred == INDEX_OPCODE) {
IPred(pe, 0, CP);
}
cl0 = Yap_NthClause(pe, Count);
ARG4 = Yap_GetFromSlot( sl4 PASS_REGS );
LOCAL_CurSlot = CurSlot;
if (cl0 == NULL) {
UNLOCK(pe->PELock);
return FALSE;
}
if (pe->PredFlags & LogUpdatePredFlag) {
LogUpdClause *cl = cl0;
#if MULTIPLE_STACKS
TRAIL_CLREF(cl); /* So that fail will erase it */
INC_CLREF_COUNT(cl);
#else
if (!(cl->ClFlags & InUseMask)) {
cl->ClFlags |= InUseMask;
TRAIL_CLREF(cl); /* So that fail will erase it */
}
#endif
UNLOCK(pe->PELock);
return Yap_unify(MkDBRefTerm((DBRef)cl), ARG4);
} else if (pe->PredFlags & MegaClausePredFlag) {
MegaClause *mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
if (mcl->ClFlags & ExoMask) {
UNLOCK(pe->PELock);
return Yap_unify(Yap_MkExoRefTerm(pe,Count-1), ARG4);
}
/* fast access to nth element, all have same size */
UNLOCK(pe->PELock);
return Yap_unify(Yap_MkMegaRefTerm(pe,cl0), ARG4);
} else {
UNLOCK(pe->PELock);
return Yap_unify(Yap_MkStaticRefTerm(cl0, pe), ARG4);
}
}
}
/* t4 is bound, we have a reference */
if (IsDBRefTerm(t4)) {
DBRef ref = DBRefOfTerm(t4);
if (ref->Flags & LogUpdMask) {
LogUpdClause *cl = (LogUpdClause *)ref;
LogUpdClause *ocl;
UInt icl = 0;
pe = cl->ClPred;
PELOCK(66,pe);
if (cl->ClFlags & ErasedMask) {
UNLOCK(pe->PELock);
return FALSE;
}
ocl = ClauseCodeToLogUpdClause(pe->cs.p_code.FirstClause);
do {
icl++;
if (cl == ocl) break;
ocl = ocl->ClNext;
} while (ocl != NULL);
UNLOCK(pe->PELock);
if (ocl == NULL) {
return FALSE;
}
if (!Yap_unify(ARG3,MkIntegerTerm(icl))) {
return FALSE;
}
} else {
return Yap_unify_immediate_ref(ref PASS_REGS);
}
} else if (IsApplTerm(t4)) {
Functor f = FunctorOfTerm(t4);
if (f == FunctorStaticClause) {
StaticClause *cl = Yap_ClauseFromTerm(t4), *cl0;
pe = (PredEntry *)IntegerOfTerm(ArgOfTerm(2, t4));
Int i;
if (!pe) {
return FALSE;
}
if (! pe->cs.p_code.NOfClauses )
return FALSE;
cl0 = ClauseCodeToStaticClause(pe->cs.p_code.FirstClause);
//linear scan
for (i = 1; i < pe->cs.p_code.NOfClauses; i++) {
if (cl0 == cl) {
if (!Yap_unify(MkIntTerm(i), ARG3))
return FALSE;
break;
}
}
} else if (f == FunctorMegaClause) {
MegaClause *mcl;
yamop *cl = Yap_MegaClauseFromTerm(t4);
Int i;
pe = Yap_MegaClausePredicateFromTerm(t4);
mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
i = ((char *)cl-(char *)mcl->ClCode)/mcl->ClItemSize;
if (!Yap_unify(MkIntTerm(i), ARG3))
return FALSE;
} else if (f == FunctorExoClause) {
Int i;
pe = Yap_ExoClausePredicateFromTerm(t4);
i = Yap_ExoClauseFromTerm(t4);
if (!Yap_unify(MkIntTerm(i+1), ARG3)) {
return FALSE;
}
} else {
Yap_Error(TYPE_ERROR_REFERENCE, t4, "nth_clause/3");
return FALSE;
}
} else {
Yap_Error(TYPE_ERROR_REFERENCE, t4, "nth_clause/3");
return FALSE;
}
pred_module = pe->ModuleOfPred;
if (pred_module != IDB_MODULE) {
pred_f = pe->FunctorOfPred;
pred_arity = pe->ArityOfPE;
} else {
if (pe->PredFlags & NumberDBPredFlag) {
pred_f = (Functor)MkIntegerTerm(pe->src.IndxId);
pred_arity = 0;
} else {
pred_f = pe->FunctorOfPred;
if (pe->PredFlags & AtomDBPredFlag) {
pred_arity = 0;
} else {
pred_arity = ArityOfFunctor(pred_f);
}
}
}
if (pred_arity) {
if (!Yap_unify(ARG1,Yap_MkNewApplTerm(pred_f, pred_arity)))
return FALSE;
} else {
if (!Yap_unify(ARG1,MkAtomTerm((Atom)pred_f)))
return FALSE;
}
if (pred_module == PROLOG_MODULE) {
if (!Yap_unify(ARG2,TermProlog))
return FALSE;
} else {
if (!Yap_unify(ARG2,pred_module))
return FALSE;
}
return TRUE;
}
void void
Yap_InitCdMgr(void) Yap_InitCdMgr(void)
{ {
@ -6249,6 +6462,8 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$kill_dynamic", 2, p_kill_dynamic, 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", 3, p_new_multifile, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$is_multifile", 2, p_is_multifile, TestPredFlag | SafePredFlag); Yap_InitCPred("$is_multifile", 2, p_is_multifile, TestPredFlag | SafePredFlag);
Yap_InitCPred("$is_no_trace", 2, p_is_no_trace, TestPredFlag | SafePredFlag);
Yap_InitCPred("$set_no_trace", 2, p_set_no_trace, TestPredFlag | SafePredFlag);
Yap_InitCPred("$is_profiled", 1, p_is_profiled, SafePredFlag|SyncPredFlag); Yap_InitCPred("$is_profiled", 1, p_is_profiled, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$profile_info", 3, p_profile_info, SafePredFlag|SyncPredFlag); Yap_InitCPred("$profile_info", 3, p_profile_info, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$profile_reset", 2, p_profile_reset, SafePredFlag|SyncPredFlag); Yap_InitCPred("$profile_reset", 2, p_profile_reset, SafePredFlag|SyncPredFlag);
@ -6273,9 +6488,9 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$static_clause", 4, p_static_clause, SyncPredFlag); Yap_InitCPred("$static_clause", 4, p_static_clause, SyncPredFlag);
Yap_InitCPred("$continue_static_clause", 5, p_continue_static_clause, SafePredFlag|SyncPredFlag); Yap_InitCPred("$continue_static_clause", 5, p_continue_static_clause, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$static_pred_statistics", 5, p_static_pred_statistics, SyncPredFlag); Yap_InitCPred("$static_pred_statistics", 5, p_static_pred_statistics, SyncPredFlag);
Yap_InitCPred("$p_nth_clause", 4, p_nth_clause, SyncPredFlag);
Yap_InitCPred("$program_continuation", 3, p_program_continuation, SafePredFlag|SyncPredFlag); Yap_InitCPred("$program_continuation", 3, p_program_continuation, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$instance_property", 3, p_instance_property, SafePredFlag|SyncPredFlag); Yap_InitCPred("$instance_property", 3, p_instance_property, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$fetch_nth_clause", 4, p_nth_instance, SyncPredFlag);
CurrentModule = HACKS_MODULE; CurrentModule = HACKS_MODULE;
Yap_InitCPred("current_choicepoints", 1, p_all_choicepoints, 0); Yap_InitCPred("current_choicepoints", 1, p_all_choicepoints, 0);
Yap_InitCPred("current_continuations", 1, p_all_envs, 0); Yap_InitCPred("current_continuations", 1, p_all_envs, 0);

30
C/clause_list.c
View File

@ -13,14 +13,14 @@ mk_blob(int sz USES_REGS)
{ {
MP_INT *dst; MP_INT *dst;
H[0] = (CELL)FunctorBigInt; HR[0] = (CELL)FunctorBigInt;
H[1] = CLAUSE_LIST; HR[1] = CLAUSE_LIST;
dst = (MP_INT *)(H+2); dst = (MP_INT *)(HR+2);
dst->_mp_size = 0L; dst->_mp_size = 0L;
dst->_mp_alloc = sz; dst->_mp_alloc = sz;
H += (1+sizeof(MP_INT)/sizeof(CELL)); HR += (1+sizeof(MP_INT)/sizeof(CELL));
H[sz] = EndSpecials; HR[sz] = EndSpecials;
H += sz+1; HR += sz+1;
} }
static CELL * static CELL *
@ -29,14 +29,14 @@ extend_blob(CELL *start, int sz USES_REGS)
UInt osize; UInt osize;
MP_INT *dst; MP_INT *dst;
if (H + sz > ASP) if (HR + sz > ASP)
return NULL; return NULL;
dst = (MP_INT *)(start+2); dst = (MP_INT *)(start+2);
osize = dst->_mp_alloc; osize = dst->_mp_alloc;
start += (1+sizeof(MP_INT)/sizeof(CELL)); start += (1+sizeof(MP_INT)/sizeof(CELL));
start[sz+osize] = EndSpecials; start[sz+osize] = EndSpecials;
dst->_mp_alloc += sz; dst->_mp_alloc += sz;
H += sz; HR += sz;
return start+osize; return start+osize;
} }
@ -46,9 +46,9 @@ Yap_ClauseListInit(clause_list_t in)
{ {
CACHE_REGS CACHE_REGS
in->n = 0; in->n = 0;
in->start = H; in->start = HR;
mk_blob(0 PASS_REGS); mk_blob(0 PASS_REGS);
in->end = H; in->end = HR;
return in; return in;
} }
@ -61,7 +61,7 @@ Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred)
PredEntry *ap = (PredEntry *)pred; PredEntry *ap = (PredEntry *)pred;
/* fprintf(stderr,"cl=%p\n",clause); */ /* fprintf(stderr,"cl=%p\n",clause); */
if (cl->end != H) if (cl->end != HR)
return FALSE; return FALSE;
if (cl->n == 0) { if (cl->n == 0) {
void **ptr; void **ptr;
@ -112,7 +112,7 @@ Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred)
code_p = PREVOP(code_p,Otapl); code_p = PREVOP(code_p,Otapl);
code_p->opc = Yap_opcode(_retry); code_p->opc = Yap_opcode(_retry);
} }
cl->end = H; cl->end = HR;
cl->n++; cl->n++;
return TRUE; return TRUE;
} }
@ -129,9 +129,9 @@ X_API int
Yap_ClauseListDestroy(clause_list_t cl) Yap_ClauseListDestroy(clause_list_t cl)
{ {
CACHE_REGS CACHE_REGS
if (cl->end != H) if (cl->end != HR)
return FALSE; return FALSE;
H = cl->start; HR = cl->start;
return TRUE; return TRUE;
} }
@ -141,7 +141,7 @@ Yap_ClauseListToClause(clause_list_t cl)
{ {
CACHE_REGS CACHE_REGS
void **ptr; void **ptr;
if (cl->end != H) if (cl->end != HR)
return NULL; return NULL;
if (cl->n != 1) if (cl->n != 1)
return NULL; return NULL;

76
C/cmppreds.c
View File

@ -82,7 +82,7 @@ static int compare_complex(register CELL *pt0, register CELL *pt0_end, register
CELL *pt1) CELL *pt1)
{ {
CACHE_REGS CACHE_REGS
register CELL **to_visit = (CELL **)H; register CELL **to_visit = (CELL **)HR;
register int out = 0; register int out = 0;
loop: loop:
@ -141,6 +141,26 @@ static int compare_complex(register CELL *pt0, register CELL *pt0_end, register
} }
if (out != 0) if (out != 0)
goto done; goto done;
} else if (IsStringTerm(d0)) {
if (IsStringTerm(d1)){
out = strcmp(StringOfTerm(d0) , StringOfTerm(d1));
} else if (IsIntTerm(d1))
out = 1;
else if (IsFloatTerm(d1)) {
out = 1;
} else if (IsLongIntTerm(d1)) {
out = 1;
#ifdef USE_GMP
} else if (IsBigIntTerm(d1)) {
out = 1;
#endif
} else if (IsRefTerm(d1)) {
out = 1 ;
} else {
out = -1;
}
if (out != 0)
goto done;
} else if (IsLongIntTerm(d0)) { } else if (IsLongIntTerm(d0)) {
if (IsIntTerm(d1)) if (IsIntTerm(d1))
out = LongIntOfTerm(d0) - IntOfTerm(d1); out = LongIntOfTerm(d0) - IntOfTerm(d1);
@ -269,7 +289,7 @@ static int compare_complex(register CELL *pt0, register CELL *pt0_end, register
} }
} }
/* Do we still have compound terms to visit */ /* Do we still have compound terms to visit */
if (to_visit > (CELL **)H) { if (to_visit > (CELL **)HR) {
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
to_visit -= 4; to_visit -= 4;
pt0 = to_visit[0]; pt0 = to_visit[0];
@ -288,7 +308,7 @@ static int compare_complex(register CELL *pt0, register CELL *pt0_end, register
done: done:
/* failure */ /* failure */
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
while (to_visit > (CELL **)H) { while (to_visit > (CELL **)HR) {
to_visit -= 4; to_visit -= 4;
pt0 = to_visit[0]; pt0 = to_visit[0];
pt0_end = to_visit[1]; pt0_end = to_visit[1];
@ -319,24 +339,30 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
return cmp_atoms(AtomOfTerm(t1),AtomOfTerm(t2)); return cmp_atoms(AtomOfTerm(t1),AtomOfTerm(t2));
if (IsPrimitiveTerm(t2)) if (IsPrimitiveTerm(t2))
return 1; return 1;
if (IsStringTerm(t2))
return 1;
return -1; return -1;
} else { } else {
if (IsIntTerm(t2)) { if (IsIntTerm(t2)) {
return IntOfTerm(t1) - IntOfTerm(t2); return IntOfTerm(t1) - IntOfTerm(t2);
} }
if (IsFloatTerm(t2)) { if (IsApplTerm(t2)) {
return 1; Functor fun2 = FunctorOfTerm(t2);
} switch ((CELL)fun2) {
if (IsLongIntTerm(t2)) { case double_e:
return IntOfTerm(t1) - LongIntOfTerm(t2); return 1;
} case long_int_e:
return IntOfTerm(t1) - LongIntOfTerm(t2);
#ifdef USE_GMP #ifdef USE_GMP
if (IsBigIntTerm(t2)) { case big_int_e:
return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2); return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2);
}
#endif #endif
if (IsRefTerm(t2)) case db_ref_e:
return 1; return 1;
case string_e:
return -1;
}
}
return -1; return -1;
} }
} else if (IsPairTerm(t1)) { } else if (IsPairTerm(t1)) {
@ -408,6 +434,28 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
return -1; return -1;
} }
#endif #endif
case string_e:
{
if (IsApplTerm(t2)) {
Functor fun2 = FunctorOfTerm(t2);
switch ((CELL)fun2) {
case double_e:
return 1;
case long_int_e:
return 1;
#ifdef USE_GMP
case big_int_e:
return 1;
#endif
case db_ref_e:
return 1;
case string_e:
return strcmp(StringOfTerm(t1), StringOfTerm(t2));
}
return -1;
}
return -1;
}
case db_ref_e: case db_ref_e:
if (IsRefTerm(t2)) if (IsRefTerm(t2))
return Unsigned(RefOfTerm(t2)) - return Unsigned(RefOfTerm(t2)) -

119
C/compiler.c
View File

@ -510,10 +510,10 @@ optimize_ce(Term t, unsigned int arity, unsigned int level, compiler_struct *cgl
if (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t))) if (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t)))
return (t); return (t);
while (p != NULL) { while (p != NULL) {
CELL *oldH = H; CELL *oldH = HR;
H = (CELL *)cglobs->cint.freep; HR = (CELL *)cglobs->cint.freep;
cmp = Yap_compare_terms(t, (p->TermOfCE)); cmp = Yap_compare_terms(t, (p->TermOfCE));
H = oldH; HR = oldH;
if (cmp) { if (cmp) {
p = p->NextCE; p = p->NextCE;
@ -533,7 +533,7 @@ optimize_ce(Term t, unsigned int arity, unsigned int level, compiler_struct *cgl
p->TermOfCE = t; p->TermOfCE = t;
p->VarOfCE = MkVarTerm(); p->VarOfCE = MkVarTerm();
if (H >= (CELL *)cglobs->cint.freep0) { if (HR >= (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
@ -614,7 +614,7 @@ try_store_as_dbterm(Term t, Int argno, unsigned int arity, int level, compiler_s
CACHE_REGS CACHE_REGS
DBTerm *dbt; DBTerm *dbt;
int g; int g;
CELL *h0 = H; CELL *h0 = HR;
while ((g=Yap_SizeGroundTerm(t,TRUE)) < 0) { while ((g=Yap_SizeGroundTerm(t,TRUE)) < 0) {
/* oops, too deep a term */ /* oops, too deep a term */
@ -625,9 +625,9 @@ try_store_as_dbterm(Term t, Int argno, unsigned int arity, int level, compiler_s
if (g < 16) if (g < 16)
return FALSE; return FALSE;
/* store ground term away */ /* store ground term away */
H = CellPtr(cglobs->cint.freep); HR = CellPtr(cglobs->cint.freep);
if ((dbt = Yap_StoreTermInDB(t, -1)) == NULL) { if ((dbt = Yap_StoreTermInDB(t, -1)) == NULL) {
H = h0; HR = h0;
switch(LOCAL_Error_TYPE) { switch(LOCAL_Error_TYPE) {
case OUT_OF_STACK_ERROR: case OUT_OF_STACK_ERROR:
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
@ -645,7 +645,7 @@ try_store_as_dbterm(Term t, Int argno, unsigned int arity, int level, compiler_s
siglongjmp(cglobs->cint.CompilerBotch,COMPILER_ERR_BOTCH); siglongjmp(cglobs->cint.CompilerBotch,COMPILER_ERR_BOTCH);
} }
} }
H = h0; HR = h0;
if (level == 0) if (level == 0)
Yap_emit((cglobs->onhead ? get_dbterm_op : put_dbterm_op), dbt->Entry, argno, &cglobs->cint); Yap_emit((cglobs->onhead ? get_dbterm_op : put_dbterm_op), dbt->Entry, argno, &cglobs->cint);
else else
@ -668,7 +668,7 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_atom_op Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_atom_op
: unify_atom_op) : : unify_atom_op) :
write_atom_op), (CELL) t, Zero, &cglobs->cint); write_atom_op), (CELL) t, Zero, &cglobs->cint);
} else if (IsIntegerTerm(t) || IsFloatTerm(t) || IsBigIntTerm(t)) { } else if (IsIntegerTerm(t) || IsFloatTerm(t) || IsBigIntTerm(t) || IsStringTerm(t)) {
if (!IsIntTerm(t)) { if (!IsIntTerm(t)) {
if (IsFloatTerm(t)) { if (IsFloatTerm(t)) {
if (level == 0) if (level == 0)
@ -684,6 +684,41 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_longint_op Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_longint_op
: unify_longint_op) : : unify_longint_op) :
write_longint_op), t, Zero, &cglobs->cint); write_longint_op), t, Zero, &cglobs->cint);
} else if (IsStringTerm(t)) {
/* we are taking a string, that is supposed to be
guarded in the clause itself. . */
CELL l1 = ++cglobs->labelno;
CELL *src = RepAppl(t);
PInstr *ocpc = cglobs->cint.cpc, *OCodeStart = cglobs->cint.CodeStart;
Int sz = (3+src[1])*sizeof(CELL);
CELL *dest;
/* use a special list to store the blobs */
cglobs->cint.cpc = cglobs->cint.icpc;
/* if (IsFloatTerm(t)) {
Yap_emit(align_float_op, Zero, Zero, &cglobs->cint);
}*/
Yap_emit(label_op, l1, Zero, &cglobs->cint);
dest =
Yap_emit_extra_size(blob_op, sz/CellSize, sz, &cglobs->cint);
/* copy the bignum */
memcpy(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;
if (cglobs->cint.BlobsStart == NULL)
cglobs->cint.BlobsStart = cglobs->cint.CodeStart;
cglobs->cint.cpc = ocpc;
cglobs->cint.CodeStart = OCodeStart;
/* The argument to pass to the structure is now the label for
where we are storing the blob */
if (level == 0)
Yap_emit((cglobs->onhead ? get_string_op : put_string_op), l1, argno, &cglobs->cint);
else
Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_string_op
: unify_string_op) :
write_string_op), l1, Zero, &cglobs->cint);
} else { } else {
/* we are taking a blob, that is a binary that is supposed to be /* we are taking a blob, that is a binary that is supposed to be
guarded in the clause itself. Possible examples include guarded in the clause itself. Possible examples include
@ -1088,29 +1123,29 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
if (i2 == 0) if (i2 == 0)
c_eq(t1, t3, cglobs); c_eq(t1, t3, cglobs);
else { else {
CELL *hi = H; CELL *hi = HR;
Int i; Int i;
if (t1 == TermDot && i2 == 2) { if (t1 == TermDot && i2 == 2) {
if (H+2 >= (CELL *)cglobs->cint.freep0) { if (HR+2 >= (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
} }
RESET_VARIABLE(H); RESET_VARIABLE(HR);
RESET_VARIABLE(H+1); RESET_VARIABLE(HR+1);
H += 2; HR += 2;
c_eq(AbsPair(H-2),t3, cglobs); c_eq(AbsPair(HR-2),t3, cglobs);
} else if (i2 < 256 && IsAtomTerm(t1)) { } else if (i2 < 256 && IsAtomTerm(t1)) {
*H++ = (CELL)Yap_MkFunctor(AtomOfTerm(t1),i2); *HR++ = (CELL)Yap_MkFunctor(AtomOfTerm(t1),i2);
for (i=0; i < i2; i++) { for (i=0; i < i2; i++) {
if (H >= (CELL *)cglobs->cint.freep0) { if (HR >= (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
} }
RESET_VARIABLE(H); RESET_VARIABLE(HR);
H++; HR++;
} }
c_eq(AbsAppl(hi),t3, cglobs); c_eq(AbsAppl(hi),t3, cglobs);
} else { } else {
@ -1232,16 +1267,16 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,1); siglongjmp(cglobs->cint.CompilerBotch,1);
} }
if (H+1+arity >= (CELL *)cglobs->cint.freep0) { if (HR+1+arity >= (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
} }
tnew = AbsAppl(H); tnew = AbsAppl(HR);
*H++ = (CELL)Yap_MkFunctor(AtomOfTerm(t1),arity); *HR++ = (CELL)Yap_MkFunctor(AtomOfTerm(t1),arity);
while (arity--) { while (arity--) {
RESET_VARIABLE(H); RESET_VARIABLE(HR);
H++; HR++;
} }
c_eq(tnew, t3, cglobs); c_eq(tnew, t3, cglobs);
} else { } else {
@ -1281,7 +1316,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
if (!IsVarTerm(t3)) { if (!IsVarTerm(t3)) {
if (Op == _arg) { if (Op == _arg) {
Term tmpvar = MkVarTerm(); Term tmpvar = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) { if (HR == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
@ -1681,7 +1716,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
cglobs->goalno = savegoalno; cglobs->goalno = savegoalno;
commitflag = cglobs->labelno; commitflag = cglobs->labelno;
commitvar = MkVarTerm(); commitvar = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) { if (HR == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
@ -1765,7 +1800,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
/* for now */ /* for now */
cglobs->needs_env = TRUE; cglobs->needs_env = TRUE;
commitvar = MkVarTerm(); commitvar = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) { if (HR == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
@ -1801,7 +1836,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
int save = cglobs->onlast; int save = cglobs->onlast;
commitvar = MkVarTerm(); commitvar = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) { if (HR == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
@ -1928,7 +1963,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
} }
else { else {
Term t2 = MkVarTerm(); Term t2 = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) { if (HR == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
@ -1941,7 +1976,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
} else { } else {
Term a2 = ArgOfTerm(2,Goal); Term a2 = ArgOfTerm(2,Goal);
Term t1 = MkVarTerm(); Term t1 = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) { if (HR == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
@ -1955,7 +1990,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
} }
else { else {
Term t2 = MkVarTerm(); Term t2 = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) { if (HR == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
@ -2585,6 +2620,7 @@ CheckVoids(compiler_struct *cglobs)
case get_float_op: case get_float_op:
case get_dbterm_op: case get_dbterm_op:
case get_longint_op: case get_longint_op:
case get_string_op:
case get_bigint_op: case get_bigint_op:
case get_list_op: case get_list_op:
case get_struct_op: case get_struct_op:
@ -2935,6 +2971,7 @@ c_layout(compiler_struct *cglobs)
case get_num_op: case get_num_op:
case get_float_op: case get_float_op:
case get_longint_op: case get_longint_op:
case get_string_op:
case get_dbterm_op: case get_dbterm_op:
case get_bigint_op: case get_bigint_op:
--cglobs->Uses[rn]; --cglobs->Uses[rn];
@ -3013,6 +3050,7 @@ c_layout(compiler_struct *cglobs)
case put_num_op: case put_num_op:
case put_float_op: case put_float_op:
case put_longint_op: case put_longint_op:
case put_string_op:
case put_dbterm_op: case put_dbterm_op:
case put_bigint_op: case put_bigint_op:
rn = checkreg(arg, rn, ic, FALSE, cglobs); rn = checkreg(arg, rn, ic, FALSE, cglobs);
@ -3311,10 +3349,13 @@ c_optimize(PInstr *pc)
case unify_last_float_op: case unify_last_float_op:
case write_float_op: case write_float_op:
case unify_longint_op: case unify_longint_op:
case unify_string_op:
case unify_bigint_op: case unify_bigint_op:
case unify_last_longint_op: case unify_last_longint_op:
case unify_last_string_op:
case unify_last_bigint_op: case unify_last_bigint_op:
case write_longint_op: case write_longint_op:
case write_string_op:
case write_bigint_op: case write_bigint_op:
case unify_list_op: case unify_list_op:
case write_list_op: case write_list_op:
@ -3375,7 +3416,7 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src)
case OUT_OF_STACK_BOTCH: case OUT_OF_STACK_BOTCH:
/* out of local stack, just duplicate the stack */ /* out of local stack, just duplicate the stack */
{ {
Int osize = 2*sizeof(CELL)*(ASP-H); Int osize = 2*sizeof(CELL)*(ASP-HR);
ARG1 = inp_clause; ARG1 = inp_clause;
ARG3 = src; ARG3 = src;
@ -3384,8 +3425,8 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src)
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;
LOCAL_Error_Term = inp_clause; LOCAL_Error_Term = inp_clause;
} }
if (osize > ASP-H) { if (osize > ASP-HR) {
if (!Yap_growstack(2*sizeof(CELL)*(ASP-H))) { if (!Yap_growstack(2*sizeof(CELL)*(ASP-HR))) {
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;
LOCAL_Error_Term = inp_clause; LOCAL_Error_Term = inp_clause;
} }
@ -3449,7 +3490,7 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src)
} }
} }
my_clause = inp_clause; my_clause = inp_clause;
HB = H; HB = HR;
LOCAL_ErrorMessage = NULL; LOCAL_ErrorMessage = NULL;
LOCAL_Error_Size = 0; LOCAL_Error_Size = 0;
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
@ -3462,7 +3503,7 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src)
cglobs.cint.label_offset = NULL; cglobs.cint.label_offset = NULL;
cglobs.cint.freep = cglobs.cint.freep =
cglobs.cint.freep0 = cglobs.cint.freep0 =
(char *) (H + maxvnum+(sizeof(Int)/sizeof(CELL))*MaxTemps+MaxTemps); (char *) (HR + maxvnum+(sizeof(Int)/sizeof(CELL))*MaxTemps+MaxTemps);
cglobs.cint.success_handler = 0L; cglobs.cint.success_handler = 0L;
if (ASP <= CellPtr (cglobs.cint.freep) + 256) { if (ASP <= CellPtr (cglobs.cint.freep) + 256) {
cglobs.vtable = NULL; cglobs.vtable = NULL;
@ -3470,8 +3511,8 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src)
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs.cint.CompilerBotch,3); siglongjmp(cglobs.cint.CompilerBotch,3);
} }
cglobs.Uses = (Int *)(H+maxvnum); cglobs.Uses = (Int *)(HR+maxvnum);
cglobs.Contents = (Term *)(H+maxvnum+(sizeof(Int)/sizeof(CELL))*MaxTemps); cglobs.Contents = (Term *)(HR+maxvnum+(sizeof(Int)/sizeof(CELL))*MaxTemps);
cglobs.curbranch = cglobs.onbranch = 0; cglobs.curbranch = cglobs.onbranch = 0;
cglobs.branch_pointer = cglobs.parent_branches; cglobs.branch_pointer = cglobs.parent_branches;
cglobs.or_found = FALSE; cglobs.or_found = FALSE;
@ -3586,7 +3627,7 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src)
} }
reset_vars(cglobs.vtable); reset_vars(cglobs.vtable);
H = HB; HR = HB;
if (B != NULL) { if (B != NULL) {
HB = B->cp_h; HB = B->cp_h;
} }

20
C/computils.c
View File

@ -81,7 +81,7 @@ typedef struct mem_blk {
union { union {
struct mem_blk *next; struct mem_blk *next;
double fill; double fill;
} u; } ublock;
char contents[1]; char contents[1];
} MemBlk; } MemBlk;
@ -110,7 +110,7 @@ AllocCMem (UInt size, struct intermediates *cip)
if (LOCAL_CMemFirstBlock) { if (LOCAL_CMemFirstBlock) {
p = LOCAL_CMemFirstBlock; p = LOCAL_CMemFirstBlock;
blksz = LOCAL_CMemFirstBlockSz; blksz = LOCAL_CMemFirstBlockSz;
p->u.next = NULL; p->ublock.next = NULL;
} else { } else {
if (blksz < FIRST_CMEM_BLK_SIZE) if (blksz < FIRST_CMEM_BLK_SIZE)
blksz = FIRST_CMEM_BLK_SIZE; blksz = FIRST_CMEM_BLK_SIZE;
@ -132,7 +132,7 @@ AllocCMem (UInt size, struct intermediates *cip)
siglongjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH); siglongjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH);
} }
} }
p->u.next = cip->blks; p->ublock.next = cip->blks;
cip->blks = p; cip->blks = p;
cip->blk_cur = p->contents; cip->blk_cur = p->contents;
cip->blk_top = (char *)p+blksz; cip->blk_top = (char *)p+blksz;
@ -146,7 +146,7 @@ AllocCMem (UInt size, struct intermediates *cip)
char *p; char *p;
if (ASP <= CellPtr (cip->freep) + 256) { if (ASP <= CellPtr (cip->freep) + 256) {
CACHE_REGS CACHE_REGS
LOCAL_Error_Size = 256+((char *)cip->freep - (char *)H); LOCAL_Error_Size = 256+((char *)cip->freep - (char *)HR);
save_machine_regs(); save_machine_regs();
siglongjmp(cip->CompilerBotch, OUT_OF_STACK_BOTCH); siglongjmp(cip->CompilerBotch, OUT_OF_STACK_BOTCH);
} }
@ -163,7 +163,7 @@ Yap_ReleaseCMem (struct intermediates *cip)
CACHE_REGS CACHE_REGS
struct mem_blk *p = cip->blks; struct mem_blk *p = cip->blks;
while (p) { while (p) {
struct mem_blk *nextp = p->u.next; struct mem_blk *nextp = p->ublock.next;
if (p != LOCAL_CMemFirstBlock) if (p != LOCAL_CMemFirstBlock)
Yap_FreeCodeSpace((ADDR)p); Yap_FreeCodeSpace((ADDR)p);
p = nextp; p = nextp;
@ -435,6 +435,8 @@ write_functor(Functor f)
Yap_DebugPlWrite(MkAtomTerm(AtomLONGINT)); Yap_DebugPlWrite(MkAtomTerm(AtomLONGINT));
} else if (f == FunctorDouble) { } else if (f == FunctorDouble) {
Yap_DebugPlWrite(MkAtomTerm(AtomDOUBLE)); Yap_DebugPlWrite(MkAtomTerm(AtomDOUBLE));
} else if (f == FunctorString) {
Yap_DebugPlWrite(MkAtomTerm(AtomSTRING));
} }
} else { } else {
Yap_DebugPlWrite(MkAtomTerm(NameOfFunctor (f))); Yap_DebugPlWrite(MkAtomTerm(NameOfFunctor (f)));
@ -590,6 +592,8 @@ ShowOp (char *f, struct PSEUDO *cpc)
Yap_DebugPlWrite(MkAtomTerm(AtomLONGINT)); Yap_DebugPlWrite(MkAtomTerm(AtomLONGINT));
} else if (fun == FunctorDouble) { } else if (fun == FunctorDouble) {
Yap_DebugPlWrite(MkAtomTerm(AtomDOUBLE)); Yap_DebugPlWrite(MkAtomTerm(AtomDOUBLE));
} else if (fun == FunctorString) {
Yap_DebugPlWrite(MkAtomTerm(AtomSTRING));
} }
} else { } else {
Yap_DebugPlWrite (MkAtomTerm(NameOfFunctor(fun))); Yap_DebugPlWrite (MkAtomTerm(NameOfFunctor(fun)));
@ -852,12 +856,12 @@ void
Yap_ShowCode (struct intermediates *cint) Yap_ShowCode (struct intermediates *cint)
{ {
CACHE_REGS CACHE_REGS
CELL *oldH = H; CELL *oldH = HR;
struct PSEUDO *cpc; struct PSEUDO *cpc;
cpc = cint->CodeStart; cpc = cint->CodeStart;
/* MkIntTerm and friends may build terms in the global stack */ /* MkIntTerm and friends may build terms in the global stack */
H = (CELL *)cint->freep; HR = (CELL *)cint->freep;
while (cpc) { while (cpc) {
compiler_vm_op ic = cpc->op; compiler_vm_op ic = cpc->op;
if (ic != nop_op) { if (ic != nop_op) {
@ -866,7 +870,7 @@ Yap_ShowCode (struct intermediates *cint)
cpc = cpc->nextInst; cpc = cpc->nextInst;
} }
Yap_DebugErrorPutc ('\n'); Yap_DebugErrorPutc ('\n');
H = oldH; HR = oldH;
} }
#endif /* DEBUG */ #endif /* DEBUG */

8
C/corout.c
View File

@ -60,7 +60,7 @@ static int can_unify_complex(register CELL *pt0,
saved_TR = TR; saved_TR = TR;
saved_B = B; saved_B = B;
saved_HB = HB; saved_HB = HB;
HB = H; HB = HR;
loop: loop:
while (pt0 < pt0_end) { while (pt0 < pt0_end) {
@ -152,6 +152,9 @@ static int can_unify_complex(register CELL *pt0,
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
if (FloatOfTerm(d0) == FloatOfTerm(d1)) continue; if (FloatOfTerm(d0) == FloatOfTerm(d1)) continue;
goto comparison_failed; goto comparison_failed;
case (CELL)FunctorString:
if (strcmp(StringOfTerm(d0), StringOfTerm(d1)) == 0) continue;
goto comparison_failed;
#ifdef USE_GMP #ifdef USE_GMP
case (CELL)FunctorBigInt: case (CELL)FunctorBigInt:
if (Yap_gmp_tcmp_big_big(d0,d1) == 0) continue; if (Yap_gmp_tcmp_big_big(d0,d1) == 0) continue;
@ -288,6 +291,9 @@ can_unify(Term t1, Term t2, Term *Vars USES_REGS)
case (CELL)FunctorLongInt: case (CELL)FunctorLongInt:
if (RepAppl(t1)[1] == RepAppl(t2)[1]) return(TRUE); if (RepAppl(t1)[1] == RepAppl(t2)[1]) return(TRUE);
return FALSE; return FALSE;
case (CELL)FunctorString:
if (strcmp(StringOfTerm(t1), StringOfTerm(t2)) == 0) return(TRUE);
return FALSE;
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
if (FloatOfTerm(t1) == FloatOfTerm(t2)) return(TRUE); if (FloatOfTerm(t1) == FloatOfTerm(t2)) return(TRUE);
return FALSE; return FALSE;

4
C/cut_c.c
View File

@ -1,5 +1,3 @@
#ifdef CUT_C
#include "Yap.h" #include "Yap.h"
#include "cut_c.h" #include "cut_c.h"
#include <stdio.h> #include <stdio.h>
@ -33,5 +31,3 @@ void cut_c_push(cut_c_str_ptr new_top){
Yap_REGS.CUT_C_TOP=new_top; Yap_REGS.CUT_C_TOP=new_top;
return; return;
} }
#endif /*CUT_C*/

301
C/dbase.c
View File

@ -92,8 +92,6 @@ static char SccsId[] = "%W% %G%";
#define ToSmall(V) ((link_entry)(Unsigned(V)>>3)) #define ToSmall(V) ((link_entry)(Unsigned(V)>>3))
#endif #endif
#define DEAD_REF(ref) FALSE
#ifdef SFUNC #ifdef SFUNC
#define MaxSFs 256 #define MaxSFs 256
@ -586,14 +584,24 @@ copy_double(CELL *st, CELL *pt)
/* first thing, store a link to the list before we move on */ /* first thing, store a link to the list before we move on */
st[0] = (CELL)FunctorDouble; st[0] = (CELL)FunctorDouble;
st[1] = pt[1]; st[1] = pt[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
st[2] = pt[2]; st[2] = pt[2];
st[3] = EndSpecials; st[3] = EndSpecials;
#else #else
st[2] = EndSpecials; st[2] = EndSpecials;
#endif #endif
/* now reserve space */ /* now reserve space */
return st+(2+SIZEOF_DOUBLE/SIZEOF_LONG_INT); return st+(2+SIZEOF_DOUBLE/SIZEOF_INT_P);
}
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);
/* now reserve space */
return st+sz;
} }
#ifdef USE_GMP #ifdef USE_GMP
@ -637,13 +645,13 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
#endif #endif
register visitel *visited = (visitel *)AuxSp; register visitel *visited = (visitel *)AuxSp;
/* store this in H */ /* store this in H */
register CELL **to_visit = (CELL **)H; register CELL **to_visit = (CELL **)HR;
CELL **to_visit_base = to_visit; CELL **to_visit_base = to_visit;
/* where we are going to add a new pair */ /* where we are going to add a new pair */
int vars_found = 0; int vars_found = 0;
#ifdef COROUTINING #ifdef COROUTINING
Term ConstraintsTerm = TermNil; Term ConstraintsTerm = TermNil;
CELL *origH = H; CELL *origH = HR;
#endif #endif
CELL *CodeMaxBase = CodeMax; CELL *CodeMaxBase = CodeMax;
@ -711,6 +719,17 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
++pt0; ++pt0;
continue; continue;
#endif #endif
case (CELL)FunctorString:
{
CELL *st = CodeMax;
CheckDBOverflow(3+ap2[1]);
/* first thing, store a link to the list before we move on */
*StoPoint++ = AbsAppl(st);
CodeMax = copy_string(CodeMax, ap2);
++pt0;
continue;
}
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
{ {
CELL *st = CodeMax; CELL *st = CodeMax;
@ -900,7 +919,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
Term t[4]; Term t[4];
int sz = to_visit-to_visit_base; int sz = to_visit-to_visit_base;
H = (CELL *)to_visit; HR = (CELL *)to_visit;
/* store the constraint away for: we need a back pointer to /* store the constraint away for: we need a back pointer to
the variable, the constraint in some cannonical form, what type the variable, the constraint in some cannonical form, what type
of constraint, and a list pointer */ of constraint, and a list pointer */
@ -909,11 +928,11 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
t[2] = MkIntegerTerm(ExtFromCell(ptd0)); t[2] = MkIntegerTerm(ExtFromCell(ptd0));
t[3] = ConstraintsTerm; t[3] = ConstraintsTerm;
ConstraintsTerm = Yap_MkApplTerm(FunctorClist, 4, t); ConstraintsTerm = Yap_MkApplTerm(FunctorClist, 4, t);
if (H+sz >= ASP) { if (HR+sz >= ASP) {
goto error2; goto error2;
} }
memcpy((void *)H, (void *)(to_visit_base), sz*sizeof(CELL *)); memcpy((void *)HR, (void *)(to_visit_base), sz*sizeof(CELL *));
to_visit_base = (CELL **)H; to_visit_base = (CELL **)HR;
to_visit = to_visit_base+sz; to_visit = to_visit_base+sz;
} }
#endif #endif
@ -969,7 +988,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
*vars_foundp = vars_found; *vars_foundp = vars_found;
DB_UNWIND_CUNIF(); DB_UNWIND_CUNIF();
#ifdef COROUTINING #ifdef COROUTINING
H = origH; HR = origH;
#endif #endif
return CodeMax; return CodeMax;
@ -988,7 +1007,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
#endif #endif
DB_UNWIND_CUNIF(); DB_UNWIND_CUNIF();
#ifdef COROUTINING #ifdef COROUTINING
H = origH; HR = origH;
#endif #endif
return NULL; return NULL;
@ -1006,7 +1025,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
#endif #endif
DB_UNWIND_CUNIF(); DB_UNWIND_CUNIF();
#ifdef COROUTINING #ifdef COROUTINING
H = origH; HR = origH;
#endif #endif
return NULL; return NULL;
@ -1024,7 +1043,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
#endif #endif
DB_UNWIND_CUNIF(); DB_UNWIND_CUNIF();
#ifdef COROUTINING #ifdef COROUTINING
H = origH; HR = origH;
#endif #endif
return NULL; return NULL;
#if THREADS #if THREADS
@ -1478,6 +1497,9 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
ntp = copy_double(ntp0, RepAppl(Tm)); ntp = copy_double(ntp0, RepAppl(Tm));
break; break;
case (CELL)FunctorString:
ntp = copy_string(ntp0, RepAppl(Tm));
break;
case (CELL)FunctorDBRef: case (CELL)FunctorDBRef:
Yap_ReleasePreAllocCodeSpace((ADDR)pp0); Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return CreateDBWithDBRef(Tm, p, dbg); return CreateDBWithDBRef(Tm, p, dbg);
@ -2449,6 +2471,22 @@ UnifyDBNumber(DBRef DBSP, Term t)
return Yap_unify(MkIntegerTerm(i),t); return Yap_unify(MkIntegerTerm(i),t);
} }
Int
Yap_unify_immediate_ref(DBRef ref USES_REGS)
{
// old immediate semantics style
LOCK(ref->lock);
if (ref == NULL
|| DEAD_REF(ref)
|| !UnifyDBKey(ref,0,ARG1)
|| !UnifyDBNumber(ref,ARG2)) {
UNLOCK(ref->lock);
return FALSE;
} else {
UNLOCK(ref->lock);
return TRUE;
}
}
static Term static Term
GetDBTerm(DBTerm *DBSP, int src USES_REGS) GetDBTerm(DBTerm *DBSP, int src USES_REGS)
@ -2464,7 +2502,7 @@ GetDBTerm(DBTerm *DBSP, int src USES_REGS)
} else if (IsAtomOrIntTerm(t)) { } else if (IsAtomOrIntTerm(t)) {
return t; return t;
} else { } else {
CELL *HOld = H; CELL *HOld = HR;
CELL *HeapPtr; CELL *HeapPtr;
CELL *pt; CELL *pt;
CELL NOf; CELL NOf;
@ -2473,9 +2511,10 @@ GetDBTerm(DBTerm *DBSP, int src USES_REGS)
return t; return t;
} }
pt = CellPtr(DBSP->Contents); pt = CellPtr(DBSP->Contents);
if (H+NOf > ASP-CalculateStackGap()/sizeof(CELL)) { CalculateStackGap( PASS_REGS1 );
if (HR+NOf > ASP-EventFlag/sizeof(CELL)) {
if (LOCAL_PrologMode & InErrorMode) { if (LOCAL_PrologMode & InErrorMode) {
if (H+NOf > ASP) if (HR+NOf > ASP)
fprintf(GLOBAL_stderr, "\n\n [ FATAL ERROR: No Stack for Error Handling ]\n"); fprintf(GLOBAL_stderr, "\n\n [ FATAL ERROR: No Stack for Error Handling ]\n");
Yap_exit( 1); Yap_exit( 1);
} else { } else {
@ -2486,7 +2525,7 @@ GetDBTerm(DBTerm *DBSP, int src USES_REGS)
} }
HeapPtr = cpcells(HOld, pt, NOf); HeapPtr = cpcells(HOld, pt, NOf);
pt += HeapPtr - HOld; pt += HeapPtr - HOld;
H = HeapPtr; HR = HeapPtr;
{ {
link_entry *lp = (link_entry *)pt; link_entry *lp = (link_entry *)pt;
linkblk(lp, HOld-1, (CELL)HOld-(CELL)(DBSP->Contents)); linkblk(lp, HOld-1, (CELL)HOld-(CELL)(DBSP->Contents));
@ -2494,7 +2533,7 @@ GetDBTerm(DBTerm *DBSP, int src USES_REGS)
#ifdef COROUTINING #ifdef COROUTINING
if (DBSP->ag.attachments != 0L && !src) { if (DBSP->ag.attachments != 0L && !src) {
if (!copy_attachments((CELL *)AdjustIDBPtr(DBSP->ag.attachments,(CELL)HOld-(CELL)(DBSP->Contents)) PASS_REGS)) { if (!copy_attachments((CELL *)AdjustIDBPtr(DBSP->ag.attachments,(CELL)HOld-(CELL)(DBSP->Contents)) PASS_REGS)) {
H = HOld; HR = HOld;
LOCAL_Error_TYPE = OUT_OF_ATTVARS_ERROR; LOCAL_Error_TYPE = OUT_OF_ATTVARS_ERROR;
LOCAL_Error_Size = 0; LOCAL_Error_Size = 0;
return (Term)0; return (Term)0;
@ -2925,17 +2964,16 @@ lu_nth_recorded(PredEntry *pe, Int Count USES_REGS)
if (cl == NULL) if (cl == NULL)
return FALSE; return FALSE;
#if MULTIPLE_STACKS #if MULTIPLE_STACKS
PELOCK(65,pe);
TRAIL_CLREF(cl); /* So that fail will erase it */ TRAIL_CLREF(cl); /* So that fail will erase it */
INC_CLREF_COUNT(cl); INC_CLREF_COUNT(cl);
UNLOCK(pe->PELock);
#else #else
if (!(cl->ClFlags & InUseMask)) { if (!(cl->ClFlags & InUseMask)) {
cl->ClFlags |= InUseMask; cl->ClFlags |= InUseMask;
TRAIL_CLREF(cl); /* So that fail will erase it */ TRAIL_CLREF(cl); /* So that fail will erase it */
} }
#endif #endif
return Yap_unify(MkDBRefTerm((DBRef)cl),ARG3); UNLOCK(pe->PELock);
return Yap_unify(MkDBRefTerm((DBRef)cl),ARG4);
} }
@ -2979,175 +3017,22 @@ nth_recorded(DBProp AtProp, Int Count USES_REGS)
} }
READ_UNLOCK(AtProp->DBRWLock); READ_UNLOCK(AtProp->DBRWLock);
#endif #endif
return Yap_unify(MkDBRefTerm(ref),ARG3); return Yap_unify(MkDBRefTerm(ref),ARG4);
} }
static Int Int
p_nth_instance( USES_REGS1 ) Yap_db_nth_recorded( PredEntry *pe, Int Count USES_REGS )
{ {
DBProp AtProp; DBProp AtProp;
Term TCount;
Int Count;
PredEntry *pe;
Term t3 = Deref(ARG3);
if (!IsVarTerm(t3)) { if (pe == NULL) {
if (!IsDBRefTerm(t3)) {
Yap_Error(TYPE_ERROR_DBREF,t3,"nth_instance/3");
return FALSE;
} else {
DBRef ref = DBRefOfTerm(t3);
if (ref->Flags & LogUpdMask) {
LogUpdClause *cl = (LogUpdClause *)ref;
PredEntry *pe;
LogUpdClause *ocl;
UInt pred_arity, icl = 0;
Functor pred_f;
Term tpred;
Term pred_module;
pe = cl->ClPred;
PELOCK(66,pe);
if (cl->ClFlags & ErasedMask) {
UNLOCK(pe->PELock);
return FALSE;
}
ocl = ClauseCodeToLogUpdClause(pe->cs.p_code.FirstClause);
pred_module = pe->ModuleOfPred;
if (pred_module != IDB_MODULE) {
pred_f = pe->FunctorOfPred;
pred_arity = pe->ArityOfPE;
} else {
if (pe->PredFlags & NumberDBPredFlag) {
pred_f = (Functor)MkIntegerTerm(pe->src.IndxId);
pred_arity = 0;
} else {
pred_f = pe->FunctorOfPred;
if (pe->PredFlags & AtomDBPredFlag) {
pred_arity = 0;
} else {
pred_arity = ArityOfFunctor(pred_f);
}
}
}
do {
icl++;
if (cl == ocl) break;
ocl = ocl->ClNext;
} while (ocl != NULL);
UNLOCK(pe->PELock);
if (ocl == NULL) {
return FALSE;
}
if (!Yap_unify(ARG2,MkIntegerTerm(icl))) {
return FALSE;
}
if (pred_arity) {
tpred = Yap_MkNewApplTerm(pred_f,pred_arity);
} else {
tpred = MkAtomTerm((Atom)pred_f);
}
if (pred_module == IDB_MODULE) {
return Yap_unify(ARG1,tpred);
} else {
Term ttpred, ts[2];
ts[0] = pred_module;
ts[1] = tpred;
ttpred = Yap_MkApplTerm(FunctorModule,pred_arity,ts);
return Yap_unify(ARG1,ttpred);
}
} else {
LOCK(ref->lock);
if (ref == NULL
|| DEAD_REF(ref)
|| !UnifyDBKey(ref,0,ARG1)
|| !UnifyDBNumber(ref,ARG2)) {
UNLOCK(ref->lock);
return FALSE;
} else {
UNLOCK(ref->lock);
return TRUE;
}
}
}
}
TCount = Deref(ARG2);
if (IsVarTerm(TCount)) {
Yap_Error(INSTANTIATION_ERROR, TCount, "nth_instance/3");
return FALSE;
}
if (!IsIntegerTerm(TCount)) {
Yap_Error(TYPE_ERROR_INTEGER, TCount, "nth_instance/3");
return FALSE;
}
Count = IntegerOfTerm(TCount);
if (Count <= 0) {
if (Count)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, TCount, "nth_instance/3");
else
Yap_Error(DOMAIN_ERROR_NOT_ZERO, TCount, "nth_instance/3");
return FALSE;
}
if ((pe = find_lu_entry(Deref(ARG1))) != NULL) {
return lu_nth_recorded(pe,Count PASS_REGS); return lu_nth_recorded(pe,Count PASS_REGS);
} }
if (EndOfPAEntr(AtProp = FetchDBPropFromKey(Deref(ARG1), 0, FALSE, "nth_instance/3"))) { if (EndOfPAEntr(AtProp = FetchDBPropFromKey(Deref(ARG1), 0, FALSE, "nth_instance/3"))) {
UNLOCK(pe->PELock);
return FALSE; return FALSE;
} }
return nth_recorded(AtProp,Count PASS_REGS); return nth_recorded(AtProp, Count PASS_REGS);
}
static Int
p_nth_instancep( USES_REGS1 )
{
DBProp AtProp;
Term TCount;
Int Count;
Term t3 = Deref(ARG3);
if (!IsVarTerm(t3)) {
if (!IsDBRefTerm(t3)) {
Yap_Error(TYPE_ERROR_DBREF,t3,"nth_instance/3");
return FALSE;
} else {
DBRef ref = DBRefOfTerm(t3);
LOCK(ref->lock);
if (ref == NULL
|| DEAD_REF(ref)
|| !UnifyDBKey(ref,CodeDBBit,ARG1)
|| !UnifyDBNumber(ref,ARG2)) {
UNLOCK(ref->lock);
return
FALSE;
} else {
UNLOCK(ref->lock);
return
TRUE;
}
}
}
if (EndOfPAEntr(AtProp = FetchDBPropFromKey(Deref(ARG1), MkCode, FALSE, "nth_instance/3"))) {
return
FALSE;
}
TCount = Deref(ARG2);
if (IsVarTerm(TCount)) {
Yap_Error(INSTANTIATION_ERROR, TCount, "recorded_at/4");
return (FALSE);
}
if (!IsIntegerTerm(TCount)) {
Yap_Error(TYPE_ERROR_INTEGER, TCount, "recorded_at/4");
return (FALSE);
}
Count = IntegerOfTerm(TCount);
if (Count <= 0) {
if (Count)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, TCount, "recorded_at/4");
else
Yap_Error(DOMAIN_ERROR_NOT_ZERO, TCount, "recorded_at/4");
return (FALSE);
}
return nth_recorded(AtProp,Count PASS_REGS);
} }
static Int static Int
@ -3184,7 +3069,7 @@ i_recorded(DBProp AtProp, Term t3 USES_REGS)
if (IsVarTerm(twork)) { if (IsVarTerm(twork)) {
EXTRA_CBACK_ARG(3,2) = MkIntegerTerm(0); EXTRA_CBACK_ARG(3,2) = MkIntegerTerm(0);
EXTRA_CBACK_ARG(3,3) = MkIntegerTerm(0); EXTRA_CBACK_ARG(3,3) = MkIntegerTerm(0);
B->cp_h = H; B->cp_h = HR;
while ((TermDB = GetDBTermFromDBEntry(ref PASS_REGS)) == (CELL)0) { while ((TermDB = GetDBTermFromDBEntry(ref PASS_REGS)) == (CELL)0) {
/* make sure the garbage collector sees what we want it to see! */ /* make sure the garbage collector sees what we want it to see! */
EXTRA_CBACK_ARG(3,1) = (CELL)ref; EXTRA_CBACK_ARG(3,1) = (CELL)ref;
@ -3212,7 +3097,7 @@ i_recorded(DBProp AtProp, Term t3 USES_REGS)
} else if (IsAtomOrIntTerm(twork)) { } else if (IsAtomOrIntTerm(twork)) {
EXTRA_CBACK_ARG(3,2) = MkIntegerTerm(0); EXTRA_CBACK_ARG(3,2) = MkIntegerTerm(0);
EXTRA_CBACK_ARG(3,3) = MkIntegerTerm((Int)twork); EXTRA_CBACK_ARG(3,3) = MkIntegerTerm((Int)twork);
B->cp_h = H; B->cp_h = HR;
READ_LOCK(AtProp->DBRWLock); READ_LOCK(AtProp->DBRWLock);
do { do {
if (((twork == ref->DBT.Entry) || IsVarTerm(ref->DBT.Entry)) && if (((twork == ref->DBT.Entry) || IsVarTerm(ref->DBT.Entry)) &&
@ -3229,7 +3114,7 @@ i_recorded(DBProp AtProp, Term t3 USES_REGS)
CELL key; CELL key;
CELL mask = EvalMasks(twork, &key); CELL mask = EvalMasks(twork, &key);
B->cp_h = H; B->cp_h = HR;
READ_LOCK(AtProp->DBRWLock); READ_LOCK(AtProp->DBRWLock);
do { do {
while ((mask & ref->Key) != (key & ref->Mask) && !DEAD_REF(ref)) { while ((mask & ref->Key) != (key & ref->Mask) && !DEAD_REF(ref)) {
@ -3244,7 +3129,7 @@ i_recorded(DBProp AtProp, Term t3 USES_REGS)
/* success */ /* success */
EXTRA_CBACK_ARG(3,2) = MkIntegerTerm(((Int)mask)); EXTRA_CBACK_ARG(3,2) = MkIntegerTerm(((Int)mask));
EXTRA_CBACK_ARG(3,3) = MkIntegerTerm(((Int)key)); EXTRA_CBACK_ARG(3,3) = MkIntegerTerm(((Int)key));
B->cp_h = H; B->cp_h = HR;
break; break;
} else { } else {
while ((ref = NextDBRef(ref)) != NULL while ((ref = NextDBRef(ref)) != NULL
@ -3302,7 +3187,7 @@ c_recorded(int flags USES_REGS)
{ {
Term TermDB, TRef; Term TermDB, TRef;
Register DBRef ref, ref0; Register DBRef ref, ref0;
CELL *PreviousHeap = H; CELL *PreviousHeap = HR;
CELL mask, key; CELL mask, key;
Term t1; Term t1;
@ -3371,7 +3256,7 @@ c_recorded(int flags USES_REGS)
} }
} }
LOCAL_Error_Size = 0; LOCAL_Error_Size = 0;
PreviousHeap = H; PreviousHeap = HR;
} }
Yap_unify(ARG2, TermDB); Yap_unify(ARG2, TermDB);
} else if (mask == 0) { /* ARG2 is a constant */ } else if (mask == 0) { /* ARG2 is a constant */
@ -3387,7 +3272,7 @@ c_recorded(int flags USES_REGS)
} }
} else } else
do { /* ARG2 is a structure */ do { /* ARG2 is a structure */
H = PreviousHeap; HR = PreviousHeap;
while ((mask & ref->Key) != (key & ref->Mask)) { while ((mask & ref->Key) != (key & ref->Mask)) {
while ((ref = NextDBRef(ref)) != NIL while ((ref = NextDBRef(ref)) != NIL
&& DEAD_REF(ref)); && DEAD_REF(ref));
@ -3414,7 +3299,7 @@ c_recorded(int flags USES_REGS)
} }
} }
LOCAL_Error_Size = 0; LOCAL_Error_Size = 0;
PreviousHeap = H; PreviousHeap = HR;
} }
if (Yap_unify(ARG2, TermDB)) if (Yap_unify(ARG2, TermDB))
break; break;
@ -4654,6 +4539,36 @@ static_instance(StaticClause *cl, PredEntry *ap USES_REGS)
} }
} }
static Int
exo_instance(Int i, PredEntry *ap USES_REGS)
{
if (ap->ArityOfPE == 0) {
return Yap_unify(ARG2,MkAtomTerm((Atom)ap->FunctorOfPred));
} else {
MegaClause *mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
Functor f = ap->FunctorOfPred;
UInt arity = ArityOfFunctor(ap->FunctorOfPred);
Term t2 = Deref(ARG2);
CELL *ptr = (CELL *)((ADDR)mcl->ClCode+2*sizeof(struct index_t *)+i*(mcl->ClItemSize));
if (IsVarTerm(t2)) {
// fresh slate
t2 = Yap_MkApplTerm(f,arity,ptr);
Yap_unify(ARG2, t2);
} else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) {
return FALSE;
}
for (i=0; i<arity; i++) {
XREGS[i+1] = ptr[i];
}
S = ptr;
CP = P;
YENV = ASP;
YENV[E_CB] = (CELL) B;
P = mcl->ClCode;
return TRUE;
}
}
static Int static Int
mega_instance(yamop *code, PredEntry *ap USES_REGS) mega_instance(yamop *code, PredEntry *ap USES_REGS)
{ {
@ -4699,7 +4614,7 @@ p_instance( USES_REGS1 )
return mega_instance(Yap_MegaClauseFromTerm(t1), Yap_MegaClausePredicateFromTerm(t1) PASS_REGS); return mega_instance(Yap_MegaClauseFromTerm(t1), Yap_MegaClausePredicateFromTerm(t1) PASS_REGS);
} }
if (FunctorOfTerm(t1) == FunctorExoClause) { if (FunctorOfTerm(t1) == FunctorExoClause) {
return Yap_unify(ARG2,ArgOfTerm(2,t1)); return exo_instance(Yap_ExoClauseFromTerm(t1), Yap_ExoClausePredicateFromTerm(t1) PASS_REGS);
} }
} }
return FALSE; return FALSE;
@ -4802,6 +4717,8 @@ p_instance( USES_REGS1 )
} }
} }
Term Term
Yap_LUInstance(LogUpdClause *cl, UInt arity) Yap_LUInstance(LogUpdClause *cl, UInt arity)
{ {
@ -5010,7 +4927,7 @@ cont_current_key( USES_REGS1 )
term = AtT = MkAtomTerm(a); term = AtT = MkAtomTerm(a);
} else { } else {
unsigned int j; unsigned int j;
CELL *p = H; CELL *p = HR;
for (j = 0; j < arity; j++) { for (j = 0; j < arity; j++) {
p[j] = MkVarTerm(); p[j] = MkVarTerm();
@ -5593,8 +5510,6 @@ Yap_InitDBPreds(void)
Yap_InitCPred("total_erased", 4, p_total_erased, SyncPredFlag); Yap_InitCPred("total_erased", 4, p_total_erased, SyncPredFlag);
Yap_InitCPred("key_erased_statistics", 5, p_key_erased_statistics, SyncPredFlag); Yap_InitCPred("key_erased_statistics", 5, p_key_erased_statistics, SyncPredFlag);
Yap_InitCPred("heap_space_info", 3, p_heap_space_info, SyncPredFlag); Yap_InitCPred("heap_space_info", 3, p_heap_space_info, SyncPredFlag);
Yap_InitCPred("$nth_instance", 3, p_nth_instance, SyncPredFlag);
Yap_InitCPred("$nth_instancep", 3, p_nth_instancep, SyncPredFlag);
Yap_InitCPred("$jump_to_next_dynamic_clause", 0, p_jump_to_next_dynamic_clause, SyncPredFlag); Yap_InitCPred("$jump_to_next_dynamic_clause", 0, p_jump_to_next_dynamic_clause, SyncPredFlag);
Yap_InitCPred("$install_thread_local", 2, p_install_thread_local, SafePredFlag); Yap_InitCPred("$install_thread_local", 2, p_install_thread_local, SafePredFlag);
} }

168
C/errors.c
View File

@ -29,6 +29,84 @@
#endif #endif
#include "Foreign.h" #include "Foreign.h"
int Yap_HandleError( const char *s, ... ) {
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
char *serr;
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (LOCAL_ErrorMessage) {
serr = LOCAL_ErrorMessage;
} else {
serr = (char *)s;
}
switch (err) {
case OUT_OF_STACK_ERROR:
if (!Yap_gc(2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, serr);
return(FALSE);
}
return TRUE;
case OUT_OF_AUXSPACE_ERROR:
if (LOCAL_MAX_SIZE < (char *)AuxSp-AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0,NULL, TRUE)) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, serr);
return FALSE;
}
return TRUE;
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, ARG2, serr);
return FALSE;
}
default:
Yap_Error(err, LOCAL_Error_Term, serr);
return(FALSE);
}
}
int Yap_SWIHandleError( const char *s, ... )
{
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
char *serr;
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (LOCAL_ErrorMessage) {
serr = LOCAL_ErrorMessage;
} else {
serr = (char *)s;
}
switch (err) {
case OUT_OF_STACK_ERROR:
if (!Yap_gc(2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, serr);
return(FALSE);
}
return TRUE;
case OUT_OF_AUXSPACE_ERROR:
if (LOCAL_MAX_SIZE < (char *)AuxSp-AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0,NULL, TRUE)) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, serr);
return FALSE;
}
return TRUE;
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, ARG2, serr);
return FALSE;
}
default:
Yap_Error(err, LOCAL_Error_Term, serr);
return(FALSE);
}
}
void void
Yap_RestartYap ( int flag ) Yap_RestartYap ( int flag )
@ -47,7 +125,7 @@ static void detect_bug_location(yamop *,find_pred_type,char *, int);
#define ONHEAP(ptr) (CellPtr(ptr) >= CellPtr(Yap_HeapBase) && CellPtr(ptr) < CellPtr(HeapTop)) #define ONHEAP(ptr) (CellPtr(ptr) >= CellPtr(Yap_HeapBase) && CellPtr(ptr) < CellPtr(HeapTop))
#define ONLOCAL(ptr) (CellPtr(ptr) > CellPtr(H) && CellPtr(ptr) < CellPtr(LOCAL_LocalBase)) #define ONLOCAL(ptr) (CellPtr(ptr) > CellPtr(HR) && CellPtr(ptr) < CellPtr(LOCAL_LocalBase))
static int static int
hidden (Atom at) hidden (Atom at)
@ -285,13 +363,13 @@ dump_stack( USES_REGS1 )
if (handled_exception( PASS_REGS1 )) if (handled_exception( PASS_REGS1 ))
return; return;
#if DEBUG #if DEBUG
fprintf(stderr,"%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n",P,CP,ASP,H,TR,HeapTop); 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); fprintf(stderr,"%% YAP mode: %ux\n",(unsigned int)LOCAL_PrologMode);
if (LOCAL_ErrorMessage) if (LOCAL_ErrorMessage)
fprintf(stderr,"%% LOCAL_ErrorMessage: %s\n",LOCAL_ErrorMessage); fprintf(stderr,"%% LOCAL_ErrorMessage: %s\n",LOCAL_ErrorMessage);
#endif #endif
if (H > ASP || H > LCL0) { if (HR > ASP || HR > LCL0) {
fprintf(stderr,"%% YAP ERROR: Global Collided against Local (%p--%p)\n",H,ASP); fprintf(stderr,"%% YAP ERROR: Global Collided against Local (%p--%p)\n",HR,ASP);
} else if (HeapTop > (ADDR)LOCAL_GlobalBase) { } else if (HeapTop > (ADDR)LOCAL_GlobalBase) {
fprintf(stderr,"%% YAP ERROR: Code Space Collided against Global (%p--%p)\n", HeapTop, LOCAL_GlobalBase); fprintf(stderr,"%% YAP ERROR: Code Space Collided against Global (%p--%p)\n", HeapTop, LOCAL_GlobalBase);
} else { } else {
@ -308,11 +386,11 @@ dump_stack( USES_REGS1 )
} }
#endif #endif
#endif #endif
detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, (char *)H, 256); detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256);
fprintf (stderr,"%%\n%% PC: %s\n",(char *)H); fprintf (stderr,"%%\n%% PC: %s\n",(char *)HR);
detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, (char *)H, 256); detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256);
fprintf (stderr,"%% Continuation: %s\n",(char *)H); fprintf (stderr,"%% Continuation: %s\n",(char *)HR);
fprintf (stderr,"%% %luKB of Global Stack (%p--%p)\n",(unsigned long int)(sizeof(CELL)*(H-H0))/1024,H0,H); fprintf (stderr,"%% %luKB of Global Stack (%p--%p)\n",(unsigned long int)(sizeof(CELL)*(HR-H0))/1024,H0,HR);
fprintf (stderr,"%% %luKB of Local Stack (%p--%p)\n",(unsigned long int)(sizeof(CELL)*(LCL0-ASP))/1024,ASP,LCL0); fprintf (stderr,"%% %luKB of Local Stack (%p--%p)\n",(unsigned long int)(sizeof(CELL)*(LCL0-ASP))/1024,ASP,LCL0);
fprintf (stderr,"%% %luKB of Trail (%p--%p)\n",(unsigned long int)((ADDR)TR-LOCAL_TrailBase)/1024,LOCAL_TrailBase,TR); fprintf (stderr,"%% %luKB of Trail (%p--%p)\n",(unsigned long int)((ADDR)TR-LOCAL_TrailBase)/1024,LOCAL_TrailBase,TR);
fprintf (stderr,"%% Performed %ld garbage collections\n", (unsigned long int)LOCAL_GcCalls); fprintf (stderr,"%% Performed %ld garbage collections\n", (unsigned long int)LOCAL_GcCalls);
@ -390,8 +468,8 @@ void
Yap_bug_location(yamop *pc) Yap_bug_location(yamop *pc)
{ {
CACHE_REGS CACHE_REGS
detect_bug_location(pc, FIND_PRED_FROM_ANYWHERE, (char *)H, 256); detect_bug_location(pc, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256);
fprintf(stderr,"%s\n",(char *)H); fprintf(stderr,"%s\n",(char *)HR);
dump_stack( PASS_REGS1 ); dump_stack( PASS_REGS1 );
} }
@ -489,10 +567,10 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
fprintf(stderr,"%% YAP OOOPS: %s.\n",tmpbuf); fprintf(stderr,"%% YAP OOOPS: %s.\n",tmpbuf);
fprintf(stderr,"%%\n%%\n"); fprintf(stderr,"%%\n%%\n");
} }
detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, (char *)H, 256); detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256);
fprintf (stderr,"%%\n%% PC: %s\n",(char *)H); fprintf (stderr,"%%\n%% PC: %s\n",(char *)HR);
detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, (char *)H, 256); detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256);
fprintf (stderr,"%% Continuation: %s\n",(char *)H); fprintf (stderr,"%% Continuation: %s\n",(char *)HR);
DumpActiveGoals( PASS_REGS1 ); DumpActiveGoals( PASS_REGS1 );
error_exit_yap (1); error_exit_yap (1);
} }
@ -1382,6 +1460,19 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
serious = TRUE; serious = TRUE;
} }
break; break;
case REPRESENTATION_ERROR_INT:
{
int i;
Term ti[1];
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomInt);
nt[0] = Yap_MkApplTerm(FunctorRepresentationError, 1, ti);
psize -= i;
fun = FunctorError;
serious = TRUE;
}
break;
case REPRESENTATION_ERROR_MAX_ARITY: case REPRESENTATION_ERROR_MAX_ARITY:
{ {
int i; int i;
@ -1450,11 +1541,8 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
case SYNTAX_ERROR: case SYNTAX_ERROR:
{ {
int i; int i;
Term ti[1];
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomSyntaxError);
nt[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, ti);
psize -= i; psize -= i;
fun = FunctorError; fun = FunctorError;
serious = TRUE; serious = TRUE;
@ -1535,6 +1623,20 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
serious = TRUE; serious = TRUE;
} }
break; break;
case TYPE_ERROR_BIGNUM:
{
int i;
Term ti[2];
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomBigNum);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
psize -= i;
fun = FunctorError;
serious = TRUE;
}
break;
case TYPE_ERROR_BYTE: case TYPE_ERROR_BYTE:
{ {
int i; int i;
@ -1745,6 +1847,20 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
serious = TRUE; serious = TRUE;
} }
break; break;
case TYPE_ERROR_REFERENCE:
{
int i;
Term ti[2];
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomDBReference);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
psize -= i;
fun = FunctorError;
serious = TRUE;
}
break;
case TYPE_ERROR_STRING: case TYPE_ERROR_STRING:
{ {
int i; int i;
@ -1759,6 +1875,20 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
serious = TRUE; serious = TRUE;
} }
break; break;
case TYPE_ERROR_TEXT:
{
int i;
Term ti[2];
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomText);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
psize -= i;
fun = FunctorError;
serious = TRUE;
}
break;
case TYPE_ERROR_UBYTE: case TYPE_ERROR_UBYTE:
{ {
int i; int i;
@ -1847,7 +1977,7 @@ E);
if (serious) { if (serious) {
/* disable active signals at this point */ /* disable active signals at this point */
LOCAL_ActiveSignals = 0; LOCAL_ActiveSignals = 0;
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
LOCAL_PrologMode &= ~InErrorMode; LOCAL_PrologMode &= ~InErrorMode;
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
/* we might be in the middle of a critical region */ /* we might be in the middle of a critical region */

4
C/eval.c
View File

@ -366,7 +366,7 @@ static Int cont_between( USES_REGS1 )
i1 = IntegerOfTerm(t1); i1 = IntegerOfTerm(t1);
tn = add_int(i1, 1 PASS_REGS); tn = add_int(i1, 1 PASS_REGS);
EXTRA_CBACK_ARG(3,1) = tn; EXTRA_CBACK_ARG(3,1) = tn;
HB = B->cp_h = H; HB = B->cp_h = HR;
return TRUE; return TRUE;
} else { } else {
Term t[2]; Term t[2];
@ -380,7 +380,7 @@ static Int cont_between( USES_REGS1 )
t[1] = MkIntTerm(1); t[1] = MkIntTerm(1);
tn = Eval(Yap_MkApplTerm(FunctorPlus, 2, t) PASS_REGS); tn = Eval(Yap_MkApplTerm(FunctorPlus, 2, t) PASS_REGS);
EXTRA_CBACK_ARG(3,1) = tn; EXTRA_CBACK_ARG(3,1) = tn;
HB = B->cp_h = H; HB = B->cp_h = HR;
return TRUE; return TRUE;
} }
} }

104
C/exec.c
View File

@ -22,12 +22,7 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#include "pl-shared.h" #include "pl-shared.h"
#include "yapio.h" #include "yapio.h"
#include "attvar.h" #include "attvar.h"
#ifdef CUT_C
#include "cut_c.h" #include "cut_c.h"
#endif
#if defined MYDDAS_ODBC || defined MYDDAS_MYSQL
#include "myddas.h"
#endif
static Int CallPredicate(PredEntry *, choiceptr, yamop * CACHE_TYPE); static Int CallPredicate(PredEntry *, choiceptr, yamop * CACHE_TYPE);
static Int EnterCreepMode(Term, Term CACHE_TYPE); static Int EnterCreepMode(Term, Term CACHE_TYPE);
@ -166,13 +161,14 @@ do_execute(Term t, Term mod USES_REGS)
if (PRED_GOAL_EXPANSION_ALL) { if (PRED_GOAL_EXPANSION_ALL) {
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
/* disable creeping when we do goal expansion */ /* disable creeping when we do goal expansion */
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) { if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
} }
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
return CallMetaCall(ARG1, mod PASS_REGS); return CallMetaCall(ARG1, mod PASS_REGS);
} else if (LOCAL_ActiveSignals && !LOCAL_InterruptsDisabled) { } else if (LOCAL_ActiveSignals && !LOCAL_InterruptsDisabled &&
!(LOCAL_PrologMode & (AbortMode|InterruptMode|SystemMode))) {
return EnterCreepMode(t, mod PASS_REGS); return EnterCreepMode(t, mod PASS_REGS);
} }
restart_exec: restart_exec:
@ -254,34 +250,34 @@ do_execute(Term t, Term mod USES_REGS)
static Term static Term
copy_execn_to_heap(Functor f, CELL *pt, unsigned int n, unsigned int arity, Term mod USES_REGS) copy_execn_to_heap(Functor f, CELL *pt, unsigned int n, unsigned int arity, Term mod USES_REGS)
{ {
CELL *h0 = H; CELL *h0 = HR;
Term tf; Term tf;
unsigned int i; unsigned int i;
if (arity == 2 && if (arity == 2 &&
NameOfFunctor(f) == AtomDot) { NameOfFunctor(f) == AtomDot) {
for (i = 0; i<arity-n;i++) { for (i = 0; i<arity-n;i++) {
*H++ = pt[i]; *HR++ = pt[i];
} }
for (i=0; i< n; i++) { for (i=0; i< n; i++) {
*H++ = h0[(int)(i-n)]; *HR++ = h0[(int)(i-n)];
} }
tf = AbsPair(h0); tf = AbsPair(h0);
} else { } else {
*H++ = (CELL)f; *HR++ = (CELL)f;
for (i = 0; i<arity-n;i++) { for (i = 0; i<arity-n;i++) {
*H++ = pt[i]; *HR++ = pt[i];
} }
for (i=0; i< n; i++) { for (i=0; i< n; i++) {
*H++ = h0[(int)(i-n)]; *HR++ = h0[(int)(i-n)];
} }
tf = AbsAppl(h0); tf = AbsAppl(h0);
} }
if (mod != CurrentModule) { if (mod != CurrentModule) {
CELL *h0 = H; CELL *h0 = HR;
*H++ = (CELL)FunctorModule; *HR++ = (CELL)FunctorModule;
*H++ = mod; *HR++ = mod;
*H++ = tf; *HR++ = tf;
tf = AbsAppl(h0); tf = AbsAppl(h0);
} }
return tf; return tf;
@ -338,9 +334,9 @@ do_execute_n(Term t, Term mod, unsigned int n USES_REGS)
if (PRED_GOAL_EXPANSION_ALL) { if (PRED_GOAL_EXPANSION_ALL) {
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
/* disable creeping when we do goal expansion */ /* disable creeping when we do goal expansion */
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) { if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
} }
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS); t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS);
@ -374,7 +370,7 @@ do_execute_n(Term t, Term mod, unsigned int n USES_REGS)
#endif #endif
} }
for (i = arity-n+1; i <= arity; i++,j++) { for (i = arity-n+1; i <= arity; i++,j++) {
XREGS[i] = H[j]; XREGS[i] = HR[j];
} }
return CallPredicate(pen, B, pen->CodeOfPred PASS_REGS); return CallPredicate(pen, B, pen->CodeOfPred PASS_REGS);
} }
@ -404,7 +400,7 @@ EnterCreepMode(Term t, Term mod USES_REGS) {
} }
} }
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
P_before_spy = P; P_before_spy = P;
return CallPredicate(PredCreep, B, PredCreep->CodeOfPred PASS_REGS); return CallPredicate(PredCreep, B, PredCreep->CodeOfPred PASS_REGS);
@ -421,15 +417,15 @@ static void
heap_store(Term t USES_REGS) heap_store(Term t USES_REGS)
{ {
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
if (VarOfTerm(t) < H) { if (VarOfTerm(t) < HR) {
*H++ = t; *HR++ = t;
} else { } else {
RESET_VARIABLE(H); RESET_VARIABLE(HR);
Bind_Local(VarOfTerm(t), (CELL)H); Bind_Local(VarOfTerm(t), (CELL)HR);
H++; HR++;
} }
} else { } else {
*H++ = t; *HR++ = t;
} }
} }
@ -640,8 +636,8 @@ p_execute_clause( USES_REGS1 )
} else { } else {
code = Yap_ClauseFromTerm(clt)->ClCode; code = Yap_ClauseFromTerm(clt)->ClCode;
} }
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL)) { if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL)) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
Yap_signal(YAP_CREEP_SIGNAL); Yap_signal(YAP_CREEP_SIGNAL);
} }
return CallPredicate(RepPredProp(pe), cut_cp, code PASS_REGS); return CallPredicate(RepPredProp(pe), cut_cp, code PASS_REGS);
@ -656,7 +652,7 @@ p_execute_in_mod( USES_REGS1 )
static Int static Int
p_do_goal_expansion( USES_REGS1 ) p_do_goal_expansion( USES_REGS1 )
{ {
Int creeping = LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); Int creeping = LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL);
Int out = FALSE; Int out = FALSE;
PredEntry *pe; PredEntry *pe;
Term cmod = Deref(ARG2); Term cmod = Deref(ARG2);
@ -664,9 +660,9 @@ p_do_goal_expansion( USES_REGS1 )
ARG2 = ARG3; ARG2 = ARG3;
/* disable creeping */ /* disable creeping */
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
if (!LOCAL_ActiveSignals) if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
/* CurMod:goal_expansion(A,B) */ /* CurMod:goal_expansion(A,B) */
@ -719,16 +715,16 @@ p_do_goal_expansion( USES_REGS1 )
static Int static Int
p_do_term_expansion( USES_REGS1 ) p_do_term_expansion( USES_REGS1 )
{ {
Int creeping = LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); Int creeping = LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL);
Int out = FALSE; Int out = FALSE;
PredEntry *pe; PredEntry *pe;
Term cmod = CurrentModule; Term cmod = CurrentModule;
/* disable creeping */ /* disable creeping */
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
if (!LOCAL_ActiveSignals) if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
/* CurMod:term_expansion(A,B) */ /* CurMod:term_expansion(A,B) */
@ -902,8 +898,8 @@ p_execute_nonstop( USES_REGS1 )
/* N = arity; */ /* N = arity; */
/* call may not define new system predicates!! */ /* call may not define new system predicates!! */
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) { if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) { if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
Yap_signal(YAP_CREEP_SIGNAL); Yap_signal(YAP_CREEP_SIGNAL);
} }
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
@ -1092,7 +1088,7 @@ exec_absmi(int top USES_REGS)
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
/* forget any signals active, we're reborne */ /* forget any signals active, we're reborne */
LOCAL_ActiveSignals = 0; LOCAL_ActiveSignals = 0;
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
@ -1126,7 +1122,7 @@ exec_absmi(int top USES_REGS)
/* make sure we don't leave a FAIL signal hanging around */ /* make sure we don't leave a FAIL signal hanging around */
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL; LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (!LOCAL_ActiveSignals) if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
return out; return out;
} }
@ -1162,7 +1158,7 @@ Yap_PrepGoal(UInt arity, CELL *pt, choiceptr saved_b USES_REGS)
} }
B = (choiceptr)ASP; B = (choiceptr)ASP;
B--; B--;
B->cp_h = H; B->cp_h = HR;
B->cp_tr = TR; B->cp_tr = TR;
B->cp_cp = CP; B->cp_cp = CP;
B->cp_ap = NOCODE; B->cp_ap = NOCODE;
@ -1173,7 +1169,7 @@ Yap_PrepGoal(UInt arity, CELL *pt, choiceptr saved_b USES_REGS)
#endif /* DEPTH_LIMIT */ #endif /* DEPTH_LIMIT */
YENV = ASP = (CELL *)B; YENV = ASP = (CELL *)B;
YENV[E_CB] = (CELL)B; YENV[E_CB] = (CELL)B;
HB = H; HB = HR;
CP = YESCODE; CP = YESCODE;
} }
@ -1231,7 +1227,6 @@ execute_pred(PredEntry *ppe, CELL *pt USES_REGS)
/* restore the old environment */ /* restore the old environment */
/* get to previous environment */ /* get to previous environment */
cut_B = (choiceptr)ENV[E_CB]; cut_B = (choiceptr)ENV[E_CB];
#ifdef CUT_C
{ {
/* Note that /* Note that
cut_B == (choiceptr)ENV[E_CB] */ cut_B == (choiceptr)ENV[E_CB] */
@ -1240,7 +1235,6 @@ execute_pred(PredEntry *ppe, CELL *pt USES_REGS)
POP_EXECUTE(); POP_EXECUTE();
} }
} }
#endif /* CUT_C */
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to(cut_B); CUT_prune_to(cut_B);
#endif /* YAPOR */ #endif /* YAPOR */
@ -1271,7 +1265,7 @@ execute_pred(PredEntry *ppe, CELL *pt USES_REGS)
} else if (out == 0) { } else if (out == 0) {
P = saved_p; P = saved_p;
CP = saved_cp; CP = saved_cp;
H = B->cp_h; HR = B->cp_h;
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
DEPTH= B->cp_depth; DEPTH= B->cp_depth;
#endif #endif
@ -1337,7 +1331,7 @@ Yap_trust_last(void)
CACHE_REGS CACHE_REGS
ASP = B->cp_env; ASP = B->cp_env;
CP = B->cp_cp; CP = B->cp_cp;
H = B->cp_h; HR = B->cp_h;
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
DEPTH= B->cp_depth; DEPTH= B->cp_depth;
#endif #endif
@ -1756,7 +1750,7 @@ Yap_InitYaamRegs( int myworker_id )
Yap_ResetExceptionTerm ( myworker_id ); Yap_ResetExceptionTerm ( myworker_id );
Yap_PutValue (AtomBreak, MkIntTerm (0)); Yap_PutValue (AtomBreak, MkIntTerm (0));
TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
H = H0 = ((CELL *) REMOTE_GlobalBase(myworker_id))+1; // +1: hack to ensure the gc does not try to mark mistakenly HR = H0 = ((CELL *) REMOTE_GlobalBase(myworker_id))+1; // +1: hack to ensure the gc does not try to mark mistakenly
LCL0 = ASP = (CELL *) REMOTE_LocalBase(myworker_id); LCL0 = ASP = (CELL *) REMOTE_LocalBase(myworker_id);
CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id)-MinTrailGap); CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id)-MinTrailGap);
/* notice that an initial choice-point and environment /* notice that an initial choice-point and environment
@ -1769,7 +1763,7 @@ Yap_InitYaamRegs( int myworker_id )
#endif #endif
STATIC_PREDICATES_MARKED = FALSE; STATIC_PREDICATES_MARKED = FALSE;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
H_FZ = H; H_FZ = HR;
#ifdef YAPOR_SBA #ifdef YAPOR_SBA
BSEG = BSEG =
#endif /* YAPOR_SBA */ #endif /* YAPOR_SBA */
@ -1777,7 +1771,7 @@ Yap_InitYaamRegs( int myworker_id )
TR = TR_FZ = (tr_fr_ptr) REMOTE_TrailBase(myworker_id); TR = TR_FZ = (tr_fr_ptr) REMOTE_TrailBase(myworker_id);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
LOCK(REMOTE_SignalLock(myworker_id)); LOCK(REMOTE_SignalLock(myworker_id));
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
/* the first real choice-point will also have AP=FAIL */ /* the first real choice-point will also have AP=FAIL */
/* always have an empty slots for people to use */ /* always have an empty slots for people to use */
REMOTE_GlobalArena(myworker_id) = TermNil; REMOTE_GlobalArena(myworker_id) = TermNil;
@ -1801,12 +1795,7 @@ Yap_InitYaamRegs( int myworker_id )
#endif #endif
Yap_AllocateDefaultArena(128*1024, 2, myworker_id); Yap_AllocateDefaultArena(128*1024, 2, myworker_id);
Yap_InitPreAllocCodeSpace( myworker_id ); Yap_InitPreAllocCodeSpace( myworker_id );
#ifdef CUT_C
cut_c_initialize( myworker_id ); cut_c_initialize( myworker_id );
#endif
#if defined MYDDAS_MYSQL || defined MYDDAS_ODBC
Yap_REGS.MYDDAS_GLOBAL_POINTER = NULL;
#endif
Yap_PrepGoal(0, NULL, NULL PASS_REGS); Yap_PrepGoal(0, NULL, NULL PASS_REGS);
#ifdef TABLING #ifdef TABLING
/* ensure that LOCAL_top_dep_fr is always valid */ /* ensure that LOCAL_top_dep_fr is always valid */
@ -1814,6 +1803,9 @@ Yap_InitYaamRegs( int myworker_id )
DepFr_cons_cp(REMOTE_top_dep_fr(myworker_id)) = NORM_CP(B); DepFr_cons_cp(REMOTE_top_dep_fr(myworker_id)) = NORM_CP(B);
#endif #endif
UNLOCK(REMOTE_SignalLock(myworker_id)); UNLOCK(REMOTE_SignalLock(myworker_id));
// make sure we have slots in case we don go through the top-level */
Yap_StartSlots( PASS_REGS1 );
} }
static Int static Int

12
C/exo.c
View File

@ -36,8 +36,6 @@
//void do_write(void) { exo_write=TRUE;} //void do_write(void) { exo_write=TRUE;}
#define NEXTOP(V,TYPE) ((yamop *)(&((V)->u.TYPE.next)))
#define MAX_ARITY 256 #define MAX_ARITY 256
#define FNV32_PRIME ((UInt)16777619) #define FNV32_PRIME ((UInt)16777619)
@ -407,7 +405,7 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count)
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
return NULL; return NULL;
} }
bzero(base, dsz); memset(base, 0, dsz);
} }
i->size = sz+dsz+sizeof(struct index_t); i->size = sz+dsz+sizeof(struct index_t);
i->key = (BITS32 *)base; i->key = (BITS32 *)base;
@ -430,7 +428,7 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count)
} }
if (base != (CELL *)Yap_ReallocCodeSpace((char *)base, sz)) if (base != (CELL *)Yap_ReallocCodeSpace((char *)base, sz))
return FALSE; return FALSE;
bzero(base, sz); memset(base, 0, sz);
i->key = (BITS32 *)base; i->key = (BITS32 *)base;
i->links = (BITS32 *)(base+i->hsize); i->links = (BITS32 *)(base+i->hsize);
i->ncollisions = i->nentries = i->ntrys = 0; i->ncollisions = i->nentries = i->ntrys = 0;
@ -455,7 +453,7 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count)
} }
if (base != (CELL *)Yap_ReallocCodeSpace((char *)base, sz)) if (base != (CELL *)Yap_ReallocCodeSpace((char *)base, sz))
return FALSE; return FALSE;
bzero(base, sz); memset(base, 0, sz);
i->key = (BITS32 *)base; i->key = (BITS32 *)base;
i->links = (BITS32 *)base+i->hsize; i->links = (BITS32 *)base+i->hsize;
i->ncollisions = i->nentries = i->ntrys = 0; i->ncollisions = i->nentries = i->ntrys = 0;
@ -562,7 +560,7 @@ Yap_NextExo(choiceptr cptr, struct index_t *it)
return next; return next;
} }
MegaClause * static MegaClause *
exodb_get_space( Term t, Term mod, Term tn ) exodb_get_space( Term t, Term mod, Term tn )
{ {
UInt arity; UInt arity;
@ -668,7 +666,7 @@ store_exo(yamop *pc, UInt arity, Term t0)
return TRUE; return TRUE;
} }
void static void
exoassert( void *handle, Int n, Term term ) exoassert( void *handle, Int n, Term term )
{ /* '$number_of_clauses'(Predicate,M,N) */ { /* '$number_of_clauses'(Predicate,M,N) */
PredEntry *pe; PredEntry *pe;

308
C/globals.c
View File

@ -108,15 +108,15 @@ NewArena(UInt size, UInt arity, CELL *where USES_REGS)
Term t; Term t;
UInt new_size; UInt new_size;
if (where == NULL || where == H) { if (where == NULL || where == HR) {
while (H+size > ASP-1024) { while (HR+size > ASP-1024) {
if (!Yap_gcl(size*sizeof(CELL), arity, ENV, P)) { if (!Yap_gcl(size*sizeof(CELL), arity, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return TermNil; return TermNil;
} }
} }
t = CreateNewArena(H, size); t = CreateNewArena(HR, size);
H += size; HR += size;
} else { } else {
if ((new_size=Yap_InsertInGlobal(where, size*sizeof(CELL)))==0) { if ((new_size=Yap_InsertInGlobal(where, size*sizeof(CELL)))==0) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms"); Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms");
@ -162,7 +162,7 @@ adjust_cps(UInt size USES_REGS)
{ {
/* adjust possible back pointers in choice-point stack */ /* adjust possible back pointers in choice-point stack */
choiceptr b_ptr = B; choiceptr b_ptr = B;
while (b_ptr->cp_h == H) { while (b_ptr->cp_h == HR) {
b_ptr->cp_h += size; b_ptr->cp_h += size;
b_ptr = b_ptr->cp_b; b_ptr = b_ptr->cp_b;
} }
@ -183,8 +183,8 @@ GrowArena(Term arena, CELL *pt, UInt old_size, UInt size, UInt arity USES_REGS)
if (size < 4096) { if (size < 4096) {
size = 4096; size = 4096;
} }
if (pt == H) { if (pt == HR) {
if (H+size > ASP-1024) { if (HR+size > ASP-1024) {
XREGS[arity+1] = arena; XREGS[arity+1] = arena;
if (!Yap_gcl(size*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) { if (!Yap_gcl(size*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) {
@ -197,11 +197,11 @@ GrowArena(Term arena, CELL *pt, UInt old_size, UInt size, UInt arity USES_REGS)
return GrowArena(arena, pt, old_size, size, arity PASS_REGS); return GrowArena(arena, pt, old_size, size, arity PASS_REGS);
} }
adjust_cps(size PASS_REGS); adjust_cps(size PASS_REGS);
H += size; HR += size;
} else { } else {
XREGS[arity+1] = arena; XREGS[arity+1] = arena;
/* try to recover some room */ /* try to recover some room */
if (arena == LOCAL_GlobalArena && 10*(pt-H0) > 8*(H-H0)) { if (arena == LOCAL_GlobalArena && 10*(pt-H0) > 8*(HR-H0)) {
if (!Yap_gcl(size*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) { if (!Yap_gcl(size*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage);
return FALSE; return FALSE;
@ -231,9 +231,9 @@ Yap_GetFromArena(Term *arenap, UInt cells, UInt arity)
CELL *newH; CELL *newH;
UInt old_sz = ArenaSz(arena), new_size; UInt old_sz = ArenaSz(arena), new_size;
if (IN_BETWEEN(base, H, max)) { if (IN_BETWEEN(base, HR, max)) {
base = H; base = HR;
H += cells; HR += cells;
return base; return base;
} }
if (base+cells > max-1024) { if (base+cells > max-1024) {
@ -254,11 +254,11 @@ CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP, UInt old_size
{ {
UInt new_size; UInt new_size;
if (H == oldH) if (HR == oldH)
return; return;
new_size = old_size - (H-RepAppl(*oldArenaP)); new_size = old_size - (HR-RepAppl(*oldArenaP));
*oldArenaP = CreateNewArena(H, new_size); *oldArenaP = CreateNewArena(HR, new_size);
H = oldH; HR = oldH;
HB = oldHB; HB = oldHB;
ASP = oldASP; ASP = oldASP;
} }
@ -308,12 +308,12 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
if (IsPairTerm(d0)) { if (IsPairTerm(d0)) {
CELL *ap2 = RepPair(d0); CELL *ap2 = RepPair(d0);
if ((share && ap2 < HB) || if ((share && ap2 < HB) ||
(ap2 >= HB && ap2 < H)) { (ap2 >= HB && ap2 < HR)) {
/* If this is newer than the current term, just reuse */ /* If this is newer than the current term, just reuse */
*ptf++ = d0; *ptf++ = d0;
continue; continue;
} }
*ptf = AbsPair(H); *ptf = AbsPair(HR);
ptf++; ptf++;
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
if (to_visit+1 >= (struct cp_frame *)AuxSp) { if (to_visit+1 >= (struct cp_frame *)AuxSp) {
@ -325,7 +325,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
to_visit->oldv = *pt0; to_visit->oldv = *pt0;
to_visit->ground = ground; to_visit->ground = ground;
/* fool the system into thinking we had a variable there */ /* fool the system into thinking we had a variable there */
*pt0 = AbsPair(H); *pt0 = AbsPair(HR);
to_visit ++; to_visit ++;
#else #else
if (pt0 < pt0_end) { if (pt0 < pt0_end) {
@ -342,9 +342,9 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
ground = TRUE; ground = TRUE;
pt0 = ap2 - 1; pt0 = ap2 - 1;
pt0_end = ap2 + 1; pt0_end = ap2 + 1;
ptf = H; ptf = HR;
H += 2; HR += 2;
if (H > ASP - MIN_ARENA_SIZE) { if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow; goto overflow;
} }
} else if (IsApplTerm(d0)) { } else if (IsApplTerm(d0)) {
@ -353,7 +353,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
/* store the terms to visit */ /* store the terms to visit */
ap2 = RepAppl(d0); ap2 = RepAppl(d0);
if ((share && ap2 < HB) || if ((share && ap2 < HB) ||
(ap2 >= HB && ap2 < H)) { (ap2 >= HB && ap2 < HR)) {
/* If this is newer than the current term, just reuse */ /* If this is newer than the current term, just reuse */
*ptf++ = d0; *ptf++ = d0;
continue; continue;
@ -367,54 +367,62 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
*ptf++ = d0; *ptf++ = d0;
break; break;
case (CELL)FunctorLongInt: case (CELL)FunctorLongInt:
if (H > ASP - (MIN_ARENA_SIZE+3)) { if (HR > ASP - (MIN_ARENA_SIZE+3)) {
goto overflow; goto overflow;
} }
*ptf++ = AbsAppl(H); *ptf++ = AbsAppl(HR);
H[0] = (CELL)f; HR[0] = (CELL)f;
H[1] = ap2[1]; HR[1] = ap2[1];
H[2] = EndSpecials; HR[2] = EndSpecials;
H += 3; HR += 3;
if (H > ASP - MIN_ARENA_SIZE) { if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow; goto overflow;
} }
break; break;
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
if (H > ASP - (MIN_ARENA_SIZE+(2+SIZEOF_DOUBLE/sizeof(CELL)))) { if (HR > ASP - (MIN_ARENA_SIZE+(2+SIZEOF_DOUBLE/sizeof(CELL)))) {
goto overflow; goto overflow;
} }
*ptf++ = AbsAppl(H); *ptf++ = AbsAppl(HR);
H[0] = (CELL)f; HR[0] = (CELL)f;
H[1] = ap2[1]; HR[1] = ap2[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
H[2] = ap2[2]; HR[2] = ap2[2];
H[3] = EndSpecials; HR[3] = EndSpecials;
H += 4; HR += 4;
#else #else
H[2] = EndSpecials; HR[2] = EndSpecials;
H += 3; HR += 3;
#endif #endif
break; break;
case (CELL)FunctorString:
if (ASP - HR > MIN_ARENA_SIZE+3+ap2[1]) {
goto overflow;
}
*ptf++ = AbsAppl(HR);
memcpy(HR, ap2, sizeof(CELL)*(3+ap2[1]));
HR+=ap2[1]+3;
break;
default: default:
{ {
/* big int */ /* big int */
UInt sz = (sizeof(MP_INT)+3*CellSize+ UInt sz = (sizeof(MP_INT)+3*CellSize+
((MP_INT *)(ap2+2))->_mp_alloc*sizeof(mp_limb_t))/CellSize, i; ((MP_INT *)(ap2+2))->_mp_alloc*sizeof(mp_limb_t))/CellSize, i;
if (H > ASP - (MIN_ARENA_SIZE+sz)) { if (HR > ASP - (MIN_ARENA_SIZE+sz)) {
goto overflow; goto overflow;
} }
*ptf++ = AbsAppl(H); *ptf++ = AbsAppl(HR);
H[0] = (CELL)f; HR[0] = (CELL)f;
for (i = 1; i < sz; i++) { for (i = 1; i < sz; i++) {
H[i] = ap2[i]; HR[i] = ap2[i];
} }
H += sz; HR += sz;
} }
} }
continue; continue;
} }
*ptf = AbsAppl(H); *ptf = AbsAppl(HR);
ptf++; ptf++;
/* store the terms to visit */ /* store the terms to visit */
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
@ -427,7 +435,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
to_visit->oldv = *pt0; to_visit->oldv = *pt0;
to_visit->ground = ground; to_visit->ground = ground;
/* fool the system into thinking we had a variable there */ /* fool the system into thinking we had a variable there */
*pt0 = AbsAppl(H); *pt0 = AbsAppl(HR);
to_visit ++; to_visit ++;
#else #else
if (pt0 < pt0_end) { if (pt0 < pt0_end) {
@ -446,10 +454,10 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
pt0 = ap2; pt0 = ap2;
pt0_end = ap2 + d0; pt0_end = ap2 + d0;
/* store the functor for the new term */ /* store the functor for the new term */
H[0] = (CELL)f; HR[0] = (CELL)f;
ptf = H+1; ptf = HR+1;
H += 1+d0; HR += 1+d0;
if (H > ASP - MIN_ARENA_SIZE) { if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow; goto overflow;
} }
} else { } else {
@ -463,7 +471,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
ground = FALSE; ground = FALSE;
/* don't need to copy variables if we want to share the global term */ /* don't need to copy variables if we want to share the global term */
if ((share && ptd0 < HB && ptd0 > H0) || if ((share && ptd0 < HB && ptd0 > H0) ||
(ptd0 >= HLow && ptd0 < H)) { (ptd0 >= HLow && ptd0 < HR)) {
/* we have already found this cell */ /* we have already found this cell */
*ptf++ = (CELL) ptd0; *ptf++ = (CELL) ptd0;
} else { } else {
@ -522,7 +530,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
overflow: overflow:
/* oops, we're in trouble */ /* oops, we're in trouble */
H = HLow; HR = HLow;
/* we've done it */ /* we've done it */
/* restore our nice, friendly, term to its original state */ /* restore our nice, friendly, term to its original state */
HB = HB0; HB = HB0;
@ -540,7 +548,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
heap_overflow: heap_overflow:
/* oops, we're in trouble */ /* oops, we're in trouble */
H = HLow; HR = HLow;
/* we've done it */ /* we've done it */
/* restore our nice, friendly, term to its original state */ /* restore our nice, friendly, term to its original state */
HB = HB0; HB = HB0;
@ -558,7 +566,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
trail_overflow: trail_overflow:
/* oops, we're in trouble */ /* oops, we're in trouble */
H = HLow; HR = HLow;
/* we've done it */ /* we've done it */
/* restore our nice, friendly, term to its original state */ /* restore our nice, friendly, term to its original state */
HB = HB0; HB = HB0;
@ -579,7 +587,7 @@ static Term
CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Term *newarena, UInt min_grow USES_REGS) CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Term *newarena, UInt min_grow USES_REGS)
{ {
UInt old_size = ArenaSz(arena); UInt old_size = ArenaSz(arena);
CELL *oldH = H; CELL *oldH = HR;
CELL *oldHB = HB; CELL *oldHB = HB;
CELL *oldASP = ASP; CELL *oldASP = ASP;
int res = 0; int res = 0;
@ -589,14 +597,14 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
t = Deref(t); t = Deref(t);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
ASP = ArenaLimit(arena); ASP = ArenaLimit(arena);
H = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
#if COROUTINING #if COROUTINING
if (GlobalIsAttachedTerm(t)) { if (GlobalIsAttachedTerm(t)) {
CELL *Hi; CELL *Hi;
*H = t; *HR = t;
Hi = H+1; Hi = HR+1;
H += 2; HR += 2;
if ((res = copy_complex_term(Hi-2, Hi-1, share, copy_att_vars, Hi, Hi PASS_REGS)) < 0) if ((res = copy_complex_term(Hi-2, Hi-1, share, copy_att_vars, Hi, Hi PASS_REGS)) < 0)
goto error_handler; goto error_handler;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
@ -608,7 +616,7 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
return t; return t;
} }
tn = MkVarTerm(); tn = MkVarTerm();
if (H > ASP - MIN_ARENA_SIZE) { if (HR > ASP - MIN_ARENA_SIZE) {
res = -1; res = -1;
goto error_handler; goto error_handler;
} }
@ -624,12 +632,12 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
if (share && ArenaPt(arena) > RepPair(t)) { if (share && ArenaPt(arena) > RepPair(t)) {
return t; return t;
} }
H = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
ASP = ArenaLimit(arena); ASP = ArenaLimit(arena);
ap = RepPair(t); ap = RepPair(t);
Hi = H; Hi = HR;
tf = AbsPair(H); tf = AbsPair(HR);
H += 2; HR += 2;
if ((res = copy_complex_term(ap-1, ap+1, share, copy_att_vars, Hi, Hi PASS_REGS)) < 0) { if ((res = copy_complex_term(ap-1, ap+1, share, copy_att_vars, Hi, Hi PASS_REGS)) < 0) {
goto error_handler; goto error_handler;
} }
@ -644,59 +652,67 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
if (share && ArenaPt(arena) > RepAppl(t)) { if (share && ArenaPt(arena) > RepAppl(t)) {
return t; return t;
} }
H = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
ASP = ArenaLimit(arena); ASP = ArenaLimit(arena);
f = FunctorOfTerm(t); f = FunctorOfTerm(t);
HB0 = H; HB0 = HR;
ap = RepAppl(t); ap = RepAppl(t);
tf = AbsAppl(H); tf = AbsAppl(HR);
H[0] = (CELL)f; HR[0] = (CELL)f;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
switch((CELL)f) { switch((CELL)f) {
case (CELL)FunctorDBRef: case (CELL)FunctorDBRef:
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
return t; return t;
case (CELL)FunctorLongInt: case (CELL)FunctorLongInt:
if (H > ASP - (MIN_ARENA_SIZE+3)) { if (HR > ASP - (MIN_ARENA_SIZE+3)) {
res = -1; res = -1;
goto error_handler; goto error_handler;
} }
H[1] = ap[1]; HR[1] = ap[1];
H[2] = EndSpecials; HR[2] = EndSpecials;
H += 3; HR += 3;
break; break;
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
if (H > ASP - (MIN_ARENA_SIZE+(2+SIZEOF_DOUBLE/sizeof(CELL)))) { if (HR > ASP - (MIN_ARENA_SIZE+(2+SIZEOF_DOUBLE/sizeof(CELL)))) {
res = -1; res = -1;
goto error_handler; goto error_handler;
} }
H[1] = ap[1]; HR[1] = ap[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
H[2] = ap[2]; HR[2] = ap[2];
H[3] = EndSpecials; HR[3] = EndSpecials;
H += 4; HR += 4;
#else #else
H[2] = EndSpecials; HR[2] = EndSpecials;
H += 3; HR += 3;
#endif #endif
break; break;
case (CELL)FunctorString:
if (HR > ASP - MIN_ARENA_SIZE+3+ap[1]) {
res = -1;
goto error_handler;
}
memcpy(HR, ap, sizeof(CELL)*(3+ap[1]));
HR += ap[1]+3;
break;
default: default:
{ {
UInt sz = ArenaSz(t), i; UInt sz = ArenaSz(t), i;
if (H > ASP - (MIN_ARENA_SIZE+sz)) { if (HR > ASP - (MIN_ARENA_SIZE+sz)) {
res = -1; res = -1;
goto error_handler; goto error_handler;
} }
for (i = 1; i < sz; i++) { for (i = 1; i < sz; i++) {
H[i] = ap[i]; HR[i] = ap[i];
} }
H += sz; HR += sz;
} }
} }
} else { } else {
H += 1+ArityOfFunctor(f); HR += 1+ArityOfFunctor(f);
if (H > ASP-MIN_ARENA_SIZE) { if (HR > ASP-MIN_ARENA_SIZE) {
res = -1; res = -1;
goto error_handler; goto error_handler;
} }
@ -708,7 +724,7 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
return tf; return tf;
} }
error_handler: error_handler:
H = HB; HR = HB;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
XREGS[arity+1] = t; XREGS[arity+1] = t;
XREGS[arity+2] = arena; XREGS[arity+2] = arena;
@ -716,7 +732,7 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
{ {
CELL *old_top = ArenaLimit(*newarena); CELL *old_top = ArenaLimit(*newarena);
ASP = oldASP; ASP = oldASP;
H = oldH; HR = oldH;
HB = oldHB; HB = oldHB;
switch (res) { switch (res) {
case -1: case -1:
@ -734,7 +750,7 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
} }
} }
} }
oldH = H; oldH = HR;
oldHB = HB; oldHB = HB;
oldASP = ASP; oldASP = ASP;
newarena = (CELL *)XREGS[arity+3]; newarena = (CELL *)XREGS[arity+3];
@ -748,7 +764,7 @@ static Term
CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity, Term *newarena, Term init USES_REGS) CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity, Term *newarena, Term init USES_REGS)
{ {
UInt old_size = ArenaSz(arena); UInt old_size = ArenaSz(arena);
CELL *oldH = H; CELL *oldH = HR;
CELL *oldHB = HB; CELL *oldHB = HB;
CELL *oldASP = ASP; CELL *oldASP = ASP;
Term tf; Term tf;
@ -757,22 +773,22 @@ CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity, Term *newarena, Ter
UInt i; UInt i;
restart: restart:
H = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
ASP = ArenaLimit(arena); ASP = ArenaLimit(arena);
HB0 = H; HB0 = HR;
tf = AbsAppl(H); tf = AbsAppl(HR);
H[0] = (CELL)f; HR[0] = (CELL)f;
H += 1+ArityOfFunctor(f); HR += 1+ArityOfFunctor(f);
if (H > ASP-MIN_ARENA_SIZE) { if (HR > ASP-MIN_ARENA_SIZE) {
/* overflow */ /* overflow */
H = HB; HR = HB;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
XREGS[arity+1] = arena; XREGS[arity+1] = arena;
XREGS[arity+2] = (CELL)newarena; XREGS[arity+2] = (CELL)newarena;
{ {
CELL *old_top = ArenaLimit(*newarena); CELL *old_top = ArenaLimit(*newarena);
ASP = oldASP; ASP = oldASP;
H = oldH; HR = oldH;
HB = oldHB; HB = oldHB;
if (arena == LOCAL_GlobalArena) if (arena == LOCAL_GlobalArena)
LOCAL_GlobalArenaOverflows++; LOCAL_GlobalArenaOverflows++;
@ -781,7 +797,7 @@ CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity, Term *newarena, Ter
return 0L; return 0L;
} }
} }
oldH = H; oldH = HR;
oldHB = HB; oldHB = HB;
oldASP = ASP; oldASP = ASP;
newarena = (CELL *)XREGS[arity+2]; newarena = (CELL *)XREGS[arity+2];
@ -1108,7 +1124,7 @@ p_nb_add_to_accumulator( USES_REGS1 )
CELL *target = RepAppl(t0); CELL *target = RepAppl(t0);
CELL *source = RepAppl(new); CELL *source = RepAppl(new);
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
target[2] = source[2]; target[2] = source[2];
#endif #endif
target[1] = source[1]; target[1] = source[1];
@ -1236,7 +1252,7 @@ p_b_setval( USES_REGS1 )
{ {
/* but first make sure we are doing on a global object, or a constant! */ /* but first make sure we are doing on a global object, or a constant! */
Term t = Deref(ARG2); Term t = Deref(ARG2);
if (IsVarTerm(t) && VarOfTerm(t) > H && VarOfTerm(t) < LCL0) { if (IsVarTerm(t) && VarOfTerm(t) > HR && VarOfTerm(t) < LCL0) {
Term tn = MkVarTerm(); Term tn = MkVarTerm();
Bind_Local(VarOfTerm(t), tn); Bind_Local(VarOfTerm(t), tn);
t = tn; t = tn;
@ -1476,7 +1492,7 @@ nb_queue(UInt arena_sz USES_REGS)
static Int static Int
p_nb_queue( USES_REGS1 ) p_nb_queue( USES_REGS1 )
{ {
UInt arena_sz = (ASP-H)/16; UInt arena_sz = (ASP-HR)/16;
if (LOCAL_DepthArenas > 1) if (LOCAL_DepthArenas > 1)
arena_sz /= LOCAL_DepthArenas; arena_sz /= LOCAL_DepthArenas;
if (arena_sz < MIN_ARENA_SIZE) if (arena_sz < MIN_ARENA_SIZE)
@ -1547,8 +1563,8 @@ RecoverArena(Term arena USES_REGS)
CELL *pt = ArenaPt(arena), CELL *pt = ArenaPt(arena),
*max = ArenaLimit(arena); *max = ArenaLimit(arena);
if (max == H) { if (max == HR) {
H = pt; HR = pt;
} }
} }
@ -1610,14 +1626,14 @@ p_nb_queue_enqueue( USES_REGS1 )
qd = GetQueue(ARG1,"enqueue"); qd = GetQueue(ARG1,"enqueue");
arena = GetQueueArena(qd,"enqueue"); arena = GetQueueArena(qd,"enqueue");
/* garbage collection ? */ /* garbage collection ? */
oldH = H; oldH = HR;
oldHB = HB; oldHB = HB;
H = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena); old_sz = ArenaSz(arena);
qsize = IntegerOfTerm(qd[QUEUE_SIZE]); qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
while (old_sz < MIN_ARENA_SIZE) { while (old_sz < MIN_ARENA_SIZE) {
UInt gsiz = H-RepPair(qd[QUEUE_HEAD]); UInt gsiz = HR-RepPair(qd[QUEUE_HEAD]);
H = oldH; HR = oldH;
HB = oldHB; HB = oldHB;
if (gsiz > 1024*1024) { if (gsiz > 1024*1024) {
gsiz = 1024*1024; gsiz = 1024*1024;
@ -1633,21 +1649,21 @@ p_nb_queue_enqueue( USES_REGS1 )
to = ARG3; to = ARG3;
qd = RepAppl(Deref(ARG1))+1; qd = RepAppl(Deref(ARG1))+1;
arena = GetQueueArena(qd,"enqueue"); arena = GetQueueArena(qd,"enqueue");
oldH = H; oldH = HR;
oldHB = HB; oldHB = HB;
H = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena); old_sz = ArenaSz(arena);
} }
qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsize+1); qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsize+1);
if (qsize == 0) { if (qsize == 0) {
qd[QUEUE_HEAD] = AbsPair(H); qd[QUEUE_HEAD] = AbsPair(HR);
} else { } else {
*VarOfTerm(qd[QUEUE_TAIL]) = AbsPair(H); *VarOfTerm(qd[QUEUE_TAIL]) = AbsPair(HR);
} }
*H++ = to; *HR++ = to;
RESET_VARIABLE(H); RESET_VARIABLE(HR);
qd[QUEUE_TAIL] = (CELL)H; qd[QUEUE_TAIL] = (CELL)HR;
H++; HR++;
CloseArena(oldH, oldHB, ASP, qd+QUEUE_ARENA, old_sz PASS_REGS); CloseArena(oldH, oldHB, ASP, qd+QUEUE_ARENA, old_sz PASS_REGS);
return TRUE; return TRUE;
} }
@ -1672,7 +1688,7 @@ p_nb_queue_dequeue( USES_REGS1 )
out = HeadOfTerm(qd[QUEUE_HEAD]); out = HeadOfTerm(qd[QUEUE_HEAD]);
qd[QUEUE_HEAD] = TailOfTerm(qd[QUEUE_HEAD]); qd[QUEUE_HEAD] = TailOfTerm(qd[QUEUE_HEAD]);
/* garbage collection ? */ /* garbage collection ? */
oldH = H; oldH = HR;
oldHB = HB; oldHB = HB;
qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsz-1); qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsz-1);
CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS); CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS);
@ -1771,16 +1787,16 @@ MkZeroApplTerm(Functor f, UInt sz USES_REGS)
Term t0, tf; Term t0, tf;
CELL *pt; CELL *pt;
if (H+(sz+1) > ASP-1024) if (HR+(sz+1) > ASP-1024)
return TermNil; return TermNil;
tf = AbsAppl(H); tf = AbsAppl(HR);
*H = (CELL)f; *HR = (CELL)f;
t0 = MkIntTerm(0); t0 = MkIntTerm(0);
pt = H+1; pt = HR+1;
while (sz--) { while (sz--) {
*pt++ = t0; *pt++ = t0;
} }
H = pt; HR = pt;
return tf; return tf;
} }
@ -1790,7 +1806,7 @@ p_nb_heap( USES_REGS1 )
Term heap_arena, heap, *ar, *nar; Term heap_arena, heap, *ar, *nar;
UInt hsize; UInt hsize;
Term tsize = Deref(ARG1); Term tsize = Deref(ARG1);
UInt arena_sz = (H-H0)/16; UInt arena_sz = (HR-H0)/16;
if (IsVarTerm(tsize)) { if (IsVarTerm(tsize)) {
Yap_Error(INSTANTIATION_ERROR,tsize,"nb_heap"); Yap_Error(INSTANTIATION_ERROR,tsize,"nb_heap");
@ -1941,9 +1957,9 @@ p_nb_heap_add_to_heap( USES_REGS1 )
} }
arena = qd[HEAP_ARENA]; arena = qd[HEAP_ARENA];
old_sz = ArenaSz(arena); old_sz = ArenaSz(arena);
oldH = H; oldH = HR;
oldHB = HB; oldHB = HB;
H = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
qd[HEAP_MAX] = Global_MkIntegerTerm(hmsize); qd[HEAP_MAX] = Global_MkIntegerTerm(hmsize);
CloseArena(oldH, oldHB, ASP, qd+HEAP_ARENA, old_sz PASS_REGS); CloseArena(oldH, oldHB, ASP, qd+HEAP_ARENA, old_sz PASS_REGS);
goto restart; goto restart;
@ -1963,14 +1979,14 @@ p_nb_heap_add_to_heap( USES_REGS1 )
qd = GetHeap(ARG1,"add_to_heap"); qd = GetHeap(ARG1,"add_to_heap");
arena = qd[HEAP_ARENA]; arena = qd[HEAP_ARENA];
/* garbage collection ? */ /* garbage collection ? */
oldH = H; oldH = HR;
oldHB = HB; oldHB = HB;
H = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena); old_sz = ArenaSz(arena);
while (old_sz < MIN_ARENA_SIZE) { while (old_sz < MIN_ARENA_SIZE) {
UInt gsiz = hsize*2; UInt gsiz = hsize*2;
H = oldH; HR = oldH;
HB = oldHB; HB = oldHB;
if (gsiz > 1024*1024) { if (gsiz > 1024*1024) {
gsiz = 1024*1024; gsiz = 1024*1024;
@ -1985,9 +2001,9 @@ p_nb_heap_add_to_heap( USES_REGS1 )
to = ARG3; to = ARG3;
qd = RepAppl(Deref(ARG1))+1; qd = RepAppl(Deref(ARG1))+1;
arena = qd[HEAP_ARENA]; arena = qd[HEAP_ARENA];
oldH = H; oldH = HR;
oldHB = HB; oldHB = HB;
H = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena); old_sz = ArenaSz(arena);
} }
pt = qd+HEAP_START; pt = qd+HEAP_START;
@ -2018,7 +2034,7 @@ p_nb_heap_del( USES_REGS1 )
return FALSE; return FALSE;
old_sz = ArenaSz(arena); old_sz = ArenaSz(arena);
/* garbage collection ? */ /* garbage collection ? */
oldH = H; oldH = HR;
oldHB = HB; oldHB = HB;
qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz-1); qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz-1);
CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS); CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS);
@ -2073,7 +2089,7 @@ p_nb_beam( USES_REGS1 )
Term beam_arena, beam, *ar, *nar; Term beam_arena, beam, *ar, *nar;
UInt hsize; UInt hsize;
Term tsize = Deref(ARG1); Term tsize = Deref(ARG1);
UInt arena_sz = (H-H0)/16; UInt arena_sz = (HR-H0)/16;
if (IsVarTerm(tsize)) { if (IsVarTerm(tsize)) {
Yap_Error(INSTANTIATION_ERROR,tsize,"nb_beam"); Yap_Error(INSTANTIATION_ERROR,tsize,"nb_beam");
@ -2352,14 +2368,14 @@ p_nb_beam_add_to_beam( USES_REGS1 )
qd = GetHeap(ARG1,"add_to_beam"); qd = GetHeap(ARG1,"add_to_beam");
arena = qd[HEAP_ARENA]; arena = qd[HEAP_ARENA];
/* garbage collection ? */ /* garbage collection ? */
oldH = H; oldH = HR;
oldHB = HB; oldHB = HB;
H = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena); old_sz = ArenaSz(arena);
while (old_sz < MIN_ARENA_SIZE) { while (old_sz < MIN_ARENA_SIZE) {
UInt gsiz = hsize*2; UInt gsiz = hsize*2;
H = oldH; HR = oldH;
HB = oldHB; HB = oldHB;
if (gsiz > 1024*1024) { if (gsiz > 1024*1024) {
gsiz = 1024*1024; gsiz = 1024*1024;
@ -2374,9 +2390,9 @@ p_nb_beam_add_to_beam( USES_REGS1 )
to = ARG3; to = ARG3;
qd = RepAppl(Deref(ARG1))+1; qd = RepAppl(Deref(ARG1))+1;
arena = qd[HEAP_ARENA]; arena = qd[HEAP_ARENA];
oldH = H; oldH = HR;
oldHB = HB; oldHB = HB;
H = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena); old_sz = ArenaSz(arena);
} }
pt = qd+HEAP_START; pt = qd+HEAP_START;
@ -2405,7 +2421,7 @@ p_nb_beam_del( USES_REGS1 )
return FALSE; return FALSE;
old_sz = ArenaSz(arena); old_sz = ArenaSz(arena);
/* garbage collection ? */ /* garbage collection ? */
oldH = H; oldH = HR;
oldHB = HB; oldHB = HB;
qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz-1); qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz-1);
CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS); CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS);
@ -2472,25 +2488,25 @@ p_nb_beam_keys( USES_REGS1 )
if (!qd) if (!qd)
return FALSE; return FALSE;
qsz = IntegerOfTerm(qd[HEAP_SIZE]); qsz = IntegerOfTerm(qd[HEAP_SIZE]);
ho = H; ho = HR;
pt = qd+HEAP_START; pt = qd+HEAP_START;
if (qsz == 0) if (qsz == 0)
return Yap_unify(ARG2, TermNil); return Yap_unify(ARG2, TermNil);
for (i=0; i < qsz; i++) { for (i=0; i < qsz; i++) {
if (H > ASP-1024) { if (HR > ASP-1024) {
H = ho; HR = ho;
if (!Yap_gcl(((ASP-H)-1024)*sizeof(CELL), 2, ENV, P)) { if (!Yap_gcl(((ASP-HR)-1024)*sizeof(CELL), 2, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return TermNil; return TermNil;
} }
goto restart; goto restart;
} }
*H++ = pt[0]; *HR++ = pt[0];
*H = AbsPair(H+1); *HR = AbsPair(HR+1);
H++; HR++;
pt += 2; pt += 2;
} }
H[-1] = TermNil; HR[-1] = TermNil;
return Yap_unify(ARG2, AbsPair(ho)); return Yap_unify(ARG2, AbsPair(ho));
} }

58
C/gmp_support.c
View File

@ -1327,51 +1327,6 @@ Yap_gmp_tcmp_big_big(Term t1, Term t2)
return 1; return 1;
} else if (pt1[1] == BIG_RATIONAL) { } else if (pt1[1] == BIG_RATIONAL) {
b1 = Yap_BigRatOfTerm(t1); b1 = Yap_BigRatOfTerm(t1);
} else if (pt1[1] == BLOB_STRING) {
char *s1 = Yap_BlobStringOfTerm(t1);
if (pt2[1] == BLOB_STRING) {
char *s2 = Yap_BlobStringOfTerm(t2);
return strcmp(s1,s2);
} else if (pt2[1] == BLOB_WIDE_STRING) {
wchar_t *wcs2 = Yap_BlobWideStringOfTerm(t2), *wcs1, *tmp1;
int out;
size_t n = strlen(s1);
if (!(wcs1 = (wchar_t *)malloc((n+1)*sizeof(wchar_t)))) {
Yap_Error(OUT_OF_HEAP_ERROR, t1, "compare/3");
return 0;
}
tmp1 = wcs1;
while (*s1) {
*tmp1++ = *s1++;
}
out = wcscmp(wcs1, wcs2);
free(wcs1);
return out;
}
b1 = Yap_BigRatOfTerm(t1);
} else if (pt1[1] == BLOB_WIDE_STRING) {
wchar_t *wcs1 = Yap_BlobWideStringOfTerm(t1);
if (pt2[1] == BLOB_STRING) {
char *s2 = Yap_BlobStringOfTerm(t2);
wchar_t *wcs2, *tmp2;
int out;
size_t n = strlen(s2);
if (!(wcs2 = (wchar_t *)malloc((n+1)*sizeof(wchar_t)))) {
Yap_Error(OUT_OF_HEAP_ERROR, t2, "compare/3");
return 0;
}
tmp2 = wcs2;
while (*s2) {
*tmp2++ = *s2++;
}
out = wcscmp(wcs1, wcs2);
free(wcs2);
return out;
} else if (pt2[1] == BLOB_WIDE_STRING) {
wchar_t *wcs2 = Yap_BlobWideStringOfTerm(t2);
return wcscmp(wcs1,wcs2);
}
b1 = Yap_BigRatOfTerm(t1);
} else { } else {
return pt1-pt2; return pt1-pt2;
} }
@ -1686,6 +1641,19 @@ Yap_gmp_popcount(Term t)
} }
} }
char *
Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base)
{
if (s) {
size_t size = mpz_sizeinbase(b, base);
if (size+2 > sz) {
return NULL;
}
return mpz_get_str (s, base, b);
}
return NULL;
}
char * char *
Yap_gmp_to_string(Term t, char *s, size_t sz, int base) Yap_gmp_to_string(Term t, char *s, size_t sz, int base)
{ {

131
C/grow.c
View File

@ -22,9 +22,7 @@
#include "sshift.h" #include "sshift.h"
#include "compile.h" #include "compile.h"
#include "attvar.h" #include "attvar.h"
#ifdef CUT_C
#include "cut_c.h" #include "cut_c.h"
#endif /* CUT_C */
#if HAVE_STRING_H #if HAVE_STRING_H
#include <string.h> #include <string.h>
#endif #endif
@ -100,7 +98,7 @@ SetHeapRegs(int copying_threads USES_REGS)
LOCAL_OldLCL0 = LCL0; LOCAL_OldLCL0 = LCL0;
LOCAL_OldASP = ASP; LOCAL_OldASP = ASP;
LOCAL_OldGlobalBase = (CELL *)LOCAL_GlobalBase; LOCAL_OldGlobalBase = (CELL *)LOCAL_GlobalBase;
LOCAL_OldH = H; LOCAL_OldH = HR;
LOCAL_OldH0 = H0; LOCAL_OldH0 = H0;
LOCAL_OldTrailBase = LOCAL_TrailBase; LOCAL_OldTrailBase = LOCAL_TrailBase;
LOCAL_OldTrailTop = LOCAL_TrailTop; LOCAL_OldTrailTop = LOCAL_TrailTop;
@ -135,18 +133,26 @@ SetHeapRegs(int copying_threads USES_REGS)
if (LCL0) if (LCL0)
LCL0 = PtoLocAdjust(LCL0); LCL0 = PtoLocAdjust(LCL0);
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
if (H) if (HR)
H = PtoGloAdjust(H); HR = PtoGloAdjust(HR);
#ifdef CUT_C
if (Yap_REGS.CUT_C_TOP) if (Yap_REGS.CUT_C_TOP)
Yap_REGS.CUT_C_TOP = CutCAdjust(Yap_REGS.CUT_C_TOP); Yap_REGS.CUT_C_TOP = CutCAdjust(Yap_REGS.CUT_C_TOP);
#endif
if (HB) if (HB)
HB = PtoGloAdjust(HB); HB = PtoGloAdjust(HB);
if (LOCAL_OpenArray) if (LOCAL_OpenArray)
LOCAL_OpenArray = PtoGloAdjust(LOCAL_OpenArray); LOCAL_OpenArray = PtoGloAdjust(LOCAL_OpenArray);
if (B) if (B)
B = ChoicePtrAdjust(B); B = ChoicePtrAdjust(B);
#ifdef YAPOR_THREADS
{
choiceptr cpt;
cpt = Get_LOCAL_top_cp();
if (cpt) {
// cpt = ChoicePtrAdjust( cpt );
Set_LOCAL_top_cp( cpt );
}
}
#endif
#ifdef TABLING #ifdef TABLING
if (B_FZ) if (B_FZ)
B_FZ = ChoicePtrAdjust(B_FZ); B_FZ = ChoicePtrAdjust(B_FZ);
@ -220,7 +226,7 @@ static CELL
worker_p_binding(int worker_p, CELL *aux_ptr) worker_p_binding(int worker_p, CELL *aux_ptr)
{ {
CACHE_REGS CACHE_REGS
if (aux_ptr > H) { if (aux_ptr > HR) {
CELL reg = REMOTE_ThreadHandle(worker_p).current_yaam_regs->LCL0_[aux_ptr-LCL0]; CELL reg = REMOTE_ThreadHandle(worker_p).current_yaam_regs->LCL0_[aux_ptr-LCL0];
reg = AdjustGlobTerm(reg PASS_REGS); reg = AdjustGlobTerm(reg PASS_REGS);
return reg; return reg;
@ -245,7 +251,7 @@ RestoreTrail(int worker_p USES_REGS)
if (aux_tr < TR){ if (aux_tr < TR){
Yap_Error(SYSTEM_ERROR, TermNil, "oops"); Yap_Error(SYSTEM_ERROR, TermNil, "oops");
} }
Yap_NEW_MAHASH((ma_h_inner_struct *)H PASS_REGS); Yap_NEW_MAHASH((ma_h_inner_struct *)HR PASS_REGS);
while (TR != aux_tr) { while (TR != aux_tr) {
CELL aux_cell = TrailTerm(--aux_tr); CELL aux_cell = TrailTerm(--aux_tr);
if (IsVarTerm(aux_cell)) { if (IsVarTerm(aux_cell)) {
@ -532,7 +538,7 @@ AdjustGlobal(long sz, int thread_copying USES_REGS)
} else { } else {
#endif #endif
pt = H0; pt = H0;
pt_max = (H-sz/CellSize); pt_max = (HR-sz/CellSize);
#if defined(YAPOR_THREADS) #if defined(YAPOR_THREADS)
} }
#endif #endif
@ -553,12 +559,15 @@ AdjustGlobal(long sz, int thread_copying USES_REGS)
/* skip bitmaps */ /* skip bitmaps */
switch((CELL)f) { switch((CELL)f) {
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
pt += 3; pt += 3;
#else #else
pt += 2; pt += 2;
#endif #endif
break; break;
case (CELL)FunctorString:
pt += 3+pt[1];
break;
case (CELL)FunctorBigInt: case (CELL)FunctorBigInt:
{ {
Int sz = 2+ Int sz = 2+
@ -811,7 +820,7 @@ static_growheap(long size, int fix_code, struct intermediates *cip, tr_fr_ptr *o
/* CreepFlag is set to force heap expansion */ /* CreepFlag is set to force heap expansion */
if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) { if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) {
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
} }
ASP -= 256; ASP -= 256;
@ -888,19 +897,19 @@ static_growglobal(long request, CELL **ptr, CELL *hsplit USES_REGS)
do_grow = FALSE; do_grow = FALSE;
} }
} else if (hsplit < (CELL*)omax || } else if (hsplit < (CELL*)omax ||
hsplit > H) hsplit > HR)
return FALSE; return FALSE;
else if (hsplit == (CELL *)omax) else if (hsplit == (CELL *)omax)
hsplit = NULL; hsplit = NULL;
if (size < 0 || if (size < 0 ||
(Unsigned(H)+size < Unsigned(ASP)-CreepFlag && (Unsigned(HR)+size < Unsigned(ASP)-StackGap( PASS_REGS1 ) &&
hsplit > H0)) { hsplit > H0)) {
/* don't need to expand stacks */ /* don't need to expand stacks */
insert_in_delays = FALSE; insert_in_delays = FALSE;
do_grow = FALSE; do_grow = FALSE;
} }
} else { } else {
if (Unsigned(H)+size < Unsigned(ASP)-CreepFlag) { if (Unsigned(HR)+size < Unsigned(ASP)-CreepFlag) {
/* we can just ask for more room */ /* we can just ask for more room */
do_grow = FALSE; do_grow = FALSE;
} }
@ -1082,7 +1091,9 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS)
case get_float_op: case get_float_op:
case put_float_op: case put_float_op:
case get_longint_op: case get_longint_op:
case get_string_op:
case put_longint_op: case put_longint_op:
case put_string_op:
case unify_float_op: case unify_float_op:
case unify_last_float_op: case unify_last_float_op:
case write_float_op: case write_float_op:
@ -1112,8 +1123,11 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS)
case unify_last_num_op: case unify_last_num_op:
case write_num_op: case write_num_op:
case unify_longint_op: case unify_longint_op:
case unify_string_op:
case unify_last_longint_op: case unify_last_longint_op:
case unify_last_string_op:
case write_longint_op: case write_longint_op:
case write_string_op:
case unify_bigint_op: case unify_bigint_op:
case unify_last_bigint_op: case unify_last_bigint_op:
case unify_dbterm_op: case unify_dbterm_op:
@ -1166,6 +1180,7 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS)
case index_dbref_op: case index_dbref_op:
case index_blob_op: case index_blob_op:
case index_long_op: case index_long_op:
case index_string_op:
case if_nonvar_op: case if_nonvar_op:
case unify_last_list_op: case unify_last_list_op:
case write_last_list_op: case write_last_list_op:
@ -1182,6 +1197,7 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS)
case enter_lu_op: case enter_lu_op:
case empty_call_op: case empty_call_op:
case blob_op: case blob_op:
case string_op:
case fetch_args_vi_op: case fetch_args_vi_op:
case fetch_args_iv_op: case fetch_args_iv_op:
case label_ctl_op: case label_ctl_op:
@ -1305,7 +1321,7 @@ do_growheap(int fix_code, UInt in_size, struct intermediates *cip, tr_fr_ptr *ol
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~YAP_CDOVF_SIGNAL; LOCAL_ActiveSignals &= ~YAP_CDOVF_SIGNAL;
if (!LOCAL_ActiveSignals) if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
return TRUE; return TRUE;
} }
@ -1361,7 +1377,7 @@ growatomtable( USES_REGS1 )
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) { if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) {
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
} }
LOCAL_ActiveSignals &= ~YAP_CDOVF_SIGNAL; LOCAL_ActiveSignals &= ~YAP_CDOVF_SIGNAL;
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
@ -1416,6 +1432,18 @@ Yap_growheap(int fix_code, size_t in_size, void *cip)
int res; int res;
int blob_overflow = (NOfBlobs > NOfBlobsMax); int blob_overflow = (NOfBlobs > NOfBlobsMax);
#if (THREADS) || YAPOR
res = FALSE;
if (NOfAtoms > 2*AtomHashTableSize || blob_overflow) {
LOCK(LOCAL_SignalLock);
if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) {
CalculateStackGap( PASS_REGS1 );
}
LOCAL_ActiveSignals &= ~YAP_CDOVF_SIGNAL;
UNLOCK(LOCAL_SignalLock);
return TRUE;
}
#else
if (NOfAtoms > 2*AtomHashTableSize || blob_overflow) { if (NOfAtoms > 2*AtomHashTableSize || blob_overflow) {
UInt n = NOfAtoms; UInt n = NOfAtoms;
if (GLOBAL_AGcThreshold) if (GLOBAL_AGcThreshold)
@ -1429,7 +1457,7 @@ Yap_growheap(int fix_code, size_t in_size, void *cip)
} else { } else {
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) { if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) {
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
} }
LOCAL_ActiveSignals &= ~YAP_CDOVF_SIGNAL; LOCAL_ActiveSignals &= ~YAP_CDOVF_SIGNAL;
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
@ -1446,6 +1474,7 @@ Yap_growheap(int fix_code, size_t in_size, void *cip)
res=do_growheap(fix_code, in_size, (struct intermediates *)cip, NULL, NULL, NULL PASS_REGS); res=do_growheap(fix_code, in_size, (struct intermediates *)cip, NULL, NULL, NULL PASS_REGS);
#endif #endif
LeaveGrowMode(GrowHeapMode); LeaveGrowMode(GrowHeapMode);
#endif
return res; return res;
} }
@ -1634,7 +1663,7 @@ growstack(size_t size USES_REGS)
fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id); fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id);
#endif #endif
fprintf(GLOBAL_stderr, "%% Stack Overflow %d\n", LOCAL_stack_overflows); fprintf(GLOBAL_stderr, "%% Stack Overflow %d\n", LOCAL_stack_overflows);
fprintf(GLOBAL_stderr, "%% Global: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)LOCAL_GlobalBase),LOCAL_GlobalBase,H); fprintf(GLOBAL_stderr, "%% Global: %8ld cells (%p-%p)\n", (unsigned long int)(HR-(CELL *)LOCAL_GlobalBase),LOCAL_GlobalBase,HR);
fprintf(GLOBAL_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); fprintf(GLOBAL_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
fprintf(GLOBAL_stderr, "%% Trail:%8ld cells (%p-%p)\n", fprintf(GLOBAL_stderr, "%% Trail:%8ld cells (%p-%p)\n",
(unsigned long int)(TR-(tr_fr_ptr)LOCAL_TrailBase),LOCAL_TrailBase,TR); (unsigned long int)(TR-(tr_fr_ptr)LOCAL_TrailBase),LOCAL_TrailBase,TR);
@ -1672,7 +1701,7 @@ Yap_growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id); fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id);
#endif #endif
fprintf(GLOBAL_stderr, "%% Stack Overflow %d\n", LOCAL_stack_overflows); fprintf(GLOBAL_stderr, "%% Stack Overflow %d\n", LOCAL_stack_overflows);
fprintf(GLOBAL_stderr, "%% Global: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)LOCAL_GlobalBase),LOCAL_GlobalBase,H); fprintf(GLOBAL_stderr, "%% Global: %8ld cells (%p-%p)\n", (unsigned long int)(HR-(CELL *)LOCAL_GlobalBase),LOCAL_GlobalBase,HR);
fprintf(GLOBAL_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); fprintf(GLOBAL_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
fprintf(GLOBAL_stderr, "%% Trail:%8ld cells (%p-%p)\n", fprintf(GLOBAL_stderr, "%% Trail:%8ld cells (%p-%p)\n",
(unsigned long int)(TR-(tr_fr_ptr)LOCAL_TrailBase),LOCAL_TrailBase,TR); (unsigned long int)(TR-(tr_fr_ptr)LOCAL_TrailBase),LOCAL_TrailBase,TR);
@ -1721,7 +1750,7 @@ static int do_growtrail(long size, int contiguous_only, int in_parser, tr_fr_ptr
#endif #endif
fprintf(GLOBAL_stderr, "%% Trail Overflow %d\n", LOCAL_trail_overflows); fprintf(GLOBAL_stderr, "%% Trail Overflow %d\n", LOCAL_trail_overflows);
#if USE_SYSTEM_MALLOC #if USE_SYSTEM_MALLOC
fprintf(GLOBAL_stderr, "%% Heap: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)LOCAL_GlobalBase),(CELL *)LOCAL_GlobalBase,H); fprintf(GLOBAL_stderr, "%% Heap: %8ld cells (%p-%p)\n", (unsigned long int)(HR-(CELL *)LOCAL_GlobalBase),(CELL *)LOCAL_GlobalBase,HR);
fprintf(GLOBAL_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); fprintf(GLOBAL_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
fprintf(GLOBAL_stderr, "%% Trail:%8ld cells (%p-%p)\n", fprintf(GLOBAL_stderr, "%% Trail:%8ld cells (%p-%p)\n",
(unsigned long int)(TR-(tr_fr_ptr)LOCAL_TrailBase),LOCAL_TrailBase,TR); (unsigned long int)(TR-(tr_fr_ptr)LOCAL_TrailBase),LOCAL_TrailBase,TR);
@ -1764,7 +1793,7 @@ static int do_growtrail(long size, int contiguous_only, int in_parser, tr_fr_ptr
} }
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
if (LOCAL_ActiveSignals == YAP_TROVF_SIGNAL) { if (LOCAL_ActiveSignals == YAP_TROVF_SIGNAL) {
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
} }
LOCAL_ActiveSignals &= ~YAP_TROVF_SIGNAL; LOCAL_ActiveSignals &= ~YAP_TROVF_SIGNAL;
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
@ -1878,11 +1907,59 @@ Yap_CopyThreadStacks(int worker_q, int worker_p, int incremental)
/* make sure both stacks have same size */ /* make sure both stacks have same size */
Int p_size = REMOTE_ThreadHandle(worker_p).ssize+REMOTE_ThreadHandle(worker_p).tsize; Int p_size = REMOTE_ThreadHandle(worker_p).ssize+REMOTE_ThreadHandle(worker_p).tsize;
Int q_size = REMOTE_ThreadHandle(worker_q).ssize+REMOTE_ThreadHandle(worker_q).tsize; Int q_size = REMOTE_ThreadHandle(worker_q).ssize+REMOTE_ThreadHandle(worker_q).tsize;
if (p_size != q_size) { if (p_size != q_size) {
if (!(REMOTE_ThreadHandle(worker_q).stack_address = realloc(REMOTE_ThreadHandle(worker_q).stack_address,p_size*K1))) { UInt start_growth_time, growth_time;
exit(1); int gc_verbose;
size_t ssiz = REMOTE_ThreadHandle(worker_q).ssize*K1;
size_t tsiz = REMOTE_ThreadHandle(worker_q).tsize*K1;
size_t diff = (REMOTE_ThreadHandle(worker_p).ssize-REMOTE_ThreadHandle(worker_q).ssize)*K1;
char *oldq = (char *)REMOTE_ThreadHandle(worker_q).stack_address, *newq;
if (!(newq = REMOTE_ThreadHandle(worker_q).stack_address = realloc(REMOTE_ThreadHandle(worker_q).stack_address,p_size*K1))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"cannot expand slave thread to match master thread");
}
start_growth_time = Yap_cputime();
gc_verbose = Yap_is_gc_verbose();
LOCAL_stack_overflows++;
if (gc_verbose) {
#if defined(YAPOR) || defined(THREADS)
fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id);
#endif
fprintf(GLOBAL_stderr, "%% Stack Overflow %d\n", LOCAL_stack_overflows);
fprintf(GLOBAL_stderr, "%% Stack: %8ld cells (%p-%p)\n", (unsigned long int)(LCL0-(CELL *)LOCAL_GlobalBase),LOCAL_GlobalBase,LCL0);
fprintf(GLOBAL_stderr, "%% Trail:%8ld cells (%p-%p)\n",
(unsigned long int)(TR-(tr_fr_ptr)LOCAL_TrailBase),LOCAL_TrailBase,TR);
fprintf(GLOBAL_stderr, "%% Growing the stacks %ld bytes\n", diff);
}
LOCAL_GDiff = LOCAL_GDiff0 = LOCAL_DelayDiff = LOCAL_BaseDiff = (newq-oldq);
LOCAL_TrDiff = LOCAL_LDiff = diff + LOCAL_GDiff;
LOCAL_XDiff = LOCAL_HDiff = 0;
LOCAL_GSplit = NULL;
YAPEnterCriticalSection();
SetHeapRegs(FALSE PASS_REGS);
{
choiceptr imageB;
LOCAL_OldLCL0 = LCL0;
LCL0 = REMOTE_ThreadHandle(0).current_yaam_regs->LCL0_;
imageB = Get_GLOBAL_root_cp();
/* we know B */
B->cp_tr = TR =
(tr_fr_ptr)((CELL)(imageB->cp_tr)+((CELL)LOCAL_OldLCL0-(CELL)LCL0));
LCL0 = LOCAL_OldLCL0;
B->cp_h = H0;
B->cp_ap = GETWORK;
B->cp_or_fr = GLOBAL_root_or_fr;
}
YAPLeaveCriticalSection();
growth_time = Yap_cputime()-start_growth_time;
LOCAL_total_stack_overflow_time += growth_time;
if (gc_verbose) {
fprintf(GLOBAL_stderr, "%% took %g sec\n", (double)growth_time/1000);
fprintf(GLOBAL_stderr, "%% Total of %g sec expanding stacks \n", (double)LOCAL_total_stack_overflow_time/1000);
} }
} }
REMOTE_ThreadHandle(worker_q).ssize = REMOTE_ThreadHandle(worker_p).ssize; REMOTE_ThreadHandle(worker_q).ssize = REMOTE_ThreadHandle(worker_p).ssize;
REMOTE_ThreadHandle(worker_q).tsize = REMOTE_ThreadHandle(worker_p).tsize; REMOTE_ThreadHandle(worker_q).tsize = REMOTE_ThreadHandle(worker_p).tsize;
/* compute offset indicators */ /* compute offset indicators */
@ -1895,7 +1972,7 @@ Yap_CopyThreadStacks(int worker_q, int worker_p, int incremental)
LOCAL_TrDiff = LOCAL_LDiff = LOCAL_GDiff = LOCAL_GDiff0 = LOCAL_DelayDiff = LOCAL_BaseDiff = size; LOCAL_TrDiff = LOCAL_LDiff = LOCAL_GDiff = LOCAL_GDiff0 = LOCAL_DelayDiff = LOCAL_BaseDiff = size;
LOCAL_XDiff = LOCAL_HDiff = 0; LOCAL_XDiff = LOCAL_HDiff = 0;
LOCAL_GSplit = NULL; LOCAL_GSplit = NULL;
H = REMOTE_ThreadHandle(worker_p).current_yaam_regs->H_; HR = REMOTE_ThreadHandle(worker_p).current_yaam_regs->H_;
H0 = REMOTE_ThreadHandle(worker_p).current_yaam_regs->H0_; H0 = REMOTE_ThreadHandle(worker_p).current_yaam_regs->H0_;
B = REMOTE_ThreadHandle(worker_p).current_yaam_regs->B_; B = REMOTE_ThreadHandle(worker_p).current_yaam_regs->B_;
ENV = REMOTE_ThreadHandle(worker_p).current_yaam_regs->ENV_; ENV = REMOTE_ThreadHandle(worker_p).current_yaam_regs->ENV_;
@ -1905,9 +1982,7 @@ Yap_CopyThreadStacks(int worker_q, int worker_p, int incremental)
if (ASP > CellPtr(B)) if (ASP > CellPtr(B))
ASP = CellPtr(B); ASP = CellPtr(B);
LCL0 = REMOTE_ThreadHandle(worker_p).current_yaam_regs->LCL0_; LCL0 = REMOTE_ThreadHandle(worker_p).current_yaam_regs->LCL0_;
#ifdef CUT_C
Yap_REGS.CUT_C_TOP = REMOTE_ThreadHandle(worker_p).current_yaam_regs->CUT_C_TOP; Yap_REGS.CUT_C_TOP = REMOTE_ThreadHandle(worker_p).current_yaam_regs->CUT_C_TOP;
#endif
LOCAL_DynamicArrays = NULL; LOCAL_DynamicArrays = NULL;
LOCAL_StaticArrays = NULL; LOCAL_StaticArrays = NULL;
LOCAL_GlobalVariables = NULL; LOCAL_GlobalVariables = NULL;

84
C/heapgc.c
View File

@ -1010,7 +1010,7 @@ static void
inc_vars_of_type(CELL *curr,gc_types val) { inc_vars_of_type(CELL *curr,gc_types val) {
if (curr >= H0 && curr < TrueHB) { if (curr >= H0 && curr < TrueHB) {
old_vars++; old_vars++;
} else if (curr >= TrueHB && curr < H) { } else if (curr >= TrueHB && curr < HR) {
new_vars++; new_vars++;
} else { } else {
return; return;
@ -1163,7 +1163,7 @@ mark_variable(CELL_PTR current USES_REGS)
if (UNMARKED_MARK(current,local_bp)) { if (UNMARKED_MARK(current,local_bp)) {
POP_CONTINUATION(); POP_CONTINUATION();
} }
if (current >= H0 && current < H) { if (current >= H0 && current < HR) {
//fprintf(stderr,"%p M\n", current); //fprintf(stderr,"%p M\n", current);
LOCAL_total_marked++; LOCAL_total_marked++;
if (current < LOCAL_HGEN) { if (current < LOCAL_HGEN) {
@ -1177,7 +1177,7 @@ mark_variable(CELL_PTR current USES_REGS)
next = GET_NEXT(ccur); next = GET_NEXT(ccur);
if (IsVarTerm(ccur)) { if (IsVarTerm(ccur)) {
if (IN_BETWEEN(LOCAL_GlobalBase,current,H) && GlobalIsAttVar(current) && current==next) { if (IN_BETWEEN(LOCAL_GlobalBase,current,HR) && GlobalIsAttVar(current) && current==next) {
if (next < H0) POP_CONTINUATION(); if (next < H0) POP_CONTINUATION();
if (!UNMARKED_MARK(next-1,local_bp)) { if (!UNMARKED_MARK(next-1,local_bp)) {
//fprintf(stderr,"%p M\n", next-1); //fprintf(stderr,"%p M\n", next-1);
@ -1222,7 +1222,7 @@ mark_variable(CELL_PTR current USES_REGS)
if (next >= HB && current < LCL0 && cnext != TermFoundVar) { if (next >= HB && current < LCL0 && cnext != TermFoundVar) {
UNMARK(current); UNMARK(current);
*current = cnext; *current = cnext;
if (current >= H0 && current < H) { if (current >= H0 && current < HR) {
//fprintf(stderr,"%p M\n", current-1); //fprintf(stderr,"%p M\n", current-1);
LOCAL_total_marked--; LOCAL_total_marked--;
if (current < LOCAL_HGEN) { if (current < LOCAL_HGEN) {
@ -1247,7 +1247,7 @@ mark_variable(CELL_PTR current USES_REGS)
/* This step is possible because we clean up the trail */ /* This step is possible because we clean up the trail */
*current = UNMARK_CELL(cnext); *current = UNMARK_CELL(cnext);
UNMARK(current); UNMARK(current);
if (current >= H0 && current < H ) { if (current >= H0 && current < HR ) {
//fprintf(stderr,"%p M\n", current); //fprintf(stderr,"%p M\n", current);
LOCAL_total_marked--; LOCAL_total_marked--;
if (current < LOCAL_HGEN) { if (current < LOCAL_HGEN) {
@ -1365,7 +1365,24 @@ mark_variable(CELL_PTR current USES_REGS)
MARK(next); MARK(next);
PUSH_POINTER(next PASS_REGS); PUSH_POINTER(next PASS_REGS);
{ {
UInt sz = 1+SIZEOF_DOUBLE/SIZEOF_LONG_INT; UInt sz = 1+SIZEOF_DOUBLE/SIZEOF_INT_P;
if (next < LOCAL_HGEN) {
LOCAL_total_oldies+= 1+sz;
} else {
DEBUG_printf0("%p 1\n", next);
DEBUG_printf1("%p %ld\n", next, (long int)(sz+1));
}
//fprintf(stderr,"%p M %d\n", next,1+sz);
LOCAL_total_marked += 1+sz;
PUSH_POINTER(next+sz PASS_REGS);
MARK(next+sz);
}
POP_CONTINUATION();
case (CELL)FunctorString:
MARK(next);
PUSH_POINTER(next PASS_REGS);
{
UInt sz = 2+next[1];
if (next < LOCAL_HGEN) { if (next < LOCAL_HGEN) {
LOCAL_total_oldies+= 1+sz; LOCAL_total_oldies+= 1+sz;
} else { } else {
@ -1719,7 +1736,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
nondeterministically, I know that after backtracking it will be back to be an unbound variable. nondeterministically, I know that after backtracking it will be back to be an unbound variable.
The ideal solution would be to unbind all variables. The current solution is to The ideal solution would be to unbind all variables. The current solution is to
remark it as an attributed variable */ remark it as an attributed variable */
if (IN_BETWEEN(LOCAL_GlobalBase,hp,H) && GlobalIsAttVar(hp) && !UNMARKED_MARK(hp-1,LOCAL_bp)) { if (IN_BETWEEN(LOCAL_GlobalBase,hp,HR) && GlobalIsAttVar(hp) && !UNMARKED_MARK(hp-1,LOCAL_bp)) {
//fprintf(stderr,"%p M\n", hp); //fprintf(stderr,"%p M\n", hp);
LOCAL_total_marked++; LOCAL_total_marked++;
PUSH_POINTER(hp-1 PASS_REGS); PUSH_POINTER(hp-1 PASS_REGS);
@ -1762,7 +1779,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
} else if (IsPairTerm(trail_cell)) { } else if (IsPairTerm(trail_cell)) {
/* cannot safely ignore this */ /* cannot safely ignore this */
CELL *cptr = RepPair(trail_cell); CELL *cptr = RepPair(trail_cell);
if (IN_BETWEEN(LOCAL_GlobalBase,cptr,H)) { if (IN_BETWEEN(LOCAL_GlobalBase,cptr,HR)) {
if (GlobalIsAttVar(cptr)) { if (GlobalIsAttVar(cptr)) {
TrailTerm(trail_base) = (CELL)cptr; TrailTerm(trail_base) = (CELL)cptr;
mark_external_reference(&TrailTerm(trail_base) PASS_REGS); mark_external_reference(&TrailTerm(trail_base) PASS_REGS);
@ -2354,7 +2371,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose
case _count_trust_me: case _count_trust_me:
case _retry: case _retry:
case _trust: case _trust:
if (IN_BETWEEN(H0,(CELL *)(gc_B->cp_ap),H)) { if (IN_BETWEEN(H0,(CELL *)(gc_B->cp_ap),HR)) {
fprintf(stderr,"OOPS in GC: gc not supported in this case!!!\n"); fprintf(stderr,"OOPS in GC: gc not supported in this case!!!\n");
exit(1); exit(1);
} }
@ -2600,7 +2617,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR USES_REGS)
if (IsVarTerm(trail_cell)) { if (IsVarTerm(trail_cell)) {
/* we need to check whether this is a honest to god trail entry */ /* we need to check whether this is a honest to god trail entry */
/* make sure it is a heap cell before we test whether it has been marked */ /* make sure it is a heap cell before we test whether it has been marked */
if ((CELL *)trail_cell < H && (CELL *)trail_cell >= H0 && MARKED_PTR((CELL *)trail_cell)) { if ((CELL *)trail_cell < HR && (CELL *)trail_cell >= H0 && MARKED_PTR((CELL *)trail_cell)) {
if (HEAP_PTR(trail_cell)) { if (HEAP_PTR(trail_cell)) {
into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell) PASS_REGS); into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell) PASS_REGS);
} }
@ -2618,7 +2635,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR USES_REGS)
CELL *pt0 = RepPair(trail_cell); CELL *pt0 = RepPair(trail_cell);
CELL flags; CELL flags;
if (IN_BETWEEN(LOCAL_GlobalBase, pt0, H)) { if (IN_BETWEEN(LOCAL_GlobalBase, pt0, HR)) {
if (GlobalIsAttVar(pt0)) { if (GlobalIsAttVar(pt0)) {
TrailTerm(dest) = trail_cell; TrailTerm(dest) = trail_cell;
/* be careful with partial gc */ /* be careful with partial gc */
@ -3428,12 +3445,12 @@ compact_heap( USES_REGS1 )
next_hb = set_next_hb(gc_B PASS_REGS); next_hb = set_next_hb(gc_B PASS_REGS);
dest = H0 + LOCAL_total_marked - 1; dest = H0 + LOCAL_total_marked - 1;
gc_B = update_B_H(gc_B, H, dest+1, dest+2 gc_B = update_B_H(gc_B, HR, dest+1, dest+2
#ifdef TABLING #ifdef TABLING
, &depfr , &depfr
#endif /* TABLING */ #endif /* TABLING */
); );
for (current = H - 1; current >= start_from; current--) { for (current = HR - 1; current >= start_from; current--) {
if (MARKED_PTR(current)) { if (MARKED_PTR(current)) {
CELL ccell = UNMARK_CELL(*current); CELL ccell = UNMARK_CELL(*current);
@ -3524,7 +3541,7 @@ compact_heap( USES_REGS1 )
*/ */
dest = (CELL_PTR) start_from; dest = (CELL_PTR) start_from;
for (current = start_from; current < H; current++) { for (current = start_from; current < HR; current++) {
CELL ccur = *current; CELL ccur = *current;
if (MARKED_PTR(current)) { if (MARKED_PTR(current)) {
CELL uccur = UNMARK_CELL(ccur); CELL uccur = UNMARK_CELL(ccur);
@ -3560,7 +3577,7 @@ compact_heap( USES_REGS1 )
ccur = *current; ccur = *current;
next = GET_NEXT(ccur); next = GET_NEXT(ccur);
if (HEAP_PTR(ccur) && if (HEAP_PTR(ccur) &&
(next = GET_NEXT(ccur)) < H && /* move current cell & (next = GET_NEXT(ccur)) < HR && /* move current cell &
* push */ * push */
next > current) { /* into relocation chain */ next > current) { /* into relocation chain */
*dest = ccur; *dest = ccur;
@ -3584,7 +3601,7 @@ compact_heap( USES_REGS1 )
(unsigned long int)found_marked); (unsigned long int)found_marked);
#endif #endif
H = dest; /* reset H */ HR = dest; /* reset H */
HB = B->cp_h; HB = B->cp_h;
#ifdef TABLING #ifdef TABLING
if (B_FZ == (choiceptr)LCL0) if (B_FZ == (choiceptr)LCL0)
@ -3603,7 +3620,7 @@ compact_heap( USES_REGS1 )
static void static void
icompact_heap( USES_REGS1 ) icompact_heap( USES_REGS1 )
{ {
CELL_PTR *iptr, *ibase = (CELL_PTR *)H; CELL_PTR *iptr, *ibase = (CELL_PTR *)HR;
CELL_PTR dest; CELL_PTR dest;
CELL *next_hb; CELL *next_hb;
#ifdef DEBUG #ifdef DEBUG
@ -3628,7 +3645,7 @@ icompact_heap( USES_REGS1 )
#endif /* TABLING */ #endif /* TABLING */
next_hb = set_next_hb(gc_B PASS_REGS); next_hb = set_next_hb(gc_B PASS_REGS);
dest = (CELL_PTR) H0 + LOCAL_total_marked - 1; dest = (CELL_PTR) H0 + LOCAL_total_marked - 1;
gc_B = update_B_H(gc_B, H, dest+1, dest+2 gc_B = update_B_H(gc_B, HR, dest+1, dest+2
#ifdef TABLING #ifdef TABLING
, &depfr , &depfr
#endif /* TABLING */ #endif /* TABLING */
@ -3761,7 +3778,7 @@ icompact_heap( USES_REGS1 )
(unsigned long int)found_marked); (unsigned long int)found_marked);
#endif #endif
H = dest; /* reset H */ HR = dest; /* reset H */
HB = B->cp_h; HB = B->cp_h;
#ifdef TABLING #ifdef TABLING
if (B_FZ == (choiceptr)LCL0) if (B_FZ == (choiceptr)LCL0)
@ -3850,7 +3867,7 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp USES_REGS)
{ {
CELL *CurrentH0 = NULL; CELL *CurrentH0 = NULL;
int icompact = (LOCAL_iptop < (CELL_PTR *)ASP && 10*LOCAL_total_marked < H-H0); int icompact = (LOCAL_iptop < (CELL_PTR *)ASP && 10*LOCAL_total_marked < HR-H0);
if (icompact) { if (icompact) {
/* we are going to reuse the total space */ /* we are going to reuse the total space */
@ -3878,7 +3895,7 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp USES_REGS)
-LOCAL_total_smarked -LOCAL_total_smarked
#endif #endif
!= LOCAL_iptop-(CELL_PTR *)H && LOCAL_iptop < (CELL_PTR *)ASP -1024) != LOCAL_iptop-(CELL_PTR *)H && LOCAL_iptop < (CELL_PTR *)ASP -1024)
fprintf(GLOBAL_stderr,"%% Oops on LOCAL_iptop-H (%ld) vs %ld\n", (unsigned long int)(LOCAL_iptop-(CELL_PTR *)H), LOCAL_total_marked); fprintf(GLOBAL_stderr,"%% Oops on LOCAL_iptop-H (%ld) vs %ld\n", (unsigned long int)(LOCAL_iptop-(CELL_PTR *)HR), LOCAL_total_marked);
*/ */
#endif #endif
#if DEBUGX #if DEBUGX
@ -3891,7 +3908,7 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp USES_REGS)
LOCAL_total_marked += LOCAL_total_oldies; LOCAL_total_marked += LOCAL_total_oldies;
CurrentH0 = NULL; CurrentH0 = NULL;
} }
quicksort((CELL_PTR *)H, 0, (LOCAL_iptop-(CELL_PTR *)H)-1); quicksort((CELL_PTR *)HR, 0, (LOCAL_iptop-(CELL_PTR *)HR)-1);
icompact_heap( PASS_REGS1 ); icompact_heap( PASS_REGS1 );
} else } else
#endif /* HYBRID_SCHEME */ #endif /* HYBRID_SCHEME */
@ -3930,7 +3947,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS)
UInt alloc_sz; UInt alloc_sz;
int jmp_res; int jmp_res;
heap_cells = H-H0; heap_cells = HR-H0;
gc_verbose = is_gc_verbose(); gc_verbose = is_gc_verbose();
effectiveness = 0; effectiveness = 0;
gc_trace = FALSE; gc_trace = FALSE;
@ -3967,7 +3984,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS)
fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id); fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id);
#endif #endif
fprintf(GLOBAL_stderr, "%% Start of garbage collection %lu:\n", (unsigned long int)LOCAL_GcCalls); fprintf(GLOBAL_stderr, "%% Start of garbage collection %lu:\n", (unsigned long int)LOCAL_GcCalls);
fprintf(GLOBAL_stderr, "%% Global: %8ld cells (%p-%p)\n", (long int)heap_cells,H0,H); fprintf(GLOBAL_stderr, "%% Global: %8ld cells (%p-%p)\n", (long int)heap_cells,H0,HR);
fprintf(GLOBAL_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); fprintf(GLOBAL_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
fprintf(GLOBAL_stderr, "%% Trail:%8ld cells (%p-%p)\n", fprintf(GLOBAL_stderr, "%% Trail:%8ld cells (%p-%p)\n",
(unsigned long int)(TR-(tr_fr_ptr)LOCAL_TrailBase),LOCAL_TrailBase,TR); (unsigned long int)(TR-(tr_fr_ptr)LOCAL_TrailBase),LOCAL_TrailBase,TR);
@ -4053,7 +4070,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS)
} }
memset((void *)LOCAL_bp, 0, alloc_sz); memset((void *)LOCAL_bp, 0, alloc_sz);
#ifdef HYBRID_SCHEME #ifdef HYBRID_SCHEME
LOCAL_iptop = (CELL_PTR *)H; LOCAL_iptop = (CELL_PTR *)HR;
#endif #endif
/* get the number of active registers */ /* get the number of active registers */
LOCAL_HGEN = VarOfTerm(Yap_ReadTimedVar(LOCAL_GcGeneration)); LOCAL_HGEN = VarOfTerm(Yap_ReadTimedVar(LOCAL_GcGeneration));
@ -4127,7 +4144,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS)
if (gc_verbose) { if (gc_verbose) {
fprintf(GLOBAL_stderr, "%% GC %lu took %g sec, total of %g sec doing GC so far.\n", (unsigned long int)LOCAL_GcCalls, (double)gc_time/1000, (double)LOCAL_TotGcTime/1000); fprintf(GLOBAL_stderr, "%% GC %lu took %g sec, total of %g sec doing GC so far.\n", (unsigned long int)LOCAL_GcCalls, (double)gc_time/1000, (double)LOCAL_TotGcTime/1000);
fprintf(GLOBAL_stderr, "%% Left %ld cells free in stacks.\n", fprintf(GLOBAL_stderr, "%% Left %ld cells free in stacks.\n",
(unsigned long int)(ASP-H)); (unsigned long int)(ASP-HR));
} }
check_global(); check_global();
return effectiveness; return effectiveness;
@ -4214,24 +4231,25 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop USES_REGS)
if (gc_on && !(LOCAL_PrologMode & InErrorMode) && if (gc_on && !(LOCAL_PrologMode & InErrorMode) &&
/* make sure there is a point in collecting the heap */ /* make sure there is a point in collecting the heap */
(ASP-H0)*sizeof(CELL) > gc_lim && (ASP-H0)*sizeof(CELL) > gc_lim &&
H-LOCAL_HGEN > (LCL0-ASP)/2) { HR-LOCAL_HGEN > (LCL0-ASP)/2) {
effectiveness = do_gc(predarity, current_env, nextop PASS_REGS); effectiveness = do_gc(predarity, current_env, nextop PASS_REGS);
if (effectiveness < 0) if (effectiveness < 0)
return FALSE; return FALSE;
if (effectiveness > 90 && !gc_t) { if (effectiveness > 90 && !gc_t) {
while (gc_margin < (H-H0)/sizeof(CELL)) while (gc_margin < (HR-H0)/sizeof(CELL))
gc_margin <<= 1; gc_margin <<= 1;
} }
} else { } else {
effectiveness = 0; effectiveness = 0;
} }
/* expand the stack if effectiveness is less than 20 % */ /* expand the stack if effectiveness is less than 20 % */
if (ASP - H < gc_margin/sizeof(CELL) || if (ASP - HR < gc_margin/sizeof(CELL) ||
effectiveness < 20) { effectiveness < 20) {
LeaveGCMode( PASS_REGS1 ); LeaveGCMode( PASS_REGS1 );
#ifndef YAPOR #ifndef YAPOR
if (gc_margin < 2*CalculateStackGap()) CalculateStackGap( PASS_REGS1 );
gc_margin = 2*CalculateStackGap(); if (gc_margin < 2*EventFlag)
gc_margin = 2*EventFlag;
return Yap_growstack(gc_margin); return Yap_growstack(gc_margin);
#endif #endif
} }
@ -4277,8 +4295,10 @@ Yap_gcl(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
{ {
CACHE_REGS CACHE_REGS
int res; int res;
UInt min = CalculateStackGap()*sizeof(CELL); UInt min;
CalculateStackGap( PASS_REGS1 );
min = EventFlag*sizeof(CELL);
LOCAL_PrologMode |= GCMode; LOCAL_PrologMode |= GCMode;
if (gc_lim < min) if (gc_lim < min)
gc_lim = min; gc_lim = min;

314
C/index.c
View File

@ -492,9 +492,7 @@ static char SccsId[] = "%W% %G%";
#if HAVE_STRING_H #if HAVE_STRING_H
#include <string.h> #include <string.h>
#endif #endif
#ifdef CUT_C
#include "cut_c.h" #include "cut_c.h"
#endif
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
#define SET_JLBL(X) jlbl = &(ipc->u.X) #define SET_JLBL(X) jlbl = &(ipc->u.X)
@ -598,7 +596,7 @@ recover_from_failed_susp_on_cls(struct intermediates *cint, UInt sz)
int cases = cpc->rnd1, i; int cases = cpc->rnd1, i;
for (i = 0; i < cases; i++) { for (i = 0; i < cases; i++) {
sz = cleanup_sw_on_clauses(target[i].u.Label, sz, ecls); sz = cleanup_sw_on_clauses(target[i].u_a.Label, sz, ecls);
} }
if (log_upd_pred) { if (log_upd_pred) {
LogUpdIndex *lcl = ClauseCodeToLogUpdIndex(cpc->rnd2); LogUpdIndex *lcl = ClauseCodeToLogUpdIndex(cpc->rnd2);
@ -620,7 +618,7 @@ recover_from_failed_susp_on_cls(struct intermediates *cint, UInt sz)
int cases = cpc->rnd1, i; int cases = cpc->rnd1, i;
for (i = 0; i < cases; i++) { for (i = 0; i < cases; i++) {
sz = cleanup_sw_on_clauses(target[i].u.Label, sz, ecls); sz = cleanup_sw_on_clauses(target[i].u_f.Label, sz, ecls);
} }
if (log_upd_pred) { if (log_upd_pred) {
LogUpdIndex *lcl = ClauseCodeToLogUpdIndex(cpc->rnd2); LogUpdIndex *lcl = ClauseCodeToLogUpdIndex(cpc->rnd2);
@ -1033,7 +1031,7 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
if (ap->ModuleOfPred == IDB_MODULE) { if (ap->ModuleOfPred == IDB_MODULE) {
cl = clause->Code; cl = clause->Code;
} else { } else {
cl = clause->u.WorkPC; cl = clause->ucd.WorkPC;
} }
while (TRUE) { while (TRUE) {
op_numbers op = Yap_op_from_opcode(cl->opc); op_numbers op = Yap_op_from_opcode(cl->opc);
@ -1139,7 +1137,7 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
case _unify_l_list: case _unify_l_list:
if (argno == 1) { if (argno == 1) {
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.WorkPC = NEXTOP(cl,o); clause->ucd.WorkPC = NEXTOP(cl,o);
return; return;
} }
argno += 1; /* 2-1: have two extra arguments to skip */ argno += 1; /* 2-1: have two extra arguments to skip */
@ -1177,7 +1175,7 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
case _unify_l_float: case _unify_l_float:
if (argno == 1) { if (argno == 1) {
clause->Tag = AbsAppl((CELL *)FunctorDouble); clause->Tag = AbsAppl((CELL *)FunctorDouble);
clause->u.t_ptr = AbsAppl(cl->u.od.d); clause->ucd.t_ptr = AbsAppl(cl->u.od.d);
return; return;
} }
cl = NEXTOP(cl,od); cl = NEXTOP(cl,od);
@ -1187,7 +1185,7 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
case _unify_l_longint: case _unify_l_longint:
if (argno == 1) { if (argno == 1) {
clause->Tag = AbsAppl((CELL *)FunctorLongInt); clause->Tag = AbsAppl((CELL *)FunctorLongInt);
clause->u.t_ptr = AbsAppl(cl->u.oi.i); clause->ucd.t_ptr = AbsAppl(cl->u.oi.i);
return; return;
} }
argno--; argno--;
@ -1197,12 +1195,22 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
case _unify_l_bigint: case _unify_l_bigint:
if (argno == 1) { if (argno == 1) {
clause->Tag = AbsAppl((CELL *)FunctorBigInt); clause->Tag = AbsAppl((CELL *)FunctorBigInt);
clause->u.t_ptr = cl->u.oc.c; clause->ucd.t_ptr = cl->u.oc.c;
return; return;
} }
cl = NEXTOP(cl,oc); cl = NEXTOP(cl,oc);
argno--; argno--;
break; break;
case _unify_string:
case _unify_l_string:
if (argno == 1) {
clause->Tag = AbsAppl((CELL *)FunctorString);
clause->ucd.t_ptr = cl->u.ou.u;
return;
}
cl = NEXTOP(cl,ou);
argno--;
break;
case _unify_n_atoms: case _unify_n_atoms:
if (argno <= cl->u.osc.s) { if (argno <= cl->u.osc.s) {
clause->Tag = cl->u.osc.c; clause->Tag = cl->u.osc.c;
@ -1216,7 +1224,7 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
case _unify_l_struc: case _unify_l_struc:
if (argno == 1) { if (argno == 1) {
clause->Tag = AbsAppl((CELL *)cl->u.ofa.f); clause->Tag = AbsAppl((CELL *)cl->u.ofa.f);
clause->u.WorkPC = NEXTOP(cl,ofa); clause->ucd.WorkPC = NEXTOP(cl,ofa);
return; return;
} }
/* must skip next n arguments */ /* must skip next n arguments */
@ -1246,7 +1254,7 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
case _unify_idb_term: case _unify_idb_term:
case _copy_idb_term: case _copy_idb_term:
{ {
Term t = clause->u.c_sreg[argno]; Term t = clause->ucd.c_sreg[argno];
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
clause->Tag = (CELL)NULL; clause->Tag = (CELL)NULL;
@ -1255,15 +1263,15 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
if (IsExtensionFunctor(FunctorOfTerm(t))) { if (IsExtensionFunctor(FunctorOfTerm(t))) {
clause->u.t_ptr = t; clause->ucd.t_ptr = t;
} else { } else {
clause->u.c_sreg = pt; clause->ucd.c_sreg = pt;
} }
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
CELL *pt = RepPair(t); CELL *pt = RepPair(t);
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1; clause->ucd.c_sreg = pt-1;
} else { } else {
clause->Tag = t; clause->Tag = t;
} }
@ -1323,7 +1331,7 @@ skip_to_arg(ClauseDef *clause, PredEntry *ap, UInt argno, int at_point)
*/ */
case _unify_struct: case _unify_struct:
case _unify_l_struc: case _unify_l_struc:
if (cl == clause->u.WorkPC) { if (cl == clause->ucd.WorkPC) {
clause->CurrentCode = cl; clause->CurrentCode = cl;
} else { } else {
clause->CurrentCode = clause->Code; clause->CurrentCode = clause->Code;
@ -1628,7 +1636,7 @@ emit_cswitch(COUNT n, yamop *fail_l, struct intermediates *cint)
target = (AtomSwiEntry *)emit_switch_space(n, sizeof(AtomSwiEntry), cint, 0); target = (AtomSwiEntry *)emit_switch_space(n, sizeof(AtomSwiEntry), cint, 0);
for (i=0; i<n; i++) { for (i=0; i<n; i++) {
target[i].Tag = Zero; target[i].Tag = Zero;
target[i].u.labp = fail_l; target[i].u_a.labp = fail_l;
} }
Yap_emit(op, Unsigned(n), (CELL)target, cint); Yap_emit(op, Unsigned(n), (CELL)target, cint);
} else { } else {
@ -1638,10 +1646,10 @@ emit_cswitch(COUNT n, yamop *fail_l, struct intermediates *cint)
target = (AtomSwiEntry *)emit_switch_space(n+1, sizeof(AtomSwiEntry), cint, 0); target = (AtomSwiEntry *)emit_switch_space(n+1, sizeof(AtomSwiEntry), cint, 0);
for (i=0; i<n; i++) { for (i=0; i<n; i++) {
target[i].u.labp = fail_l; target[i].u_a.labp = fail_l;
} }
target[n].Tag = Zero; target[n].Tag = Zero;
target[n].u.labp = fail_l; target[n].u_a.labp = fail_l;
Yap_emit(op, Unsigned(n), (CELL)target, cint); Yap_emit(op, Unsigned(n), (CELL)target, cint);
} }
return target; return target;
@ -1695,7 +1703,7 @@ emit_fswitch(COUNT n, yamop *fail_l, struct intermediates *cint)
target = (FuncSwiEntry *)emit_switch_space(n, sizeof(FuncSwiEntry), cint, FuncSwitchMask); target = (FuncSwiEntry *)emit_switch_space(n, sizeof(FuncSwiEntry), cint, FuncSwitchMask);
for (i=0; i<n; i++) { for (i=0; i<n; i++) {
target[i].Tag = NULL; target[i].Tag = NULL;
target[i].u.labp = fail_l; target[i].u_f.labp = fail_l;
} }
Yap_emit(op, Unsigned(n), (CELL)target, cint); Yap_emit(op, Unsigned(n), (CELL)target, cint);
} else { } else {
@ -1704,10 +1712,10 @@ emit_fswitch(COUNT n, yamop *fail_l, struct intermediates *cint)
op = if_f_op; op = if_f_op;
target = (FuncSwiEntry *)emit_switch_space(n+1, sizeof(FuncSwiEntry), cint, FuncSwitchMask); target = (FuncSwiEntry *)emit_switch_space(n+1, sizeof(FuncSwiEntry), cint, FuncSwitchMask);
for (i=0; i<n; i++) { for (i=0; i<n; i++) {
target[i].u.labp = fail_l; target[i].u_f.labp = fail_l;
} }
target[n].Tag = NULL; target[n].Tag = NULL;
target[n].u.labp = fail_l; target[n].u_f.labp = fail_l;
Yap_emit(op, Unsigned(n), (CELL)target, cint); Yap_emit(op, Unsigned(n), (CELL)target, cint);
} }
return target; return target;
@ -2025,17 +2033,17 @@ do_consts(GroupDef *grp, Term t, struct intermediates *cint, int compound_term,
if (min != max) { if (min != max) {
if (sreg != NULL) { if (sreg != NULL) {
if (ap->PredFlags & LogUpdatePredFlag && max > min) { if (ap->PredFlags & LogUpdatePredFlag && max > min) {
ics->u.Label = suspend_indexing(min, max, ap, cint); ics->u_a.Label = suspend_indexing(min, max, ap, cint);
} else { } else {
ics->u.Label = do_compound_index(min, max, sreg, cint, compound_term, arity, argno, nxtlbl, first, last_arg, clleft, top, TRUE); ics->u_a.Label = do_compound_index(min, max, sreg, cint, compound_term, arity, argno, nxtlbl, first, last_arg, clleft, top, TRUE);
} }
} else if (ap->PredFlags & LogUpdatePredFlag) { } else if (ap->PredFlags & LogUpdatePredFlag) {
ics->u.Label = suspend_indexing(min, max, cint->CurrentPred, cint); ics->u_a.Label = suspend_indexing(min, max, cint->CurrentPred, cint);
} else { } else {
ics->u.Label = do_index(min, max, cint, argno+1, nxtlbl, first, clleft, top); ics->u_a.Label = do_index(min, max, cint, argno+1, nxtlbl, first, clleft, top);
} }
} else { } else {
ics->u.Label = do_index(min, max, cint, argno+1, nxtlbl, first, clleft, top); ics->u_a.Label = do_index(min, max, cint, argno+1, nxtlbl, first, clleft, top);
} }
grp->FirstClause = min = max+1; grp->FirstClause = min = max+1;
} }
@ -2064,9 +2072,9 @@ do_blobs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int firs
(max+1)->Tag == min->Tag) max++; (max+1)->Tag == min->Tag) max++;
if (min != max && if (min != max &&
(ap->PredFlags & LogUpdatePredFlag)) { (ap->PredFlags & LogUpdatePredFlag)) {
ics->u.Label = suspend_indexing(min, max, ap, cint); ics->u_a.Label = suspend_indexing(min, max, ap, cint);
} else { } else {
ics->u.Label = do_index(min, max, cint, argno+1, nxtlbl, first, clleft, top); ics->u_a.Label = do_index(min, max, cint, argno+1, nxtlbl, first, clleft, top);
} }
grp->FirstClause = min = max+1; grp->FirstClause = min = max+1;
} }
@ -2107,11 +2115,11 @@ do_funcs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int firs
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) if (f == FunctorDBRef)
ifs->u.Label = do_dbref_index(min, max, t, cint, argno, nxtlbl, first, clleft, top); ifs->u_f.Label = do_dbref_index(min, max, t, cint, argno, nxtlbl, first, clleft, top);
else if (f == FunctorLongInt || f == FunctorBigInt) else if (f == FunctorLongInt || f == FunctorBigInt)
ifs->u.Label = do_blob_index(min, max, t, cint, argno, nxtlbl, first, clleft, top, FALSE); ifs->u_f.Label = do_blob_index(min, max, t, cint, argno, nxtlbl, first, clleft, top, FALSE);
else else
ifs->u.Label = do_blob_index(min, max, t, cint, argno, nxtlbl, first, clleft, top, TRUE); ifs->u_f.Label = do_blob_index(min, max, t, cint, argno, nxtlbl, first, clleft, top, TRUE);
} else { } else {
CELL *sreg; CELL *sreg;
@ -2121,7 +2129,7 @@ do_funcs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int firs
} else { } else {
sreg = NULL; sreg = NULL;
} }
ifs->u.Label = do_compound_index(min, max, sreg, cint, 0, ArityOfFunctor(f), argno, nxtlbl, first, last_arg, clleft, top, TRUE); ifs->u_f.Label = do_compound_index(min, max, sreg, cint, 0, ArityOfFunctor(f), argno, nxtlbl, first, last_arg, clleft, top, TRUE);
} }
grp->FirstClause = min = max+1; grp->FirstClause = min = max+1;
} }
@ -2349,15 +2357,15 @@ cls_head_info(ClauseDef *min, ClauseDef *max, UInt argno, int in_idb)
cl->Tag = AbsAppl((CELL *)pt[0]); cl->Tag = AbsAppl((CELL *)pt[0]);
if (IsExtensionFunctor(FunctorOfTerm(t))) { if (IsExtensionFunctor(FunctorOfTerm(t))) {
cl->u.t_ptr = t; cl->ucd.t_ptr = t;
} else { } else {
cl->u.c_sreg = pt; cl->ucd.c_sreg = pt;
} }
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
CELL *pt = RepPair(t); CELL *pt = RepPair(t);
cl->Tag = AbsPair(NULL); cl->Tag = AbsPair(NULL);
cl->u.c_sreg = pt-1; cl->ucd.c_sreg = pt-1;
} else { } else {
cl->Tag = t; cl->Tag = t;
} }
@ -2629,7 +2637,7 @@ do_dbref_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cin
cl = min; cl = min;
while (cl <= max) { while (cl <= max) {
cl->Tag = cl->u.t_ptr; cl->Tag = cl->ucd.t_ptr;
cl++; cl++;
} }
ngroups = groups_in(min, max, group, cint); ngroups = groups_in(min, max, group, cint);
@ -2657,12 +2665,12 @@ do_blob_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cint
cl = min; cl = min;
while (cl <= max) { while (cl <= max) {
if (cl->u.t_ptr == (CELL)NULL) { /* check whether it is a builtin */ if (cl->ucd.t_ptr == (CELL)NULL) { /* check whether it is a builtin */
cl->Tag = Zero; cl->Tag = Zero;
} else if (blob) { } else if (blob) {
cl->Tag = Yap_Double_key(cl->u.t_ptr); cl->Tag = Yap_Double_key(cl->ucd.t_ptr);
} else { } else {
cl->Tag = Yap_Int_key(cl->u.t_ptr); cl->Tag = Yap_Int_key(cl->ucd.t_ptr);
} }
cl++; cl++;
} }
@ -2746,10 +2754,10 @@ compile_index(struct intermediates *cint)
siglongjmp(cint->CompilerBotch,2); siglongjmp(cint->CompilerBotch,2);
} }
} }
cint->freep = (char *)H; cint->freep = (char *)HR;
#else #else
/* reserve double the space for compiler */ /* reserve double the space for compiler */
cint->cls = (ClauseDef *)H; cint->cls = (ClauseDef *)HR;
if (cint->cls+2*NClauses > (ClauseDef *)(ASP-4096)) { if (cint->cls+2*NClauses > (ClauseDef *)(ASP-4096)) {
/* tell how much space we need */ /* tell how much space we need */
LOCAL_Error_Size += NClauses*sizeof(ClauseDef); LOCAL_Error_Size += NClauses*sizeof(ClauseDef);
@ -2915,14 +2923,18 @@ install_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack)
Functor f = (Functor)RepAppl(cls->Tag); Functor f = (Functor)RepAppl(cls->Tag);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) { if (f == FunctorDBRef) {
if (cls->u.t_ptr != sp->extra) break; if (cls->ucd.t_ptr != sp->extra) break;
} else if (f == FunctorDouble) { } else if (f == FunctorDouble) {
if (cls->u.t_ptr && if (cls->ucd.t_ptr &&
Yap_Double_key(sp->extra) != Yap_Double_key(cls->u.t_ptr)) Yap_Double_key(sp->extra) != Yap_Double_key(cls->ucd.t_ptr))
break;
} else if (f == FunctorString) {
if (cls->ucd.t_ptr &&
Yap_String_key(sp->extra) != Yap_String_key(cls->ucd.t_ptr))
break; break;
} else { } else {
if (cls->u.t_ptr && if (cls->ucd.t_ptr &&
Yap_Int_key(sp->extra) != Yap_Int_key(cls->u.t_ptr)) Yap_Int_key(sp->extra) != Yap_Int_key(cls->ucd.t_ptr))
break; break;
} }
} }
@ -3066,14 +3078,14 @@ install_log_upd_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack)
Functor f = (Functor)RepAppl(cls->Tag); Functor f = (Functor)RepAppl(cls->Tag);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) { if (f == FunctorDBRef) {
if (cls->u.t_ptr != sp->extra) break; if (cls->ucd.t_ptr != sp->extra) break;
} else if (f == FunctorDouble) { } else if (f == FunctorDouble) {
if (cls->u.t_ptr && if (cls->ucd.t_ptr &&
Yap_Double_key(sp->extra) != Yap_Double_key(cls->u.t_ptr)) Yap_Double_key(sp->extra) != Yap_Double_key(cls->ucd.t_ptr))
break; break;
} else { } else {
if (cls->u.t_ptr && if (cls->ucd.t_ptr &&
Yap_Int_key(sp->extra) != Yap_Int_key(cls->u.t_ptr)) Yap_Int_key(sp->extra) != Yap_Int_key(cls->ucd.t_ptr))
break; break;
} }
} }
@ -3665,9 +3677,9 @@ expand_index(struct intermediates *cint) {
} else { } else {
fe = lookup_f(f,ipc->u.sssl.l,ipc->u.sssl.s); fe = lookup_f(f,ipc->u.sssl.l,ipc->u.sssl.s);
} }
newpc = fe->u.labp; newpc = fe->u_f.labp;
labp = &(fe->u.labp); labp = &(fe->u_f.labp);
if (newpc == e_code) { if (newpc == e_code) {
/* we found it */ /* we found it */
parentcl = code_to_indexcl(ipc->u.sssl.l,is_lu); parentcl = code_to_indexcl(ipc->u.sssl.l,is_lu);
@ -3691,14 +3703,14 @@ expand_index(struct intermediates *cint) {
ae = lookup_c(t,ipc->u.sssl.l,ipc->u.sssl.s); ae = lookup_c(t,ipc->u.sssl.l,ipc->u.sssl.s);
} }
labp = &(ae->u.labp); labp = &(ae->u_a.labp);
if (ae->u.labp == e_code) { if (ae->u_a.labp == e_code) {
/* we found it */ /* we found it */
parentcl = code_to_indexcl(ipc->u.sssl.l,is_lu); parentcl = code_to_indexcl(ipc->u.sssl.l,is_lu);
ipc = NULL; ipc = NULL;
} else { } else {
ClausePointer npar = code_to_indexcl(ipc->u.sssl.l,is_lu); ClausePointer npar = code_to_indexcl(ipc->u.sssl.l,is_lu);
ipc = ae->u.labp; ipc = ae->u_a.labp;
parentcl = index_jmp(npar, parentcl, ipc, is_lu, e_code); parentcl = index_jmp(npar, parentcl, ipc, is_lu, e_code);
} }
} }
@ -3795,7 +3807,7 @@ expand_index(struct intermediates *cint) {
} }
} }
#else #else
cint->cls = (ClauseDef *)H; cint->cls = (ClauseDef *)HR;
if (cint->cls+2*nclauses > (ClauseDef *)(ASP-4096)) { if (cint->cls+2*nclauses > (ClauseDef *)(ASP-4096)) {
/* tell how much space we need (worst case) */ /* tell how much space we need (worst case) */
LOCAL_Error_Size += 2*NClauses*sizeof(ClauseDef); LOCAL_Error_Size += 2*NClauses*sizeof(ClauseDef);
@ -3823,7 +3835,7 @@ expand_index(struct intermediates *cint) {
} }
} }
#else #else
cint->cls = (ClauseDef *)H; cint->cls = (ClauseDef *)HR;
if (cint->cls+2*NClauses > (ClauseDef *)(ASP-4096)) { if (cint->cls+2*NClauses > (ClauseDef *)(ASP-4096)) {
/* tell how much space we need (worst case) */ /* tell how much space we need (worst case) */
LOCAL_Error_Size += 2*NClauses*sizeof(ClauseDef); LOCAL_Error_Size += 2*NClauses*sizeof(ClauseDef);
@ -3852,7 +3864,7 @@ expand_index(struct intermediates *cint) {
return labp; return labp;
} }
#if USE_SYSTEM_MALLOC #if USE_SYSTEM_MALLOC
cint->freep = (char *)H; cint->freep = (char *)HR;
#else #else
cint->freep = (char *)(max+1); cint->freep = (char *)(max+1);
#endif #endif
@ -4139,11 +4151,11 @@ push_path(path_stack_entry *sp, yamop **pipc, ClauseDef *clp, struct intermediat
siglongjmp(cint->CompilerBotch,4); siglongjmp(cint->CompilerBotch,4);
} }
sp->flag = pc_entry; sp->flag = pc_entry;
sp->u.pce.pi_pc = pipc; sp->uip.pce.pi_pc = pipc;
sp->u.pce.code = clp->Code; sp->uip.pce.code = clp->Code;
sp->u.pce.current_code = clp->CurrentCode; sp->uip.pce.current_code = clp->CurrentCode;
sp->u.pce.work_pc = clp->u.WorkPC; sp->uip.pce.work_pc = clp->ucd.WorkPC;
sp->u.pce.tag = clp->Tag; sp->uip.pce.tag = clp->Tag;
return sp+1; return sp+1;
} }
@ -4157,11 +4169,11 @@ fetch_new_block(path_stack_entry *sp, yamop **pipc, PredEntry *ap, struct interm
} }
/* add current position */ /* add current position */
sp->flag = block_entry; sp->flag = block_entry;
sp->u.cle.entry_code = pipc; sp->uip.cle.entry_code = pipc;
if (ap->PredFlags & LogUpdatePredFlag) { if (ap->PredFlags & LogUpdatePredFlag) {
sp->u.cle.block = (ClauseUnion *)ClauseCodeToLogUpdIndex(*pipc); sp->uip.cle.block = (ClauseUnion *)ClauseCodeToLogUpdIndex(*pipc);
} else { } else {
sp->u.cle.block = (ClauseUnion *)ClauseCodeToStaticIndex(*pipc); sp->uip.cle.block = (ClauseUnion *)ClauseCodeToStaticIndex(*pipc);
} }
return sp+1; return sp+1;
} }
@ -4172,11 +4184,11 @@ init_block_stack(path_stack_entry *sp, yamop *ipc, PredEntry *ap)
/* add current position */ /* add current position */
sp->flag = block_entry; sp->flag = block_entry;
sp->u.cle.entry_code = NULL; sp->uip.cle.entry_code = NULL;
if (ap->PredFlags & LogUpdatePredFlag) { if (ap->PredFlags & LogUpdatePredFlag) {
sp->u.cle.block = (ClauseUnion *)ClauseCodeToLogUpdIndex(ipc); sp->uip.cle.block = (ClauseUnion *)ClauseCodeToLogUpdIndex(ipc);
} else { } else {
sp->u.cle.block = (ClauseUnion *)ClauseCodeToStaticIndex(ipc); sp->uip.cle.block = (ClauseUnion *)ClauseCodeToStaticIndex(ipc);
} }
return sp+1; return sp+1;
} }
@ -4191,7 +4203,7 @@ cross_block(path_stack_entry *sp, yamop **pipc, PredEntry *ap, struct intermedia
do { do {
UInt bsize; UInt bsize;
while ((--tsp)->flag != block_entry); while ((--tsp)->flag != block_entry);
block = tsp->u.cle.block; block = tsp->uip.cle.block;
if (block->lui.ClFlags & LogUpdMask) if (block->lui.ClFlags & LogUpdMask)
bsize = block->lui.ClSize; bsize = block->lui.ClSize;
else else
@ -4203,18 +4215,18 @@ cross_block(path_stack_entry *sp, yamop **pipc, PredEntry *ap, struct intermedia
if (tsp->flag == pc_entry) { if (tsp->flag == pc_entry) {
if (nsp != tsp) { if (nsp != tsp) {
nsp->flag = pc_entry; nsp->flag = pc_entry;
nsp->u.pce.pi_pc = tsp->u.pce.pi_pc; nsp->uip.pce.pi_pc = tsp->uip.pce.pi_pc;
nsp->u.pce.code = tsp->u.pce.code; nsp->uip.pce.code = tsp->uip.pce.code;
nsp->u.pce.current_code = tsp->u.pce.current_code; nsp->uip.pce.current_code = tsp->uip.pce.current_code;
nsp->u.pce.work_pc = tsp->u.pce.work_pc; nsp->uip.pce.work_pc = tsp->uip.pce.work_pc;
nsp->u.pce.tag = tsp->u.pce.tag; nsp->uip.pce.tag = tsp->uip.pce.tag;
} }
nsp++; nsp++;
} }
} }
return nsp; return nsp;
} }
} while (tsp->u.cle.entry_code != NULL); } while (tsp->uip.cle.entry_code != NULL);
/* moved to a new block */ /* moved to a new block */
return fetch_new_block(sp, pipc, ap, cint); return fetch_new_block(sp, pipc, ap, cint);
} }
@ -4228,16 +4240,16 @@ pop_path(path_stack_entry **spp, ClauseDef *clp, PredEntry *ap, struct intermedi
while ((--sp)->flag != pc_entry); while ((--sp)->flag != pc_entry);
*spp = sp; *spp = sp;
clp->Code = sp->u.pce.code; clp->Code = sp->uip.pce.code;
clp->CurrentCode = sp->u.pce.current_code; clp->CurrentCode = sp->uip.pce.current_code;
clp->u.WorkPC = sp->u.pce.work_pc; clp->ucd.WorkPC = sp->uip.pce.work_pc;
clp->Tag = sp->u.pce.tag; clp->Tag = sp->uip.pce.tag;
if (sp->u.pce.pi_pc == NULL) { if (sp->uip.pce.pi_pc == NULL) {
*spp = sp; *spp = sp;
return NULL; return NULL;
} }
nipc = *(sp->u.pce.pi_pc); nipc = *(sp->uip.pce.pi_pc);
*spp = cross_block(sp, sp->u.pce.pi_pc, ap, cint); *spp = cross_block(sp, sp->uip.pce.pi_pc, ap, cint);
return nipc; return nipc;
} }
@ -4345,10 +4357,10 @@ expand_ctable(yamop *pc, ClauseUnion *blk, struct intermediates *cint, Term at)
n = 1; n = 1;
for (i = 0; i < pc->u.sssl.s; i++,tmp++) { for (i = 0; i < pc->u.sssl.s; i++,tmp++) {
if (tmp->Tag != Zero) n++; if (tmp->Tag != Zero) n++;
else fail_l = tmp->u.Label; else fail_l = tmp->u_a.Label;
} }
} else { } else {
fail_l = old_ae[n].u.Label; fail_l = old_ae[n].u_a.Label;
n++; n++;
} }
if (n > MIN_HASH_ENTRIES) { if (n > MIN_HASH_ENTRIES) {
@ -4364,14 +4376,14 @@ expand_ctable(yamop *pc, ClauseUnion *blk, struct intermediates *cint, Term at)
pc->u.sssl.s = cases; pc->u.sssl.s = cases;
for (i=0; i<cases; i++) { for (i=0; i<cases; i++) {
target[i].Tag = Zero; target[i].Tag = Zero;
target[i].u.Label = fail_l; target[i].u_a.Label = fail_l;
} }
} else { } else {
pc->opc = Yap_opcode(_if_cons); pc->opc = Yap_opcode(_if_cons);
pc->u.sssl.s = n; pc->u.sssl.s = n;
target = (AtomSwiEntry *)emit_switch_space(n+1, sizeof(AtomSwiEntry), cint, 0); target = (AtomSwiEntry *)emit_switch_space(n+1, sizeof(AtomSwiEntry), cint, 0);
target[n].Tag = Zero; target[n].Tag = Zero;
target[n].u.Label = fail_l; target[n].u_a.Label = fail_l;
} }
for (i = 0; i < i0; i++,old_ae++) { for (i = 0; i < i0; i++,old_ae++) {
Term tag = old_ae->Tag; Term tag = old_ae->Tag;
@ -4379,7 +4391,7 @@ expand_ctable(yamop *pc, ClauseUnion *blk, struct intermediates *cint, Term at)
if (tag != Zero) { if (tag != Zero) {
AtomSwiEntry *ics = fetch_centry(target, tag, i, n); AtomSwiEntry *ics = fetch_centry(target, tag, i, n);
ics->Tag = tag; ics->Tag = tag;
ics->u.Label = old_ae->u.Label; ics->u_a.Label = old_ae->u_a.Label;
} }
} }
/* support for threads */ /* support for threads */
@ -4404,10 +4416,10 @@ expand_ftable(yamop *pc, ClauseUnion *blk, struct intermediates *cint, Functor f
n = 1; n = 1;
for (i = 0; i < pc->u.sssl.s; i++,tmp++) { for (i = 0; i < pc->u.sssl.s; i++,tmp++) {
if (tmp->Tag != Zero) n++; if (tmp->Tag != Zero) n++;
else fail_l = tmp->u.Label; else fail_l = tmp->u_f.Label;
} }
} else { } else {
fail_l = old_fe[n].u.Label; fail_l = old_fe[n].u_f.Label;
n++; n++;
} }
if (n > MIN_HASH_ENTRIES) { if (n > MIN_HASH_ENTRIES) {
@ -4426,7 +4438,7 @@ expand_ftable(yamop *pc, ClauseUnion *blk, struct intermediates *cint, Functor f
target = (FuncSwiEntry *)emit_switch_space(cases, sizeof(FuncSwiEntry), cint, FuncSwitchMask); target = (FuncSwiEntry *)emit_switch_space(cases, sizeof(FuncSwiEntry), cint, FuncSwitchMask);
for (i=0; i<cases; i++) { for (i=0; i<cases; i++) {
target[i].Tag = NULL; target[i].Tag = NULL;
target[i].u.Label = fail_l; target[i].u_f.Label = fail_l;
} }
} else { } else {
pc->opc = Yap_opcode(_if_func); pc->opc = Yap_opcode(_if_func);
@ -4435,7 +4447,7 @@ expand_ftable(yamop *pc, ClauseUnion *blk, struct intermediates *cint, Functor f
pc->u.sssl.w = 0; pc->u.sssl.w = 0;
target = (FuncSwiEntry *)emit_switch_space(n+1, sizeof(FuncSwiEntry), cint, FuncSwitchMask); target = (FuncSwiEntry *)emit_switch_space(n+1, sizeof(FuncSwiEntry), cint, FuncSwitchMask);
target[n].Tag = Zero; target[n].Tag = Zero;
target[n].u.Label = fail_l; target[n].u_f.Label = fail_l;
} }
for (i = 0; i < i0; i++,old_fe++) { for (i = 0; i < i0; i++,old_fe++) {
Functor f = old_fe->Tag; Functor f = old_fe->Tag;
@ -4443,7 +4455,7 @@ expand_ftable(yamop *pc, ClauseUnion *blk, struct intermediates *cint, Functor f
if (f != NULL) { if (f != NULL) {
FuncSwiEntry *ifs = fetch_fentry(target, f, i, n); FuncSwiEntry *ifs = fetch_fentry(target, f, i, n);
ifs->Tag = old_fe->Tag; ifs->Tag = old_fe->Tag;
ifs->u.Label = old_fe->u.Label; ifs->u_f.Label = old_fe->u_f.Label;
} }
} }
replace_index_block(blk, pc->u.sssl.l, (yamop *)target, ap); replace_index_block(blk, pc->u.sssl.l, (yamop *)target, ap);
@ -4468,21 +4480,21 @@ static ClauseUnion *
current_block(path_stack_entry *sp) current_block(path_stack_entry *sp)
{ {
while ((--sp)->flag != block_entry); while ((--sp)->flag != block_entry);
return sp->u.cle.block; return sp->uip.cle.block;
} }
static path_stack_entry * static path_stack_entry *
kill_block(path_stack_entry *sp, PredEntry *ap) kill_block(path_stack_entry *sp, PredEntry *ap)
{ {
while ((--sp)->flag != block_entry); while ((--sp)->flag != block_entry);
if (sp->u.cle.entry_code == NULL) { if (sp->uip.cle.entry_code == NULL) {
Yap_kill_iblock(sp->u.cle.block, NULL, ap); Yap_kill_iblock(sp->uip.cle.block, NULL, ap);
} else { } else {
path_stack_entry *nsp = sp; path_stack_entry *nsp = sp;
while ((--nsp)->flag != block_entry); while ((--nsp)->flag != block_entry);
Yap_kill_iblock(sp->u.cle.block, nsp->u.cle.block, ap); Yap_kill_iblock(sp->uip.cle.block, nsp->uip.cle.block, ap);
*sp->u.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode); *sp->uip.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
} }
return sp; return sp;
} }
@ -4626,7 +4638,7 @@ kill_clause(yamop *ipc, yamop *bg, yamop *lt, path_stack_entry *sp0, PredEntry *
path_stack_entry *sp = sp0; path_stack_entry *sp = sp0;
while ((--sp)->flag != block_entry); while ((--sp)->flag != block_entry);
blk = (LogUpdIndex *)(sp->u.cle.block); blk = (LogUpdIndex *)(sp->uip.cle.block);
start = blk->ClCode; start = blk->ClCode;
op0 = Yap_op_from_opcode(start->opc); op0 = Yap_op_from_opcode(start->opc);
while (op0 == _lock_lu) { while (op0 == _lock_lu) {
@ -4655,8 +4667,8 @@ kill_clause(yamop *ipc, yamop *bg, yamop *lt, path_stack_entry *sp0, PredEntry *
nsp = sp; nsp = sp;
while ((--nsp)->flag != block_entry); while ((--nsp)->flag != block_entry);
/* make us point straight at clause */ /* make us point straight at clause */
*sp->u.cle.entry_code = tgl->ClCode; *sp->uip.cle.entry_code = tgl->ClCode;
Yap_kill_iblock(sp->u.cle.block, nsp->u.cle.block, ap); Yap_kill_iblock(sp->uip.cle.block, nsp->uip.cle.block, ap);
return sp; return sp;
} else { } else {
if ( if (
@ -4679,7 +4691,7 @@ static path_stack_entry *
expanda_block(path_stack_entry *sp, PredEntry *ap, ClauseDef *cls, int group1, yamop *alt, struct intermediates *cint) expanda_block(path_stack_entry *sp, PredEntry *ap, ClauseDef *cls, int group1, yamop *alt, struct intermediates *cint)
{ {
while ((--sp)->flag != block_entry); while ((--sp)->flag != block_entry);
Yap_kill_iblock(sp->u.cle.block, NULL, ap); Yap_kill_iblock(sp->uip.cle.block, NULL, ap);
return sp; return sp;
} }
@ -4687,7 +4699,7 @@ static path_stack_entry *
expandz_block(path_stack_entry *sp, PredEntry *ap, ClauseDef *cls, int group1, yamop *alt, struct intermediates *cint) expandz_block(path_stack_entry *sp, PredEntry *ap, ClauseDef *cls, int group1, yamop *alt, struct intermediates *cint)
{ {
while ((--sp)->flag != block_entry); while ((--sp)->flag != block_entry);
Yap_kill_iblock(sp->u.cle.block, NULL, ap); Yap_kill_iblock(sp->uip.cle.block, NULL, ap);
return sp; return sp;
} }
@ -4784,18 +4796,18 @@ kill_unsafe_block(path_stack_entry *sp, op_numbers op, PredEntry *ap, int first,
{ {
yamop *ipc; yamop *ipc;
while ((--sp)->flag != block_entry); while ((--sp)->flag != block_entry);
if (sp->u.cle.entry_code == NULL) { if (sp->uip.cle.entry_code == NULL) {
/* we have reached the top */ /* we have reached the top */
Yap_RemoveIndexation(ap); Yap_RemoveIndexation(ap);
return sp; return sp;
} }
ipc = *sp->u.cle.entry_code; ipc = *sp->uip.cle.entry_code;
if (Yap_op_from_opcode(ipc->opc) == op) { if (Yap_op_from_opcode(ipc->opc) == op) {
/* the new block was the current clause */ /* the new block was the current clause */
ClauseDef cld[2]; ClauseDef cld[2];
if (remove) { if (remove) {
*sp->u.cle.entry_code = FAILCODE; *sp->uip.cle.entry_code = FAILCODE;
return sp; return sp;
} }
if (ap->PredFlags & LogUpdatePredFlag) { if (ap->PredFlags & LogUpdatePredFlag) {
@ -4810,10 +4822,10 @@ kill_unsafe_block(path_stack_entry *sp, op_numbers op, PredEntry *ap, int first,
cld[1].Code = cls[0].Code; cld[1].Code = cls[0].Code;
} }
intrs.expand_block = NULL; intrs.expand_block = NULL;
*sp->u.cle.entry_code = (yamop *)suspend_indexing(cld, cld+1, ap, &intrs); *sp->uip.cle.entry_code = (yamop *)suspend_indexing(cld, cld+1, ap, &intrs);
} else { } else {
/* static predicate, shouldn't do much, just suspend the code here */ /* static predicate, shouldn't do much, just suspend the code here */
*sp->u.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode); *sp->uip.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
return sp; return sp;
} }
return sp; return sp;
@ -4905,8 +4917,8 @@ add_to_expand_clauses(path_stack_entry **spp, yamop *ipc, ClauseDef *cls, PredEn
} while (compactz_expand_clauses(ipc)); } while (compactz_expand_clauses(ipc));
} }
while ((--sp)->flag != block_entry); while ((--sp)->flag != block_entry);
if (sp->u.cle.entry_code) { if (sp->uip.cle.entry_code) {
*sp->u.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode); *sp->uip.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
} }
recover_ecls_block(ipc); recover_ecls_block(ipc);
return pop_path(spp, cls, ap, cint); return pop_path(spp, cls, ap, cint);
@ -4934,7 +4946,7 @@ nullify_expand_clause(yamop *ipc, path_stack_entry *sp, ClauseDef *cls)
while ((--sp)->flag != block_entry); while ((--sp)->flag != block_entry);
while (TRUE) { while (TRUE) {
if (*st && *st != cls->Code) { if (*st && *st != cls->Code) {
*sp->u.cle.entry_code = *st; *sp->uip.cle.entry_code = *st;
recover_ecls_block(ipc); recover_ecls_block(ipc);
return; return;
} }
@ -5329,7 +5341,7 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
if (!IsExtensionFunctor(f)) { if (!IsExtensionFunctor(f)) {
current_arity = ArityOfFunctor(f); current_arity = ArityOfFunctor(f);
} }
newpc = fe->u.labp; newpc = fe->u_f.labp;
if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) { if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
/* we found it */ /* we found it */
ipc = pop_path(&sp, cls, ap, cint); ipc = pop_path(&sp, cls, ap, cint);
@ -5348,29 +5360,29 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
ipc->u.sssl.e++; ipc->u.sssl.e++;
} }
if (ap->PredFlags & LogUpdatePredFlag) { if (ap->PredFlags & LogUpdatePredFlag) {
fe->u.labp = cls->Code; fe->u_f.labp = cls->Code;
} else { } else {
fe->u.labp = cls->CurrentCode; fe->u_f.labp = cls->CurrentCode;
} }
ipc = pop_path(&sp, cls, ap, cint); ipc = pop_path(&sp, cls, ap, cint);
} else { } else {
yamop *newpc = fe->u.labp; yamop *newpc = fe->u_f.labp;
sp = fetch_new_block(sp, &(ipc->u.sssl.l), ap, cint); sp = fetch_new_block(sp, &(ipc->u.sssl.l), ap, cint);
sp = cross_block(sp, &(fe->u.labp), ap, cint); sp = cross_block(sp, &(fe->u_f.labp), ap, cint);
ipc = newpc; ipc = newpc;
} }
} }
break; break;
case _index_dbref: case _index_dbref:
cls->Tag = cls->u.t_ptr; cls->Tag = cls->ucd.t_ptr;
ipc = NEXTOP(ipc,e); ipc = NEXTOP(ipc,e);
break; break;
case _index_blob: case _index_blob:
cls->Tag = Yap_Double_key(cls->u.t_ptr); cls->Tag = Yap_Double_key(cls->ucd.t_ptr);
ipc = NEXTOP(ipc,e); ipc = NEXTOP(ipc,e);
break; break;
case _index_long: case _index_long:
cls->Tag = Yap_Int_key(cls->u.t_ptr); cls->Tag = Yap_Int_key(cls->ucd.t_ptr);
ipc = NEXTOP(ipc,e); ipc = NEXTOP(ipc,e);
break; break;
case _switch_on_cons: case _switch_on_cons:
@ -5386,7 +5398,7 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
} else { } else {
ae = lookup_c(at, ipc->u.sssl.l, ipc->u.sssl.s); ae = lookup_c(at, ipc->u.sssl.l, ipc->u.sssl.s);
} }
newpc = ae->u.labp; newpc = ae->u_a.labp;
if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) { if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
/* nothing more to do */ /* nothing more to do */
@ -5401,16 +5413,16 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
ipc->u.sssl.e++; ipc->u.sssl.e++;
} }
if (ap->PredFlags & LogUpdatePredFlag) { if (ap->PredFlags & LogUpdatePredFlag) {
ae->u.labp = cls->Code; ae->u_a.labp = cls->Code;
} else { } else {
ae->u.labp = cls->CurrentCode; ae->u_a.labp = cls->CurrentCode;
} }
ipc = pop_path(&sp, cls, ap, cint); ipc = pop_path(&sp, cls, ap, cint);
} else { } else {
yamop *newpc = ae->u.labp; yamop *newpc = ae->u_a.labp;
sp = fetch_new_block(sp, &(ipc->u.sssl.l), ap, cint); sp = fetch_new_block(sp, &(ipc->u.sssl.l), ap, cint);
sp = cross_block(sp, &(ae->u.labp), ap, cint); sp = cross_block(sp, &(ae->u_a.labp), ap, cint);
ipc = newpc; ipc = newpc;
} }
} }
@ -5429,7 +5441,7 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
break; break;
case _op_fail: case _op_fail:
while ((--sp)->flag != block_entry); while ((--sp)->flag != block_entry);
*sp->u.cle.entry_code = cls->Code; *sp->uip.cle.entry_code = cls->Code;
ipc = pop_path(&sp, cls, ap, cint); ipc = pop_path(&sp, cls, ap, cint);
break; break;
default: default:
@ -5531,7 +5543,7 @@ contract_ftable(yamop *ipc, ClauseUnion *blk, PredEntry *ap, Functor f) {
fep = (FuncSwiEntry *)(ipc->u.sssl.l); fep = (FuncSwiEntry *)(ipc->u.sssl.l);
while (fep->Tag != f) fep++; while (fep->Tag != f) fep++;
} }
fep->u.labp = FAILCODE; fep->u_f.labp = FAILCODE;
} }
static void static void
@ -5545,7 +5557,7 @@ contract_ctable(yamop *ipc, ClauseUnion *blk, PredEntry *ap, Term at) {
cep = (AtomSwiEntry *)(ipc->u.sssl.l); cep = (AtomSwiEntry *)(ipc->u.sssl.l);
while (cep->Tag != at) cep++; while (cep->Tag != at) cep++;
} }
cep->u.labp = FAILCODE; cep->u_a.labp = FAILCODE;
} }
static void static void
@ -5828,35 +5840,35 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
} else { } else {
fe = lookup_f(f, ipc->u.sssl.l, ipc->u.sssl.s); fe = lookup_f(f, ipc->u.sssl.l, ipc->u.sssl.s);
} }
newpc = fe->u.labp; newpc = fe->u_f.labp;
if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) { if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
/* we found it */ /* we found it */
ipc = pop_path(&sp, cls, ap, cint); ipc = pop_path(&sp, cls, ap, cint);
} else if (newpc == FAILCODE) { } else if (newpc == FAILCODE) {
ipc = pop_path(&sp, cls, ap, cint); ipc = pop_path(&sp, cls, ap, cint);
} else if (IN_BETWEEN(bg,fe->u.Label,lt)) { } else if (IN_BETWEEN(bg,fe->u_f.Label,lt)) {
/* oops, nothing there */ /* oops, nothing there */
contract_ftable(ipc, current_block(sp), ap, f); contract_ftable(ipc, current_block(sp), ap, f);
ipc = pop_path(&sp, cls, ap, cint); ipc = pop_path(&sp, cls, ap, cint);
} else { } else {
yamop *newpc = fe->u.labp; yamop *newpc = fe->u_f.labp;
sp = fetch_new_block(sp, &(ipc->u.sssl.l), ap, cint); sp = fetch_new_block(sp, &(ipc->u.sssl.l), ap, cint);
sp = cross_block(sp, &(fe->u.labp), ap, cint); sp = cross_block(sp, &(fe->u_f.labp), ap, cint);
ipc = newpc; ipc = newpc;
} }
} }
break; break;
case _index_dbref: case _index_dbref:
cls->Tag = cls->u.t_ptr; cls->Tag = cls->ucd.t_ptr;
ipc = NEXTOP(ipc,e); ipc = NEXTOP(ipc,e);
break; break;
case _index_blob: case _index_blob:
cls->Tag = Yap_Double_key(cls->u.t_ptr); cls->Tag = Yap_Double_key(cls->ucd.t_ptr);
ipc = NEXTOP(ipc,e); ipc = NEXTOP(ipc,e);
break; break;
case _index_long: case _index_long:
cls->Tag = Yap_Int_key(cls->u.t_ptr); cls->Tag = Yap_Int_key(cls->ucd.t_ptr);
ipc = NEXTOP(ipc,e); ipc = NEXTOP(ipc,e);
break; break;
case _switch_on_cons: case _switch_on_cons:
@ -5872,22 +5884,22 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
} else { } else {
ae = lookup_c(at, ipc->u.sssl.l, ipc->u.sssl.s); ae = lookup_c(at, ipc->u.sssl.l, ipc->u.sssl.s);
} }
newpc = ae->u.labp; newpc = ae->u_a.labp;
if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) { if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
/* we found it */ /* we found it */
ipc = pop_path(&sp, cls, ap, cint); ipc = pop_path(&sp, cls, ap, cint);
} else if (newpc == FAILCODE) { } else if (newpc == FAILCODE) {
ipc = pop_path(&sp, cls, ap, cint); ipc = pop_path(&sp, cls, ap, cint);
} else if (IN_BETWEEN(bg,ae->u.Label,lt)) { } else if (IN_BETWEEN(bg,ae->u_a.Label,lt)) {
/* oops, nothing there */ /* oops, nothing there */
contract_ctable(ipc, current_block(sp), ap, at); contract_ctable(ipc, current_block(sp), ap, at);
ipc = pop_path(&sp, cls, ap, cint); ipc = pop_path(&sp, cls, ap, cint);
} else { } else {
yamop *newpc = ae->u.labp; yamop *newpc = ae->u_a.labp;
sp = fetch_new_block(sp, &(ipc->u.sssl.l), ap, cint); sp = fetch_new_block(sp, &(ipc->u.sssl.l), ap, cint);
sp = cross_block(sp, &(ae->u.labp), ap, cint); sp = cross_block(sp, &(ae->u_a.labp), ap, cint);
ipc = newpc; ipc = newpc;
} }
} }
@ -6042,7 +6054,7 @@ store_clause_choice_point(Term t1, Term tb, Term tr, yamop *ipc, PredEntry *pe,
tsp[3] = tb; tsp[3] = tb;
tsp[4] = tr; tsp[4] = tr;
bptr->cp_tr = TR; bptr->cp_tr = TR;
HB = bptr->cp_h = H; HB = bptr->cp_h = HR;
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
bptr->cp_depth = DEPTH; bptr->cp_depth = DEPTH;
#endif #endif
@ -6065,7 +6077,7 @@ update_clause_choice_point(yamop *ipc, yamop *ap_pc USES_REGS)
{ {
Term tpc = MkIntegerTerm((Int)ipc); Term tpc = MkIntegerTerm((Int)ipc);
B->cp_args[1] = tpc; B->cp_args[1] = tpc;
B->cp_h = H; B->cp_h = HR;
B->cp_ap = ap_pc; B->cp_ap = ap_pc;
} }
@ -6186,14 +6198,12 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
#if TABLING #if TABLING
case _table_trust: case _table_trust:
#endif #endif
#ifdef CUT_C
{ {
while (POP_CHOICE_POINT(B->cp_b)) while (POP_CHOICE_POINT(B->cp_b))
{ {
POP_EXECUTE(); POP_EXECUTE();
} }
} }
#endif /* CUT_C */
#ifdef YAPOR #ifdef YAPOR
{ {
choiceptr cut_pt; choiceptr cut_pt;
@ -6216,14 +6226,12 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
case _table_trust_me: case _table_trust_me:
#endif #endif
b0 = B; b0 = B;
#ifdef CUT_C
{ {
while (POP_CHOICE_POINT(B->cp_b)) while (POP_CHOICE_POINT(B->cp_b))
{ {
POP_EXECUTE(); POP_EXECUTE();
} }
} }
#endif /* CUT_C */
#ifdef YAPOR #ifdef YAPOR
{ {
choiceptr cut_pt; choiceptr cut_pt;
@ -6355,7 +6363,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
LogUpdClause *lcl = ipc->u.OtILl.d; LogUpdClause *lcl = ipc->u.OtILl.d;
/* make sure we don't erase the clause we are jumping to, notice that /* make sure we don't erase the clause we are jumping to, notice that
ErLogUpdIndex may remove several references in one go. ErLogUpdIndex may remove several references in one go.
Notice we only need to do this if we´ re jumping to the clause. Notice we only need to do this if we´ re jumping to the clause.
*/ */
if (newpc && !(lcl->ClFlags & (DirtyMask|InUseMask))) { if (newpc && !(lcl->ClFlags & (DirtyMask|InUseMask))) {
lcl->ClFlags |= InUseMask; lcl->ClFlags |= InUseMask;
@ -6369,14 +6377,12 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
} }
} }
#endif #endif
#ifdef CUT_C
{ {
while (POP_CHOICE_POINT(B->cp_b)) while (POP_CHOICE_POINT(B->cp_b))
{ {
POP_EXECUTE(); POP_EXECUTE();
} }
} }
#endif /* CUT_C */
#ifdef YAPOR #ifdef YAPOR
{ {
choiceptr cut_pt; choiceptr cut_pt;
@ -6533,9 +6539,9 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
fe = lookup_f(f, ipc->u.sssl.l, ipc->u.sssl.s); fe = lookup_f(f, ipc->u.sssl.l, ipc->u.sssl.s);
} }
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
jlbl = &(fe->u.labp); jlbl = &(fe->u_f.labp);
#endif #endif
ipc = fe->u.labp; ipc = fe->u_f.labp;
} }
break; break;
case _index_dbref: case _index_dbref:
@ -6566,9 +6572,9 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
ae = lookup_c(t, ipc->u.sssl.l, ipc->u.sssl.s); ae = lookup_c(t, ipc->u.sssl.l, ipc->u.sssl.s);
} }
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
jlbl = &(ae->u.labp); jlbl = &(ae->u_a.labp);
#endif #endif
ipc = ae->u.labp; ipc = ae->u_a.labp;
} }
break; break;
case _expand_index: case _expand_index:
@ -6643,14 +6649,12 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
return NULL; return NULL;
default: default:
if (b0) { if (b0) {
#ifdef CUT_C
{ {
while (POP_CHOICE_POINT(B->cp_b)) while (POP_CHOICE_POINT(B->cp_b))
{ {
POP_EXECUTE(); POP_EXECUTE();
} }
} }
#endif /* CUT_C */
#ifdef YAPOR #ifdef YAPOR
{ {
choiceptr cut_pt; choiceptr cut_pt;
@ -6673,14 +6677,12 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
} }
if (b0) { if (b0) {
/* I did a trust */ /* I did a trust */
#ifdef CUT_C
{ {
while (POP_CHOICE_POINT(B->cp_b)) while (POP_CHOICE_POINT(B->cp_b))
{ {
POP_EXECUTE(); POP_EXECUTE();
} }
} }
#endif /* CUT_C */
#ifdef YAPOR #ifdef YAPOR
{ {
choiceptr cut_pt; choiceptr cut_pt;

51
C/init.c
View File

@ -69,11 +69,7 @@ static void InTTYLine(char *);
static void SetOp(int, int, char *, Term); static void SetOp(int, int, char *, Term);
static void InitOps(void); static void InitOps(void);
static void InitDebug(void); static void InitDebug(void);
#ifdef CUT_C
static void CleanBack(PredEntry *, CPredicate, CPredicate, CPredicate); static void CleanBack(PredEntry *, CPredicate, CPredicate, CPredicate);
#else
static void CleanBack(PredEntry *, CPredicate, CPredicate);
#endif
static void InitStdPreds(void); static void InitStdPreds(void);
static void InitFlags(void); static void InitFlags(void);
static void InitCodes(void); static void InitCodes(void);
@ -477,6 +473,7 @@ Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, UInt flags)
} }
pe->CodeOfPred = p_code; pe->CodeOfPred = p_code;
pe->PredFlags = flags | StandardPredFlag | CPredFlag; pe->PredFlags = flags | StandardPredFlag | CPredFlag;
pe->src.OwnerFile = Yap_ConsultingFile( PASS_REGS1 );
pe->cs.f_code = code; pe->cs.f_code = code;
if (!(flags & SafePredFlag)) { if (!(flags & SafePredFlag)) {
p_code->opc = Yap_opcode(_allocate); p_code->opc = Yap_opcode(_allocate);
@ -681,11 +678,7 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def,
static void static void
#ifdef CUT_C
CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont, CPredicate Cut) CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont, CPredicate Cut)
#else
CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
#endif
{ {
yamop *code; yamop *code;
if (pe->cs.p_code.FirstClause != pe->cs.p_code.LastClause || if (pe->cs.p_code.FirstClause != pe->cs.p_code.LastClause ||
@ -716,7 +709,6 @@ CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
PUT_YAMOP_SEQ(code); PUT_YAMOP_SEQ(code);
#endif /* YAPOR */ #endif /* YAPOR */
code->u.OtapFs.f = Cont; code->u.OtapFs.f = Cont;
#ifdef CUT_C
code = NEXTOP(code,OtapFs); code = NEXTOP(code,OtapFs);
if (pe->PredFlags & UserCPredFlag) if (pe->PredFlags & UserCPredFlag)
code->opc = Yap_opcode(_cut_c); code->opc = Yap_opcode(_cut_c);
@ -724,11 +716,8 @@ CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
code->opc = Yap_opcode(_cut_userc); code->opc = Yap_opcode(_cut_userc);
code->u.OtapFs.p = pe; code->u.OtapFs.p = pe;
code->u.OtapFs.f = Cut; code->u.OtapFs.f = Cut;
#endif
} }
#ifdef CUT_C
void void
Yap_InitCPredBack(char *Name, unsigned long int Arity, Yap_InitCPredBack(char *Name, unsigned long int Arity,
unsigned int Extra, CPredicate Start, unsigned int Extra, CPredicate Start,
@ -742,24 +731,11 @@ Yap_InitCPredBackCut(char *Name, unsigned long int Arity,
CPredicate Cont,CPredicate Cut, UInt flags){ CPredicate Cont,CPredicate Cut, UInt flags){
Yap_InitCPredBack_(Name,Arity,Extra,Start,Cont,Cut,flags); Yap_InitCPredBack_(Name,Arity,Extra,Start,Cont,Cut,flags);
} }
#else
Yap_InitCPredBackCut(char *Name, unsigned long int Arity,
unsigned int Extra, CPredicate Start,
CPredicate Cont,CPredicate Cut, UInt flags){
Yap_InitCPredBack(Name,Arity,Extra,Start,Cont,flags);
}
#endif /* CUT_C */
void void
#ifdef CUT_C
Yap_InitCPredBack_(char *Name, unsigned long int Arity, Yap_InitCPredBack_(char *Name, unsigned long int Arity,
unsigned int Extra, CPredicate Start, unsigned int Extra, CPredicate Start,
CPredicate Cont, CPredicate Cut, UInt flags) CPredicate Cont, CPredicate Cut, UInt flags)
#else
Yap_InitCPredBack(char *Name, unsigned long int Arity,
unsigned int Extra, CPredicate Start,
CPredicate Cont, UInt flags)
#endif
{ {
CACHE_REGS CACHE_REGS
PredEntry *pe = NULL; PredEntry *pe = NULL;
@ -795,11 +771,7 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity,
if (pe->cs.p_code.FirstClause != NIL) if (pe->cs.p_code.FirstClause != NIL)
{ {
flags = update_flags_from_prolog(flags, pe); flags = update_flags_from_prolog(flags, pe);
#ifdef CUT_C
CleanBack(pe, Start, Cont, Cut); CleanBack(pe, Start, Cont, Cut);
#else
CleanBack(pe, Start, Cont);
#endif /*CUT_C*/
} }
else { else {
StaticClause *cl; StaticClause *cl;
@ -813,11 +785,7 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity,
pe->PredFlags |= SequentialPredFlag; pe->PredFlags |= SequentialPredFlag;
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef CUT_C
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),l)); cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),l));
#else
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),l));
#endif
if (cl == NULL) { if (cl == NULL) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCPredBack"); Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCPredBack");
@ -825,15 +793,9 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity,
} }
cl->ClFlags = StaticMask; cl->ClFlags = StaticMask;
cl->ClNext = NULL; cl->ClNext = NULL;
#ifdef CUT_C
Yap_ClauseSpace += (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),l); Yap_ClauseSpace += (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),l);
cl->ClSize = cl->ClSize =
(CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),e); (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),e);
#else
Yap_ClauseSpace += (CELL)NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),l);
cl->ClSize =
(CELL)NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),e);
#endif
cl->usc.ClLine = Yap_source_line_no(); cl->usc.ClLine = Yap_source_line_no();
code = cl->ClCode; code = cl->ClCode;
@ -865,7 +827,6 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity,
PUT_YAMOP_SEQ(code); PUT_YAMOP_SEQ(code);
#endif /* YAPOR */ #endif /* YAPOR */
code = NEXTOP(code,OtapFs); code = NEXTOP(code,OtapFs);
#ifdef CUT_C
if (flags & UserCPredFlag) if (flags & UserCPredFlag)
code->opc = Yap_opcode(_cut_userc); code->opc = Yap_opcode(_cut_userc);
else else
@ -875,7 +836,6 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity,
code->u.OtapFs.s = Arity; code->u.OtapFs.s = Arity;
code->u.OtapFs.extra = Extra; code->u.OtapFs.extra = Extra;
code = NEXTOP(code,OtapFs); code = NEXTOP(code,OtapFs);
#endif /* CUT_C */
code->opc = Yap_opcode(_Ystop); code->opc = Yap_opcode(_Ystop);
code->u.l.l = cl->ClCode; code->u.l.l = cl->ClCode;
} }
@ -1233,11 +1193,7 @@ static void
InitVersion(void) InitVersion(void)
{ {
Yap_PutValue(AtomVersionNumber, Yap_PutValue(AtomVersionNumber,
MkAtomTerm(Yap_LookupAtom(YAP_SVERSION))); MkAtomTerm(Yap_LookupAtom(YAP_FULL_VERSION)));
#if defined MYDDAS_MYSQL || defined MYDDAS_ODBC
Yap_PutValue(AtomMyddasVersionName,
MkAtomTerm(Yap_LookupAtom(MYDDAS_VERSION)));
#endif
} }
void void
@ -1402,9 +1358,6 @@ Yap_exit (int value)
#ifdef LOW_PROF #ifdef LOW_PROF
remove("PROFPREDS"); remove("PROFPREDS");
remove("PROFILING"); remove("PROFILING");
#endif
#if defined MYDDAS_MYSQL || defined MYDDAS_ODBC
Yap_MYDDAS_delete_all_myddas_structs();
#endif #endif
run_halt_hooks(value); run_halt_hooks(value);
Yap_ShutdownLoadForeign(); Yap_ShutdownLoadForeign();

35
C/inlines.c
View File

@ -19,9 +19,7 @@
#include "absmi.h" #include "absmi.h"
#ifdef CUT_C
#include "cut_c.h" #include "cut_c.h"
#endif
static Int p_atom( USES_REGS1 ); static Int p_atom( USES_REGS1 );
static Int p_atomic( USES_REGS1 ); static Int p_atomic( USES_REGS1 );
@ -325,6 +323,8 @@ eq(Term t1, Term t2 USES_REGS)
return (d0 == d1); return (d0 == d1);
case (CELL)FunctorLongInt: case (CELL)FunctorLongInt:
return(LongIntOfTerm(d0) == LongIntOfTerm(d1)); return(LongIntOfTerm(d0) == LongIntOfTerm(d1));
case (CELL)FunctorString:
return(strcmp(StringOfTerm(d0), StringOfTerm(d1)) == 0);
#ifdef USE_GMP #ifdef USE_GMP
case (CELL)FunctorBigInt: case (CELL)FunctorBigInt:
return (Yap_gmp_tcmp_big_big(d0, d1) == 0); return (Yap_gmp_tcmp_big_big(d0, d1) == 0);
@ -423,9 +423,9 @@ p_dif( USES_REGS1 )
/* make B and HB point to H to guarantee all bindings will /* make B and HB point to H to guarantee all bindings will
* be trailed * be trailed
*/ */
HBREG = H; HBREG = HR;
B = (choiceptr) H; B = (choiceptr) HR;
B->cp_h = H; B->cp_h = HR;
SET_BB(B); SET_BB(B);
save_hb(); save_hb();
d0 = Yap_IUnify(d0, d1); d0 = Yap_IUnify(d0, d1);
@ -440,7 +440,7 @@ p_dif( USES_REGS1 )
B = pt1; B = pt1;
SET_BB(PROTECT_FROZEN_B(pt1)); SET_BB(PROTECT_FROZEN_B(pt1));
#ifdef COROUTINING #ifdef COROUTINING
H = HBREG; HR = HBREG;
#endif #endif
HBREG = B->cp_h; HBREG = B->cp_h;
/* untrail all bindings made by Yap_IUnify */ /* untrail all bindings made by Yap_IUnify */
@ -508,7 +508,8 @@ p_arg( USES_REGS1 )
else if (IsLongIntTerm(d0)) { else if (IsLongIntTerm(d0)) {
d0 = LongIntOfTerm(d0); d0 = LongIntOfTerm(d0);
} else { } else {
Yap_Error(TYPE_ERROR_INTEGER,d0,"arg 1 of arg/3"); if (!IsBigIntTerm( d0 ))
Yap_Error(TYPE_ERROR_INTEGER,d0,"arg 1 of arg/3");
return(FALSE); return(FALSE);
} }
@ -611,6 +612,8 @@ p_functor( USES_REGS1 ) /* functor(?,?,?) */
d1 = MkIntTerm(0); d1 = MkIntTerm(0);
} else if (d1 == (CELL)FunctorLongInt) { } else if (d1 == (CELL)FunctorLongInt) {
d1 = MkIntTerm(0); d1 = MkIntTerm(0);
} else if (d1 == (CELL)FunctorString) {
d1 = MkIntTerm(0);
} else } else
return(FALSE); return(FALSE);
} else { } else {
@ -703,10 +706,10 @@ p_functor( USES_REGS1 ) /* functor(?,?,?) */
/* We made it!!!!! we got in d0 the name, in d1 the arity and /* We made it!!!!! we got in d0 the name, in d1 the arity and
* in pt0 the variable to bind it to. */ * in pt0 the variable to bind it to. */
if (d0 == TermDot && d1 == 2) { if (d0 == TermDot && d1 == 2) {
RESET_VARIABLE(H); RESET_VARIABLE(HR);
RESET_VARIABLE(H+1); RESET_VARIABLE(HR+1);
d0 = AbsPair(H); d0 = AbsPair(HR);
H += 2; HR += 2;
} }
else if ((Int)d1 > 0) { else if ((Int)d1 > 0) {
/* now let's build a compound term */ /* now let's build a compound term */
@ -720,10 +723,10 @@ p_functor( USES_REGS1 ) /* functor(?,?,?) */
} }
else else
d0 = (CELL) Yap_MkFunctor(AtomOfTerm(d0), (Int) d1); d0 = (CELL) Yap_MkFunctor(AtomOfTerm(d0), (Int) d1);
pt1 = H; pt1 = HR;
*pt1++ = d0; *pt1++ = d0;
d0 = AbsAppl(H); d0 = AbsAppl(HR);
if (pt1+d1 > ENV - CreepFlag) { if (pt1+d1 > ENV - StackGap( PASS_REGS1 )) {
if (!Yap_gcl((1+d1)*sizeof(CELL), 3, ENV, gc_P(P,CP))) { if (!Yap_gcl((1+d1)*sizeof(CELL), 3, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return FALSE; return FALSE;
@ -735,7 +738,7 @@ p_functor( USES_REGS1 ) /* functor(?,?,?) */
pt1++; pt1++;
} }
/* done building the term */ /* done building the term */
H = pt1; HR = pt1;
ENDP(pt1); ENDP(pt1);
} else if ((Int)d1 < 0) { } else if ((Int)d1 < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,MkIntegerTerm(d1),"functor/3"); Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,MkIntegerTerm(d1),"functor/3");
@ -793,14 +796,12 @@ p_cut_by( USES_REGS1 )
#else #else
pt0 = (choiceptr)(LCL0-IntOfTerm(d0)); pt0 = (choiceptr)(LCL0-IntOfTerm(d0));
#endif #endif
#ifdef CUT_C
{ {
while (POP_CHOICE_POINT(pt0)) while (POP_CHOICE_POINT(pt0))
{ {
POP_EXECUTE(); POP_EXECUTE();
} }
} }
#endif /* CUT_C */
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to(pt0); CUT_prune_to(pt0);
#endif /* YAPOR */ #endif /* YAPOR */

40
C/iopreds.c
View File

@ -31,6 +31,7 @@ static char SccsId[] = "%W% %G%";
#include "eval.h" #include "eval.h"
/* stuff we want to use in standard YAP code */ /* stuff we want to use in standard YAP code */
#include "pl-shared.h" #include "pl-shared.h"
#include "YapText.h"
#include <stdlib.h> #include <stdlib.h>
#if HAVE_STDARG_H #if HAVE_STDARG_H
#include <stdarg.h> #include <stdarg.h>
@ -270,7 +271,7 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
Int start, err = 0, end; Int start, err = 0, end;
Term tf[7]; Term tf[7];
Term *error = tf+3; Term *error = tf+3;
CELL *Hi = H; CELL *Hi = HR;
int has_qq = FALSE; int has_qq = FALSE;
/* make sure to globalise variable */ /* make sure to globalise variable */
@ -279,12 +280,12 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
clean_vars(LOCAL_AnonVarTable); clean_vars(LOCAL_AnonVarTable);
while (1) { while (1) {
Term ts[2]; Term ts[2];
if (H > ASP-1024) { if (HR > ASP-1024) {
tf[3] = TermNil; tf[3] = TermNil;
err = 0; err = 0;
end = 0; end = 0;
/* for some reason moving this earlier confuses gcc on solaris */ /* for some reason moving this earlier confuses gcc on solaris */
H = Hi; HR = Hi;
break; break;
} }
if (tokptr == LOCAL_toktide) { if (tokptr == LOCAL_toktide) {
@ -301,6 +302,7 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
} }
break; break;
case QuasiQuotes_tok: case QuasiQuotes_tok:
case WQuasiQuotes_tok:
{ {
if (has_qq) { if (has_qq) {
Term t0[1]; Term t0[1];
@ -324,7 +326,7 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
VarEntry *varinfo = (VarEntry *)info; VarEntry *varinfo = (VarEntry *)info;
t[0] = MkIntTerm(0); t[0] = MkIntTerm(0);
t[1] = Yap_StringToList(varinfo->VarRep); t[1] = Yap_CharsToListOfCodes((const char *)varinfo->VarRep PASS_REGS);
if (varinfo->VarAdr == TermNil) { if (varinfo->VarAdr == TermNil) {
t[2] = varinfo->VarAdr = MkVarTerm(); t[2] = varinfo->VarAdr = MkVarTerm();
} else { } else {
@ -335,13 +337,13 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
break; break;
case String_tok: case String_tok:
{ {
Term t0 = Yap_StringToList((char *)info); Term t0 = Yap_CharsToListOfCodes((const char *)info PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
} }
break; break;
case WString_tok: case WString_tok:
{ {
Term t0 = Yap_WideStringToList((wchar_t *)info); Term t0 = Yap_WCharsToListOfCodes((const wchar_t *)info PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
} }
break; break;
@ -371,7 +373,7 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
} }
/* now we can throw away tokens, so we can unify and possibly overwrite TR */ /* now we can throw away tokens, so we can unify and possibly overwrite TR */
Yap_unify(*outp, MkVarTerm()); Yap_unify(*outp, MkVarTerm());
if (IsVarTerm(*outp) && (VarOfTerm(*outp) > H || VarOfTerm(*outp) < H0)) { if (IsVarTerm(*outp) && (VarOfTerm(*outp) > HR || VarOfTerm(*outp) < H0)) {
tf[0] = Yap_MkNewApplTerm(Yap_MkFunctor(AtomRead,1),1); tf[0] = Yap_MkNewApplTerm(Yap_MkFunctor(AtomRead,1),1);
} else { } else {
tf[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomRead,1),1,outp); tf[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomRead,1),1,outp);
@ -500,12 +502,12 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
} }
/* Scans the term using stack space */ /* Scans the term using stack space */
while (TRUE) { while (TRUE) {
old_H = H; old_H = HR;
LOCAL_Comments = TermNil; LOCAL_Comments = TermNil;
LOCAL_CommentsNextChar = LOCAL_CommentsTail = NULL; LOCAL_CommentsNextChar = LOCAL_CommentsTail = NULL;
tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp_stream, store_comments, &tpos); tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp_stream, store_comments, &tpos, rd);
if (LOCAL_Error_TYPE != YAP_NO_ERROR && seekable) { if (LOCAL_Error_TYPE != YAP_NO_ERROR && seekable) {
H = old_H; HR = old_H;
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
if (seekable) { if (seekable) {
Sseek64(inp_stream, cpos, SIO_SEEK_SET); Sseek64(inp_stream, cpos, SIO_SEEK_SET);
@ -539,7 +541,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
/* preserve value of H after scanning: otherwise we may lose strings /* preserve value of H after scanning: otherwise we may lose strings
and floats */ and floats */
old_H = H; old_H = HR;
if (tokstart != NULL && tokstart->Tok == Ord (eot_tok)) { if (tokstart != NULL && tokstart->Tok == Ord (eot_tok)) {
/* did we get the end of file from an abort? */ /* did we get the end of file from an abort? */
if (LOCAL_ErrorMessage && if (LOCAL_ErrorMessage &&
@ -566,7 +568,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
tr_fr_ptr old_TR = TR; tr_fr_ptr old_TR = TR;
H = old_H; HR = old_H;
TR = (tr_fr_ptr)LOCAL_ScannerStack; TR = (tr_fr_ptr)LOCAL_ScannerStack;
if (!strcmp(LOCAL_ErrorMessage,"Stack Overflow")) if (!strcmp(LOCAL_ErrorMessage,"Stack Overflow"))
@ -578,7 +580,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
if (res) { if (res) {
LOCAL_ScannerStack = (char *)TR; LOCAL_ScannerStack = (char *)TR;
TR = old_TR; TR = old_TR;
old_H = H; old_H = HR;
LOCAL_tokptr = LOCAL_toktide = tokstart; LOCAL_tokptr = LOCAL_toktide = tokstart;
LOCAL_ErrorMessage = NULL; LOCAL_ErrorMessage = NULL;
goto repeat_cycle; goto repeat_cycle;
@ -610,7 +612,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
return FALSE; return FALSE;
if (rd->varnames) { if (rd->varnames) {
while (TRUE) { while (TRUE) {
CELL *old_H = H; CELL *old_H = HR;
if (setjmp(LOCAL_IOBotch) == 0) { if (setjmp(LOCAL_IOBotch) == 0) {
v = Yap_VarNames(LOCAL_VarTable, TermNil); v = Yap_VarNames(LOCAL_VarTable, TermNil);
@ -621,7 +623,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
old_TR = TR; old_TR = TR;
/* restart global */ /* restart global */
H = old_H; HR = old_H;
TR = (tr_fr_ptr)LOCAL_ScannerStack; TR = (tr_fr_ptr)LOCAL_ScannerStack;
Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable); Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable);
LOCAL_ScannerStack = (char *)TR; LOCAL_ScannerStack = (char *)TR;
@ -635,7 +637,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
if (rd->variables) { if (rd->variables) {
while (TRUE) { while (TRUE) {
CELL *old_H = H; CELL *old_H = HR;
if (setjmp(LOCAL_IOBotch) == 0) { if (setjmp(LOCAL_IOBotch) == 0) {
v = Yap_Variables(LOCAL_VarTable, TermNil); v = Yap_Variables(LOCAL_VarTable, TermNil);
@ -646,7 +648,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
old_TR = TR; old_TR = TR;
/* restart global */ /* restart global */
H = old_H; HR = old_H;
TR = (tr_fr_ptr)LOCAL_ScannerStack; TR = (tr_fr_ptr)LOCAL_ScannerStack;
Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable); Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable);
LOCAL_ScannerStack = (char *)TR; LOCAL_ScannerStack = (char *)TR;
@ -658,7 +660,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
} }
if (rd->singles) { if (rd->singles) {
while (TRUE) { while (TRUE) {
CELL *old_H = H; CELL *old_H = HR;
if (setjmp(LOCAL_IOBotch) == 0) { if (setjmp(LOCAL_IOBotch) == 0) {
v = Yap_Singletons(LOCAL_VarTable, TermNil); v = Yap_Singletons(LOCAL_VarTable, TermNil);
@ -669,7 +671,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
old_TR = TR; old_TR = TR;
/* restart global */ /* restart global */
H = old_H; HR = old_H;
TR = (tr_fr_ptr)LOCAL_ScannerStack; TR = (tr_fr_ptr)LOCAL_ScannerStack;
Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable); Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable);
LOCAL_ScannerStack = (char *)TR; LOCAL_ScannerStack = (char *)TR;

6
C/load_foreign.c
View File

@ -21,6 +21,8 @@ static char SccsId[] = "%W% %G%.2";
#include "Yatom.h" #include "Yatom.h"
#include "YapHeap.h" #include "YapHeap.h"
#include "yapio.h" #include "yapio.h"
#include "pl-shared.h"
#include "YapText.h"
#include <stdlib.h> #include <stdlib.h>
#if HAVE_STRING_H #if HAVE_STRING_H
#include <string.h> #include <string.h>
@ -81,7 +83,9 @@ p_load_foreign( USES_REGS1 )
/* call the OS specific function for dynamic loading */ /* call the OS specific function for dynamic loading */
if(Yap_LoadForeign(ofiles,libs,InitProcName,&InitProc)==LOAD_SUCCEEDED) { if(Yap_LoadForeign(ofiles,libs,InitProcName,&InitProc)==LOAD_SUCCEEDED) {
Int CurSlot = Yap_StartSlots( PASS_REGS1 );
(*InitProc)(); (*InitProc)();
LOCAL_CurSlot = CurSlot;
returncode = TRUE; returncode = TRUE;
} }
@ -211,7 +215,7 @@ p_call_shared_object_function( USES_REGS1 ) {
static Int static Int
p_obj_suffix( USES_REGS1 ) { p_obj_suffix( USES_REGS1 ) {
return Yap_unify(Yap_StringToList(SO_EXT),ARG1); return Yap_unify(Yap_CharsToListOfCodes(SO_EXT PASS_REGS),ARG1);
} }
static Int static Int

26
C/mavar.c
View File

@ -36,7 +36,7 @@ p_setarg( USES_REGS1 )
Int i; Int i;
if (IsVarTerm(t3) && if (IsVarTerm(t3) &&
VarOfTerm(t3) > H &&VarOfTerm(t3) < ASP) { VarOfTerm(t3) > HR &&VarOfTerm(t3) < ASP) {
/* local variable */ /* local variable */
Term tn = MkVarTerm(); Term tn = MkVarTerm();
Bind_Local(VarOfTerm(t3), tn); Bind_Local(VarOfTerm(t3), tn);
@ -124,17 +124,17 @@ NewTimedVar(CELL val USES_REGS)
Term out; Term out;
timed_var *tv; timed_var *tv;
if (IsVarTerm(val) && if (IsVarTerm(val) &&
VarOfTerm(val) > H) { VarOfTerm(val) > HR) {
Term nval = MkVarTerm(); Term nval = MkVarTerm();
Bind_Local(VarOfTerm(val), nval); Bind_Local(VarOfTerm(val), nval);
val = nval; val = nval;
} }
out = AbsAppl(H); out = AbsAppl(HR);
*H++ = (CELL)FunctorMutable; *HR++ = (CELL)FunctorMutable;
tv = (timed_var *)H; tv = (timed_var *)HR;
RESET_VARIABLE(&(tv->clock)); RESET_VARIABLE(&(tv->clock));
tv->value = val; tv->value = val;
H += sizeof(timed_var)/sizeof(CELL); HR += sizeof(timed_var)/sizeof(CELL);
return(out); return(out);
} }
@ -149,13 +149,13 @@ Term
Yap_NewEmptyTimedVar( void ) Yap_NewEmptyTimedVar( void )
{ {
CACHE_REGS CACHE_REGS
Term out = AbsAppl(H); Term out = AbsAppl(HR);
timed_var *tv; timed_var *tv;
*H++ = (CELL)FunctorMutable; *HR++ = (CELL)FunctorMutable;
tv = (timed_var *)H; tv = (timed_var *)HR;
RESET_VARIABLE(&(tv->clock)); RESET_VARIABLE(&(tv->clock));
RESET_VARIABLE(&(tv->value)); RESET_VARIABLE(&(tv->value));
H += sizeof(timed_var)/sizeof(CELL); HR += sizeof(timed_var)/sizeof(CELL);
return(out); return(out);
} }
@ -181,7 +181,7 @@ UpdateTimedVar(Term inv, Term new USES_REGS)
CELL t = tv->value; CELL t = tv->value;
CELL* timestmp = (CELL *)(tv->clock); CELL* timestmp = (CELL *)(tv->clock);
if (IsVarTerm(new) && if (IsVarTerm(new) &&
VarOfTerm(new) > H) { VarOfTerm(new) > HR) {
Term nnew = MkVarTerm(); Term nnew = MkVarTerm();
Bind_Local(VarOfTerm(new), nnew); Bind_Local(VarOfTerm(new), nnew);
new = nnew; new = nnew;
@ -200,9 +200,9 @@ UpdateTimedVar(Term inv, Term new USES_REGS)
#endif #endif
tv->value = new; tv->value = new;
} else { } else {
Term nclock = (Term)H; Term nclock = (Term)HR;
MaBind(&(tv->value), new); MaBind(&(tv->value), new);
*H++ = TermFoundVar; *HR++ = TermFoundVar;
MaBind(&(tv->clock), nclock); MaBind(&(tv->clock), nclock);
} }
return(t); return(t);

43
C/modules.c
View File

@ -249,26 +249,15 @@ init_current_module( USES_REGS1 )
static Int static Int
p_strip_module( USES_REGS1 ) p_strip_module( USES_REGS1 )
{ {
Term t1 = Deref(ARG1), t2, tmod = CurrentModule; Term t1 = Deref(ARG1), tmod = CurrentModule;
if (tmod == PROLOG_MODULE) { if (tmod == PROLOG_MODULE) {
tmod = TermProlog; tmod = TermProlog;
} }
if (IsVarTerm(t1) || t1 = Yap_StripModule( t1, &tmod );
!IsApplTerm(t1) || if (!t1) {
FunctorOfTerm(t1) != FunctorModule || Yap_Error(TYPE_ERROR_CALLABLE,ARG1,"trying to obtain module");
IsVarTerm(t2 = ArgOfTerm(1,t1)) || return FALSE;
!IsAtomTerm(t2)) {
return Yap_unify(ARG3, t1) &&
Yap_unify(ARG2, tmod);
} }
do {
tmod = t2;
t1 = ArgOfTerm(2,t1);
} while (!IsVarTerm(t1) &&
IsApplTerm(t1) &&
FunctorOfTerm(t1) == FunctorModule &&
!IsVarTerm(t2 = ArgOfTerm(1,t1)) &&
IsAtomTerm(t2));
return Yap_unify(ARG3, t1) && return Yap_unify(ARG3, t1) &&
Yap_unify(ARG2, tmod); Yap_unify(ARG2, tmod);
} }
@ -303,23 +292,27 @@ Yap_StripModule(Term t, Term *modp)
if (modp) if (modp)
tmod = *modp; tmod = *modp;
else else {
tmod = CurrentModule; tmod = CurrentModule;
if (tmod == PROLOG_MODULE) {
tmod = TermProlog;
}
}
restart: restart:
if (IsVarTerm(t)) { if (IsVarTerm(t) || !IsApplTerm(t)) {
return 0L;
} else if (IsAtomTerm(t) || IsPairTerm(t)) {
if (modp) if (modp)
*modp = tmod; *modp = tmod;
return t; return t;
} else if (IsApplTerm(t)) { } else {
Functor fun = FunctorOfTerm(t); Functor fun = FunctorOfTerm(t);
if (fun == FunctorModule) { if (fun == FunctorModule) {
tmod = ArgOfTerm(1, t); Term t1 = ArgOfTerm(1, t);
if (IsVarTerm(tmod) ) { if (IsVarTerm( t1 ) ) {
return 0L; *modp = tmod;
return t;
} }
if (!IsAtomTerm(tmod) ) { tmod = t1;
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod) ) {
return 0L; return 0L;
} }
t = ArgOfTerm(2, t); t = ArgOfTerm(2, t);

30
C/other.c
View File

@ -52,11 +52,11 @@ Term
Yap_MkNewPairTerm(void) Yap_MkNewPairTerm(void)
{ {
CACHE_REGS CACHE_REGS
register CELL *p = H; register CELL *p = HR;
RESET_VARIABLE(H); RESET_VARIABLE(HR);
RESET_VARIABLE(H+1); RESET_VARIABLE(HR+1);
H+=2; HR+=2;
return (AbsPair(p)); return (AbsPair(p));
} }
@ -66,15 +66,15 @@ Yap_MkApplTerm(Functor f, unsigned int n, register Term *a)
* args a */ * args a */
{ {
CACHE_REGS CACHE_REGS
CELL *t = H; CELL *t = HR;
if (n == 0) if (n == 0)
return (MkAtomTerm(NameOfFunctor(f))); return (MkAtomTerm(NameOfFunctor(f)));
if (f == FunctorList) if (f == FunctorList)
return MkPairTerm(a[0], a[1]); return MkPairTerm(a[0], a[1]);
*H++ = (CELL) f; *HR++ = (CELL) f;
while (n--) while (n--)
*H++ = (CELL) * a++; *HR++ = (CELL) * a++;
return (AbsAppl(t)); return (AbsAppl(t));
} }
@ -84,20 +84,20 @@ Yap_MkNewApplTerm(Functor f, unsigned int n)
* args a */ * args a */
{ {
CACHE_REGS CACHE_REGS
CELL *t = H; CELL *t = HR;
if (n == 0) if (n == 0)
return (MkAtomTerm(NameOfFunctor(f))); return (MkAtomTerm(NameOfFunctor(f)));
if (f == FunctorList) { if (f == FunctorList) {
RESET_VARIABLE(H); RESET_VARIABLE(HR);
RESET_VARIABLE(H+1); RESET_VARIABLE(HR+1);
H+=2; HR+=2;
return (AbsPair(t)); return (AbsPair(t));
} }
*H++ = (CELL) f; *HR++ = (CELL) f;
while (n--) { while (n--) {
RESET_VARIABLE(H); RESET_VARIABLE(HR);
H++; HR++;
} }
return (AbsAppl(t)); return (AbsAppl(t));
} }
@ -113,7 +113,7 @@ Yap_Globalise(Term t)
if (!IsVarTerm(t)) if (!IsVarTerm(t))
return t; return t;
vt = VarOfTerm(t); vt = VarOfTerm(t);
if (vt <= H && vt > H0) if (vt <= HR && vt > H0)
return t; return t;
tn = MkVarTerm(); tn = MkVarTerm();
Yap_unify(t, tn); Yap_unify(t, tn);

87
C/parser.c
View File

@ -53,6 +53,7 @@ static char SccsId[] = "%W% %G%";
#include "eval.h" #include "eval.h"
/* stuff we want to use in standard YAP code */ /* stuff we want to use in standard YAP code */
#include "pl-shared.h" #include "pl-shared.h"
#include "YapText.h"
#include "pl-read.h" #include "pl-read.h"
#include "pl-text.h" #include "pl-text.h"
#if HAVE_STRING_H #if HAVE_STRING_H
@ -82,7 +83,7 @@ static Term ParseTerm(read_data *, int, JMPBUFF * CACHE_TYPE);
#define TRY(S,P) \ #define TRY(S,P) \
{ Volatile JMPBUFF *saveenv, newenv; \ { Volatile JMPBUFF *saveenv, newenv; \
Volatile TokEntry *saveT=LOCAL_tokptr; \ Volatile TokEntry *saveT=LOCAL_tokptr; \
Volatile CELL *saveH=H; \ Volatile CELL *saveH=HR; \
Volatile int savecurprio=curprio; \ Volatile int savecurprio=curprio; \
saveenv=FailBuff; \ saveenv=FailBuff; \
if(!sigsetjmp(newenv.JmpBuff, 0)) { \ if(!sigsetjmp(newenv.JmpBuff, 0)) { \
@ -92,7 +93,7 @@ static Term ParseTerm(read_data *, int, JMPBUFF * CACHE_TYPE);
P; \ P; \
} \ } \
else { FailBuff=saveenv; \ else { FailBuff=saveenv; \
H=saveH; \ HR=saveH; \
curprio = savecurprio; \ curprio = savecurprio; \
LOCAL_tokptr=saveT; \ LOCAL_tokptr=saveT; \
} \ } \
@ -101,7 +102,7 @@ static Term ParseTerm(read_data *, int, JMPBUFF * CACHE_TYPE);
#define TRY3(S,P,F) \ #define TRY3(S,P,F) \
{ Volatile JMPBUFF *saveenv, newenv; \ { Volatile JMPBUFF *saveenv, newenv; \
Volatile TokEntry *saveT=LOCAL_tokptr; \ Volatile TokEntry *saveT=LOCAL_tokptr; \
Volatile CELL *saveH=H; \ Volatile CELL *saveH=HR; \
saveenv=FailBuff; \ saveenv=FailBuff; \
if(!sigsetjmp(newenv.JmpBuff, 0)) { \ if(!sigsetjmp(newenv.JmpBuff, 0)) { \
FailBuff = &newenv; \ FailBuff = &newenv; \
@ -111,7 +112,7 @@ static Term ParseTerm(read_data *, int, JMPBUFF * CACHE_TYPE);
} \ } \
else { \ else { \
FailBuff=saveenv; \ FailBuff=saveenv; \
H=saveH; \ HR=saveH; \
LOCAL_tokptr=saveT; \ LOCAL_tokptr=saveT; \
F } \ F } \
} }
@ -192,7 +193,7 @@ VarNames(VarEntry *p,Term l USES_REGS)
o = Yap_MkApplTerm(FunctorEq, 2, t); o = Yap_MkApplTerm(FunctorEq, 2, t);
o = MkPairTerm(o, VarNames(p->VarRight, o = MkPairTerm(o, VarNames(p->VarRight,
VarNames(p->VarLeft,l PASS_REGS) PASS_REGS)); VarNames(p->VarLeft,l PASS_REGS) PASS_REGS));
if (H > ASP-4096) { if (HR > ASP-4096) {
save_machine_regs(); save_machine_regs();
siglongjmp(LOCAL_IOBotch,1); siglongjmp(LOCAL_IOBotch,1);
} }
@ -225,7 +226,7 @@ Singletons(VarEntry *p,Term l USES_REGS)
o = Yap_MkApplTerm(FunctorEq, 2, t); o = Yap_MkApplTerm(FunctorEq, 2, t);
o = MkPairTerm(o, Singletons(p->VarRight, o = MkPairTerm(o, Singletons(p->VarRight,
Singletons(p->VarLeft,l PASS_REGS) PASS_REGS)); Singletons(p->VarLeft,l PASS_REGS) PASS_REGS));
if (H > ASP-4096) { if (HR > ASP-4096) {
save_machine_regs(); save_machine_regs();
siglongjmp(LOCAL_IOBotch,1); siglongjmp(LOCAL_IOBotch,1);
} }
@ -252,7 +253,7 @@ Variables(VarEntry *p,Term l USES_REGS)
if (p != NULL) { if (p != NULL) {
Term o; Term o;
o = MkPairTerm(p->VarAdr, Variables(p->VarRight,Variables(p->VarLeft,l PASS_REGS) PASS_REGS)); o = MkPairTerm(p->VarAdr, Variables(p->VarRight,Variables(p->VarLeft,l PASS_REGS) PASS_REGS));
if (H > ASP-4096) { if (HR > ASP-4096) {
save_machine_regs(); save_machine_regs();
siglongjmp(LOCAL_IOBotch,1); siglongjmp(LOCAL_IOBotch,1);
} }
@ -392,7 +393,7 @@ checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS)
static int static int
is_quasi_quotation_syntax(Term goal, ReadData _PL_rd, Atom *pat) is_quasi_quotation_syntax(Term goal, ReadData _PL_rd, Atom *pat)
{ GET_LD { CACHE_REGS
Term m = CurrentModule, t; Term m = CurrentModule, t;
Atom at; Atom at;
UInt arity; UInt arity;
@ -471,7 +472,7 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
FAIL; FAIL;
} }
t = Yap_MkApplTerm(func, nargs, p); t = Yap_MkApplTerm(func, nargs, p);
if (H > ASP-4096) { if (HR > ASP-4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
return TermNil; return TermNil;
} }
@ -499,7 +500,7 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
* Needed because the arguments for the functor are placed in reverse * Needed because the arguments for the functor are placed in reverse
* order * order
*/ */
if (H > ASP-(nargs+1)) { if (HR > ASP-(nargs+1)) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
@ -519,7 +520,7 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
else else
t = Yap_MkApplTerm(func, nargs, p); t = Yap_MkApplTerm(func, nargs, p);
#endif #endif
if (H > ASP-4096) { if (HR > ASP-4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
return TermNil; return TermNil;
} }
@ -546,10 +547,10 @@ ParseList(read_data *rd, JMPBUFF *FailBuff USES_REGS)
{ {
Term o; Term o;
CELL *to_store; CELL *to_store;
o = AbsPair(H); o = AbsPair(HR);
loop: loop:
to_store = H; to_store = HR;
H+=2; HR+=2;
to_store[0] = ParseTerm(rd, 999, FailBuff PASS_REGS); to_store[0] = ParseTerm(rd, 999, FailBuff PASS_REGS);
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) { if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (((int) LOCAL_tokptr->TokInfo) == ',') { if (((int) LOCAL_tokptr->TokInfo) == ',') {
@ -560,12 +561,12 @@ ParseList(read_data *rd, JMPBUFF *FailBuff USES_REGS)
to_store[1] = ParseTerm(rd, 999, FailBuff PASS_REGS); to_store[1] = ParseTerm(rd, 999, FailBuff PASS_REGS);
} else { } else {
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (HR > ASP-4096) {
to_store[1] = TermNil; to_store[1] = TermNil;
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} else { } else {
to_store[1] = AbsPair(H); to_store[1] = AbsPair(HR);
goto loop; goto loop;
} }
} }
@ -663,7 +664,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
t = ParseTerm(rd, oprprio, FailBuff PASS_REGS); t = ParseTerm(rd, oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(func, 1, &t); t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (HR > ASP-4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
@ -688,23 +689,9 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
case String_tok: /* build list on the heap */ case String_tok: /* build list on the heap */
{ {
Volatile char *p = (char *) LOCAL_tokptr->TokInfo; Volatile char *p = (char *) LOCAL_tokptr->TokInfo;
if (*p == 0) t = Yap_CharsToTDQ(p, CurrentModule PASS_REGS);
t = MkAtomTerm(AtomNil); if (!t) {
else { FAIL;
unsigned int flags = Yap_GetModuleEntry(CurrentModule)->flags;
if (flags & DBLQ_CHARS)
t = Yap_StringToListOfAtoms(p);
else if (flags & DBLQ_ATOM) {
Atom at = Yap_LookupAtom(p);
if (at == NIL) {
LOCAL_ErrorMessage = "Heap Overflow";
FAIL;
}
t = MkAtomTerm(at);
} else if (flags & DBLQ_STRING) {
t = Yap_MkBlobStringTerm(p, strlen(p));
} else
t = Yap_StringToList(p);
} }
NextToken; NextToken;
} }
@ -713,26 +700,8 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
case WString_tok: /* build list on the heap */ case WString_tok: /* build list on the heap */
{ {
Volatile wchar_t *p = (wchar_t *) LOCAL_tokptr->TokInfo; Volatile wchar_t *p = (wchar_t *) LOCAL_tokptr->TokInfo;
if (*p == 0) t = Yap_WCharsToTDQ(p, CurrentModule PASS_REGS);
t = MkAtomTerm(AtomNil); if (!t) {
else {
unsigned int flags = Yap_GetModuleEntry(CurrentModule)->flags;
if (flags & DBLQ_CHARS)
t = Yap_WideStringToListOfAtoms(p);
else if (flags & DBLQ_ATOM) {
Atom at = Yap_LookupWideAtom(p);
if (at == NIL) {
LOCAL_ErrorMessage = "Heap Overflow";
FAIL;
}
t = MkAtomTerm(at);
} else if (flags & DBLQ_STRING) {
t = Yap_MkBlobWideStringTerm(p, wcslen(p));
} else
t = Yap_WideStringToList(p);
}
if (t == 0L) {
LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
NextToken; NextToken;
@ -780,7 +749,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
t = ParseTerm(rd, 1200, FailBuff PASS_REGS); t = ParseTerm(rd, 1200, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorBraces, 1, &t); t = Yap_MkApplTerm(FunctorBraces, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (HR > ASP-4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
@ -891,7 +860,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
args[1] = ParseTerm(rd, oprprio, FailBuff PASS_REGS); args[1] = ParseTerm(rd, oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(func, 2, args); t = Yap_MkApplTerm(func, 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (HR > ASP-4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
@ -914,7 +883,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
} }
t = Yap_MkApplTerm(func, 1, &t); t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (HR > ASP-4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
@ -933,7 +902,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
args[1] = ParseTerm(rd, 1000, FailBuff PASS_REGS); args[1] = ParseTerm(rd, 1000, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorComma, 2, args); t = Yap_MkApplTerm(FunctorComma, 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (HR > ASP-4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
@ -948,7 +917,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
args[1] = ParseTerm(rd, oprprio, FailBuff PASS_REGS); args[1] = ParseTerm(rd, oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorVBar, 2, args); t = Yap_MkApplTerm(FunctorVBar, 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (HR > ASP-4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }

31
C/pl-yap.c
View File

@ -7,6 +7,7 @@
#include "Yap.h" #include "Yap.h"
#include "Yatom.h" #include "Yatom.h"
#include "pl-incl.h" #include "pl-incl.h"
#include "YapText.h"
#if HAVE_MATH_H #if HAVE_MATH_H
#include <math.h> #include <math.h>
#endif #endif
@ -84,13 +85,17 @@ codeToAtom(int chrcode)
word word
globalString(size_t size, char *s) globalString(size_t size, char *s)
{ {
return Yap_MkBlobStringTerm(s, size); CACHE_REGS
return Yap_CharsToString(s PASS_REGS);
} }
word word
globalWString(size_t size, wchar_t *s) globalWString(size_t size, wchar_t *s)
{ {
return Yap_MkBlobWideStringTerm(s, size); CACHE_REGS
return Yap_WCharsToString(s PASS_REGS);
} }
int int
@ -385,14 +390,13 @@ typedef union
int int
get_atom_ptr_text(Atom a, PL_chars_t *text) get_atom_ptr_text(Atom a, PL_chars_t *text)
{ {
YAP_Atom ya = (YAP_Atom)a; if (IsWideAtom(a)) {
if (YAP_IsWideAtom(ya)) { pl_wchar_t *name = (pl_wchar_t *)a->WStrOfAE;
pl_wchar_t *name = (pl_wchar_t *)YAP_WideAtomName(ya);
text->text.w = name; text->text.w = name;
text->length = wcslen(name); text->length = wcslen(name);
text->encoding = ENC_WCHAR; text->encoding = ENC_WCHAR;
} else } else
{ char *name = (char *)YAP_AtomName(ya); { char *name = a->StrOfAE;
text->text.t = name; text->text.t = name;
text->length = strlen(name); text->length = strlen(name);
text->encoding = ENC_ISO_LATIN_1; text->encoding = ENC_ISO_LATIN_1;
@ -406,7 +410,7 @@ get_atom_ptr_text(Atom a, PL_chars_t *text)
int int
get_atom_text(atom_t atom, PL_chars_t *text) get_atom_text(atom_t atom, PL_chars_t *text)
{ Atom a = (Atom)atomValue(atom); { Atom a = YAP_AtomFromSWIAtom(atom);
return get_atom_ptr_text(a, text); return get_atom_ptr_text(a, text);
} }
@ -414,16 +418,9 @@ get_atom_text(atom_t atom, PL_chars_t *text)
int int
get_string_text(word w, PL_chars_t *text ARG_LD) get_string_text(word w, PL_chars_t *text ARG_LD)
{ {
CELL fl = RepAppl(w)[1]; text->text.t = (char *)StringOfTerm(w);
if (fl == BLOB_STRING) { text->encoding = ENC_UTF8;
text->text.t = Yap_BlobStringOfTerm(w); text->length = strlen(text->text.t);
text->encoding = ENC_ISO_LATIN_1;
text->length = strlen(text->text.t);
} else {
text->text.w = Yap_BlobWideStringOfTerm(w);
text->encoding = ENC_WCHAR;
text->length = wcslen(text->text.w);
}
text->storage = PL_CHARS_STACK; text->storage = PL_CHARS_STACK;
text->canonical = TRUE; text->canonical = TRUE;
return TRUE; return TRUE;

18
C/qlyr.c
View File

@ -932,18 +932,32 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
static void static void
read_pred(IOSTREAM *stream, Term mod) { read_pred(IOSTREAM *stream, Term mod) {
UInt flags; UInt flags;
#if SIZEOF_INT_P==4
UInt eflags;
#endif
UInt nclauses, fl1; UInt nclauses, fl1;
PredEntry *ap; PredEntry *ap;
ap = LookupPredEntry((PredEntry *)read_uint(stream)); ap = LookupPredEntry((PredEntry *)read_uint(stream));
flags = read_uint(stream); flags = read_uint(stream);
#if SIZEOF_INT_P==4
eflags = read_uint(stream);
#endif
nclauses = read_uint(stream); nclauses = read_uint(stream);
if (ap->PredFlags & IndexedPredFlag) { if (ap->PredFlags & IndexedPredFlag) {
Yap_RemoveIndexation(ap); Yap_RemoveIndexation(ap);
} }
fl1 = flags & STATIC_PRED_FLAGS;
ap->PredFlags &= ~STATIC_PRED_FLAGS; #if SIZEOF_INT_P==4
fl1 = flags & ((UInt)STATIC_PRED_FLAGS);
ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS);
ap->PredFlags |= fl1; ap->PredFlags |= fl1;
ap->ExtraPredFlags = eflags;
#else
fl1 = flags & ((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
ap->PredFlags |= fl1;
#endif
if (flags & NumberDBPredFlag) { if (flags & NumberDBPredFlag) {
ap->src.IndxId = read_uint(stream); ap->src.IndxId = read_uint(stream);
} else { } else {

19
C/qlyw.c
View File

@ -194,7 +194,7 @@ GrowPredTable(void) {
} }
newp->val = p->val; newp->val = p->val;
newp->arity = p->arity; newp->arity = p->arity;
newp->u.f = p->u.f; newp->u_af.f = p->u_af.f;
newp->module = p->module; newp->module = p->module;
} }
LOCAL_ExportPredEntryHashChain = newt; LOCAL_ExportPredEntryHashChain = newt;
@ -223,23 +223,23 @@ LookupPredEntry(PredEntry *pe)
p->val = pe; p->val = pe;
if (pe->ModuleOfPred != IDB_MODULE) { if (pe->ModuleOfPred != IDB_MODULE) {
if (arity) { if (arity) {
p->u.f = pe->FunctorOfPred; p->u_af.f = pe->FunctorOfPred;
LookupFunctor(pe->FunctorOfPred); LookupFunctor(pe->FunctorOfPred);
} else { } else {
p->u.a = (Atom)(pe->FunctorOfPred); p->u_af.a = (Atom)(pe->FunctorOfPred);
LookupAtom((Atom)(pe->FunctorOfPred)); LookupAtom((Atom)(pe->FunctorOfPred));
} }
} else { } else {
if (pe->PredFlags & AtomDBPredFlag) { if (pe->PredFlags & AtomDBPredFlag) {
p->u.a = (Atom)(pe->FunctorOfPred); p->u_af.a = (Atom)(pe->FunctorOfPred);
p->arity = (CELL)(-2); p->arity = (CELL)(-2);
LookupAtom((Atom)(pe->FunctorOfPred)); LookupAtom((Atom)(pe->FunctorOfPred));
} else if (!(pe->PredFlags & NumberDBPredFlag)) { } else if (!(pe->PredFlags & NumberDBPredFlag)) {
p->u.f = pe->FunctorOfPred; p->u_af.f = pe->FunctorOfPred;
p->arity = (CELL)(-1); p->arity = (CELL)(-1);
LookupFunctor(pe->FunctorOfPred); LookupFunctor(pe->FunctorOfPred);
} else { } else {
p->u.f = pe->FunctorOfPred; p->u_af.f = pe->FunctorOfPred;
} }
} }
if (pe->ModuleOfPred) { if (pe->ModuleOfPred) {
@ -604,7 +604,7 @@ SaveHash(IOSTREAM *stream)
CHECK(save_uint(stream, (UInt)(p->val))); CHECK(save_uint(stream, (UInt)(p->val)));
CHECK(save_uint(stream, p->arity)); CHECK(save_uint(stream, p->arity));
CHECK(save_uint(stream, (UInt)p->module)); CHECK(save_uint(stream, (UInt)p->module));
CHECK(save_uint(stream, (UInt)p->u.f)); CHECK(save_uint(stream, (UInt)p->u_af.f));
} }
save_tag(stream, QLY_START_DBREFS); save_tag(stream, QLY_START_DBREFS);
save_uint(stream, LOCAL_ExportDBRefHashTableNum); save_uint(stream, LOCAL_ExportDBRefHashTableNum);
@ -688,6 +688,9 @@ static size_t
save_pred(IOSTREAM *stream, PredEntry *ap) { save_pred(IOSTREAM *stream, PredEntry *ap) {
CHECK(save_uint(stream, (UInt)ap)); CHECK(save_uint(stream, (UInt)ap));
CHECK(save_uint(stream, ap->PredFlags)); CHECK(save_uint(stream, ap->PredFlags));
#if SIZEOF_INT_P==4
CHECK(save_uint(stream, ap->ExtraPredFlags));
#endif
CHECK(save_uint(stream, ap->cs.p_code.NOfClauses)); CHECK(save_uint(stream, ap->cs.p_code.NOfClauses));
CHECK(save_uint(stream, ap->src.IndxId)); CHECK(save_uint(stream, ap->src.IndxId));
CHECK(save_uint(stream, ap->TimeStampOfPred)); CHECK(save_uint(stream, ap->TimeStampOfPred));
@ -797,7 +800,7 @@ save_header(IOSTREAM *stream)
{ {
char msg[256]; char msg[256];
sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%s", YAP_BINDIR, YAP_SVERSION); sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%s", YAP_BINDIR, YAP_FULL_VERSION);
return save_bytes(stream, msg, strlen(msg)+1); return save_bytes(stream, msg, strlen(msg)+1);
} }

27
C/save.c
View File

@ -344,7 +344,7 @@ put_info(int info, int mode USES_REGS)
{ {
char msg[256]; char msg[256];
sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%cYAP-%s", YAP_BINDIR, 1, YAP_SVERSION); sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%cYAP-%s", YAP_BINDIR, 1, YAP_FULL_VERSION);
if (mywrite(splfild, msg, strlen(msg) + 1)) if (mywrite(splfild, msg, strlen(msg) + 1))
return -1; return -1;
if (putout(Unsigned(info)) < 0) if (putout(Unsigned(info)) < 0)
@ -369,7 +369,7 @@ put_info(int info, int mode USES_REGS)
if (putout(Unsigned(LCL0)-Unsigned(ASP)) < 0) if (putout(Unsigned(LCL0)-Unsigned(ASP)) < 0)
return -1; return -1;
/* Space used for global stack */ /* Space used for global stack */
if (putout(Unsigned(H) - Unsigned(LOCAL_GlobalBase)) < 0) if (putout(Unsigned(HR) - Unsigned(LOCAL_GlobalBase)) < 0)
return -1; return -1;
/* Space used for trail */ /* Space used for trail */
if (putout(Unsigned(TR) - Unsigned(LOCAL_TrailBase)) < 0) if (putout(Unsigned(TR) - Unsigned(LOCAL_TrailBase)) < 0)
@ -396,7 +396,7 @@ save_regs(int mode USES_REGS)
return -1; return -1;
if (putcellptr(LCL0) < 0) if (putcellptr(LCL0) < 0)
return -1; return -1;
if (putcellptr(H) < 0) if (putcellptr(HR) < 0)
return -1; return -1;
if (putcellptr(HB) < 0) if (putcellptr(HB) < 0)
return -1; return -1;
@ -412,6 +412,8 @@ save_regs(int mode USES_REGS)
return -1; return -1;
if (putout(CreepFlag) < 0) if (putout(CreepFlag) < 0)
return -1; return -1;
if (putout(EventFlag) < 0)
return -1;
if (putcellptr((CELL *)EX) < 0) if (putcellptr((CELL *)EX) < 0)
return -1; return -1;
#if defined(YAPOR_SBA) || defined(TABLING) #if defined(YAPOR_SBA) || defined(TABLING)
@ -533,7 +535,7 @@ save_stacks(int mode USES_REGS)
if (mywrite(splfild, (char *) ASP, j) < 0) if (mywrite(splfild, (char *) ASP, j) < 0)
return -1; return -1;
/* Save the global stack */ /* Save the global stack */
j = Unsigned(H) - Unsigned(LOCAL_GlobalBase); j = Unsigned(HR) - Unsigned(LOCAL_GlobalBase);
if (mywrite(splfild, (char *) LOCAL_GlobalBase, j) < 0) if (mywrite(splfild, (char *) LOCAL_GlobalBase, j) < 0)
return -1; return -1;
/* Save the trail */ /* Save the trail */
@ -675,7 +677,7 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap USES_REGS)
} }
} while (pp[0] != 1); } while (pp[0] != 1);
/* now check the version */ /* now check the version */
sprintf(msg, "YAP-%s", YAP_SVERSION); sprintf(msg, "YAP-%s", YAP_FULL_VERSION);
{ {
int count = 0, n, to_read = Unsigned(strlen(msg) + 1); int count = 0, n, to_read = Unsigned(strlen(msg) + 1);
while (count < to_read) { while (count < to_read) {
@ -832,7 +834,7 @@ get_regs(int flag USES_REGS)
LCL0 = get_cellptr(); LCL0 = get_cellptr();
if (LOCAL_ErrorMessage) if (LOCAL_ErrorMessage)
return -1; return -1;
H = get_cellptr(); HR = get_cellptr();
if (LOCAL_ErrorMessage) if (LOCAL_ErrorMessage)
return -1; return -1;
HB = get_cellptr(); HB = get_cellptr();
@ -854,6 +856,9 @@ get_regs(int flag USES_REGS)
if (LOCAL_ErrorMessage) if (LOCAL_ErrorMessage)
return -1; return -1;
CreepFlag = get_cell(); CreepFlag = get_cell();
if (LOCAL_ErrorMessage)
return -1;
EventFlag = get_cell();
if (LOCAL_ErrorMessage) if (LOCAL_ErrorMessage)
return -1; return -1;
EX = (struct DB_TERM *)get_cellptr(); EX = (struct DB_TERM *)get_cellptr();
@ -924,7 +929,7 @@ get_regs(int flag USES_REGS)
LOCAL_OldASP = ASP; LOCAL_OldASP = ASP;
LOCAL_OldLCL0 = LCL0; LOCAL_OldLCL0 = LCL0;
LOCAL_OldGlobalBase = (CELL *)LOCAL_GlobalBase; LOCAL_OldGlobalBase = (CELL *)LOCAL_GlobalBase;
LOCAL_OldH = H; LOCAL_OldH = HR;
LOCAL_OldTR = TR; LOCAL_OldTR = TR;
LOCAL_GDiff = Unsigned(NewGlobalBase) - Unsigned(LOCAL_GlobalBase); LOCAL_GDiff = Unsigned(NewGlobalBase) - Unsigned(LOCAL_GlobalBase);
LOCAL_GDiff0 = 0; LOCAL_GDiff0 = 0;
@ -972,7 +977,7 @@ CopyStacks( USES_REGS1 )
NewASP = (char *) (Unsigned(ASP) + (Unsigned(LCL0) - Unsigned(LOCAL_OldLCL0))); NewASP = (char *) (Unsigned(ASP) + (Unsigned(LCL0) - Unsigned(LOCAL_OldLCL0)));
if (myread(splfild, (char *) NewASP, j) < 0) if (myread(splfild, (char *) NewASP, j) < 0)
return -1; return -1;
j = Unsigned(H) - Unsigned(LOCAL_OldGlobalBase); j = Unsigned(HR) - Unsigned(LOCAL_OldGlobalBase);
if (myread(splfild, (char *) LOCAL_GlobalBase, j) < 0) if (myread(splfild, (char *) LOCAL_GlobalBase, j) < 0)
return -1; return -1;
j = Unsigned(TR) - Unsigned(LOCAL_OldTrailBase); j = Unsigned(TR) - Unsigned(LOCAL_OldTrailBase);
@ -1055,7 +1060,7 @@ restore_regs(int flag USES_REGS)
CP = PtoOpAdjust(CP); CP = PtoOpAdjust(CP);
ENV = PtoLocAdjust(ENV); ENV = PtoLocAdjust(ENV);
ASP = PtoLocAdjust(ASP); ASP = PtoLocAdjust(ASP);
H = PtoGloAdjust(H); HR = PtoGloAdjust(HR);
B = (choiceptr)PtoLocAdjust(CellPtr(B)); B = (choiceptr)PtoLocAdjust(CellPtr(B));
TR = PtoTRAdjust(TR); TR = PtoTRAdjust(TR);
P = PtoOpAdjust(P); P = PtoOpAdjust(P);
@ -1144,8 +1149,8 @@ rehash(CELL *oldcode, int NOfE, int KindOfEntries USES_REGS)
if (LOCAL_HDiff == 0) if (LOCAL_HDiff == 0)
return; return;
basep = H; basep = HR;
if (H + (NOfE*2) > ASP) { if (HR + (NOfE*2) > ASP) {
basep = (CELL *)TR; basep = (CELL *)TR;
if (basep + (NOfE*2) > (CELL *)LOCAL_TrailTop) { if (basep + (NOfE*2) > (CELL *)LOCAL_TrailTop) {
if (!Yap_growtrail((ADDR)(basep + (NOfE*2))-LOCAL_TrailTop, TRUE)) { if (!Yap_growtrail((ADDR)(basep + (NOfE*2))-LOCAL_TrailTop, TRUE)) {

25
C/scanner.c
View File

@ -42,7 +42,7 @@
/* stuff we want to use in standard YAP code */ /* stuff we want to use in standard YAP code */
#include "pl-shared.h" #include "pl-shared.h"
#include "pl-read.h" #include "pl-read.h"
#include "pl-utf8.h" #include "YapText.h"
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
#if HAVE_FINITE==1 #if HAVE_FINITE==1
#undef HAVE_FINITE #undef HAVE_FINITE
@ -631,22 +631,18 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
} }
} }
if (ch == 'e' || ch == 'E') { if (ch == 'e' || ch == 'E') {
char cbuff = ch;
if (--max_size == 0) { if (--max_size == 0) {
return num_send_error_message("Number Too Long"); return num_send_error_message("Number Too Long");
} }
*sp++ = ch; *sp++ = ch;
ch = getchr(inp_stream); ch = getchr(inp_stream);
if (ch == '-') { if (ch == '-') {
cbuff = '-';
if (--max_size == 0) { if (--max_size == 0) {
return num_send_error_message("Number Too Long"); return num_send_error_message("Number Too Long");
} }
*sp++ = '-'; *sp++ = '-';
ch = getchr(inp_stream); ch = getchr(inp_stream);
} else if (ch == '+') { } else if (ch == '+') {
cbuff = '+';
ch = getchr(inp_stream); ch = getchr(inp_stream);
} }
if (chtype(ch) != NU) { if (chtype(ch) != NU) {
@ -719,7 +715,7 @@ Yap_scan_num(IOSTREAM *inp)
return TermNil; return TermNil;
} }
cherr = '\0'; cherr = '\0';
if (ASP-H < 1024) if (ASP-HR < 1024)
return TermNil; return TermNil;
out = get_num(&ch, &cherr, inp, ptr, 4096, sign); /* */ out = get_num(&ch, &cherr, inp, ptr, 4096, sign); /* */
PopScannerMemory(ptr, 4096); PopScannerMemory(ptr, 4096);
@ -731,7 +727,7 @@ Yap_scan_num(IOSTREAM *inp)
#define CHECK_SPACE() \ #define CHECK_SPACE() \
if (ASP-H < 1024) { \ if (ASP-HR < 1024) { \
LOCAL_ErrorMessage = "Stack Overflow"; \ LOCAL_ErrorMessage = "Stack Overflow"; \
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; \ LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; \
LOCAL_Error_Size = 0L; \ LOCAL_Error_Size = 0L; \
@ -744,8 +740,8 @@ Yap_scan_num(IOSTREAM *inp)
static void static void
open_comment(int ch, IOSTREAM *inp_stream USES_REGS) { open_comment(int ch, IOSTREAM *inp_stream USES_REGS) {
CELL *h0 = H; CELL *h0 = HR;
H += 5; HR += 5;
h0[0] = AbsAppl(h0+2); h0[0] = AbsAppl(h0+2);
h0[1] = TermNil; h0[1] = TermNil;
if (!LOCAL_CommentsTail) { if (!LOCAL_CommentsTail) {
@ -780,7 +776,7 @@ extend_comment(int ch USES_REGS) {
static void static void
close_comment( USES_REGS1 ) { close_comment( USES_REGS1 ) {
LOCAL_CommentsBuff[LOCAL_CommentsBuffPos] = '\0'; LOCAL_CommentsBuff[LOCAL_CommentsBuffPos] = '\0';
*LOCAL_CommentsNextChar = Yap_MkBlobWideStringTerm(LOCAL_CommentsBuff, LOCAL_CommentsBuffPos); *LOCAL_CommentsNextChar = Yap_WCharsToString(LOCAL_CommentsBuff PASS_REGS);
free(LOCAL_CommentsBuff); free(LOCAL_CommentsBuff);
LOCAL_CommentsBuff = NULL; LOCAL_CommentsBuff = NULL;
LOCAL_CommentsBuffLim = 0; LOCAL_CommentsBuffLim = 0;
@ -820,7 +816,7 @@ ch_to_wide(char *base, char *charp)
{ charp = _PL__utf8_put_char(charp, ch); } } { charp = _PL__utf8_put_char(charp, ch); } }
TokEntry * TokEntry *
Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp) Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
{ {
GET_LD GET_LD
TokEntry *t, *l, *p; TokEntry *t, *l, *p;
@ -829,6 +825,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
int ch; int ch;
wchar_t *wcharp; wchar_t *wcharp;
struct qq_struct_t *cur_qq = NULL; struct qq_struct_t *cur_qq = NULL;
struct read_data_t *rd = rd0;
LOCAL_ErrorMessage = NULL; LOCAL_ErrorMessage = NULL;
LOCAL_Error_Size = 0; LOCAL_Error_Size = 0;
@ -843,7 +840,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
ch = getchr(inp_stream); ch = getchr(inp_stream);
} }
*tposp = Yap_StreamPosition(inp_stream); *tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(&inp_stream); Yap_setCurrentSourceLocation( rd );
LOCAL_StartLine = inp_stream->posbuf.lineno; LOCAL_StartLine = inp_stream->posbuf.lineno;
do { do {
wchar_t och; wchar_t och;
@ -907,7 +904,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
} }
CHECK_SPACE(); CHECK_SPACE();
*tposp = Yap_StreamPosition(inp_stream); *tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(&inp_stream); Yap_setCurrentSourceLocation( rd );
} }
goto restart; goto restart;
} else { } else {
@ -1230,7 +1227,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
} }
CHECK_SPACE(); CHECK_SPACE();
*tposp = Yap_StreamPosition(inp_stream); *tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(&inp_stream); Yap_setCurrentSourceLocation( rd );
} }
} }
goto restart; goto restart;

51
C/signals.c
View File

@ -41,8 +41,11 @@ inline static void
do_signal(yap_signals sig USES_REGS) do_signal(yap_signals sig USES_REGS)
{ {
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
if (!LOCAL_InterruptsDisabled) if (!LOCAL_InterruptsDisabled) {
CreepFlag = Unsigned(LCL0); CreepFlag = Unsigned(LCL0);
if (sig != YAP_CREEP_SIGNAL)
EventFlag = Unsigned(LCL0);
}
LOCAL_ActiveSignals |= sig; LOCAL_ActiveSignals |= sig;
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
} }
@ -51,8 +54,8 @@ inline static void
undo_signal(yap_signals sig USES_REGS) undo_signal(yap_signals sig USES_REGS)
{ {
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
if ((LOCAL_ActiveSignals & ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL)) == sig) { if ((LOCAL_ActiveSignals & ~(YAP_CREEP_SIGNAL)) == sig) {
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
} }
LOCAL_ActiveSignals &= ~sig; LOCAL_ActiveSignals &= ~sig;
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
@ -72,19 +75,7 @@ p_creep( USES_REGS1 )
} }
static Int static Int
p_stop_creeping( USES_REGS1 ) p_creep_fail( USES_REGS1 )
{
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
if (!LOCAL_ActiveSignals) {
CreepFlag = CalculateStackGap();
}
UNLOCK(LOCAL_SignalLock);
return TRUE;
}
static Int
p_meta_creep( USES_REGS1 )
{ {
Atom at; Atom at;
PredEntry *pred; PredEntry *pred;
@ -92,8 +83,18 @@ p_meta_creep( USES_REGS1 )
at = AtomCreep; at = AtomCreep;
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0)); pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
CreepCode = pred; CreepCode = pred;
do_signal(YAP_CREEP_SIGNAL PASS_REGS);
return FALSE;
}
static Int
p_stop_creeping( USES_REGS1 )
{
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals |= YAP_DELAY_CREEP_SIGNAL; LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
if (!LOCAL_ActiveSignals) {
CalculateStackGap( PASS_REGS1 );
}
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
return TRUE; return TRUE;
} }
@ -106,7 +107,7 @@ p_creep_allowed( USES_REGS1 )
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL && !LOCAL_InterruptsDisabled) { if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
if (!LOCAL_ActiveSignals) if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
} else { } else {
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
@ -205,12 +206,6 @@ p_first_signal( USES_REGS1 )
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigVTAlarm)); return Yap_unify(ARG1, MkAtomTerm(AtomSigVTAlarm));
} }
if (LOCAL_ActiveSignals & YAP_DELAY_CREEP_SIGNAL) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
MUTEX_UNLOCK(&(LOCAL_ThreadHandle.tlock));
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigDelayCreep));
}
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) { if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
MUTEX_UNLOCK(&(LOCAL_ThreadHandle.tlock)); MUTEX_UNLOCK(&(LOCAL_ThreadHandle.tlock));
@ -286,12 +281,6 @@ p_continue_signals( USES_REGS1 )
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) { if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) {
Yap_signal(YAP_CREEP_SIGNAL); Yap_signal(YAP_CREEP_SIGNAL);
} }
if (LOCAL_ActiveSignals & YAP_DELAY_CREEP_SIGNAL) {
Yap_signal(YAP_DELAY_CREEP_SIGNAL|YAP_CREEP_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_TRACE_SIGNAL) {
Yap_signal(YAP_TRACE_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_DEBUG_SIGNAL) { if (LOCAL_ActiveSignals & YAP_DEBUG_SIGNAL) {
Yap_signal(YAP_DEBUG_SIGNAL); Yap_signal(YAP_DEBUG_SIGNAL);
} }
@ -316,7 +305,7 @@ Yap_InitSignalCPreds(void)
{ {
/* Basic predicates for the debugger */ /* Basic predicates for the debugger */
Yap_InitCPred("$creep", 0, p_creep, SafePredFlag); Yap_InitCPred("$creep", 0, p_creep, SafePredFlag);
Yap_InitCPred("$meta_creep", 0, p_meta_creep, SafePredFlag); Yap_InitCPred("$creep_fail", 0, p_creep_fail, SafePredFlag);
Yap_InitCPred("$stop_creeping", 0, p_stop_creeping, SafePredFlag); Yap_InitCPred("$stop_creeping", 0, p_stop_creeping, SafePredFlag);
Yap_InitCPred ("$first_signal", 1, p_first_signal, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$first_signal", 1, p_first_signal, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$continue_signals", 0, p_continue_signals, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$continue_signals", 0, p_continue_signals, SafePredFlag|SyncPredFlag);

24
C/sort.c
View File

@ -58,12 +58,12 @@ build_new_list(CELL *pt, Term t USES_REGS)
} }
pt += 2; pt += 2;
if (pt > ASP - 4096) { if (pt > ASP - 4096) {
if (!Yap_gcl((ASP-H)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { if (!Yap_gcl((ASP-HR)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return(FALSE); return(FALSE);
} }
t = Deref(ARG1); t = Deref(ARG1);
pt = H; pt = HR;
out = 0; out = 0;
goto restart; goto restart;
} }
@ -346,7 +346,7 @@ static Int
p_sort( USES_REGS1 ) p_sort( USES_REGS1 )
{ {
/* use the heap to build a new list */ /* use the heap to build a new list */
CELL *pt = H; CELL *pt = HR;
Term out; Term out;
/* list size */ /* list size */
Int size; Int size;
@ -355,13 +355,13 @@ p_sort( USES_REGS1 )
return(FALSE); return(FALSE);
if (size < 2) if (size < 2)
return(Yap_unify(ARG1, ARG2)); return(Yap_unify(ARG1, ARG2));
pt = H; /* because of possible garbage collection */ pt = HR; /* because of possible garbage collection */
/* make sure no one writes on our temp data structure */ /* make sure no one writes on our temp data structure */
H += size*2; HR += size*2;
/* reserve the necessary space */ /* reserve the necessary space */
size = compact_mergesort(pt, size, M_EVEN); size = compact_mergesort(pt, size, M_EVEN);
/* reajust space */ /* reajust space */
H = pt+size*2; HR = pt+size*2;
adjust_vector(pt, size); adjust_vector(pt, size);
out = AbsPair(pt); out = AbsPair(pt);
return(Yap_unify(out, ARG2)); return(Yap_unify(out, ARG2));
@ -371,7 +371,7 @@ static Int
p_msort( USES_REGS1 ) p_msort( USES_REGS1 )
{ {
/* use the heap to build a new list */ /* use the heap to build a new list */
CELL *pt = H; CELL *pt = HR;
Term out; Term out;
/* list size */ /* list size */
Int size; Int size;
@ -380,9 +380,9 @@ p_msort( USES_REGS1 )
return(FALSE); return(FALSE);
if (size < 2) if (size < 2)
return(Yap_unify(ARG1, ARG2)); return(Yap_unify(ARG1, ARG2));
pt = H; /* because of possible garbage collection */ pt = HR; /* because of possible garbage collection */
/* reserve the necessary space */ /* reserve the necessary space */
H += size*2; HR += size*2;
simple_mergesort(pt, size, M_EVEN); simple_mergesort(pt, size, M_EVEN);
adjust_vector(pt, size); adjust_vector(pt, size);
out = AbsPair(pt); out = AbsPair(pt);
@ -393,7 +393,7 @@ static Int
p_ksort( USES_REGS1 ) p_ksort( USES_REGS1 )
{ {
/* use the heap to build a new list */ /* use the heap to build a new list */
CELL *pt = H; CELL *pt = HR;
Term out; Term out;
/* list size */ /* list size */
Int size; Int size;
@ -403,8 +403,8 @@ p_ksort( USES_REGS1 )
if (size < 2) if (size < 2)
return(Yap_unify(ARG1, ARG2)); return(Yap_unify(ARG1, ARG2));
/* reserve the necessary space */ /* reserve the necessary space */
pt = H; /* because of possible garbage collection */ pt = HR; /* because of possible garbage collection */
H += size*2; HR += size*2;
if (!key_mergesort(pt, size, M_EVEN, FunctorMinus)) if (!key_mergesort(pt, size, M_EVEN, FunctorMinus))
return(FALSE); return(FALSE);
adjust_vector(pt, size); adjust_vector(pt, size);

89
C/stdpreds.c
View File

@ -634,15 +634,15 @@ p_univ( USES_REGS1 )
} }
build_compound: build_compound:
/* build the term directly on the heap */ /* build the term directly on the heap */
Ar = H; Ar = HR;
H++; HR++;
while (!IsVarTerm(twork) && IsPairTerm(twork)) { while (!IsVarTerm(twork) && IsPairTerm(twork)) {
*H++ = HeadOfTerm(twork); *HR++ = HeadOfTerm(twork);
if (H > ASP - 1024) { if (HR > ASP - 1024) {
/* restore space */ /* restore space */
H = Ar; HR = Ar;
if (!Yap_gcl((ASP-H)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { if (!Yap_gcl((ASP-HR)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return FALSE; return FALSE;
} }
@ -671,11 +671,11 @@ p_univ( USES_REGS1 )
arity, CellPtr(TR)); arity, CellPtr(TR));
} }
#else #else
arity = H-Ar-1; arity = HR-Ar-1;
if (at == AtomDot && arity == 2) { if (at == AtomDot && arity == 2) {
Ar[0] = Ar[1]; Ar[0] = Ar[1];
Ar[1] = Ar[2]; Ar[1] = Ar[2];
H --; HR --;
twork = AbsPair(Ar); twork = AbsPair(Ar);
} else { } else {
*Ar = (CELL)(Yap_MkFunctor(at, arity)); *Ar = (CELL)(Yap_MkFunctor(at, arity));
@ -692,6 +692,10 @@ p_univ( USES_REGS1 )
return (FALSE); return (FALSE);
if (IsApplTerm(tin)) { if (IsApplTerm(tin)) {
Functor fun = FunctorOfTerm(tin); Functor fun = FunctorOfTerm(tin);
if (IsExtensionFunctor ( fun ) ) {
twork = MkPairTerm(tin, MkAtomTerm(AtomNil));
return (Yap_unify(twork, ARG2));
}
arity = ArityOfFunctor(fun); arity = ArityOfFunctor(fun);
at = NameOfFunctor(fun); at = NameOfFunctor(fun);
#ifdef SFUNC #ifdef SFUNC
@ -716,7 +720,7 @@ p_univ( USES_REGS1 )
} else } else
#endif #endif
{ {
while (H+arity*2 > ASP-1024) { while (HR+arity*2 > ASP-1024) {
if (!Yap_gcl((arity*2)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { if (!Yap_gcl((arity*2)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return(FALSE); return(FALSE);
@ -1301,7 +1305,7 @@ Yap_show_statistics(void)
frag); frag);
fprintf(GLOBAL_stderr, "Stack Space: %ld (%ld for Global, %ld for local).\n", fprintf(GLOBAL_stderr, "Stack Space: %ld (%ld for Global, %ld for local).\n",
(unsigned long int)(sizeof(CELL)*(LCL0-H0)), (unsigned long int)(sizeof(CELL)*(LCL0-H0)),
(unsigned long int)(sizeof(CELL)*(H-H0)), (unsigned long int)(sizeof(CELL)*(HR-H0)),
(unsigned long int)(sizeof(CELL)*(LCL0-ASP))); (unsigned long int)(sizeof(CELL)*(LCL0-ASP)));
fprintf(GLOBAL_stderr, "Trail Space: %ld (%ld used).\n", fprintf(GLOBAL_stderr, "Trail Space: %ld (%ld used).\n",
(unsigned long int)(sizeof(tr_fr_ptr)*(Unsigned(LOCAL_TrailTop)-Unsigned(LOCAL_TrailBase))), (unsigned long int)(sizeof(tr_fr_ptr)*(Unsigned(LOCAL_TrailTop)-Unsigned(LOCAL_TrailBase))),
@ -1376,7 +1380,7 @@ GlobalMax(void)
CELL *pt; CELL *pt;
if (GlobalTide != StkWidth) { if (GlobalTide != StkWidth) {
pt = H; pt = HR;
while (pt+2 < ASP) { while (pt+2 < ASP) {
if (pt[0] == 0 && if (pt[0] == 0 &&
pt[1] == 0 && pt[1] == 0 &&
@ -1419,7 +1423,7 @@ LocalMax(void)
if (LocalTide != StkWidth) { if (LocalTide != StkWidth) {
pt = LCL0; pt = LCL0;
while (pt-3 > H) { while (pt-3 > HR) {
if (pt[-1] == 0 && if (pt[-1] == 0 &&
pt[-2] == 0 && pt[-2] == 0 &&
pt[-3] == 0) pt[-3] == 0)
@ -1427,7 +1431,7 @@ LocalMax(void)
else else
--pt; --pt;
} }
if (pt-3 > H) if (pt-3 > HR)
i = Unsigned(LCL0) - Unsigned(pt); i = Unsigned(LCL0) - Unsigned(pt);
else else
/* so that both Local and Global have reached maximum width */ /* so that both Local and Global have reached maximum width */
@ -1477,7 +1481,7 @@ static Int
p_statistics_stacks_info( USES_REGS1 ) p_statistics_stacks_info( USES_REGS1 )
{ {
Term tmax = MkIntegerTerm(Unsigned(LCL0) - Unsigned(H0)); Term tmax = MkIntegerTerm(Unsigned(LCL0) - Unsigned(H0));
Term tgusage = MkIntegerTerm(Unsigned(H) - Unsigned(H0)); Term tgusage = MkIntegerTerm(Unsigned(HR) - Unsigned(H0));
Term tlusage = MkIntegerTerm(Unsigned(LCL0) - Unsigned(ASP)); Term tlusage = MkIntegerTerm(Unsigned(LCL0) - Unsigned(ASP));
return(Yap_unify(tmax, ARG1) && Yap_unify(tgusage,ARG2) && Yap_unify(tlusage,ARG3)); return(Yap_unify(tmax, ARG1) && Yap_unify(tgusage,ARG2) && Yap_unify(tlusage,ARG3));
@ -1666,16 +1670,18 @@ p_access_yap_flags( USES_REGS1 )
tout = TermNil; tout = TermNil;
if (IsMode_LocalTrie(yap_flags[flag])) if (IsMode_LocalTrie(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomLocalTrie), tout); tout = MkPairTerm(MkAtomTerm(AtomLocalTrie), tout);
else // if (IsMode_GlobalTrie(yap_flags[flag])) else if (IsMode_GlobalTrie(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomGlobalTrie), tout); tout = MkPairTerm(MkAtomTerm(AtomGlobalTrie), tout);
if (IsMode_LoadAnswers(yap_flags[flag])) if (IsMode_LoadAnswers(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomLoadAnswers), tout); tout = MkPairTerm(MkAtomTerm(AtomLoadAnswers), tout);
else // if (IsMode_ExecAnswers(yap_flags[flag])) else if (IsMode_ExecAnswers(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomExecAnswers), tout); tout = MkPairTerm(MkAtomTerm(AtomExecAnswers), tout);
if (IsMode_Local(yap_flags[flag])) if (IsMode_Local(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomLocal), tout); tout = MkPairTerm(MkAtomTerm(AtomLocal), tout);
else // if (IsMode_Batched(yap_flags[flag])) else if (IsMode_Batched(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomBatched), tout); tout = MkPairTerm(MkAtomTerm(AtomBatched), tout);
else if (IsMode_CoInductive(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomCoInductive), tout);
#else #else
tout = MkAtomTerm(AtomFalse); tout = MkAtomTerm(AtomFalse);
#endif /* TABLING */ #endif /* TABLING */
@ -1818,6 +1824,13 @@ p_set_yap_flags( USES_REGS1 )
tab_ent = TabEnt_next(tab_ent); tab_ent = TabEnt_next(tab_ent);
} }
SetMode_GlobalTrie(yap_flags[TABLING_MODE_FLAG]); SetMode_GlobalTrie(yap_flags[TABLING_MODE_FLAG]);
} else if (value == 7) { /* CoInductive */
tab_ent_ptr tab_ent = GLOBAL_root_tab_ent;
while(tab_ent) {
SetMode_CoInductive(TabEnt_mode(tab_ent));
tab_ent = TabEnt_next(tab_ent);
}
SetMode_CoInductive(yap_flags[TABLING_MODE_FLAG]);
} }
break; break;
#endif /* TABLING */ #endif /* TABLING */
@ -1840,11 +1853,20 @@ p_set_yap_flags( USES_REGS1 )
static Int static Int
p_system_mode( USES_REGS1 ) p_system_mode( USES_REGS1 )
{ {
Int i = IntegerOfTerm(Deref(ARG1)); Term t1 = Deref(ARG1);
if (i == 0)
LOCAL_PrologMode &= ~SystemMode; if (IsVarTerm(t1)) {
else if (LOCAL_PrologMode & SystemMode)
LOCAL_PrologMode |= SystemMode; return Yap_unify( t1, MkAtomTerm(AtomTrue));
else
return Yap_unify( t1, MkAtomTerm(AtomFalse));
} else {
Atom at = AtomOfTerm(t1);
if (at == AtomFalse)
LOCAL_PrologMode &= ~SystemMode;
else
LOCAL_PrologMode |= SystemMode;
}
return TRUE; return TRUE;
} }
@ -1948,15 +1970,6 @@ Yap_InitBackCPreds(void)
Yap_InitBackIO(); Yap_InitBackIO();
Yap_InitBackDB(); Yap_InitBackDB();
Yap_InitUserBacks(); Yap_InitUserBacks();
#if defined MYDDAS_MYSQL && defined CUT_C
Yap_InitBackMYDDAS_MySQLPreds();
#endif
#if defined MYDDAS_ODBC && defined CUT_C
Yap_InitBackMYDDAS_ODBCPreds();
#endif
#if defined CUT_C && (defined MYDDAS_ODBC || defined MYDDAS_MYSQL)
Yap_InitBackMYDDAS_SharedPreds();
#endif
} }
typedef void (*Proc)(void); typedef void (*Proc)(void);
@ -2002,7 +2015,7 @@ Yap_InitCPreds(void)
Yap_InitCPred("$walltime", 2, p_walltime, SafePredFlag|SyncPredFlag); Yap_InitCPred("$walltime", 2, p_walltime, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$access_yap_flags", 2, p_access_yap_flags, SafePredFlag); Yap_InitCPred("$access_yap_flags", 2, p_access_yap_flags, SafePredFlag);
Yap_InitCPred("$set_yap_flags", 2, p_set_yap_flags, SafePredFlag|SyncPredFlag); Yap_InitCPred("$set_yap_flags", 2, p_set_yap_flags, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$p_system_mode", 1, p_system_mode, SafePredFlag|SyncPredFlag); Yap_InitCPred("$system_mode", 1, p_system_mode, SafePredFlag|SyncPredFlag);
Yap_InitCPred("abort", 0, p_abort, SyncPredFlag); Yap_InitCPred("abort", 0, p_abort, SyncPredFlag);
Yap_InitCPred("$break", 1, p_break, SafePredFlag); Yap_InitCPred("$break", 1, p_break, SafePredFlag);
#ifdef BEAM #ifdef BEAM
@ -2065,18 +2078,6 @@ Yap_InitCPreds(void)
Yap_InitUnify(); Yap_InitUnify();
Yap_InitQLY(); Yap_InitQLY();
Yap_InitQLYR(); Yap_InitQLYR();
#if defined CUT_C && defined MYDDAS_MYSQL
Yap_InitMYDDAS_MySQLPreds();
#endif
#if defined CUT_C && defined MYDDAS_ODBC
Yap_InitMYDDAS_ODBCPreds();
#endif
#if defined CUT_C && (defined MYDDAS_ODBC || defined MYDDAS_MYSQL)
Yap_InitMYDDAS_SharedPreds();
#endif
#if defined MYDDAS_TOP_LEVEL && defined MYDDAS_MYSQL // && defined HAVE_LIBREADLINE
Yap_InitMYDDAS_TopLevelPreds();
#endif
Yap_udi_init(); Yap_udi_init();
Yap_udi_Interval_init(); Yap_udi_Interval_init();
Yap_InitSignalCPreds(); Yap_InitSignalCPreds();

20
C/sysbits.c
View File

@ -186,12 +186,14 @@ Yap_InitSysPath(void) {
int commons_done = FALSE; int commons_done = FALSE;
{ {
char *dir; char *dir;
if ((dir = Yap_RegistryGetString("library"))) { if ((dir = Yap_RegistryGetString("library")) &&
is_directory(dir)) {
Yap_PutValue(AtomSystemLibraryDir, Yap_PutValue(AtomSystemLibraryDir,
MkAtomTerm(Yap_LookupAtom(dir))); MkAtomTerm(Yap_LookupAtom(dir)));
dir_done = TRUE; dir_done = TRUE;
} }
if ((dir = Yap_RegistryGetString("prolog_commons"))) { if ((dir = Yap_RegistryGetString("prolog_commons")) &&
is_directory(dir)) {
Yap_PutValue(AtomPrologCommonsDir, Yap_PutValue(AtomPrologCommonsDir,
MkAtomTerm(Yap_LookupAtom(dir))); MkAtomTerm(Yap_LookupAtom(dir)));
commons_done = TRUE; commons_done = TRUE;
@ -203,12 +205,10 @@ Yap_InitSysPath(void) {
strncpy(LOCAL_FileNameBuf, YAP_SHAREDIR, YAP_FILENAME_MAX); strncpy(LOCAL_FileNameBuf, YAP_SHAREDIR, YAP_FILENAME_MAX);
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
{ {
DWORD fatts;
int buflen; int buflen;
char *pt; char *pt;
if ((fatts = GetFileAttributes(LOCAL_FileNameBuf)) == 0xFFFFFFFFL || if (!is_directory(LOCAL_FileNameBuf)) {
!(fatts & FILE_ATTRIBUTE_DIRECTORY)) {
/* couldn't find it where it was supposed to be, /* couldn't find it where it was supposed to be,
let's try using the executable */ let's try using the executable */
if (!GetModuleFileNameEx( GetCurrentProcess(), NULL, LOCAL_FileNameBuf, YAP_FILENAME_MAX)) { if (!GetModuleFileNameEx( GetCurrentProcess(), NULL, LOCAL_FileNameBuf, YAP_FILENAME_MAX)) {
@ -2549,7 +2549,7 @@ p_alarm( USES_REGS1 )
if (LOCAL_ActiveSignals & YAP_ALARM_SIGNAL) { if (LOCAL_ActiveSignals & YAP_ALARM_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_ALARM_SIGNAL; LOCAL_ActiveSignals &= ~YAP_ALARM_SIGNAL;
if (!LOCAL_ActiveSignals) { if (!LOCAL_ActiveSignals) {
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
} }
} }
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
@ -2732,7 +2732,9 @@ set_fpu_exceptions(int flag)
#if HAVE_FETESTEXCEPT #if HAVE_FETESTEXCEPT
feclearexcept(FE_ALL_EXCEPT); feclearexcept(FE_ALL_EXCEPT);
#endif #endif
#ifndef _WIN32
my_signal (SIGFPE, HandleMatherr); my_signal (SIGFPE, HandleMatherr);
#endif
} else { } else {
/* do IEEE arithmetic in the way the big boys do */ /* do IEEE arithmetic in the way the big boys do */
#if defined(__hpux) #if defined(__hpux)
@ -2747,7 +2749,9 @@ set_fpu_exceptions(int flag)
int v = _FPU_IEEE; int v = _FPU_IEEE;
_FPU_SETCW(v); _FPU_SETCW(v);
#endif #endif
#ifndef _WIN32
my_signal (SIGFPE, SIG_IGN); my_signal (SIGFPE, SIG_IGN);
#endif
} }
} }
@ -2861,6 +2865,8 @@ p_enable_interrupts( USES_REGS1 )
LOCAL_InterruptsDisabled--; LOCAL_InterruptsDisabled--;
if (LOCAL_ActiveSignals && !LOCAL_InterruptsDisabled) { if (LOCAL_ActiveSignals && !LOCAL_InterruptsDisabled) {
CreepFlag = Unsigned(LCL0); CreepFlag = Unsigned(LCL0);
if ( LOCAL_ActiveSignals != YAP_CREEP_SIGNAL )
EventFlag = Unsigned( LCL0 );
} }
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
return TRUE; return TRUE;
@ -2872,7 +2878,7 @@ p_disable_interrupts( USES_REGS1 )
LOCK(LOCAL_SignalLock); LOCK(LOCAL_SignalLock);
LOCAL_InterruptsDisabled++; LOCAL_InterruptsDisabled++;
if (LOCAL_ActiveSignals) { if (LOCAL_ActiveSignals) {
CreepFlag = CalculateStackGap(); CalculateStackGap( PASS_REGS1 );
} }
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
return TRUE; return TRUE;

1452
C/text.c Normal file
View File

File diff suppressed because it is too large Load Diff

71
C/threads.c
View File

@ -127,7 +127,7 @@ store_specs(int new_worker_id, UInt ssize, UInt tsize, UInt sysize, Term *tpgoal
REMOTE_c_output_stream(new_worker_id) = REMOTE_c_output_stream(0); REMOTE_c_output_stream(new_worker_id) = REMOTE_c_output_stream(0);
REMOTE_c_error_stream(new_worker_id) = REMOTE_c_error_stream(0); REMOTE_c_error_stream(new_worker_id) = REMOTE_c_error_stream(0);
} }
pm = (ssize + tsize)*1024; pm = (ssize + tsize)*K1;
if (!(REMOTE_ThreadHandle(new_worker_id).stack_address = malloc(pm))) { if (!(REMOTE_ThreadHandle(new_worker_id).stack_address = malloc(pm))) {
return FALSE; return FALSE;
} }
@ -200,39 +200,6 @@ kill_thread_engine (int wid, int always_die)
free(REMOTE_ThreadHandle(wid).default_yaam_regs); free(REMOTE_ThreadHandle(wid).default_yaam_regs);
REMOTE_ThreadHandle(wid).default_yaam_regs = NULL; REMOTE_ThreadHandle(wid).default_yaam_regs = NULL;
LOCK(GLOBAL_ThreadHandlesLock); LOCK(GLOBAL_ThreadHandlesLock);
#ifdef TABLING
CACHE_REGS
tab_ent_ptr tab_ent;
tab_ent = GLOBAL_root_tab_ent;
while (tab_ent) {
abolish_table(tab_ent);
tab_ent = TabEnt_next(tab_ent);
}
FREE_DEPENDENCY_FRAME(LOCAL_top_dep_fr);
LOCAL_top_dep_fr = NULL;
#ifdef USE_PAGES_MALLOC
DETACH_PAGES(_pages_void);
#endif /* USE_PAGES_MALLOC */
DETACH_PAGES(_pages_tab_ent);
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
DETACH_PAGES(_pages_sg_ent);
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
DETACH_PAGES(_pages_sg_fr);
DETACH_PAGES(_pages_dep_fr);
DETACH_PAGES(_pages_sg_node);
DETACH_PAGES(_pages_sg_hash);
DETACH_PAGES(_pages_ans_node);
DETACH_PAGES(_pages_ans_hash);
#if defined(THREADS_FULL_SHARING)
DETACH_PAGES(_pages_ans_ref_node);
#endif /* THREADS_FULL_SHARING */
DETACH_PAGES(_pages_gt_node);
DETACH_PAGES(_pages_gt_hash);
#ifdef OUTPUT_THREADS_TABLING
fclose(LOCAL_thread_output);
#endif /* OUTPUT_THREADS_TABLING */
#endif /* TABLING */
GLOBAL_NOfThreads--; GLOBAL_NOfThreads--;
if (!always_die) { if (!always_die) {
/* called by thread itself */ /* called by thread itself */
@ -337,6 +304,41 @@ thread_run(void *widp)
tgs[1] = LOCAL_ThreadHandle.tdetach; tgs[1] = LOCAL_ThreadHandle.tdetach;
tgoal = Yap_MkApplTerm(FunctorThreadRun, 2, tgs); tgoal = Yap_MkApplTerm(FunctorThreadRun, 2, tgs);
Yap_RunTopGoal(tgoal); Yap_RunTopGoal(tgoal);
#ifdef TABLING
{
tab_ent_ptr tab_ent;
tab_ent = GLOBAL_root_tab_ent;
while (tab_ent) {
abolish_table(tab_ent);
tab_ent = TabEnt_next(tab_ent);
}
FREE_DEPENDENCY_FRAME(REMOTE_top_dep_fr(worker_id));
REMOTE_top_dep_fr(worker_id) = NULL;
#ifdef USE_PAGES_MALLOC
DETACH_PAGES(_pages_void);
#endif /* USE_PAGES_MALLOC */
DETACH_PAGES(_pages_tab_ent);
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
DETACH_PAGES(_pages_sg_ent);
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
DETACH_PAGES(_pages_sg_fr);
DETACH_PAGES(_pages_dep_fr);
DETACH_PAGES(_pages_sg_node);
DETACH_PAGES(_pages_sg_hash);
DETACH_PAGES(_pages_ans_node);
DETACH_PAGES(_pages_ans_hash);
#if defined(THREADS_FULL_SHARING)
DETACH_PAGES(_pages_ans_ref_node);
#endif /* THREADS_FULL_SHARING */
DETACH_PAGES(_pages_gt_node);
DETACH_PAGES(_pages_gt_hash);
#ifdef OUTPUT_THREADS_TABLING
fclose(LOCAL_thread_output);
#endif /* OUTPUT_THREADS_TABLING */
}
#endif /* TABLING */
thread_die(worker_id, FALSE); thread_die(worker_id, FALSE);
return NULL; return NULL;
} }
@ -915,6 +917,7 @@ p_thread_signal( USES_REGS1 )
} }
LOCK(REMOTE_SignalLock(wid)); LOCK(REMOTE_SignalLock(wid));
REMOTE_ThreadHandle(wid).current_yaam_regs->CreepFlag_ = REMOTE_ThreadHandle(wid).current_yaam_regs->CreepFlag_ =
REMOTE_ThreadHandle(wid).current_yaam_regs->EventFlag_ =
Unsigned(REMOTE_ThreadHandle(wid).current_yaam_regs->LCL0_); Unsigned(REMOTE_ThreadHandle(wid).current_yaam_regs->LCL0_);
REMOTE_ActiveSignals(wid) |= YAP_ITI_SIGNAL; REMOTE_ActiveSignals(wid) |= YAP_ITI_SIGNAL;
UNLOCK(REMOTE_SignalLock(wid)); UNLOCK(REMOTE_SignalLock(wid));

4
C/tracer.c
View File

@ -140,12 +140,11 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
char *mname; char *mname;
Int arity; Int arity;
/* extern int gc_calls; */ /* extern int gc_calls; */
vsc_count++;
// if (!worker_id) return; // if (!worker_id) return;
LOCK(Yap_heap_regs->low_level_trace_lock); LOCK(Yap_heap_regs->low_level_trace_lock);
sc = Yap_heap_regs; sc = Yap_heap_regs;
vsc_count++;
//if (vsc_count == 54) jmp_deb(1); //if (vsc_count == 54) jmp_deb(1);
// fprintf(stderr,"B=%p ", B); // fprintf(stderr,"B=%p ", B);
#ifdef THREADS #ifdef THREADS
@ -159,7 +158,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
gc_ENV = (CELL *) gc_ENV[E_E]; /* link to prev gc_ENV = (CELL *) gc_ENV[E_E]; /* link to prev
* environment */ * environment */
} }
UNLOCK(Yap_heap_regs->low_level_trace_lock);
return; return;
{ {
choiceptr b_p = B; choiceptr b_p = B;

12
C/unify.c
View File

@ -376,6 +376,8 @@ oc_unify_nvar_nvar:
return(pt0[1] == pt1[1]); return(pt0[1] == pt1[1]);
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1))); return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0);
#ifdef USE_GMP #ifdef USE_GMP
case (CELL)FunctorBigInt: case (CELL)FunctorBigInt:
return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0); return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0);
@ -395,7 +397,7 @@ oc_unify_nvar_nvar:
/* d0 is bound and d1 is unbound */ /* d0 is bound and d1 is unbound */
Bind(pt1, d0); Bind(pt1, d0);
/* local variables cannot be in a term */ /* local variables cannot be in a term */
if (pt1 > H && pt1 < LCL0) if (pt1 > HR && pt1 < LCL0)
return TRUE; return TRUE;
if (rational_tree(d0)) if (rational_tree(d0))
return(FALSE); return(FALSE);
@ -408,7 +410,7 @@ oc_unify_var_nvar:
/* pt0 is unbound and d1 is bound */ /* pt0 is unbound and d1 is bound */
Bind(pt0, d1); Bind(pt0, d1);
/* local variables cannot be in a term */ /* local variables cannot be in a term */
if (pt0 > H && pt0 < LCL0) if (pt0 > HR && pt0 < LCL0)
return TRUE; return TRUE;
if (rational_tree(d1)) if (rational_tree(d1))
return(FALSE); return(FALSE);
@ -505,6 +507,8 @@ unify_nvar_nvar:
return(pt0 == pt1); return(pt0 == pt1);
case (CELL)FunctorLongInt: case (CELL)FunctorLongInt:
return(pt0[1] == pt1[1]); return(pt0[1] == pt1[1]);
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0);
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1))); return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
#ifdef USE_GMP #ifdef USE_GMP
@ -583,7 +587,7 @@ InitReverseLookupOpcode(void)
} }
} }
} }
bzero(OP_RTABLE, sz); memset(OP_RTABLE, 0, sz);
opeptr = OP_RTABLE; opeptr = OP_RTABLE;
/* clear up table */ /* clear up table */
{ {
@ -870,6 +874,8 @@ unifiable_nvar_nvar:
return(pt0 == pt1); return(pt0 == pt1);
case (CELL)FunctorLongInt: case (CELL)FunctorLongInt:
return(pt0[1] == pt1[1]); return(pt0[1] == pt1[1]);
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0);
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1))); return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
#ifdef USE_GMP #ifdef USE_GMP

1099
C/utilpreds.c
View File

File diff suppressed because it is too large Load Diff

149
C/write.c
View File

@ -29,6 +29,7 @@ static char SccsId[] = "%W% %G%";
#include "attvar.h" #include "attvar.h"
#endif #endif
#include "pl-shared.h" #include "pl-shared.h"
#include "pl-utf8.h"
#if HAVE_STRING_H #if HAVE_STRING_H
#include <string.h> #include <string.h>
@ -65,11 +66,11 @@ typedef struct rewind_term {
union { union {
struct union_slots s; struct union_slots s;
struct union_direct d; struct union_direct d;
} u; } u_sd;
} rwts; } rwts;
typedef struct write_globs { typedef struct write_globs {
void *stream; IOSTREAM*stream;
int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays; int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
int Keep_terms; int Keep_terms;
int Write_Loops; int Write_Loops;
@ -166,6 +167,7 @@ wrputn(Int n, struct write_globs *wglb) /* writes an integer */
#define wrputs(s, stream) Sfputs(s, stream) #define wrputs(s, stream) Sfputs(s, stream)
static void static void
wrputws(wchar_t *s, wrf stream) /* writes a string */ wrputws(wchar_t *s, wrf stream) /* writes a string */
{ {
@ -204,7 +206,7 @@ ensure_space(size_t sz) {
} }
} }
if (!s) { if (!s) {
s = (char *)H; s = (char *)HR;
if (s+sz >= (char *)ASP) { if (s+sz >= (char *)ASP) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"not enough space to write bignum: it requires %d bytes", sz); Yap_Error(OUT_OF_STACK_ERROR,TermNil,"not enough space to write bignum: it requires %d bytes", sz);
s = NULL; s = NULL;
@ -242,8 +244,14 @@ writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, stru
CELL *pt = RepAppl(t)+1; CELL *pt = RepAppl(t)+1;
CELL big_tag = pt[0]; CELL big_tag = pt[0];
if (big_tag == ARRAY_INT || big_tag == ARRAY_FLOAT) {
wrputc('{', wglb->stream);
wrputs("...", wglb->stream);
wrputc('}', wglb->stream);
lastw = separator;
return;
#ifdef USE_GMP #ifdef USE_GMP
if (big_tag == BIG_INT) } else if (big_tag == BIG_INT)
{ {
MP_INT *big = Yap_BigIntOfTerm(t); MP_INT *big = Yap_BigIntOfTerm(t);
write_mpint(big, wglb); write_mpint(big, wglb);
@ -252,39 +260,7 @@ writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, stru
Term trat = Yap_RatTermToApplTerm(t); Term trat = Yap_RatTermToApplTerm(t);
writeTerm(trat, p, depth, rinfixarg, wglb, rwt); writeTerm(trat, p, depth, rinfixarg, wglb, rwt);
return; return;
}
#endif #endif
if (big_tag == BLOB_STRING) {
if (wglb->Write_strings)
wrputc('`',wglb->stream);
else
wrputc('"',wglb->stream);
wrputs(Yap_BlobStringOfTerm(t),wglb->stream);
if (wglb->Write_strings)
wrputc('`',wglb->stream);
else
wrputc('"',wglb->stream);
return;
} else if (big_tag == BLOB_WIDE_STRING) {
wchar_t *s = Yap_BlobWideStringOfTerm(t);
if (wglb->Write_strings)
wrputc('`',wglb->stream);
else
wrputc('"', wglb->stream);
while (*s) {
wrputc(*s++, wglb->stream);
}
if (wglb->Write_strings)
wrputc('`',wglb->stream);
else
wrputc('"',wglb->stream);
return;
} else if (big_tag == ARRAY_INT || big_tag == ARRAY_FLOAT) {
wrputc('{', wglb->stream);
wrputs("...", wglb->stream);
wrputc('}', wglb->stream);
lastw = separator;
return;
} else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) { } else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) {
Opaque_CallOnWrite f; Opaque_CallOnWrite f;
CELL blob_info; CELL blob_info;
@ -391,6 +367,21 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
protect_close_number(wglb, ob); protect_close_number(wglb, ob);
} }
int
Yap_FormatFloat( Float f, const char *s, size_t sz )
{
struct write_globs wglb;
char *ws = (char *)s;
IOSTREAM *smem = Sopenmem(&ws, &sz, "w");
wglb.stream = smem;
wglb.lw = separator;
wglb.last_atom_minus = FALSE;
wrputf(f, &wglb);
Sclose(smem);
return TRUE;
}
/* writes a data base reference */ /* writes a data base reference */
static void static void
wrputref(CODEADDR ref, int Quote_illegal, struct write_globs *wglb) wrputref(CODEADDR ref, int Quote_illegal, struct write_globs *wglb)
@ -429,6 +420,7 @@ wrputblob(AtomEntry * ref, int Quote_illegal, struct write_globs *wglb)
wrputs(s, stream); wrputs(s, stream);
} }
lastw = alphanum; lastw = alphanum;
return 1;
} }
static int static int
@ -480,7 +472,7 @@ AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
} }
static void static void
write_quoted(int ch, int quote, wrf stream) write_quoted(wchar_t ch, wchar_t quote, wrf stream)
{ {
CACHE_REGS CACHE_REGS
if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) { if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) {
@ -494,8 +486,17 @@ write_quoted(int ch, int quote, wrf stream)
} else { } else {
switch (ch) { switch (ch) {
case '\\': case '\\':
case '\'':
wrputc('\\', stream); wrputc('\\', stream);
wrputc('\\', stream);
break;
case '\'':
if (ch == quote)
wrputc('\\', stream);
wrputc(ch, stream);
break;
case '"':
if (ch == quote)
wrputc('\\', stream);
wrputc(ch, stream); wrputc(ch, stream);
break; break;
case 7: case 7:
@ -542,6 +543,28 @@ write_quoted(int ch, int quote, wrf stream)
} }
} }
static void
write_string(const char *s, struct write_globs *wglb) /* writes an integer */
{
IOSTREAM *stream = wglb->stream;
int chr;
char *ptr = (char *)s;
if (wglb->Write_strings)
wrputc('`', stream);
else
wrputc('"', stream);
do {
ptr = utf8_get_char(ptr, &chr);
if (chr == '\0') break;
write_quoted(chr, '"', stream);
} while (TRUE);
if (wglb->Write_strings)
wrputc('`', stream);
else
wrputc('"', stream);
}
/* writes an atom */ /* writes an atom */
static void static void
@ -552,7 +575,7 @@ putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb)
wrf stream = wglb->stream; wrf stream = wglb->stream;
if (IsBlob(atom)) { if (IsBlob(atom)) {
wrputblob(RepAtom(atom),wglb->Quote_illegal,wglb); wrputblob(RepAtom(atom),Quote_illegal,wglb);
return; return;
} }
if (IsWideAtom(atom)) { if (IsWideAtom(atom)) {
@ -598,8 +621,17 @@ putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb)
} }
} }
void
Yap_WriteAtom(IOSTREAM *s, Atom atom)
{
struct write_globs wglb;
wglb.stream = s;
wglb.Quote_illegal = FALSE;
putAtom(atom, 0, &wglb);
}
static int static int
IsStringTerm(Term string) /* checks whether this is a string */ IsCodesTerm(Term string) /* checks whether this is a string */
{ {
if (IsVarTerm(string)) if (IsVarTerm(string))
return FALSE; return FALSE;
@ -628,7 +660,7 @@ putString(Term string, struct write_globs *wglb)
wrf stream = wglb->stream; wrf stream = wglb->stream;
wrputc('"', stream); wrputc('"', stream);
while (string != TermNil) { while (string != TermNil) {
int ch = IntOfTerm(HeadOfTerm(string)); wchar_t ch = IntOfTerm(HeadOfTerm(string));
write_quoted(ch, '"', stream); write_quoted(ch, '"', stream);
string = TailOfTerm(string); string = TailOfTerm(string);
} }
@ -664,23 +696,23 @@ from_pointer(CELL *ptr0, struct rewind_term *rwt, struct write_globs *wglb)
if (wglb->Keep_terms) { if (wglb->Keep_terms) {
struct rewind_term *x = rwt->parent; struct rewind_term *x = rwt->parent;
rwt->u.s.old = Yap_InitSlot(t PASS_REGS); rwt->u_sd.s.old = Yap_InitSlot(t PASS_REGS);
rwt->u.s.ptr = Yap_InitSlot((CELL)ptr0 PASS_REGS); rwt->u_sd.s.ptr = Yap_InitSlot((CELL)ptr0 PASS_REGS);
if (!IsAtomicTerm(t) && !IsVarTerm(t)) { if (!IsAtomicTerm(t) && !IsVarTerm(t)) {
while (x) { while (x) {
if (Yap_GetDerefedFromSlot(x->u.s.old PASS_REGS) == t) if (Yap_GetDerefedFromSlot(x->u_sd.s.old PASS_REGS) == t)
return TermFoundVar; return TermFoundVar;
x = x->parent; x = x->parent;
} }
} }
} else { } else {
rwt->u.d.old = t; rwt->u_sd.d.old = t;
rwt->u.d.ptr = ptr0; rwt->u_sd.d.ptr = ptr0;
if ( !IsVarTerm(t) && !IsAtomicTerm(t)) { if ( !IsVarTerm(t) && !IsAtomicTerm(t)) {
struct rewind_term *x = rwt->parent; struct rewind_term *x = rwt->parent;
while (x) { while (x) {
if (x->u.d.old == t) if (x->u_sd.d.old == t)
return TermFoundVar; return TermFoundVar;
x = x->parent; x = x->parent;
} }
@ -696,12 +728,12 @@ restore_from_write(struct rewind_term *rwt, struct write_globs *wglb)
CELL *ptr; CELL *ptr;
if (wglb->Keep_terms) { if (wglb->Keep_terms) {
ptr = (CELL*)Yap_GetPtrFromSlot(rwt->u.s.ptr PASS_REGS); ptr = (CELL*)Yap_GetPtrFromSlot(rwt->u_sd.s.ptr PASS_REGS);
Yap_RecoverSlots(2 PASS_REGS); Yap_RecoverSlots(2 PASS_REGS);
} else { } else {
ptr = rwt->u.d.ptr; ptr = rwt->u_sd.d.ptr;
} }
rwt->u.s.ptr = 0; rwt->u_sd.s.ptr = 0;
return ptr; return ptr;
} }
@ -722,7 +754,7 @@ write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt)
exts ext = ExtFromCell(t); exts ext = ExtFromCell(t);
struct rewind_term nrwt; struct rewind_term nrwt;
nrwt.parent = rwt; nrwt.parent = rwt;
nrwt.u.s.ptr = 0; nrwt.u_sd.s.ptr = 0;
wglb->Portray_delays = FALSE; wglb->Portray_delays = FALSE;
if (ext == attvars_ext) { if (ext == attvars_ext) {
@ -756,13 +788,13 @@ check_infinite_loop(Term t, struct rewind_term *x, struct write_globs *wglb)
CACHE_REGS CACHE_REGS
if (wglb->Keep_terms) { if (wglb->Keep_terms) {
while (x) { while (x) {
if (Yap_GetFromSlot(x->u.s.old PASS_REGS) == t) if (Yap_GetFromSlot(x->u_sd.s.old PASS_REGS) == t)
return TermFoundVar; return TermFoundVar;
x = x->parent; x = x->parent;
} }
} else { } else {
while (x) { while (x) {
if (x->u.d.old == t) if (x->u_sd.d.old == t)
return TermFoundVar; return TermFoundVar;
x = x->parent; x = x->parent;
} }
@ -776,7 +808,7 @@ write_list(Term t, int direction, int depth, struct write_globs *wglb, struct re
Term ti; Term ti;
struct rewind_term nrwt; struct rewind_term nrwt;
nrwt.parent = rwt; nrwt.parent = rwt;
nrwt.u.s.ptr = 0; nrwt.u_sd.s.ptr = 0;
while (1) { while (1) {
int ndirection; int ndirection;
@ -845,7 +877,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
CACHE_REGS CACHE_REGS
struct rewind_term nrwt; struct rewind_term nrwt;
nrwt.parent = rwt; nrwt.parent = rwt;
nrwt.u.s.ptr = 0; nrwt.u_sd.s.ptr = 0;
if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) { if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
putAtom(Atom3Dots, wglb->Quote_illegal, wglb); putAtom(Atom3Dots, wglb->Quote_illegal, wglb);
@ -888,7 +920,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (Yap_GetValue(AtomPortray) == MkAtomTerm(AtomTrue)) if (Yap_GetValue(AtomPortray) == MkAtomTerm(AtomTrue))
return; return;
} }
if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsStringTerm(t)) { if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsCodesTerm(t)) {
putString(t, wglb); putString(t, wglb);
} else { } else {
wrputc('[', wglb->stream); wrputc('[', wglb->stream);
@ -909,6 +941,9 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
wrputf(FloatOfTerm(t),wglb); wrputf(FloatOfTerm(t),wglb);
return; return;
case (CELL)FunctorString:
write_string(StringOfTerm(t),wglb);
return;
case (CELL)FunctorAttVar: case (CELL)FunctorAttVar:
write_var(RepAppl(t)+1, wglb, &nrwt); write_var(RepAppl(t)+1, wglb, &nrwt);
return; return;
@ -1099,7 +1134,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (lastw == alphanum) { if (lastw == alphanum) {
wrputc(' ', wglb->stream); wrputc(' ', wglb->stream);
} }
if (!IsVarTerm(ti) && (IsIntTerm(ti) || IsStringTerm(ti) || IsAtomTerm(ti))) { if (!IsVarTerm(ti) && (IsIntTerm(ti) || IsCodesTerm(ti) || IsAtomTerm(ti))) {
if (IsIntTerm(ti)) { if (IsIntTerm(ti)) {
Int k = IntOfTerm(ti); Int k = IntOfTerm(ti);
if (k == -1) { if (k == -1) {

57
C/yap-args.c
View File

@ -144,7 +144,7 @@ dump_runtime_variables(void)
fprintf(stdout,"YAP_ROOTDIR=\"%s\"\n",YAP_ROOTDIR); fprintf(stdout,"YAP_ROOTDIR=\"%s\"\n",YAP_ROOTDIR);
fprintf(stdout,"YAP_LIBS=\"%s\"\n",C_LIBS); fprintf(stdout,"YAP_LIBS=\"%s\"\n",C_LIBS);
fprintf(stdout,"YAP_SHLIB_SUFFIX=\"%s\"\n",SO_EXT); fprintf(stdout,"YAP_SHLIB_SUFFIX=\"%s\"\n",SO_EXT);
fprintf(stdout,"YAP_VERSION=%d\n",YAP_VERSION); fprintf(stdout,"YAP_VERSION=%d\n",YAP_NUMERIC_VERSION);
exit(0); exit(0);
return 1; return 1;
} }
@ -165,9 +165,6 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
int BootMode = YAP_FULL_BOOT_FROM_PROLOG; int BootMode = YAP_FULL_BOOT_FROM_PROLOG;
#else #else
int BootMode = YAP_BOOT_FROM_SAVED_CODE; int BootMode = YAP_BOOT_FROM_SAVED_CODE;
#endif
#ifdef MYDDAS_MYSQL
char *myddas_temp;
#endif #endif
unsigned long int *ssize; unsigned long int *ssize;
@ -199,13 +196,6 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
iap->Argc = argc; iap->Argc = argc;
iap->Argv = argv; iap->Argv = argv;
iap->def_c = 0; iap->def_c = 0;
#ifdef MYDDAS_MYSQL
iap->myddas = 0;
iap->myddas_user = NULL;
iap->myddas_pass = NULL;
iap->myddas_db = NULL;
iap->myddas_host = NULL;
#endif
iap->ErrorNo = 0; iap->ErrorNo = 0;
iap->ErrorCause = NULL; iap->ErrorCause = NULL;
iap->QuietMode = FALSE; iap->QuietMode = FALSE;
@ -259,36 +249,6 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
break; break;
} }
break; break;
#ifdef MYDDAS_MYSQL
case 'm':
if (strncmp(p,"myddas_",7) == 0)
{
iap->myddas = 1;
if ((*argv)[0] == '\0')
myddas_temp = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr," [ YAP unrecoverable error: missing file name with option 'l' ]\n");
exit(EXIT_FAILURE);
}
argv++;
myddas_temp = *argv;
}
if (strstr(p,"user") != NULL)
iap->myddas_user = myddas_temp;
else if (strstr(p,"pass") != NULL)
iap->myddas_pass = myddas_temp;
else if (strstr(p,"db") != NULL)
iap->myddas_db = myddas_temp;
else if (strstr(p,"host") != NULL)
iap->myddas_host = myddas_temp;
else
goto myddas_error_print;
break;
}
#endif
// execution mode // execution mode
case 'J': case 'J':
switch (p[1]) { switch (p[1]) {
@ -498,7 +458,7 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
iap->PrologShouldHandleInterrupts = FALSE; iap->PrologShouldHandleInterrupts = FALSE;
break; break;
} }
goto myddas_error_print; break;
case 'p': case 'p':
if ((*argv)[0] == '\0') if ((*argv)[0] == '\0')
iap->YapPrologAddPath = *argv; iap->YapPrologAddPath = *argv;
@ -540,11 +500,7 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
break; break;
default: default:
{ {
myddas_error_print :
fprintf(stderr,"[ YAP unrecoverable error: unknown switch -%c ]\n", *p); fprintf(stderr,"[ YAP unrecoverable error: unknown switch -%c ]\n", *p);
#ifdef MYDDAS_MYSQL
myddas_error :
#endif
print_usage(); print_usage();
exit(EXIT_FAILURE); exit(EXIT_FAILURE);
} }
@ -553,15 +509,6 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
iap->SavedState = p; iap->SavedState = p;
} }
} }
#ifdef MYDDAS_MYSQL
/* Check MYDDAS Arguments */
if (iap->myddas_user != NULL || iap->myddas_pass != NULL
|| iap->myddas_db != NULL || iap->myddas_host != NULL)
if (iap->myddas_user == NULL || iap->myddas_db == NULL){
fprintf(stderr,"[ YAP unrecoverable error: Missing Mandatory Arguments for MYDDAS ]\n");
goto myddas_error;
}
#endif
GD->cmdline.appl_argc = argc; GD->cmdline.appl_argc = argc;
GD->cmdline.appl_argv = argv; GD->cmdline.appl_argv = argv;
return BootMode; return BootMode;

91
H/Regs.h
View File

@ -16,15 +16,9 @@
/********* abstract machine registers **********************************/ /********* abstract machine registers **********************************/
#ifdef YAP_H #ifdef YAP_H
#ifdef CUT_C
#include "cut_c.h" #include "cut_c.h"
#endif #endif
#if defined MYDDAS_ODBC || defined MYDDAS_MYSQL
#include "myddas.h"
#endif
#endif
#define MaxTemps 512 #define MaxTemps 512
#define MaxArithms 32 #define MaxArithms 32
@ -92,6 +86,7 @@ INLINE_ONLY inline EXTERN void save_B(void);
typedef struct regstore_t typedef struct regstore_t
{ {
CELL EventFlag_; /* 13 */
CELL CreepFlag_; /* 13 */ CELL CreepFlag_; /* 13 */
CELL *HB_; /* 4 heap (global) stack top at latest c.p. */ CELL *HB_; /* 4 heap (global) stack top at latest c.p. */
#if defined(YAPOR_SBA) || defined(TABLING) #if defined(YAPOR_SBA) || defined(TABLING)
@ -106,10 +101,8 @@ typedef struct regstore_t
#endif /* DEPTH_LIMIT */ #endif /* DEPTH_LIMIT */
yamop *CP_; /* 28 continuation program counter */ yamop *CP_; /* 28 continuation program counter */
CELL *ENV_; /* 1 current environment */ CELL *ENV_; /* 1 current environment */
#ifdef CUT_C
struct cut_c_str *CUT_C_TOP; struct cut_c_str *CUT_C_TOP;
#endif #if defined MYDDAS_ODBC || defined MYDDAS_MYSQL
#if defined CUT_C && (defined MYDDAS_ODBC || defined MYDDAS_MYSQL)
struct myddas_global *MYDDAS_GLOBAL_POINTER; struct myddas_global *MYDDAS_GLOBAL_POINTER;
#endif #endif
yamop *P_; /* 7 prolog machine program counter */ yamop *P_; /* 7 prolog machine program counter */
@ -230,7 +223,7 @@ extern REGSTORE Yap_REGS;
#define P Yap_REGS.P_ /* prolog machine program counter */ #define P Yap_REGS.P_ /* prolog machine program counter */
#define YENV Yap_REGS.YENV_ /* current environment (may differ from ENV) */ #define YENV Yap_REGS.YENV_ /* current environment (may differ from ENV) */
register CELL *H asm ("$9"); register CELL *HR asm ("$9");
register CELL *HB asm ("$10"); register CELL *HB asm ("$10");
register choiceptr B asm ("$11"); register choiceptr B asm ("$11");
register yamop *CP asm ("$12"); register yamop *CP asm ("$12");
@ -246,7 +239,7 @@ register CELL CreepFlag asm ("$15");
/* Interface with foreign code, make sure the foreign code sees all the /* Interface with foreign code, make sure the foreign code sees all the
registers the way they used to be */ registers the way they used to be */
INLINE_ONLY EXTERN inline void save_machine_regs(void) { INLINE_ONLY EXTERN inline void save_machine_regs(void) {
Yap_REGS.H_ = H; Yap_REGS.H_ = HR;
Yap_REGS.HB_ = HB; Yap_REGS.HB_ = HB;
Yap_REGS.B_ = B; Yap_REGS.B_ = B;
Yap_REGS.CP_ = CP; Yap_REGS.CP_ = CP;
@ -257,7 +250,7 @@ INLINE_ONLY EXTERN inline void save_machine_regs(void) {
} }
INLINE_ONLY EXTERN inline void restore_machine_regs(void) { INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
H = Yap_REGS.H_; HR = Yap_REGS.H_;
HB = Yap_REGS.HB_; HB = Yap_REGS.HB_;
B = Yap_REGS.B_; B = Yap_REGS.B_;
CP = Yap_REGS.CP_; CP = Yap_REGS.CP_;
@ -286,16 +279,16 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
TR = BK_TR TR = BK_TR
INLINE_ONLY EXTERN inline void save_H(void) { INLINE_ONLY EXTERN inline void save_H(void) {
Yap_REGS.H_ = H; Yap_REGS.H_ = HR;
} }
INLINE_ONLY EXTERN inline void restore_H(void) { INLINE_ONLY EXTERN inline void restore_H(void) {
H = Yap_REGS.H_; HR = Yap_REGS.H_;
} }
#define BACKUP_H() CELL *BK_H = H; restore_H() #define BACKUP_H() CELL *BK_H = HR; restore_H()
#define RECOVER_H() save_H(); H = BK_H #define RECOVER_H() save_H(); HR = BK_H
INLINE_ONLY EXTERN inline void save_B(void) { INLINE_ONLY EXTERN inline void save_B(void) {
Yap_REGS.B_ = B; Yap_REGS.B_ = B;
@ -324,7 +317,7 @@ INLINE_ONLY EXTERN inline void restore_TR(void) {
#define P Yap_REGS.P_ /* prolog machine program counter */ #define P Yap_REGS.P_ /* prolog machine program counter */
#define YENV Yap_REGS.YENV_ /* current environment (may differ from ENV) */ #define YENV Yap_REGS.YENV_ /* current environment (may differ from ENV) */
register CELL *H asm ("$16"); register CELL *HR asm ("$16");
register CELL *HB asm ("$17"); register CELL *HB asm ("$17");
register choiceptr B asm ("$18"); register choiceptr B asm ("$18");
register yamop *CP asm ("$19"); register yamop *CP asm ("$19");
@ -333,7 +326,7 @@ register CELL CreepFlag asm ("$21");
register tr_fr_ptr TR asm ("$22"); register tr_fr_ptr TR asm ("$22");
INLINE_ONLY EXTERN inline void save_machine_regs(void) { INLINE_ONLY EXTERN inline void save_machine_regs(void) {
Yap_REGS.H_ = H; Yap_REGS.H_ = HR;
Yap_REGS.HB_ = HB; Yap_REGS.HB_ = HB;
Yap_REGS.B_ = B; Yap_REGS.B_ = B;
Yap_REGS.CP_ = CP; Yap_REGS.CP_ = CP;
@ -342,7 +335,7 @@ INLINE_ONLY EXTERN inline void save_machine_regs(void) {
} }
INLINE_ONLY EXTERN inline void restore_machine_regs(void) { INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
H = Yap_REGS.H_; HR = Yap_REGS.H_;
HB = Yap_REGS.HB_; HB = Yap_REGS.HB_;
B = Yap_REGS.B_; B = Yap_REGS.B_;
CP = Yap_REGS.CP_; CP = Yap_REGS.CP_;
@ -351,7 +344,7 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
} }
#define BACKUP_MACHINE_REGS() \ #define BACKUP_MACHINE_REGS() \
CELL *BK_H = H; \ CELL *BK_H = HR; \
CELL *BK_HB = HB; \ CELL *BK_HB = HB; \
choiceptr BK_B = B; \ choiceptr BK_B = B; \
CELL BK_CreepFlag = CreepFlag; \ CELL BK_CreepFlag = CreepFlag; \
@ -361,7 +354,7 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
#define RECOVER_MACHINE_REGS() \ #define RECOVER_MACHINE_REGS() \
save_machine_regs(); \ save_machine_regs(); \
H = BK_H; \ HR = BK_H; \
HB = BK_HB; \ HB = BK_HB; \
B = BK_B; \ B = BK_B; \
CreepFlag = BK_CreepFlag; \ CreepFlag = BK_CreepFlag; \
@ -369,16 +362,16 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
TR = BK_TR TR = BK_TR
INLINE_ONLY EXTERN inline void save_H(void) { INLINE_ONLY EXTERN inline void save_H(void) {
Yap_REGS.H_ = H; Yap_REGS.H_ = HR;
} }
INLINE_ONLY EXTERN inline void restore_H(void) { INLINE_ONLY EXTERN inline void restore_H(void) {
H = Yap_REGS.H_; HR = Yap_REGS.H_;
} }
#define BACKUP_H() CELL *BK_H = H; restore_H() #define BACKUP_H() CELL *BK_H = HR; restore_H()
#define RECOVER_H() save_H(); H = BK_H #define RECOVER_H() save_H(); HR = BK_H
INLINE_ONLY EXTERN inline void save_B(void) { INLINE_ONLY EXTERN inline void save_B(void) {
Yap_REGS.B_ = B; Yap_REGS.B_ = B;
@ -398,7 +391,7 @@ INLINE_ONLY EXTERN inline void restore_B(void) {
#define P Yap_REGS.P_ /* prolog machine program counter */ #define P Yap_REGS.P_ /* prolog machine program counter */
#define YENV Yap_REGS.YENV_ /* current environment (may differ from ENV) */ #define YENV Yap_REGS.YENV_ /* current environment (may differ from ENV) */
register CELL *H asm ("r12"); register CELL *HR asm ("r12");
register CELL *HB asm ("r13"); register CELL *HB asm ("r13");
register choiceptr B asm ("r14"); register choiceptr B asm ("r14");
register yamop *CP asm ("r15"); register yamop *CP asm ("r15");
@ -407,7 +400,7 @@ register CELL CreepFlag asm ("r17");
register tr_fr_ptr TR asm ("r18"); register tr_fr_ptr TR asm ("r18");
INLINE_ONLY EXTERN inline void save_machine_regs(void) { INLINE_ONLY EXTERN inline void save_machine_regs(void) {
Yap_REGS.H_ = H; Yap_REGS.H_ = HR;
Yap_REGS.HB_ = HB; Yap_REGS.HB_ = HB;
Yap_REGS.B_ = B; Yap_REGS.B_ = B;
Yap_REGS.CP_ = CP; Yap_REGS.CP_ = CP;
@ -416,7 +409,7 @@ INLINE_ONLY EXTERN inline void save_machine_regs(void) {
} }
INLINE_ONLY EXTERN inline void restore_machine_regs(void) { INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
H = Yap_REGS.H_; HR = Yap_REGS.H_;
HB = Yap_REGS.HB_; HB = Yap_REGS.HB_;
B = Yap_REGS.B_; B = Yap_REGS.B_;
CP = Yap_REGS.CP_; CP = Yap_REGS.CP_;
@ -425,7 +418,7 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
} }
#define BACKUP_MACHINE_REGS() \ #define BACKUP_MACHINE_REGS() \
CELL *BK_H = H; \ CELL *BK_H = HR; \
CELL *BK_HB = HB; \ CELL *BK_HB = HB; \
choiceptr BK_B = B; \ choiceptr BK_B = B; \
CELL BK_CreepFlag = CreepFlag; \ CELL BK_CreepFlag = CreepFlag; \
@ -435,7 +428,7 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
#define RECOVER_MACHINE_REGS() \ #define RECOVER_MACHINE_REGS() \
save_machine_regs(); \ save_machine_regs(); \
H = BK_H; \ HR = BK_H; \
HB = BK_HB; \ HB = BK_HB; \
B = BK_B; \ B = BK_B; \
CreepFlag = BK_CreepFlag; \ CreepFlag = BK_CreepFlag; \
@ -443,16 +436,16 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
TR = BK_TR TR = BK_TR
INLINE_ONLY EXTERN inline void save_H(void) { INLINE_ONLY EXTERN inline void save_H(void) {
Yap_REGS.H_ = H; Yap_REGS.H_ = HR;
} }
INLINE_ONLY EXTERN inline void restore_H(void) { INLINE_ONLY EXTERN inline void restore_H(void) {
H = Yap_REGS.H_; HR = Yap_REGS.H_;
} }
#define BACKUP_H() CELL *BK_H = H; restore_H() #define BACKUP_H() CELL *BK_H = HR; restore_H()
#define RECOVER_H() save_H(); H = BK_H #define RECOVER_H() save_H(); HR = BK_H
INLINE_ONLY EXTERN inline void save_B(void) { INLINE_ONLY EXTERN inline void save_B(void) {
Yap_REGS.B_ = B; Yap_REGS.B_ = B;
@ -500,7 +493,7 @@ register tr_fr_ptr TR asm ("r13");
#else #else
register tr_fr_ptr TR asm ("r21"); register tr_fr_ptr TR asm ("r21");
#endif #endif
register CELL *H asm ("r14"); register CELL *HR asm ("r14");
register CELL *HB asm ("r15"); register CELL *HB asm ("r15");
register choiceptr B asm ("r16"); register choiceptr B asm ("r16");
register yamop *CP asm ("r17"); register yamop *CP asm ("r17");
@ -519,7 +512,7 @@ register CELL *YENV asm ("r19");
INLINE_ONLY EXTERN inline void save_machine_regs(void) { INLINE_ONLY EXTERN inline void save_machine_regs(void) {
Yap_REGS.H_ = H; Yap_REGS.H_ = HR;
Yap_REGS.HB_ = HB; Yap_REGS.HB_ = HB;
Yap_REGS.B_ = B; Yap_REGS.B_ = B;
Yap_REGS.CP_ = CP; Yap_REGS.CP_ = CP;
@ -528,7 +521,7 @@ INLINE_ONLY EXTERN inline void save_machine_regs(void) {
} }
INLINE_ONLY EXTERN inline void restore_machine_regs(void) { INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
H = Yap_REGS.H_; HR = Yap_REGS.H_;
HB = Yap_REGS.HB_; HB = Yap_REGS.HB_;
B = Yap_REGS.B_; B = Yap_REGS.B_;
CP = Yap_REGS.CP_; CP = Yap_REGS.CP_;
@ -537,7 +530,7 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
} }
#define BACKUP_MACHINE_REGS() \ #define BACKUP_MACHINE_REGS() \
CELL *BK_H = H; \ CELL *BK_H = HR; \
CELL *BK_HB = HB; \ CELL *BK_HB = HB; \
choiceptr BK_B = B; \ choiceptr BK_B = B; \
yamop *BK_CP = CP; \ yamop *BK_CP = CP; \
@ -546,23 +539,23 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
#define RECOVER_MACHINE_REGS() \ #define RECOVER_MACHINE_REGS() \
save_machine_regs(); \ save_machine_regs(); \
H = BK_H; \ HR = BK_H; \
HB = BK_HB; \ HB = BK_HB; \
B = BK_B; \ B = BK_B; \
CP = BK_CP; \ CP = BK_CP; \
TR = BK_TR TR = BK_TR
INLINE_ONLY EXTERN inline void save_H(void) { INLINE_ONLY EXTERN inline void save_H(void) {
Yap_REGS.H_ = H; Yap_REGS.H_ = HR;
} }
INLINE_ONLY EXTERN inline void restore_H(void) { INLINE_ONLY EXTERN inline void restore_H(void) {
H = Yap_REGS.H_; HR = Yap_REGS.H_;
} }
#define BACKUP_H() CELL *BK_H = H; restore_H() #define BACKUP_H() CELL *BK_H = HR; restore_H()
#define RECOVER_H() save_H(); H = BK_H #define RECOVER_H() save_H(); HR = BK_H
INLINE_ONLY EXTERN inline void save_B(void) { INLINE_ONLY EXTERN inline void save_B(void) {
Yap_REGS.B_ = B; Yap_REGS.B_ = B;
@ -593,7 +586,7 @@ INLINE_ONLY EXTERN inline void restore_TR(void) {
#define P Yap_REGS.P_ /* prolog machine program counter */ #define P Yap_REGS.P_ /* prolog machine program counter */
#define YENV Yap_REGS.YENV_ /* current environment (may differ from ENV) */ #define YENV Yap_REGS.YENV_ /* current environment (may differ from ENV) */
#define S Yap_REGS.S_ /* structure pointer */ #define S Yap_REGS.S_ /* structure pointer */
#define H Yap_REGS.H_ /* top of heap (global) stack */ #define HR Yap_REGS.H_ /* top of heap (global) stack */
#define B Yap_REGS.B_ /* latest choice point */ #define B Yap_REGS.B_ /* latest choice point */
#define TR Yap_REGS.TR_ /* top of trail */ #define TR Yap_REGS.TR_ /* top of trail */
#define HB Yap_REGS.HB_ /* heap (global) stack top at time of latest c.p. */ #define HB Yap_REGS.HB_ /* heap (global) stack top at time of latest c.p. */
@ -666,6 +659,7 @@ INLINE_ONLY EXTERN inline void restore_B(void) {
#define Yap_isint Yap_REGS.isint_ #define Yap_isint Yap_REGS.isint_
#define Yap_Floats Yap_REGS.Floats_ #define Yap_Floats Yap_REGS.Floats_
#define Yap_Ints Yap_REGS.Ints_ #define Yap_Ints Yap_REGS.Ints_
#define EventFlag Yap_REGS.EventFlag_
#define REG_SIZE sizeof(REGS)/sizeof(CELL *) #define REG_SIZE sizeof(REGS)/sizeof(CELL *)
@ -713,9 +707,8 @@ extern REGSTORE Yap_standard_regs;
/******************* controlling debugging ****************************/ /******************* controlling debugging ****************************/
static inline UInt static inline UInt
CalculateStackGap(void) StackGap( USES_REGS1 )
{ {
CACHE_REGS
UInt gmin = (LCL0-H0)>>2; UInt gmin = (LCL0-H0)>>2;
if (gmin < MinStackGap) gmin = MinStackGap; if (gmin < MinStackGap) gmin = MinStackGap;
@ -723,3 +716,9 @@ CalculateStackGap(void)
return gmin; return gmin;
} }
static inline void
CalculateStackGap( USES_REGS1 )
{
CreepFlag = EventFlag = StackGap( PASS_REGS1 );
}

1
H/ScannerTypes.h
View File

@ -7,6 +7,7 @@ typedef enum TokenKinds {
Ponctuation_tok, Ponctuation_tok,
Error_tok, Error_tok,
QuasiQuotes_tok, QuasiQuotes_tok,
WQuasiQuotes_tok,
eot_tok eot_tok
} tkinds; } tkinds;

174
H/TermExt.h
View File

@ -45,18 +45,20 @@ typedef enum
{ {
db_ref_e = sizeof (Functor *), db_ref_e = sizeof (Functor *),
attvar_e = 2*sizeof (Functor *), attvar_e = 2*sizeof (Functor *),
long_int_e = 3 * sizeof (Functor *), double_e = 3 * sizeof (Functor *),
big_int_e = 4 * sizeof (Functor *), long_int_e = 4 * sizeof (Functor *),
double_e = 5 * sizeof (Functor *) big_int_e = 5 * sizeof (Functor *),
string_e = 6 * sizeof (Functor *)
} }
blob_type; blob_type;
#define FunctorDBRef ((Functor)(db_ref_e)) #define FunctorDBRef ((Functor)(db_ref_e))
#define FunctorAttVar ((Functor)(attvar_e)) #define FunctorAttVar ((Functor)(attvar_e))
#define FunctorDouble ((Functor)(double_e))
#define FunctorLongInt ((Functor)(long_int_e)) #define FunctorLongInt ((Functor)(long_int_e))
#define FunctorBigInt ((Functor)(big_int_e)) #define FunctorBigInt ((Functor)(big_int_e))
#define FunctorDouble ((Functor)(double_e)) #define FunctorString ((Functor)(string_e))
#define EndSpecials (double_e+sizeof(Functor *)) #define EndSpecials (string_e+sizeof(Functor *))
#include "inline-only.h" #include "inline-only.h"
@ -69,7 +71,7 @@ __IsAttVar (CELL *pt USES_REGS)
{ {
#ifdef YAP_H #ifdef YAP_H
return (pt)[-1] == (CELL)attvar_e return (pt)[-1] == (CELL)attvar_e
&& pt < H; && pt < HR;
#else #else
return (pt)[-1] == (CELL)attvar_e; return (pt)[-1] == (CELL)attvar_e;
#endif #endif
@ -92,8 +94,6 @@ typedef enum
ARRAY_INT = 0x21, ARRAY_INT = 0x21,
ARRAY_FLOAT = 0x22, ARRAY_FLOAT = 0x22,
CLAUSE_LIST = 0x40, CLAUSE_LIST = 0x40,
BLOB_STRING = 0x80, /* SWI style strings */
BLOB_WIDE_STRING = 0x81, /* SWI style strings */
EXTERNAL_BLOB = 0x100, /* generic data */ EXTERNAL_BLOB = 0x100, /* generic data */
USER_BLOB_START = 0x1000, /* user defined blob */ USER_BLOB_START = 0x1000, /* user defined blob */
USER_BLOB_END = 0x1100 /* end of user defined blob */ USER_BLOB_END = 0x1100 /* end of user defined blob */
@ -181,23 +181,23 @@ special_functors;
INLINE_ONLY inline EXTERN Float CpFloatUnaligned(CELL *ptr); INLINE_ONLY inline EXTERN Float CpFloatUnaligned(CELL *ptr);
#if SIZEOF_DOUBLE == SIZEOF_LONG_INT
#define MkFloatTerm(fl) __MkFloatTerm((fl) PASS_REGS) #define MkFloatTerm(fl) __MkFloatTerm((fl) PASS_REGS)
INLINE_ONLY inline EXTERN Term __MkFloatTerm (Float USES_REGS); INLINE_ONLY inline EXTERN Term __MkFloatTerm (Float USES_REGS);
INLINE_ONLY inline EXTERN Float FloatOfTerm (Term t);
#if SIZEOF_DOUBLE == SIZEOF_INT_P
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term
__MkFloatTerm (Float dbl USES_REGS) __MkFloatTerm (Float dbl USES_REGS)
{ {
return (Term) ((H[0] = (CELL) FunctorDouble, *(Float *) (H + 1) = return (Term) ((HR[0] = (CELL) FunctorDouble, *(Float *) (HR + 1) =
dbl, H[2] = EndSpecials, H += dbl, HR[2] = EndSpecials, HR +=
3, AbsAppl (H - 3))); 3, AbsAppl (HR - 3)));
} }
INLINE_ONLY inline EXTERN Float FloatOfTerm (Term t);
INLINE_ONLY inline EXTERN Float INLINE_ONLY inline EXTERN Float
FloatOfTerm (Term t) FloatOfTerm (Term t)
{ {
@ -216,7 +216,7 @@ CpFloatUnaligned(CELL *ptr)
#else #else
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
#define DOUBLE_ALIGNED(ADDR) ((CELL)(ADDR) & 0x4) #define DOUBLE_ALIGNED(ADDR) ((CELL)(ADDR) & 0x4)
@ -228,9 +228,9 @@ AlignGlobalForDouble( USES_REGS1 )
{ {
/* Force Alignment for floats. Note that garbage collector may /* Force Alignment for floats. Note that garbage collector may
break the alignment; */ break the alignment; */
if (!DOUBLE_ALIGNED(H)) { if (!DOUBLE_ALIGNED(HR)) {
RESET_VARIABLE(H); RESET_VARIABLE(HR);
H++; HR++;
} }
} }
@ -258,21 +258,16 @@ CpFloatUnaligned (CELL * ptr)
#endif #endif
INLINE_ONLY inline EXTERN Term MkFloatTerm (Float);
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term
MkFloatTerm (Float dbl) __MkFloatTerm (Float dbl USES_REGS)
{ {
CACHE_REGS return (Term) ((AlignGlobalForDouble ( PASS_REGS1 ), HR[0] =
return (Term) ((AlignGlobalForDouble ( PASS_REGS1 ), H[0] = (CELL) FunctorDouble, *(Float *) (HR + 1) = dbl, HR[3] =
(CELL) FunctorDouble, *(Float *) (H + 1) = dbl, H[3] = EndSpecials, HR +=
EndSpecials, H += 4, AbsAppl (HR - 4)));
4, AbsAppl (H - 4)));
} }
INLINE_ONLY inline EXTERN Float FloatOfTerm (Term t);
INLINE_ONLY inline EXTERN Float INLINE_ONLY inline EXTERN Float
FloatOfTerm (Term t) FloatOfTerm (Term t)
{ {
@ -295,13 +290,6 @@ OOPS
#include <stddef.h> #include <stddef.h>
#endif #endif
Term Yap_MkBlobStringTerm(const char *, size_t len);
Term Yap_MkBlobWideStringTerm(const wchar_t *, size_t len);
char *Yap_BlobStringOfTerm(Term);
wchar_t *Yap_BlobWideStringOfTerm(Term);
char *Yap_BlobStringOfTermAndLength(Term, size_t *);
INLINE_ONLY inline EXTERN int IsFloatTerm (Term); INLINE_ONLY inline EXTERN int IsFloatTerm (Term);
@ -312,8 +300,6 @@ IsFloatTerm (Term t)
} }
/* extern Functor FunctorLongInt; */ /* extern Functor FunctorLongInt; */
#define MkLongIntTerm(i) __MkLongIntTerm((i) PASS_REGS) #define MkLongIntTerm(i) __MkLongIntTerm((i) PASS_REGS)
@ -323,11 +309,11 @@ INLINE_ONLY inline EXTERN Term __MkLongIntTerm (Int USES_REGS);
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term
__MkLongIntTerm (Int i USES_REGS) __MkLongIntTerm (Int i USES_REGS)
{ {
H[0] = (CELL) FunctorLongInt; HR[0] = (CELL) FunctorLongInt;
H[1] = (CELL) (i); HR[1] = (CELL) (i);
H[2] = EndSpecials; HR[2] = EndSpecials;
H += 3; HR += 3;
return AbsAppl(H - 3); return AbsAppl(HR - 3);
} }
@ -350,6 +336,53 @@ IsLongIntTerm (Term t)
} }
/****************************************************/
/*********** strings, coded as UTF-8 ****************/
#include <string.h>
/* extern Functor FunctorString; */
#define MkStringTerm(i) __MkStringTerm((i) PASS_REGS)
INLINE_ONLY inline EXTERN Term __MkStringTerm (const char *s USES_REGS);
INLINE_ONLY inline EXTERN Term
__MkStringTerm (const char *s USES_REGS)
{
Term t = AbsAppl(HR);
size_t sz = ALIGN_YAPTYPE(strlen(s)+1,CELL);
HR[0] = (CELL) FunctorString;
HR[1] = (CELL) sz;
strcpy((char *)(HR+2), s);
HR[2+sz] = EndSpecials;
HR += 3+sz;
return t;
}
INLINE_ONLY inline EXTERN const char *StringOfTerm (Term t);
INLINE_ONLY inline EXTERN const char *
StringOfTerm (Term t)
{
return (const char *) (RepAppl (t)+2);
}
INLINE_ONLY inline EXTERN int IsStringTerm (Term);
INLINE_ONLY inline EXTERN int
IsStringTerm (Term t)
{
return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorString);
}
/****************************************************/
#ifdef USE_GMP #ifdef USE_GMP
@ -438,30 +471,6 @@ IsLargeIntTerm (Term t)
#endif #endif
typedef struct string_struct {
UInt len;
} blob_string_t;
INLINE_ONLY inline EXTERN int IsBlobStringTerm (Term);
INLINE_ONLY inline EXTERN int
IsBlobStringTerm (Term t)
{
return (int) (IsApplTerm (t) &&
FunctorOfTerm (t) == FunctorBigInt &&
(RepAppl(t)[1] & BLOB_STRING) == BLOB_STRING);
}
INLINE_ONLY inline EXTERN int IsWideBlobStringTerm (Term);
INLINE_ONLY inline EXTERN int
IsWideBlobStringTerm (Term t)
{
return (int) (IsApplTerm (t) &&
FunctorOfTerm (t) == FunctorBigInt &&
RepAppl(t)[1] == BLOB_WIDE_STRING);
}
/* extern Functor FunctorLongInt; */ /* extern Functor FunctorLongInt; */
INLINE_ONLY inline EXTERN int IsLargeNumTerm (Term); INLINE_ONLY inline EXTERN int IsLargeNumTerm (Term);
@ -470,8 +479,8 @@ INLINE_ONLY inline EXTERN int
IsLargeNumTerm (Term t) IsLargeNumTerm (Term t)
{ {
return (int) (IsApplTerm (t) return (int) (IsApplTerm (t)
&& ((FunctorOfTerm (t) <= FunctorDouble) && ((FunctorOfTerm (t) <= FunctorBigInt)
&& (FunctorOfTerm (t) >= FunctorLongInt))); && (FunctorOfTerm (t) >= FunctorDouble)));
} }
INLINE_ONLY inline EXTERN int IsExternalBlobTerm (Term, CELL); INLINE_ONLY inline EXTERN int IsExternalBlobTerm (Term, CELL);
@ -523,7 +532,7 @@ INLINE_ONLY inline EXTERN Int IsExtensionFunctor (Functor);
INLINE_ONLY inline EXTERN Int INLINE_ONLY inline EXTERN Int
IsExtensionFunctor (Functor f) IsExtensionFunctor (Functor f)
{ {
return (Int) (f <= FunctorDouble); return (Int) (f <= FunctorString);
} }
@ -533,7 +542,7 @@ INLINE_ONLY inline EXTERN Int IsBlobFunctor (Functor);
INLINE_ONLY inline EXTERN Int INLINE_ONLY inline EXTERN Int
IsBlobFunctor (Functor f) IsBlobFunctor (Functor f)
{ {
return (Int) ((f <= FunctorDouble && f >= FunctorDBRef)); return (Int) ((f <= FunctorString && f >= FunctorDBRef));
} }
@ -665,6 +674,8 @@ unify_extension (Functor f, CELL d0, CELL * pt0, CELL d1)
return (d0 == d1); return (d0 == d1);
case long_int_e: case long_int_e:
return (pt0[1] == RepAppl (d1)[1]); return (pt0[1] == RepAppl (d1)[1]);
case string_e:
return strcmp( (char *)(pt0+2), (char *)(RepAppl (d1)+2) ) == 0;
case big_int_e: case big_int_e:
#ifdef USE_GMP #ifdef USE_GMP
return (Yap_gmp_tcmp_big_big(d0,d1) == 0); return (Yap_gmp_tcmp_big_big(d0,d1) == 0);
@ -675,7 +686,7 @@ unify_extension (Functor f, CELL d0, CELL * pt0, CELL d1)
{ {
CELL *pt1 = RepAppl (d1); CELL *pt1 = RepAppl (d1);
return (pt0[1] == pt1[1] return (pt0[1] == pt1[1]
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
&& pt0[2] == pt1[2] && pt0[2] == pt1[2]
#endif #endif
); );
@ -707,7 +718,7 @@ CELL Yap_Int_key(Term t)
static inline static inline
CELL Yap_DoubleP_key(CELL *pt) CELL Yap_DoubleP_key(CELL *pt)
{ {
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE1 == 2*SIZEOF_INT_P
CELL val = pt[0]^pt[1]; CELL val = pt[0]^pt[1];
#else #else
CELL val = pt[0]; CELL val = pt[0];
@ -721,4 +732,21 @@ CELL Yap_Double_key(Term t)
return Yap_DoubleP_key(RepAppl(t)+1); return Yap_DoubleP_key(RepAppl(t)+1);
} }
static inline
CELL Yap_StringP_key(CELL *pt)
{
UInt n = pt[1], i;
CELL val = pt[2];
for (i=1; i<n; i++) {
val ^= pt[i+1];
}
return MkIntTerm(val & (MAX_ABS_INT-1));
}
static inline
CELL Yap_String_key(Term t)
{
return Yap_StringP_key(RepAppl(t)+1);
}
#endif #endif

5
H/Yap.h
View File

@ -38,6 +38,9 @@
#endif /* THREADS && (YAPOR_COW || YAPOR_SBA || YAPOR_COPY) */ #endif /* THREADS && (YAPOR_COW || YAPOR_SBA || YAPOR_COPY) */
#include "config.h" #include "config.h"
#define FunAdr(X) X
#include "inline-only.h" #include "inline-only.h"
#if defined(YAPOR) || defined(TABLING) #if defined(YAPOR) || defined(TABLING)
#include "opt.config.h" #include "opt.config.h"
@ -230,7 +233,6 @@ typedef char *ADDR;
typedef CELL OFFSET; typedef CELL OFFSET;
typedef unsigned char *CODEADDR; typedef unsigned char *CODEADDR;
#define ALIGN_YAPTYPE(X,TYPE) (((CELL)(X)+(sizeof(TYPE)-1)) & ~(sizeof(TYPE)-1))
#define TermPtr(V) ((Term *) (V)) #define TermPtr(V) ((Term *) (V))
#define Addr(V) ((ADDR) (V)) #define Addr(V) ((ADDR) (V))
@ -395,7 +397,6 @@ typedef enum
YAP_BREAK_SIGNAL = 0x2000, /* received break signal */ YAP_BREAK_SIGNAL = 0x2000, /* received break signal */
YAP_STACK_DUMP_SIGNAL = 0x4000, /* received stack dump signal */ YAP_STACK_DUMP_SIGNAL = 0x4000, /* received stack dump signal */
YAP_STATISTICS_SIGNAL = 0x8000, /* received statistics */ YAP_STATISTICS_SIGNAL = 0x8000, /* received statistics */
YAP_DELAY_CREEP_SIGNAL = 0x10000, /* received a creep but should not do it */
YAP_AGC_SIGNAL = 0x20000, /* call atom garbage collector asap */ YAP_AGC_SIGNAL = 0x20000, /* call atom garbage collector asap */
YAP_PIPE_SIGNAL = 0x40000, /* call atom garbage collector asap */ YAP_PIPE_SIGNAL = 0x40000, /* call atom garbage collector asap */
YAP_VTALARM_SIGNAL = 0x80000, /* received SIGVTALARM */ YAP_VTALARM_SIGNAL = 0x80000, /* received SIGVTALARM */

5
H/YapHandles.h
View File

@ -58,6 +58,11 @@ Yap_StartSlots( USES_REGS1 ) {
return CurSlot; return CurSlot;
} }
static inline void
Yap_CloseSlots( Int slot USES_REGS ) {
LOCAL_CurSlot = slot;
}
static inline Int static inline Int
Yap_CurrentSlot( USES_REGS1 ) { Yap_CurrentSlot( USES_REGS1 ) {
return IntOfTerm(ASP[0]); return IntOfTerm(ASP[0]);

11
H/YapOpcodes.h
View File

@ -76,6 +76,7 @@
OPCODE(get_list ,x), OPCODE(get_list ,x),
OPCODE(get_struct ,xfa), OPCODE(get_struct ,xfa),
OPCODE(get_float ,xd), OPCODE(get_float ,xd),
OPCODE(get_string ,xu),
OPCODE(get_longint ,xi), OPCODE(get_longint ,xi),
OPCODE(get_bigint ,xN), OPCODE(get_bigint ,xN),
OPCODE(get_dbterm ,xD), OPCODE(get_dbterm ,xD),
@ -131,6 +132,8 @@
OPCODE(unify_float_write ,od), OPCODE(unify_float_write ,od),
OPCODE(unify_l_float ,od), OPCODE(unify_l_float ,od),
OPCODE(unify_l_float_write ,od), OPCODE(unify_l_float_write ,od),
OPCODE(unify_string ,ou),
OPCODE(unify_l_string ,ou),
OPCODE(unify_longint ,oi), OPCODE(unify_longint ,oi),
OPCODE(unify_longint_write ,oi), OPCODE(unify_longint_write ,oi),
OPCODE(unify_l_longint ,oi), OPCODE(unify_l_longint ,oi),
@ -200,14 +203,10 @@
OPCODE(call_c_wfail ,slp), OPCODE(call_c_wfail ,slp),
OPCODE(try_c ,OtapFs), OPCODE(try_c ,OtapFs),
OPCODE(retry_c ,OtapFs), OPCODE(retry_c ,OtapFs),
#ifdef CUT_C
OPCODE(cut_c ,OtapFs), OPCODE(cut_c ,OtapFs),
#endif
OPCODE(try_userc ,OtapFs), OPCODE(try_userc ,OtapFs),
OPCODE(retry_userc ,OtapFs), OPCODE(retry_userc ,OtapFs),
#ifdef CUT_C
OPCODE(cut_userc ,OtapFs), OPCODE(cut_userc ,OtapFs),
#endif
OPCODE(lock_pred ,e), OPCODE(lock_pred ,e),
OPCODE(index_pred ,e), OPCODE(index_pred ,e),
#ifdef THREADS #ifdef THREADS
@ -413,6 +412,10 @@
OPCODE(trie_trust_longint ,e), OPCODE(trie_trust_longint ,e),
OPCODE(trie_try_longint ,e), OPCODE(trie_try_longint ,e),
OPCODE(trie_retry_longint ,e), OPCODE(trie_retry_longint ,e),
OPCODE(trie_do_bigint ,e),
OPCODE(trie_trust_bigint ,e),
OPCODE(trie_try_bigint ,e),
OPCODE(trie_retry_bigint ,e),
OPCODE(trie_do_gterm ,e), OPCODE(trie_do_gterm ,e),
OPCODE(trie_trust_gterm ,e), OPCODE(trie_trust_gterm ,e),
OPCODE(trie_try_gterm ,e), OPCODE(trie_try_gterm ,e),

12
H/YapTags.h
View File

@ -168,7 +168,7 @@ INLINE_ONLY inline EXTERN Term MkVarTerm__ ( USES_REGS1 );
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term
MkVarTerm__ ( USES_REGS1 ) MkVarTerm__ ( USES_REGS1 )
{ {
return (Term) ((*H = 0, H++)); return (Term) ((*HR = 0, HR++));
} }
@ -191,7 +191,7 @@ INLINE_ONLY inline EXTERN Term MkVarTerm__ ( USES_REGS1 );
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term
MkVarTerm__ ( USES_REGS1 ) MkVarTerm__ ( USES_REGS1 )
{ {
return (Term) ((*H = (CELL) H, H++)); return (Term) ((*HR = (CELL) HR, HR++));
} }
@ -319,11 +319,11 @@ INLINE_ONLY EXTERN inline Term MkPairTerm__(Term head, Term tail USES_REGS );
INLINE_ONLY EXTERN inline Term INLINE_ONLY EXTERN inline Term
MkPairTerm__ (Term head, Term tail USES_REGS) MkPairTerm__ (Term head, Term tail USES_REGS)
{ {
register CELL *p = H; register CELL *p = HR;
H[0] = head; HR[0] = head;
H[1] = tail; HR[1] = tail;
H += 2; HR += 2;
return (AbsPair (p)); return (AbsPair (p));
} }

3
H/YapTerm.h
View File

@ -21,6 +21,9 @@ typedef void *Atom;
#endif #endif
#define ALIGN_YAPTYPE(X,TYPE) (((CELL)(X)+(sizeof(TYPE)-1)) & ~(sizeof(TYPE)-1))
#ifndef EXTERN #ifndef EXTERN
#define EXTERN extern #define EXTERN extern
#endif #endif

1011
H/YapText.h Normal file
View File

File diff suppressed because it is too large Load Diff

102
H/Yapproto.h
View File

@ -26,6 +26,8 @@ Term Yap_GetValue(Atom);
int Yap_HasOp(Atom); int Yap_HasOp(Atom);
struct operator_entry *Yap_GetOpPropForAModuleHavingALock(AtomEntry *, Term); struct operator_entry *Yap_GetOpPropForAModuleHavingALock(AtomEntry *, Term);
Atom Yap_LookupAtom(char *); Atom Yap_LookupAtom(char *);
Atom Yap_LookupAtomWithLength(char *, size_t);
Atom Yap_LookupUTF8Atom(char *);
Atom Yap_LookupMaybeWideAtom(wchar_t *); Atom Yap_LookupMaybeWideAtom(wchar_t *);
Atom Yap_LookupMaybeWideAtomWithLength(wchar_t *, size_t); Atom Yap_LookupMaybeWideAtomWithLength(wchar_t *, size_t);
Atom Yap_FullLookupAtom(char *); Atom Yap_FullLookupAtom(char *);
@ -39,19 +41,6 @@ Functor Yap_MkFunctor(Atom,unsigned int);
void Yap_MkFunctorWithAddress(Atom,unsigned int,FunctorEntry *); void Yap_MkFunctorWithAddress(Atom,unsigned int,FunctorEntry *);
void Yap_PutValue(Atom,Term); void Yap_PutValue(Atom,Term);
void Yap_ReleaseAtom(Atom); void Yap_ReleaseAtom(Atom);
Term Yap_StringToList(char *);
Term Yap_NStringToList(char *, size_t);
Term Yap_WideStringToList(wchar_t *);
Term Yap_NWideStringToList(wchar_t *, size_t);
Term Yap_StringToDiffList(char *,Term CACHE_TYPE);
Term Yap_NStringToDiffList(char *,Term, size_t);
Term Yap_WideStringToDiffList(wchar_t *,Term);
Term Yap_NWideStringToDiffList(wchar_t *,Term, size_t);
Term Yap_StringToListOfAtoms(char *);
Term Yap_NStringToListOfAtoms(char *, size_t);
Term Yap_WideStringToListOfAtoms(wchar_t *);
Term Yap_NWideStringToListOfAtoms(wchar_t *, size_t);
Term Yap_NWideStringToDiffListOfAtoms(wchar_t *, Term, size_t);
int Yap_AtomIncreaseHold(Atom); int Yap_AtomIncreaseHold(Atom);
int Yap_AtomDecreaseHold(Atom); int Yap_AtomDecreaseHold(Atom);
struct operator_entry *Yap_OpPropForModule(Atom, Term); struct operator_entry *Yap_OpPropForModule(Atom, Term);
@ -117,6 +106,8 @@ Term Yap_RatTermToApplTerm(Term);
void Yap_InitBigNums(void); void Yap_InitBigNums(void);
Term Yap_AllocExternalDataInStack(CELL, size_t); Term Yap_AllocExternalDataInStack(CELL, size_t);
int Yap_CleanOpaqueVariable(CELL *); int Yap_CleanOpaqueVariable(CELL *);
CELL *Yap_HeapStoreOpaqueTerm(Term t);
size_t Yap_OpaqueTermToString(Term t, char *str, size_t max);
/* c_interface.c */ /* c_interface.c */
Int YAP_Execute(struct pred_entry *, CPredicate); Int YAP_Execute(struct pred_entry *, CPredicate);
@ -127,7 +118,7 @@ Int YAP_RunGoalOnce(Term);
/* cdmgr.c */ /* cdmgr.c */
Term Yap_all_calls(void); Term Yap_all_calls(void);
Atom Yap_ConsultingFile(void); Atom Yap_ConsultingFile( USES_REGS1 );
struct pred_entry *Yap_PredForChoicePt(choiceptr); struct pred_entry *Yap_PredForChoicePt(choiceptr);
void Yap_InitCdMgr(void); void Yap_InitCdMgr(void);
void Yap_init_consult(int, char *); void Yap_init_consult(int, char *);
@ -138,7 +129,7 @@ void Yap_EraseMegaClause(yamop *,struct pred_entry *);
void Yap_ResetConsultStack(void); void Yap_ResetConsultStack(void);
void Yap_AssertzClause(struct pred_entry *, yamop *); void Yap_AssertzClause(struct pred_entry *, yamop *);
void Yap_HidePred(struct pred_entry *pe); void Yap_HidePred(struct pred_entry *pe);
int Yap_SetNoTrace(char *name, UInt arity, Term tmod);
/* cmppreds.c */ /* cmppreds.c */
Int Yap_compare_terms(Term,Term); Int Yap_compare_terms(Term,Term);
@ -169,6 +160,8 @@ void Yap_RestartYap(int);
void Yap_exit(int); void Yap_exit(int);
yamop *Yap_Error(yap_error_number,Term,char *msg, ...); yamop *Yap_Error(yap_error_number,Term,char *msg, ...);
yamop *Yap_NilError(yap_error_number,char *msg, ...); yamop *Yap_NilError(yap_error_number,char *msg, ...);
int Yap_HandleError( const char *msg, ... );
int Yap_SWIHandleError( const char *, ... );
/* eval.c */ /* eval.c */
void Yap_InitEval(void); void Yap_InitEval(void);
@ -245,9 +238,7 @@ void Yap_InitAsmPred(char *, unsigned long int, int, CPredicate, UInt);
void Yap_InitCmpPred(char *, unsigned long int, CmpPredicate, UInt); void Yap_InitCmpPred(char *, unsigned long int, CmpPredicate, UInt);
void Yap_InitCPredBack(char *, unsigned long int, unsigned int, CPredicate,CPredicate,UInt); void Yap_InitCPredBack(char *, unsigned long int, unsigned int, CPredicate,CPredicate,UInt);
void Yap_InitCPredBackCut(char *, unsigned long int, unsigned int, CPredicate,CPredicate,CPredicate,UInt); void Yap_InitCPredBackCut(char *, unsigned long int, unsigned int, CPredicate,CPredicate,CPredicate,UInt);
#ifdef CUT_C
void Yap_InitCPredBack_(char *, unsigned long int, unsigned int, CPredicate,CPredicate,CPredicate,UInt); void Yap_InitCPredBack_(char *, unsigned long int, unsigned int, CPredicate,CPredicate,CPredicate,UInt);
#endif
void Yap_InitWorkspace(UInt,UInt,UInt,UInt,UInt,int,int,int); void Yap_InitWorkspace(UInt,UInt,UInt,UInt,UInt,int,int,int);
#ifdef YAPOR #ifdef YAPOR
@ -348,6 +339,7 @@ void Yap_InitSignalCPreds(void);
/* sort.c */ /* sort.c */
void Yap_InitSortPreds(void); void Yap_InitSortPreds(void);
/* stdpreds.c */ /* stdpreds.c */
void Yap_InitBackCPreds(void); void Yap_InitBackCPreds(void);
void Yap_InitCPreds(void); void Yap_InitCPreds(void);
@ -430,81 +422,7 @@ Int Yap_SkipList(Term *, Term **);
/* write.c */ /* write.c */
void Yap_plwrite(Term, void *, int, int, int); void Yap_plwrite(Term, void *, int, int, int);
int Yap_FormatFloat( Float f, const char *s, size_t sz );
/* MYDDAS */
#if defined MYDDAS_MYSQL || defined MYDDAS_ODBC
/* myddas_initialization.c */
MYDDAS_GLOBAL myddas_init_initialize_myddas(void);
MYDDAS_UTIL_CONNECTION myddas_init_initialize_connection(void *,void *,MYDDAS_UTIL_CONNECTION);
MYDDAS_UTIL_PREDICATE myddas_init_initialize_predicate(char *, int, char *,MYDDAS_UTIL_PREDICATE);
#ifdef MYDDAS_STATS
/* myddas_statistics.c */
MYDDAS_GLOBAL myddas_stats_initialize_global_stats(MYDDAS_GLOBAL);
MYDDAS_STATS_STRUCT myddas_stats_initialize_connection_stats(void);
void myddas_stats_delete_stats_list(MYDDAS_STATS_STRUCT);
#endif /* MYDDAS_STATS */
#ifdef MYDDAS_MYSQL
/* myddas_util.c */
void myddas_util_table_write(MYSQL_RES *);
#endif
Short myddas_util_connection_type(void *);
MYDDAS_UTIL_CONNECTION myddas_util_add_connection(void *,void *);
MYDDAS_UTIL_CONNECTION myddas_util_search_connection(void *);
void myddas_util_delete_connection(void *);
MYDDAS_UTIL_CONNECTION myddas_util_add_predicate(char * ,Int , char *,void *);
MYDDAS_UTIL_PREDICATE myddas_util_search_predicate(char * ,Int , char *);
void myddas_util_delete_predicate(MYDDAS_UTIL_PREDICATE);
/* Get's the number of queries to save */
UInt myddas_util_get_total_multi_queries_number(MYDDAS_UTIL_CONNECTION);
void myddas_util_set_total_multi_queries_number(MYDDAS_UTIL_CONNECTION,UInt);
#ifdef MYDDAS_ODBC
/* Return enviromment identifier*/
SQLHENV myddas_util_get_odbc_enviromment(SQLHDBC);
#endif
void * myddas_util_get_list_pred(MYDDAS_UTIL_CONNECTION);
void * myddas_util_get_pred_next(void *);
char * myddas_util_get_pred_module(void *);
char * myddas_util_get_pred_name(void *);
MyddasInt myddas_util_get_pred_arity(void *);
//DELETE THIS WHEN DB_STATS IS COMPLETED
MyddasInt get_myddas_top(void);
#ifdef DEBUG
void check_int(void);
#endif
#endif /* MYDDAS_MYSQL || MYDDAS_ODBC */
/* myddas_mysql.c */
#if defined MYDDAS_MYSQL
void Yap_InitMYDDAS_MySQLPreds(void);
void Yap_InitBackMYDDAS_MySQLPreds(void);
#endif
/* myddas_odbc.c */
#if defined MYDDAS_ODBC
void Yap_InitMYDDAS_ODBCPreds(void);
void Yap_InitBackMYDDAS_ODBCPreds(void);
#endif
/* myddas_shared.c */
#if defined MYDDAS_ODBC || defined MYDDAS_MYSQL
void Yap_MYDDAS_delete_all_myddas_structs(void);
void Yap_InitMYDDAS_SharedPreds(void);
void Yap_InitBackMYDDAS_SharedPreds(void);
#endif
/* myddas_top_level.c */
#if defined MYDDAS_TOP_LEVEL && defined MYDDAS_MYSQL //&& defined HAVE_LIBREADLINE
void Yap_InitMYDDAS_TopLevelPreds(void);
#endif
/* yap2swi.c */ /* yap2swi.c */
void Yap_swi_install(void); void Yap_swi_install(void);

16
H/Yatom.h
View File

@ -650,10 +650,14 @@ IsValProperty (int flags)
for the pred. for the pred.
C_Preds are things write, read, ... implemented in C. In this case C_Preds are things write, read, ... implemented in C. In this case
CodeOfPred holds the address of the correspondent C-function. CodeOfPred holds the address of the correspondent C-function.
don;t forget to also add in qly.h
*/ */
typedef enum typedef enum
{ {
QuasiQuotationPredFlag = ((UInt)0x00000001 << EXTRA_FLAG_BASE), /* SWI-like quasi quotations */ NoDebugPredFlag = ((UInt)0x00000004L << EXTRA_FLAG_BASE), /* cannot trace this preducate */
NoTracePredFlag = ((UInt)0x00000002L << EXTRA_FLAG_BASE), /* cannot trace this preducate */
QuasiQuotationPredFlag = ((UInt)0x00000001L << EXTRA_FLAG_BASE), /* SWI-like quasi quotations */
MegaClausePredFlag = 0x80000000L, /* predicate is implemented as a mega-clause */ MegaClausePredFlag = 0x80000000L, /* predicate is implemented as a mega-clause */
ThreadLocalPredFlag = 0x40000000L, /* local to a thread */ ThreadLocalPredFlag = 0x40000000L, /* local to a thread */
MultiFileFlag = 0x20000000L, /* is multi-file */ MultiFileFlag = 0x20000000L, /* is multi-file */
@ -1277,6 +1281,12 @@ IsTranslationProperty (int flags)
} }
typedef enum {
STATIC_ARRAY = 1,
DYNAMIC_ARRAY = 2,
MMAP_ARRAY = 4,
FIXED_ARRAY = 8
} array_type;
/* array property entry structure */ /* array property entry structure */
@ -1286,6 +1296,7 @@ typedef struct array_entry
Prop NextOfPE; /* used to chain properties */ Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */ PropFlags KindOfPE; /* kind of property */
Int ArrayEArity; /* Arity of Array (positive) */ Int ArrayEArity; /* Arity of Array (positive) */
array_type TypeOfAE;
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
rwlock_t ArRWLock; /* a read-write lock to protect the entry */ rwlock_t ArRWLock; /* a read-write lock to protect the entry */
#if THREADS #if THREADS
@ -1337,6 +1348,7 @@ typedef struct static_array_entry
Prop NextOfPE; /* used to chain properties */ Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */ PropFlags KindOfPE; /* kind of property */
Int ArrayEArity; /* Arity of Array (negative) */ Int ArrayEArity; /* Arity of Array (negative) */
array_type TypeOfAE;
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
rwlock_t ArRWLock; /* a read-write lock to protect the entry */ rwlock_t ArRWLock; /* a read-write lock to protect the entry */
#endif #endif
@ -1437,7 +1449,7 @@ INLINE_ONLY inline EXTERN int ArrayIsDynamic (ArrayEntry *);
INLINE_ONLY inline EXTERN int INLINE_ONLY inline EXTERN int
ArrayIsDynamic (ArrayEntry * are) ArrayIsDynamic (ArrayEntry * are)
{ {
return (int) (((are)->ArrayEArity > 0)); return (int) (((are)->TypeOfAE & DYNAMIC_ARRAY));
} }

55
H/absmi.h
View File

@ -72,7 +72,7 @@ static char SccsId[] = "%W% %G%";
#ifdef BP_FREE #ifdef BP_FREE
/*************************************************************** /***************************************************************
* Use bp as PREG for X86 machines * * Use bp as PREG for X86 machines *
***************************************************************/ ********************************************Term*******************/
#if defined(IN_ABSMI_C) #if defined(IN_ABSMI_C)
register struct yami* P1REG asm ("bp"); /* can't use yamop before Yap.h */ register struct yami* P1REG asm ("bp"); /* can't use yamop before Yap.h */
#define PREG P1REG #define PREG P1REG
@ -769,9 +769,9 @@ Macros to check the limits of stacks
COUNT_CPS(); \ COUNT_CPS(); \
S_YREG = (CELL *)((choiceptr)((S_YREG)-(I))-1); \ S_YREG = (CELL *)((choiceptr)((S_YREG)-(I))-1); \
/* Save Information */ \ /* Save Information */ \
HBREG = H; \ HBREG = HR; \
B_YREG->cp_tr = TR; \ B_YREG->cp_tr = TR; \
B_YREG->cp_h = H; \ B_YREG->cp_h = HR; \
B_YREG->cp_b = B; \ B_YREG->cp_b = B; \
store_yaam_reg_cpdepth(B_YREG); \ store_yaam_reg_cpdepth(B_YREG); \
B_YREG->cp_cp = CPREG; \ B_YREG->cp_cp = CPREG; \
@ -783,9 +783,9 @@ Macros to check the limits of stacks
COUNT_CPS(); \ COUNT_CPS(); \
pt1 --; /* Jump to CP_BASE */ \ pt1 --; /* Jump to CP_BASE */ \
/* Save Information */ \ /* Save Information */ \
HBREG = H; \ HBREG = HR; \
pt1->cp_tr = TR; \ pt1->cp_tr = TR; \
pt1->cp_h = H; \ pt1->cp_h = HR; \
pt1->cp_b = B; \ pt1->cp_b = B; \
store_yaam_reg_cpdepth(pt1); \ store_yaam_reg_cpdepth(pt1); \
pt1->cp_cp = d0; \ pt1->cp_cp = d0; \
@ -850,7 +850,7 @@ Macros to check the limits of stacks
#define restore_yaam_regs(AP) \ #define restore_yaam_regs(AP) \
{ register CELL *x1 = B_YREG->cp_env; \ { register CELL *x1 = B_YREG->cp_env; \
register yamop *x2; \ register yamop *x2; \
H = HBREG = PROTECT_FROZEN_H(B_YREG); \ HR = HBREG = PROTECT_FROZEN_H(B_YREG); \
restore_yaam_reg_cpdepth(B_YREG); \ restore_yaam_reg_cpdepth(B_YREG); \
CPREG = B_YREG->cp_cp; \ CPREG = B_YREG->cp_cp; \
/* AP may depend on H */ \ /* AP may depend on H */ \
@ -914,7 +914,7 @@ Macros to check the limits of stacks
#define pop_yaam_regs() \ #define pop_yaam_regs() \
{ \ { \
H = PROTECT_FROZEN_H(B_YREG); \ HR = PROTECT_FROZEN_H(B_YREG); \
B = B_YREG->cp_b; \ B = B_YREG->cp_b; \
pop_yaam_reg_cpdepth(B_YREG); \ pop_yaam_reg_cpdepth(B_YREG); \
CPREG = B_YREG->cp_cp; \ CPREG = B_YREG->cp_cp; \
@ -999,20 +999,20 @@ Macros to check the limits of stacks
} }
#define UnifyGlobalCellToCell(b, a) \ #define UnifyGlobalCellToCell(b, a) \
if ((a) < H) { /* two globals */ \ if ((a) < HR) { /* two globals */ \
UnifyGlobalCells(a,b); \ UnifyGlobalCells(a,b); \
} else { \ } else { \
Bind_Local((a),(CELL)(b)); \ Bind_Local((a),(CELL)(b)); \
} }
#define UnifyCells(a, b) \ #define UnifyCells(a, b) \
if ((a) < H) { /* at least one global */ \ if ((a) < HR) { /* at least one global */ \
if ((b) > H) { Bind_Local((b),(CELL)(a)); } \ if ((b) > HR) { Bind_Local((b),(CELL)(a)); } \
else { UnifyGlobalCells(a,b); } \ else { UnifyGlobalCells(a,b); } \
} else { \ } else { \
if ((b) > (a)) { Bind_Local((a),(CELL)(b)); } \ if ((b) > (a)) { Bind_Local((a),(CELL)(b)); } \
else if ((a) > (b)) { \ else if ((a) > (b)) { \
if ((b) < H) { Bind_Local((a),(CELL)(b)); } \ if ((b) < HR) { Bind_Local((a),(CELL)(b)); } \
else { Bind_Local((b),(CELL)(a)); } \ else { Bind_Local((b),(CELL)(a)); } \
} \ } \
} }
@ -1597,14 +1597,37 @@ void SET_ASP__(CELL *yreg, Int sz USES_REGS) {
/* l1: bind a, l2 bind b, l3 no binding */ /* l1: bind a, l2 bind b, l3 no binding */
#define UnifyAndTrailCells(a, b) \ #define UnifyAndTrailCells(a, b) \
if((a) > (b)) { \ if((a) > (b)) { \
if ((a) < H) { *(a) = (CELL)(b); DO_TRAIL((a),(CELL)(b)); } \ if ((a) < HR) { *(a) = (CELL)(b); DO_TRAIL((a),(CELL)(b)); } \
else if ((b) <= H) { *(a) =(CELL)(b); DO_TRAIL((a),(CELL)(b));} \ else if ((b) <= HR) { *(a) =(CELL)(b); DO_TRAIL((a),(CELL)(b));} \
else { *(b) = (CELL)(a); DO_TRAIL((b),(CELL)(a)); } \ else { *(b) = (CELL)(a); DO_TRAIL((b),(CELL)(a)); } \
} else if((a) < (b)){ \ } else if((a) < (b)){ \
if ((b) <= H) { *(b) = (CELL)(a); DO_TRAIL((b),(CELL)(a)); } \ if ((b) <= HR) { *(b) = (CELL)(a); DO_TRAIL((b),(CELL)(a)); } \
else if ((a) <= H) { *(b) = (CELL) (a); DO_TRAIL((b),(CELL)(a));} \ else if ((a) <= HR) { *(b) = (CELL) (a); DO_TRAIL((b),(CELL)(a));} \
else { *(a) = (CELL) (b); DO_TRAIL((a),(CELL)(b));} \ else { *(a) = (CELL) (b); DO_TRAIL((a),(CELL)(b));} \
} }
#define CHECK_ALARM(CONT) #ifdef SHADOW_S
#define PROCESS_INT( F, C ) \
BEGD(d0); \
Yap_REGS.S_ = SREG; \
saveregs(); \
d0 = F ( PASS_REGS1 );\
setregs(); \
SREG = Yap_REGS.S_; \
if (!d0) FAIL(); \
if (d0 == 2) goto C; \
JMPNext(); \
ENDD(d0);
#else
#define PROCESS_INT( F, C ) \
BEGD(d0); \
saveregs(); \
d0 = F ( PASS_REGS1 );\
setregs(); \
if (!d0) FAIL(); \
if (d0 == 2) goto C; \
JMPNext(); \
ENDD(d0);
#endif

11
H/amidefs.h
View File

@ -273,6 +273,7 @@ typedef enum {
p: predicate, struct pred_entry * p: predicate, struct pred_entry *
s: small integer, COUNT s: small integer, COUNT
t: pointer to table entry, used by yaptab, struct table_entry * t: pointer to table entry, used by yaptab, struct table_entry *
u: utf-8 string
x: wam register, wamreg x: wam register, wamreg
y: environment slot y: environment slot
@ -558,6 +559,11 @@ typedef struct yami {
COUNT s; COUNT s;
CELL next; CELL next;
} os; } os;
struct {
OPCODE opcw;
Term u;
CELL next;
} ou;
struct { struct {
OPCODE opcw; OPCODE opcw;
wamreg x; wamreg x;
@ -783,6 +789,11 @@ typedef struct yami {
wamreg xr; wamreg xr;
CELL next; CELL next;
} xx; } xx;
struct {
wamreg x;
Term u;
CELL next;
} xu;
struct { struct {
wamreg x; wamreg x;
wamreg xi; wamreg xi;

4
H/amiops.h
View File

@ -253,7 +253,7 @@ extern void Yap_WakeUp(CELL *v);
#define Bind_Local(A,D) { TRAIL_LOCAL(A,D); *(A) = (D); } #define Bind_Local(A,D) { TRAIL_LOCAL(A,D); *(A) = (D); }
#define Bind_Global(A,D) { *(A) = (D); if (__builtin_expect(GlobalIsAttVar(A),0)) Yap_WakeUp(A); else TRAIL_GLOBAL(A,D); } #define Bind_Global(A,D) { *(A) = (D); if (__builtin_expect(GlobalIsAttVar(A),0)) Yap_WakeUp(A); else TRAIL_GLOBAL(A,D); }
#define Bind(A,D) { *(A) = (D); if (A < H) { if (__builtin_expect(GlobalIsAttVar(A),0)) Yap_WakeUp(A); else TRAIL_GLOBAL(A,D); } else { TRAIL_LOCAL(A,D); } } #define Bind(A,D) { *(A) = (D); if (A < HR) { if (__builtin_expect(GlobalIsAttVar(A),0)) Yap_WakeUp(A); else TRAIL_GLOBAL(A,D); } else { TRAIL_LOCAL(A,D); } }
#define Bind_NonAtt(A,D) { *(A) = (D); TRAIL(A,D); } #define Bind_NonAtt(A,D) { *(A) = (D); TRAIL(A,D); }
#define Bind_Global_NonAtt(A,D) { *(A) = (D); TRAIL_GLOBAL(A,D); } #define Bind_Global_NonAtt(A,D) { *(A) = (D); TRAIL_GLOBAL(A,D); }
#define Bind_and_Trail(A,D) { *(A) = (D); DO_TRAIL(A, D); } #define Bind_and_Trail(A,D) { *(A) = (D); DO_TRAIL(A, D); }
@ -412,11 +412,9 @@ Yap_unify_constant(register Term a, register Term cons)
static inline int static inline int
do_cut(int i) { do_cut(int i) {
CACHE_REGS CACHE_REGS
#ifdef CUT_C
if (POP_CHOICE_POINT(B->cp_b)) { if (POP_CHOICE_POINT(B->cp_b)) {
cut_c_pop(); cut_c_pop();
} }
#endif
Yap_TrimTrail(); Yap_TrimTrail();
B = B->cp_b; B = B->cp_b;
return i; return i;

81
H/arith2.h
View File

@ -75,8 +75,29 @@ mul_overflow(Int z, Int i1, Int i2)
} }
#ifndef OPTIMIZE_MULTIPLI #ifndef OPTIMIZE_MULTIPLI
#define DO_MULTI() z = i1*i2; \ #if __clang__ && FALSE /* not in OSX yet */
if (i2 && z/i2 != i1) goto overflow #define DO_MULTI() if (__builtin_smul_overflow( i1, i2, & z ) ) { goto overflow; }
#elif SIZEOF_DOUBLE == 2*SIZEOF_INT_P
#define DO_MULTI() {\
int64_t w = (int64_t)i1*i2; \
if (w >= 0) {\
if ((w | ((int64_t)(2^31)-1)) != ((int64_t)(2^31)-1)) goto overflow; \
} else {\
if ((-w | ((int64_t)(2^31)-1)) != ((int64_t)(2^31)-1)) goto overflow; \
}\
z = w;\
}
#else
#define DO_MULTI() {\
__int128_t w = (__int128_t)i1*i2; \
if (w >= 0) {\
if ((w | ((__int128_t)(2^63)-1)) != ((__int128_t)(2^63)-1)) goto overflow; \
} else {\
if ((-w | ((__int128_t)(2^63)-1)) != ((__int128_t)(2^63)-1)) goto overflow; \
}\
z = (Int)w; \
}
#endif
#endif #endif
inline static Term inline static Term
@ -148,62 +169,6 @@ do_sll(Int i, Int j USES_REGS) /* j > 0 */
} }
static inline Term
p_plus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
return add_int(IntegerOfTerm(t1),IntegerOfTerm(t2) PASS_REGS);
case double_e:
{
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(fl1+fl2);
}
case big_int_e:
#ifdef USE_GMP
return(Yap_gmp_add_int_big(IntegerOfTerm(t1), t2));
#endif
default:
RERROR();
}
case double_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* float * integer */
RFLOAT(FloatOfTerm(t1)+IntegerOfTerm(t2));
case double_e:
RFLOAT(FloatOfTerm(t1)+FloatOfTerm(t2));
case big_int_e:
#ifdef USE_GMP
return Yap_gmp_add_float_big(FloatOfTerm(t1),t2);
#endif
default:
RERROR();
}
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return Yap_gmp_add_int_big(IntegerOfTerm(t2), t1);
case big_int_e:
/* two bignums */
return Yap_gmp_add_big_big(t1, t2);
case double_e:
return Yap_gmp_add_float_big(FloatOfTerm(t2),t1);
default:
RERROR();
}
#endif
default:
RERROR();
}
RERROR();
}
static Term static Term
p_minus(Term t1, Term t2 USES_REGS) { p_minus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) { switch (ETypeOfTerm(t1)) {

2
H/arrays.h
View File

@ -26,5 +26,3 @@ typedef struct array_access_struct {
keep it as an integer! */ keep it as an integer! */
} array_access; } array_access;

28
H/clause.h
View File

@ -281,6 +281,8 @@ void Yap_ErCl(DynamicClause *);
void Yap_ErLogUpdCl(LogUpdClause *); void Yap_ErLogUpdCl(LogUpdClause *);
void Yap_ErLogUpdIndex(LogUpdIndex *); void Yap_ErLogUpdIndex(LogUpdIndex *);
Int Yap_Recordz(Atom, Term); Int Yap_Recordz(Atom, Term);
Int Yap_db_nth_recorded( PredEntry *, Int USES_REGS );
Int Yap_unify_immediate_ref(DBRef ref USES_REGS );
/* exec.c */ /* exec.c */
Term Yap_cp_as_integer(choiceptr); Term Yap_cp_as_integer(choiceptr);
@ -395,6 +397,32 @@ Yap_MegaClausePredicateFromTerm(Term t)
return (PredEntry *)IntegerOfTerm(ArgOfTerm(1,t)); return (PredEntry *)IntegerOfTerm(ArgOfTerm(1,t));
} }
#define Yap_MkExoRefTerm(ap, i) __Yap_MkExoRefTerm((ap), (i) PASS_REGS)
static inline Term
__Yap_MkExoRefTerm(PredEntry *ap,Int i USES_REGS)
{
Term t[2];
t[0] = MkIntegerTerm((Int)ap);
t[1] = MkIntegerTerm((Int)i);
return Yap_MkApplTerm(FunctorExoClause,2,t);
}
static inline Int
Yap_ExoClauseFromTerm(Term t)
{
return IntegerOfTerm(ArgOfTerm(2,t));
}
static inline PredEntry *
Yap_ExoClausePredicateFromTerm(Term t)
{
return (PredEntry *)IntegerOfTerm(ArgOfTerm(1,t));
}
#define DEAD_REF(ref) FALSE
typedef enum { typedef enum {
FIND_PRED_FROM_ANYWHERE, FIND_PRED_FROM_ANYWHERE,
FIND_PRED_FROM_CP, FIND_PRED_FROM_CP,

7
H/compile.h
View File

@ -34,6 +34,8 @@ typedef enum compiler_op {
put_dbterm_op, put_dbterm_op,
get_longint_op, get_longint_op,
put_longint_op, put_longint_op,
get_string_op,
put_string_op,
get_bigint_op, get_bigint_op,
put_bigint_op, put_bigint_op,
get_list_op, get_list_op,
@ -55,6 +57,8 @@ typedef enum compiler_op {
write_dbterm_op, write_dbterm_op,
unify_longint_op, unify_longint_op,
write_longint_op, write_longint_op,
unify_string_op,
write_string_op,
unify_bigint_op, unify_bigint_op,
write_bigint_op, write_bigint_op,
unify_list_op, unify_list_op,
@ -76,6 +80,7 @@ typedef enum compiler_op {
unify_last_float_op, unify_last_float_op,
unify_last_dbterm_op, unify_last_dbterm_op,
unify_last_longint_op, unify_last_longint_op,
unify_last_string_op,
unify_last_bigint_op, unify_last_bigint_op,
ensure_space_op, ensure_space_op,
native_op, native_op,
@ -126,6 +131,7 @@ typedef enum compiler_op {
if_not_op, if_not_op,
index_dbref_op, index_dbref_op,
index_blob_op, index_blob_op,
index_string_op,
index_long_op, index_long_op,
if_nonvar_op, if_nonvar_op,
save_pair_op, save_pair_op,
@ -182,6 +188,7 @@ typedef enum compiler_op {
fetch_args_for_bccall, fetch_args_for_bccall,
bccall_op, bccall_op,
blob_op, blob_op,
string_op,
label_ctl_op label_ctl_op
#ifdef SFUNC #ifdef SFUNC
, ,

1
H/dhstruct.h
View File

@ -141,6 +141,7 @@
#define PredIs Yap_heap_regs->pred_is #define PredIs Yap_heap_regs->pred_is
#define PredSafeCallCleanup Yap_heap_regs->pred_safe_call_cleanup #define PredSafeCallCleanup Yap_heap_regs->pred_safe_call_cleanup
#define PredRestoreRegs Yap_heap_regs->pred_restore_regs #define PredRestoreRegs Yap_heap_regs->pred_restore_regs
#define PredCommentHook Yap_heap_regs->pred_comment_hook
#ifdef YAPOR #ifdef YAPOR
#define PredGetwork Yap_heap_regs->pred_getwork #define PredGetwork Yap_heap_regs->pred_getwork
#define PredGetworkSeq Yap_heap_regs->pred_getwork_seq #define PredGetworkSeq Yap_heap_regs->pred_getwork_seq

2
H/dlocals.h
View File

@ -417,4 +417,6 @@
#define REMOTE_CurSlot(wid) REMOTE(wid)->CurSlot_ #define REMOTE_CurSlot(wid) REMOTE(wid)->CurSlot_
#define LOCAL_SourceModule LOCAL->SourceModule_ #define LOCAL_SourceModule LOCAL->SourceModule_
#define REMOTE_SourceModule(wid) REMOTE(wid)->SourceModule_ #define REMOTE_SourceModule(wid) REMOTE(wid)->SourceModule_
#define LOCAL_MAX_SIZE LOCAL->MAX_SIZE_
#define REMOTE_MAX_SIZE(wid) REMOTE(wid)->MAX_SIZE_

88
H/eval.h
View File

@ -233,6 +233,8 @@ ETypeOfTerm(Term t)
} }
#if USE_GMP #if USE_GMP
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_int(Int, Int);
Term Yap_gmq_rdiv_int_big(Int, Term); Term Yap_gmq_rdiv_int_big(Int, Term);
Term Yap_gmq_rdiv_big_int(Term, Int); Term Yap_gmq_rdiv_big_int(Term, Int);
@ -345,28 +347,82 @@ __Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS)
} }
#if __clang__ && FALSE /* not in OSX yet */
inline static int #define DO_ADD() if (__builtin_sadd_overflow( i1, i2, & z ) ) { goto overflow; }
add_overflow(Int x, Int i, Int j) #endif
{
return ((i & j & ~x) | (~i & ~j & x)) < 0;
}
inline static Term inline static Term
add_int(Int i, Int j USES_REGS) add_int(Int i, Int j USES_REGS)
{ {
Int x = i+j;
#if USE_GMP #if USE_GMP
/* Integer overflow, we need to use big integers */ UInt w = (UInt)i+(UInt)j;
Int overflow = (i & j & ~x) | (~i & ~j & x); if (i > 0) {
if (overflow < 0) { if (j > 0 && (Int)w < 0) goto overflow;
return(Yap_gmp_add_ints(i, j)); } else {
if (j < 0 && (Int)w > 0) goto overflow;
} }
#endif RINT( (Int)w);
#ifdef BEAM /* Integer overflow, we need to use big integers */
RINT(x); overflow:
return( MkIntegerTerm (x)); return Yap_gmp_add_ints(i, j);
#else #else
RINT(x); RINT(i+j);
#endif #endif
} }
static inline Term
p_plus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
return add_int(IntegerOfTerm(t1),IntegerOfTerm(t2) PASS_REGS);
case double_e:
{
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(fl1+fl2);
}
case big_int_e:
#ifdef USE_GMP
return(Yap_gmp_add_int_big(IntegerOfTerm(t1), t2));
#endif
default:
RERROR();
}
case double_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* float * integer */
RFLOAT(FloatOfTerm(t1)+IntegerOfTerm(t2));
case double_e:
RFLOAT(FloatOfTerm(t1)+FloatOfTerm(t2));
case big_int_e:
#ifdef USE_GMP
return Yap_gmp_add_float_big(FloatOfTerm(t1),t2);
#endif
default:
RERROR();
}
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return Yap_gmp_add_int_big(IntegerOfTerm(t2), t1);
case big_int_e:
/* two bignums */
return Yap_gmp_add_big_big(t1, t2);
case double_e:
return Yap_gmp_add_float_big(FloatOfTerm(t2),t1);
default:
RERROR();
}
#endif
default:
RERROR();
}
RERROR();
}

122
H/findclause.h
View File

@ -29,7 +29,7 @@
if (IsApplTerm(cl->u.cc.c1)) { if (IsApplTerm(cl->u.cc.c1)) {
CELL *pt = RepAppl(cl->u.cc.c1); CELL *pt = RepAppl(cl->u.cc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cc.c1; clause->ucd.t_ptr = cl->u.cc.c1;
} else } else
clause->Tag = cl->u.cc.c1; clause->Tag = cl->u.cc.c1;
return; return;
@ -38,7 +38,7 @@
if (IsApplTerm(cl->u.cc.c2)) { if (IsApplTerm(cl->u.cc.c2)) {
CELL *pt = RepAppl(cl->u.cc.c2); CELL *pt = RepAppl(cl->u.cc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cc.c2; clause->ucd.t_ptr = cl->u.cc.c2;
} else } else
clause->Tag = cl->u.cc.c2; clause->Tag = cl->u.cc.c2;
return; return;
@ -50,7 +50,7 @@
if (IsApplTerm(cl->u.ccc.c1)) { if (IsApplTerm(cl->u.ccc.c1)) {
CELL *pt = RepAppl(cl->u.ccc.c1); CELL *pt = RepAppl(cl->u.ccc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccc.c1; clause->ucd.t_ptr = cl->u.ccc.c1;
} else } else
clause->Tag = cl->u.ccc.c1; clause->Tag = cl->u.ccc.c1;
return; return;
@ -59,7 +59,7 @@
if (IsApplTerm(cl->u.ccc.c2)) { if (IsApplTerm(cl->u.ccc.c2)) {
CELL *pt = RepAppl(cl->u.ccc.c2); CELL *pt = RepAppl(cl->u.ccc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccc.c2; clause->ucd.t_ptr = cl->u.ccc.c2;
} else } else
clause->Tag = cl->u.ccc.c2; clause->Tag = cl->u.ccc.c2;
return; return;
@ -68,7 +68,7 @@
if (IsApplTerm(cl->u.ccc.c3)) { if (IsApplTerm(cl->u.ccc.c3)) {
CELL *pt = RepAppl(cl->u.ccc.c3); CELL *pt = RepAppl(cl->u.ccc.c3);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccc.c3; clause->ucd.t_ptr = cl->u.ccc.c3;
} else } else
clause->Tag = cl->u.ccc.c3; clause->Tag = cl->u.ccc.c3;
return; return;
@ -80,7 +80,7 @@
if (IsApplTerm(cl->u.cccc.c1)) { if (IsApplTerm(cl->u.cccc.c1)) {
CELL *pt = RepAppl(cl->u.cccc.c1); CELL *pt = RepAppl(cl->u.cccc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccc.c1; clause->ucd.t_ptr = cl->u.cccc.c1;
} else } else
clause->Tag = cl->u.cccc.c1; clause->Tag = cl->u.cccc.c1;
return; return;
@ -89,7 +89,7 @@
if (IsApplTerm(cl->u.cccc.c2)) { if (IsApplTerm(cl->u.cccc.c2)) {
CELL *pt = RepAppl(cl->u.cccc.c2); CELL *pt = RepAppl(cl->u.cccc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccc.c2; clause->ucd.t_ptr = cl->u.cccc.c2;
} else } else
clause->Tag = cl->u.cccc.c2; clause->Tag = cl->u.cccc.c2;
return; return;
@ -98,7 +98,7 @@
if (IsApplTerm(cl->u.cccc.c3)) { if (IsApplTerm(cl->u.cccc.c3)) {
CELL *pt = RepAppl(cl->u.cccc.c3); CELL *pt = RepAppl(cl->u.cccc.c3);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccc.c3; clause->ucd.t_ptr = cl->u.cccc.c3;
} else } else
clause->Tag = cl->u.cccc.c3; clause->Tag = cl->u.cccc.c3;
return; return;
@ -107,7 +107,7 @@
if (IsApplTerm(cl->u.cccc.c4)) { if (IsApplTerm(cl->u.cccc.c4)) {
CELL *pt = RepAppl(cl->u.cccc.c4); CELL *pt = RepAppl(cl->u.cccc.c4);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccc.c4; clause->ucd.t_ptr = cl->u.cccc.c4;
} else } else
clause->Tag = cl->u.cccc.c4; clause->Tag = cl->u.cccc.c4;
return; return;
@ -119,7 +119,7 @@
if (IsApplTerm(cl->u.ccccc.c1)) { if (IsApplTerm(cl->u.ccccc.c1)) {
CELL *pt = RepAppl(cl->u.ccccc.c1); CELL *pt = RepAppl(cl->u.ccccc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c1; clause->ucd.t_ptr = cl->u.ccccc.c1;
} else } else
clause->Tag = cl->u.ccccc.c1; clause->Tag = cl->u.ccccc.c1;
return; return;
@ -128,7 +128,7 @@
if (IsApplTerm(cl->u.ccccc.c2)) { if (IsApplTerm(cl->u.ccccc.c2)) {
CELL *pt = RepAppl(cl->u.ccccc.c2); CELL *pt = RepAppl(cl->u.ccccc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c2; clause->ucd.t_ptr = cl->u.ccccc.c2;
} else } else
clause->Tag = cl->u.ccccc.c2; clause->Tag = cl->u.ccccc.c2;
return; return;
@ -137,7 +137,7 @@
if (IsApplTerm(cl->u.ccccc.c3)) { if (IsApplTerm(cl->u.ccccc.c3)) {
CELL *pt = RepAppl(cl->u.ccccc.c3); CELL *pt = RepAppl(cl->u.ccccc.c3);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c3; clause->ucd.t_ptr = cl->u.ccccc.c3;
} else } else
clause->Tag = cl->u.ccccc.c3; clause->Tag = cl->u.ccccc.c3;
return; return;
@ -146,7 +146,7 @@
if (IsApplTerm(cl->u.ccccc.c4)) { if (IsApplTerm(cl->u.ccccc.c4)) {
CELL *pt = RepAppl(cl->u.ccccc.c4); CELL *pt = RepAppl(cl->u.ccccc.c4);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c4; clause->ucd.t_ptr = cl->u.ccccc.c4;
} else } else
clause->Tag = cl->u.ccccc.c4; clause->Tag = cl->u.ccccc.c4;
return; return;
@ -155,7 +155,7 @@
if (IsApplTerm(cl->u.ccccc.c5)) { if (IsApplTerm(cl->u.ccccc.c5)) {
CELL *pt = RepAppl(cl->u.ccccc.c5); CELL *pt = RepAppl(cl->u.ccccc.c5);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c5; clause->ucd.t_ptr = cl->u.ccccc.c5;
} else } else
clause->Tag = cl->u.ccccc.c5; clause->Tag = cl->u.ccccc.c5;
return; return;
@ -167,7 +167,7 @@
if (IsApplTerm(cl->u.cccccc.c1)) { if (IsApplTerm(cl->u.cccccc.c1)) {
CELL *pt = RepAppl(cl->u.cccccc.c1); CELL *pt = RepAppl(cl->u.cccccc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c1; clause->ucd.t_ptr = cl->u.cccccc.c1;
} else } else
clause->Tag = cl->u.cccccc.c1; clause->Tag = cl->u.cccccc.c1;
return; return;
@ -176,7 +176,7 @@
if (IsApplTerm(cl->u.cccccc.c2)) { if (IsApplTerm(cl->u.cccccc.c2)) {
CELL *pt = RepAppl(cl->u.cccccc.c2); CELL *pt = RepAppl(cl->u.cccccc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c2; clause->ucd.t_ptr = cl->u.cccccc.c2;
} else } else
clause->Tag = cl->u.cccccc.c2; clause->Tag = cl->u.cccccc.c2;
return; return;
@ -185,7 +185,7 @@
if (IsApplTerm(cl->u.cccccc.c3)) { if (IsApplTerm(cl->u.cccccc.c3)) {
CELL *pt = RepAppl(cl->u.cccccc.c3); CELL *pt = RepAppl(cl->u.cccccc.c3);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c3; clause->ucd.t_ptr = cl->u.cccccc.c3;
} else } else
clause->Tag = cl->u.cccccc.c3; clause->Tag = cl->u.cccccc.c3;
return; return;
@ -194,7 +194,7 @@
if (IsApplTerm(cl->u.cccccc.c4)) { if (IsApplTerm(cl->u.cccccc.c4)) {
CELL *pt = RepAppl(cl->u.cccccc.c4); CELL *pt = RepAppl(cl->u.cccccc.c4);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c4; clause->ucd.t_ptr = cl->u.cccccc.c4;
} else } else
clause->Tag = cl->u.cccccc.c4; clause->Tag = cl->u.cccccc.c4;
return; return;
@ -203,7 +203,7 @@
if (IsApplTerm(cl->u.cccccc.c5)) { if (IsApplTerm(cl->u.cccccc.c5)) {
CELL *pt = RepAppl(cl->u.cccccc.c5); CELL *pt = RepAppl(cl->u.cccccc.c5);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c5; clause->ucd.t_ptr = cl->u.cccccc.c5;
} else } else
clause->Tag = cl->u.cccccc.c5; clause->Tag = cl->u.cccccc.c5;
return; return;
@ -212,7 +212,7 @@
if (IsApplTerm(cl->u.cccccc.c6)) { if (IsApplTerm(cl->u.cccccc.c6)) {
CELL *pt = RepAppl(cl->u.cccccc.c6); CELL *pt = RepAppl(cl->u.cccccc.c6);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c6; clause->ucd.t_ptr = cl->u.cccccc.c6;
} else } else
clause->Tag = cl->u.cccccc.c6; clause->Tag = cl->u.cccccc.c6;
return; return;
@ -236,12 +236,12 @@
CELL *pt = RepAppl(t); CELL *pt = RepAppl(t);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.c_sreg = pt; clause->ucd.c_sreg = pt;
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
CELL *pt = RepPair(t); CELL *pt = RepPair(t);
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1; clause->ucd.c_sreg = pt-1;
} else { } else {
clause->Tag = t; clause->Tag = t;
} }
@ -271,12 +271,12 @@
CELL *pt = RepAppl(t); CELL *pt = RepAppl(t);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.c_sreg = pt; clause->ucd.c_sreg = pt;
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
CELL *pt = RepPair(t); CELL *pt = RepPair(t);
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1; clause->ucd.c_sreg = pt-1;
} else { } else {
clause->Tag = t; clause->Tag = t;
} }
@ -409,6 +409,12 @@
case _unify_n_atoms_write: case _unify_n_atoms_write:
cl = NEXTOP(cl,osc); cl = NEXTOP(cl,osc);
break; break;
case _unify_l_string:
cl = NEXTOP(cl,ou);
break;
case _unify_string:
cl = NEXTOP(cl,ou);
break;
case _save_appl_x: case _save_appl_x:
if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.ox.x))) { if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.ox.x))) {
clause->Tag = (CELL)NULL; clause->Tag = (CELL)NULL;
@ -643,7 +649,7 @@
case _get_list: case _get_list:
if (is_regcopy(myregs, nofregs, cl->u.x.x)) { if (is_regcopy(myregs, nofregs, cl->u.x.x)) {
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.WorkPC = NEXTOP(cl,x); clause->ucd.WorkPC = NEXTOP(cl,x);
return; return;
} }
cl = NEXTOP(cl,x); cl = NEXTOP(cl,x);
@ -682,7 +688,7 @@
case _get_bigint: case _get_bigint:
if (is_regcopy(myregs, nofregs, cl->u.xN.x)) { if (is_regcopy(myregs, nofregs, cl->u.xN.x)) {
clause->Tag = AbsAppl((CELL *)FunctorBigInt); clause->Tag = AbsAppl((CELL *)FunctorBigInt);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,xN); cl = NEXTOP(cl,xN);
@ -699,7 +705,7 @@
if (IsApplTerm(cl->u.xc.c)) { if (IsApplTerm(cl->u.xc.c)) {
CELL *pt = RepAppl(cl->u.xc.c); CELL *pt = RepAppl(cl->u.xc.c);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.xc.c; clause->ucd.t_ptr = cl->u.xc.c;
} else } else
clause->Tag = cl->u.xc.c; clause->Tag = cl->u.xc.c;
return; return;
@ -716,7 +722,7 @@
case _get_float: case _get_float:
if (is_regcopy(myregs, nofregs, cl->u.xd.x)) { if (is_regcopy(myregs, nofregs, cl->u.xd.x)) {
clause->Tag = AbsAppl((CELL *)FunctorDouble); clause->Tag = AbsAppl((CELL *)FunctorDouble);
clause->u.t_ptr = AbsAppl(cl->u.xd.d); clause->ucd.t_ptr = AbsAppl(cl->u.xd.d);
return; return;
} }
cl = NEXTOP(cl,xd); cl = NEXTOP(cl,xd);
@ -731,7 +737,7 @@
case _get_struct: case _get_struct:
if (is_regcopy(myregs, nofregs, cl->u.xfa.x)) { if (is_regcopy(myregs, nofregs, cl->u.xfa.x)) {
clause->Tag = AbsAppl((CELL *)cl->u.xfa.f); clause->Tag = AbsAppl((CELL *)cl->u.xfa.f);
clause->u.WorkPC = NEXTOP(cl,xfa); clause->ucd.WorkPC = NEXTOP(cl,xfa);
return; return;
} }
cl = NEXTOP(cl,xfa); cl = NEXTOP(cl,xfa);
@ -746,7 +752,7 @@
case _get_longint: case _get_longint:
if (is_regcopy(myregs, nofregs, cl->u.xi.x)) { if (is_regcopy(myregs, nofregs, cl->u.xi.x)) {
clause->Tag = AbsAppl((CELL *)FunctorLongInt); clause->Tag = AbsAppl((CELL *)FunctorLongInt);
clause->u.t_ptr = AbsAppl(cl->u.xi.i); clause->ucd.t_ptr = AbsAppl(cl->u.xi.i);
return; return;
} }
cl = NEXTOP(cl,xi); cl = NEXTOP(cl,xi);
@ -765,7 +771,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) { if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = (_atom+1)*sizeof(CELL); clause->Tag = (_atom+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,xl); cl = NEXTOP(cl,xl);
@ -777,7 +783,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) { if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = (_atomic+1)*sizeof(CELL); clause->Tag = (_atomic+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,xl); cl = NEXTOP(cl,xl);
@ -789,7 +795,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) { if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = (_compound+1)*sizeof(CELL); clause->Tag = (_compound+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,xl); cl = NEXTOP(cl,xl);
@ -801,7 +807,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) { if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = AbsAppl((CELL *)FunctorDBRef); clause->Tag = AbsAppl((CELL *)FunctorDBRef);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,xl); cl = NEXTOP(cl,xl);
@ -813,7 +819,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) { if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = AbsAppl((CELL *)FunctorDouble); clause->Tag = AbsAppl((CELL *)FunctorDouble);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,xl); cl = NEXTOP(cl,xl);
@ -825,7 +831,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) { if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = (_integer+1)*sizeof(CELL); clause->Tag = (_integer+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,xl); cl = NEXTOP(cl,xl);
@ -844,7 +850,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) { if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = (_number+1)*sizeof(CELL); clause->Tag = (_number+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,xl); cl = NEXTOP(cl,xl);
@ -856,7 +862,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) { if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = (_primitive+1)*sizeof(CELL); clause->Tag = (_primitive+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,xl); cl = NEXTOP(cl,xl);
@ -868,11 +874,19 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) { if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = (_var+1)*sizeof(CELL); clause->Tag = (_var+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,xl); cl = NEXTOP(cl,xl);
break; break;
case _get_string:
if (is_regcopy(myregs, nofregs, cl->u.xu.x)) {
clause->Tag = AbsAppl((CELL *)FunctorString);
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xu);
break;
case _get_x_val: case _get_x_val:
if (!(nofregs = link_regcopies(myregs, nofregs, cl->u.xx.xl, cl->u.xx.xr))) { if (!(nofregs = link_regcopies(myregs, nofregs, cl->u.xx.xl, cl->u.xx.xr))) {
clause->Tag = (CELL)NULL; clause->Tag = (CELL)NULL;
@ -890,7 +904,7 @@
case _gl_void_valx: case _gl_void_valx:
if (is_regcopy(myregs, nofregs, cl->u.xx.xl)) { if (is_regcopy(myregs, nofregs, cl->u.xx.xl)) {
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl; clause->ucd.WorkPC = cl;
return; return;
} }
cl = NEXTOP(cl,xx); cl = NEXTOP(cl,xx);
@ -898,7 +912,7 @@
case _gl_void_varx: case _gl_void_varx:
if (is_regcopy(myregs, nofregs, cl->u.xx.xl)) { if (is_regcopy(myregs, nofregs, cl->u.xx.xl)) {
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl; clause->ucd.WorkPC = cl;
return; return;
} }
if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.xx.xr))) { if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.xx.xr))) {
@ -910,7 +924,7 @@
case _glist_valx: case _glist_valx:
if (is_regcopy(myregs, nofregs, cl->u.xx.xl)) { if (is_regcopy(myregs, nofregs, cl->u.xx.xl)) {
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl; clause->ucd.WorkPC = cl;
return; return;
} }
cl = NEXTOP(cl,xx); cl = NEXTOP(cl,xx);
@ -1146,7 +1160,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) { if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = (_atom+1)*sizeof(CELL); clause->Tag = (_atom+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,yl); cl = NEXTOP(cl,yl);
@ -1158,7 +1172,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) { if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = (_atomic+1)*sizeof(CELL); clause->Tag = (_atomic+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,yl); cl = NEXTOP(cl,yl);
@ -1170,7 +1184,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) { if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = (_compound+1)*sizeof(CELL); clause->Tag = (_compound+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,yl); cl = NEXTOP(cl,yl);
@ -1182,7 +1196,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) { if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = AbsAppl((CELL *)FunctorDBRef); clause->Tag = AbsAppl((CELL *)FunctorDBRef);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,yl); cl = NEXTOP(cl,yl);
@ -1194,7 +1208,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) { if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = AbsAppl((CELL *)FunctorDouble); clause->Tag = AbsAppl((CELL *)FunctorDouble);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,yl); cl = NEXTOP(cl,yl);
@ -1206,7 +1220,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) { if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = (_integer+1)*sizeof(CELL); clause->Tag = (_integer+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,yl); cl = NEXTOP(cl,yl);
@ -1225,7 +1239,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) { if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = (_number+1)*sizeof(CELL); clause->Tag = (_number+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,yl); cl = NEXTOP(cl,yl);
@ -1237,7 +1251,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) { if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = (_primitive+1)*sizeof(CELL); clause->Tag = (_primitive+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,yl); cl = NEXTOP(cl,yl);
@ -1249,7 +1263,7 @@
} }
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) { if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = (_var+1)*sizeof(CELL); clause->Tag = (_var+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,yl); cl = NEXTOP(cl,yl);
@ -1271,7 +1285,7 @@
case _gl_void_valy: case _gl_void_valy:
if (is_regcopy(myregs, nofregs, cl->u.yx.y)) { if (is_regcopy(myregs, nofregs, cl->u.yx.y)) {
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl; clause->ucd.WorkPC = cl;
return; return;
} }
cl = NEXTOP(cl,yx); cl = NEXTOP(cl,yx);
@ -1279,7 +1293,7 @@
case _gl_void_vary: case _gl_void_vary:
if (is_regcopy(myregs, nofregs, cl->u.yx.y)) { if (is_regcopy(myregs, nofregs, cl->u.yx.y)) {
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl; clause->ucd.WorkPC = cl;
return; return;
} }
if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.yx.y))) { if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.yx.y))) {
@ -1291,7 +1305,7 @@
case _glist_valy: case _glist_valy:
if (is_regcopy(myregs, nofregs, cl->u.yx.x)) { if (is_regcopy(myregs, nofregs, cl->u.yx.x)) {
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl; clause->ucd.WorkPC = cl;
return; return;
} }
cl = NEXTOP(cl,yx); cl = NEXTOP(cl,yx);

86
H/headclause.h
View File

@ -17,7 +17,7 @@
if (IsApplTerm(cl->u.cc.c1)) { if (IsApplTerm(cl->u.cc.c1)) {
CELL *pt = RepAppl(cl->u.cc.c1); CELL *pt = RepAppl(cl->u.cc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cc.c1; clause->ucd.t_ptr = cl->u.cc.c1;
} else } else
clause->Tag = cl->u.cc.c1; clause->Tag = cl->u.cc.c1;
return; return;
@ -26,7 +26,7 @@
if (IsApplTerm(cl->u.cc.c2)) { if (IsApplTerm(cl->u.cc.c2)) {
CELL *pt = RepAppl(cl->u.cc.c2); CELL *pt = RepAppl(cl->u.cc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cc.c2; clause->ucd.t_ptr = cl->u.cc.c2;
} else } else
clause->Tag = cl->u.cc.c2; clause->Tag = cl->u.cc.c2;
return; return;
@ -38,7 +38,7 @@
if (IsApplTerm(cl->u.ccc.c1)) { if (IsApplTerm(cl->u.ccc.c1)) {
CELL *pt = RepAppl(cl->u.ccc.c1); CELL *pt = RepAppl(cl->u.ccc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccc.c1; clause->ucd.t_ptr = cl->u.ccc.c1;
} else } else
clause->Tag = cl->u.ccc.c1; clause->Tag = cl->u.ccc.c1;
return; return;
@ -47,7 +47,7 @@
if (IsApplTerm(cl->u.ccc.c2)) { if (IsApplTerm(cl->u.ccc.c2)) {
CELL *pt = RepAppl(cl->u.ccc.c2); CELL *pt = RepAppl(cl->u.ccc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccc.c2; clause->ucd.t_ptr = cl->u.ccc.c2;
} else } else
clause->Tag = cl->u.ccc.c2; clause->Tag = cl->u.ccc.c2;
return; return;
@ -56,7 +56,7 @@
if (IsApplTerm(cl->u.ccc.c3)) { if (IsApplTerm(cl->u.ccc.c3)) {
CELL *pt = RepAppl(cl->u.ccc.c3); CELL *pt = RepAppl(cl->u.ccc.c3);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccc.c3; clause->ucd.t_ptr = cl->u.ccc.c3;
} else } else
clause->Tag = cl->u.ccc.c3; clause->Tag = cl->u.ccc.c3;
return; return;
@ -68,7 +68,7 @@
if (IsApplTerm(cl->u.cccc.c1)) { if (IsApplTerm(cl->u.cccc.c1)) {
CELL *pt = RepAppl(cl->u.cccc.c1); CELL *pt = RepAppl(cl->u.cccc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccc.c1; clause->ucd.t_ptr = cl->u.cccc.c1;
} else } else
clause->Tag = cl->u.cccc.c1; clause->Tag = cl->u.cccc.c1;
return; return;
@ -77,7 +77,7 @@
if (IsApplTerm(cl->u.cccc.c2)) { if (IsApplTerm(cl->u.cccc.c2)) {
CELL *pt = RepAppl(cl->u.cccc.c2); CELL *pt = RepAppl(cl->u.cccc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccc.c2; clause->ucd.t_ptr = cl->u.cccc.c2;
} else } else
clause->Tag = cl->u.cccc.c2; clause->Tag = cl->u.cccc.c2;
return; return;
@ -86,7 +86,7 @@
if (IsApplTerm(cl->u.cccc.c3)) { if (IsApplTerm(cl->u.cccc.c3)) {
CELL *pt = RepAppl(cl->u.cccc.c3); CELL *pt = RepAppl(cl->u.cccc.c3);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccc.c3; clause->ucd.t_ptr = cl->u.cccc.c3;
} else } else
clause->Tag = cl->u.cccc.c3; clause->Tag = cl->u.cccc.c3;
return; return;
@ -95,7 +95,7 @@
if (IsApplTerm(cl->u.cccc.c4)) { if (IsApplTerm(cl->u.cccc.c4)) {
CELL *pt = RepAppl(cl->u.cccc.c4); CELL *pt = RepAppl(cl->u.cccc.c4);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccc.c4; clause->ucd.t_ptr = cl->u.cccc.c4;
} else } else
clause->Tag = cl->u.cccc.c4; clause->Tag = cl->u.cccc.c4;
return; return;
@ -107,7 +107,7 @@
if (IsApplTerm(cl->u.ccccc.c1)) { if (IsApplTerm(cl->u.ccccc.c1)) {
CELL *pt = RepAppl(cl->u.ccccc.c1); CELL *pt = RepAppl(cl->u.ccccc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c1; clause->ucd.t_ptr = cl->u.ccccc.c1;
} else } else
clause->Tag = cl->u.ccccc.c1; clause->Tag = cl->u.ccccc.c1;
return; return;
@ -116,7 +116,7 @@
if (IsApplTerm(cl->u.ccccc.c2)) { if (IsApplTerm(cl->u.ccccc.c2)) {
CELL *pt = RepAppl(cl->u.ccccc.c2); CELL *pt = RepAppl(cl->u.ccccc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c2; clause->ucd.t_ptr = cl->u.ccccc.c2;
} else } else
clause->Tag = cl->u.ccccc.c2; clause->Tag = cl->u.ccccc.c2;
return; return;
@ -125,7 +125,7 @@
if (IsApplTerm(cl->u.ccccc.c3)) { if (IsApplTerm(cl->u.ccccc.c3)) {
CELL *pt = RepAppl(cl->u.ccccc.c3); CELL *pt = RepAppl(cl->u.ccccc.c3);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c3; clause->ucd.t_ptr = cl->u.ccccc.c3;
} else } else
clause->Tag = cl->u.ccccc.c3; clause->Tag = cl->u.ccccc.c3;
return; return;
@ -134,7 +134,7 @@
if (IsApplTerm(cl->u.ccccc.c4)) { if (IsApplTerm(cl->u.ccccc.c4)) {
CELL *pt = RepAppl(cl->u.ccccc.c4); CELL *pt = RepAppl(cl->u.ccccc.c4);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c4; clause->ucd.t_ptr = cl->u.ccccc.c4;
} else } else
clause->Tag = cl->u.ccccc.c4; clause->Tag = cl->u.ccccc.c4;
return; return;
@ -143,7 +143,7 @@
if (IsApplTerm(cl->u.ccccc.c5)) { if (IsApplTerm(cl->u.ccccc.c5)) {
CELL *pt = RepAppl(cl->u.ccccc.c5); CELL *pt = RepAppl(cl->u.ccccc.c5);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c5; clause->ucd.t_ptr = cl->u.ccccc.c5;
} else } else
clause->Tag = cl->u.ccccc.c5; clause->Tag = cl->u.ccccc.c5;
return; return;
@ -155,7 +155,7 @@
if (IsApplTerm(cl->u.cccccc.c1)) { if (IsApplTerm(cl->u.cccccc.c1)) {
CELL *pt = RepAppl(cl->u.cccccc.c1); CELL *pt = RepAppl(cl->u.cccccc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c1; clause->ucd.t_ptr = cl->u.cccccc.c1;
} else } else
clause->Tag = cl->u.cccccc.c1; clause->Tag = cl->u.cccccc.c1;
return; return;
@ -164,7 +164,7 @@
if (IsApplTerm(cl->u.cccccc.c2)) { if (IsApplTerm(cl->u.cccccc.c2)) {
CELL *pt = RepAppl(cl->u.cccccc.c2); CELL *pt = RepAppl(cl->u.cccccc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c2; clause->ucd.t_ptr = cl->u.cccccc.c2;
} else } else
clause->Tag = cl->u.cccccc.c2; clause->Tag = cl->u.cccccc.c2;
return; return;
@ -173,7 +173,7 @@
if (IsApplTerm(cl->u.cccccc.c3)) { if (IsApplTerm(cl->u.cccccc.c3)) {
CELL *pt = RepAppl(cl->u.cccccc.c3); CELL *pt = RepAppl(cl->u.cccccc.c3);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c3; clause->ucd.t_ptr = cl->u.cccccc.c3;
} else } else
clause->Tag = cl->u.cccccc.c3; clause->Tag = cl->u.cccccc.c3;
return; return;
@ -182,7 +182,7 @@
if (IsApplTerm(cl->u.cccccc.c4)) { if (IsApplTerm(cl->u.cccccc.c4)) {
CELL *pt = RepAppl(cl->u.cccccc.c4); CELL *pt = RepAppl(cl->u.cccccc.c4);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c4; clause->ucd.t_ptr = cl->u.cccccc.c4;
} else } else
clause->Tag = cl->u.cccccc.c4; clause->Tag = cl->u.cccccc.c4;
return; return;
@ -191,7 +191,7 @@
if (IsApplTerm(cl->u.cccccc.c5)) { if (IsApplTerm(cl->u.cccccc.c5)) {
CELL *pt = RepAppl(cl->u.cccccc.c5); CELL *pt = RepAppl(cl->u.cccccc.c5);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c5; clause->ucd.t_ptr = cl->u.cccccc.c5;
} else } else
clause->Tag = cl->u.cccccc.c5; clause->Tag = cl->u.cccccc.c5;
return; return;
@ -200,7 +200,7 @@
if (IsApplTerm(cl->u.cccccc.c6)) { if (IsApplTerm(cl->u.cccccc.c6)) {
CELL *pt = RepAppl(cl->u.cccccc.c6); CELL *pt = RepAppl(cl->u.cccccc.c6);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c6; clause->ucd.t_ptr = cl->u.cccccc.c6;
} else } else
clause->Tag = cl->u.cccccc.c6; clause->Tag = cl->u.cccccc.c6;
return; return;
@ -222,15 +222,15 @@
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
if (IsExtensionFunctor(FunctorOfTerm(t))) { if (IsExtensionFunctor(FunctorOfTerm(t))) {
clause->u.t_ptr = t; clause->ucd.t_ptr = t;
} else { } else {
clause->u.c_sreg = pt; clause->ucd.c_sreg = pt;
} }
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
CELL *pt = RepPair(t); CELL *pt = RepPair(t);
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1; clause->ucd.c_sreg = pt-1;
} else { } else {
clause->Tag = t; clause->Tag = t;
} }
@ -257,15 +257,15 @@
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
if (IsExtensionFunctor(FunctorOfTerm(t))) { if (IsExtensionFunctor(FunctorOfTerm(t))) {
clause->u.t_ptr = t; clause->ucd.t_ptr = t;
} else { } else {
clause->u.c_sreg = pt; clause->ucd.c_sreg = pt;
} }
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
CELL *pt = RepPair(t); CELL *pt = RepPair(t);
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1; clause->ucd.c_sreg = pt-1;
} else { } else {
clause->Tag = t; clause->Tag = t;
} }
@ -376,6 +376,12 @@
case _unify_n_atoms_write: case _unify_n_atoms_write:
cl = NEXTOP(cl,osc); cl = NEXTOP(cl,osc);
break; break;
case _unify_l_string:
cl = NEXTOP(cl,ou);
break;
case _unify_string:
cl = NEXTOP(cl,ou);
break;
case _save_appl_x: case _save_appl_x:
if (iarg == cl->u.ox.x) { if (iarg == cl->u.ox.x) {
clause->Tag = (CELL)NULL; clause->Tag = (CELL)NULL;
@ -554,7 +560,7 @@
case _get_list: case _get_list:
if (iarg == cl->u.x.x) { if (iarg == cl->u.x.x) {
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.WorkPC = NEXTOP(cl,x); clause->ucd.WorkPC = NEXTOP(cl,x);
return; return;
} }
cl = NEXTOP(cl,x); cl = NEXTOP(cl,x);
@ -576,7 +582,7 @@
case _get_bigint: case _get_bigint:
if (iarg == cl->u.xN.x) { if (iarg == cl->u.xN.x) {
clause->Tag = AbsAppl((CELL *)FunctorBigInt); clause->Tag = AbsAppl((CELL *)FunctorBigInt);
clause->u.t_ptr = (CELL)NULL; clause->ucd.t_ptr = (CELL)NULL;
return; return;
} }
cl = NEXTOP(cl,xN); cl = NEXTOP(cl,xN);
@ -593,7 +599,7 @@
if (IsApplTerm(cl->u.xc.c)) { if (IsApplTerm(cl->u.xc.c)) {
CELL *pt = RepAppl(cl->u.xc.c); CELL *pt = RepAppl(cl->u.xc.c);
clause->Tag = AbsAppl((CELL *)pt[0]); clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.xc.c; clause->ucd.t_ptr = cl->u.xc.c;
} else } else
clause->Tag = cl->u.xc.c; clause->Tag = cl->u.xc.c;
return; return;
@ -610,7 +616,7 @@
case _get_float: case _get_float:
if (iarg == cl->u.xd.x) { if (iarg == cl->u.xd.x) {
clause->Tag = AbsAppl((CELL *)FunctorDouble); clause->Tag = AbsAppl((CELL *)FunctorDouble);
clause->u.t_ptr = AbsAppl(cl->u.xd.d); clause->ucd.t_ptr = AbsAppl(cl->u.xd.d);
return; return;
} }
cl = NEXTOP(cl,xd); cl = NEXTOP(cl,xd);
@ -625,7 +631,7 @@
case _get_struct: case _get_struct:
if (iarg == cl->u.xfa.x) { if (iarg == cl->u.xfa.x) {
clause->Tag = AbsAppl((CELL *)cl->u.xfa.f); clause->Tag = AbsAppl((CELL *)cl->u.xfa.f);
clause->u.WorkPC = NEXTOP(cl,xfa); clause->ucd.WorkPC = NEXTOP(cl,xfa);
return; return;
} }
cl = NEXTOP(cl,xfa); cl = NEXTOP(cl,xfa);
@ -640,7 +646,7 @@
case _get_longint: case _get_longint:
if (iarg == cl->u.xi.x) { if (iarg == cl->u.xi.x) {
clause->Tag = AbsAppl((CELL *)FunctorLongInt); clause->Tag = AbsAppl((CELL *)FunctorLongInt);
clause->u.t_ptr = AbsAppl(cl->u.xi.i); clause->ucd.t_ptr = AbsAppl(cl->u.xi.i);
return; return;
} }
cl = NEXTOP(cl,xi); cl = NEXTOP(cl,xi);
@ -652,6 +658,14 @@
} }
cl = NEXTOP(cl,xi); cl = NEXTOP(cl,xi);
break; break;
case _get_string:
if (iarg == cl->u.xu.x) {
clause->Tag = AbsAppl((CELL *)FunctorString);
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xu);
break;
case _get_x_val: case _get_x_val:
if (cl->u.xx.xl == iarg || if (cl->u.xx.xl == iarg ||
cl->u.xx.xr == iarg) { cl->u.xx.xr == iarg) {
@ -671,7 +685,7 @@
case _gl_void_valx: case _gl_void_valx:
if (iarg == cl->u.xx.xl) { if (iarg == cl->u.xx.xl) {
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl; clause->ucd.WorkPC = cl;
return; return;
} }
cl = NEXTOP(cl,xx); cl = NEXTOP(cl,xx);
@ -679,7 +693,7 @@
case _gl_void_varx: case _gl_void_varx:
if (iarg == cl->u.xx.xl) { if (iarg == cl->u.xx.xl) {
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl; clause->ucd.WorkPC = cl;
return; return;
} }
if (iarg == cl->u.xx.xr) { if (iarg == cl->u.xx.xr) {
@ -691,7 +705,7 @@
case _glist_valx: case _glist_valx:
if (iarg == cl->u.xx.xl) { if (iarg == cl->u.xx.xl) {
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl; clause->ucd.WorkPC = cl;
return; return;
} }
cl = NEXTOP(cl,xx); cl = NEXTOP(cl,xx);
@ -751,7 +765,7 @@
case _glist_valy: case _glist_valy:
if (iarg == cl->u.yx.x) { if (iarg == cl->u.yx.x) {
clause->Tag = AbsPair(NULL); clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl; clause->ucd.WorkPC = cl;
return; return;
} }
cl = NEXTOP(cl,yx); cl = NEXTOP(cl,yx);

2
H/heapgc.h
View File

@ -45,7 +45,7 @@
#endif #endif
/* is ptr a pointer to the heap? */ /* is ptr a pointer to the heap? */
#define ONHEAP(ptr) (CellPtr(ptr) >= H0 && CellPtr(ptr) < H) #define ONHEAP(ptr) (CellPtr(ptr) >= H0 && CellPtr(ptr) < HR)
/* is ptr a pointer to code space? */ /* is ptr a pointer to code space? */
#if USE_SYSTEM_MALLOC #if USE_SYSTEM_MALLOC

1
H/hlocals.h
View File

@ -235,4 +235,5 @@ typedef struct worker_local {
Int CurSlot_; Int CurSlot_;
Term SourceModule_; Term SourceModule_;
size_t MAX_SIZE_;
} w_local; } w_local;

1
H/hstruct.h
View File

@ -141,6 +141,7 @@
struct pred_entry *pred_is; struct pred_entry *pred_is;
struct pred_entry *pred_safe_call_cleanup; struct pred_entry *pred_safe_call_cleanup;
struct pred_entry *pred_restore_regs; struct pred_entry *pred_restore_regs;
struct pred_entry *pred_comment_hook;
#ifdef YAPOR #ifdef YAPOR
struct pred_entry *pred_getwork; struct pred_entry *pred_getwork;
struct pred_entry *pred_getwork_seq; struct pred_entry *pred_getwork_seq;

6
H/iatoms.h
View File

@ -34,6 +34,7 @@
AtomBatched = Yap_LookupAtom("batched"); AtomBatched = Yap_LookupAtom("batched");
AtomBetween = Yap_LookupAtom("between"); AtomBetween = Yap_LookupAtom("between");
AtomHugeInt = Yap_LookupAtom("huge_int"); AtomHugeInt = Yap_LookupAtom("huge_int");
AtomBigNum = Yap_LookupAtom("big_num");
AtomBinaryStream = Yap_LookupAtom("binary_stream"); AtomBinaryStream = Yap_LookupAtom("binary_stream");
AtomBraces = Yap_LookupAtom("{}"); AtomBraces = Yap_LookupAtom("{}");
AtomBreak = Yap_FullLookupAtom("$break"); AtomBreak = Yap_FullLookupAtom("$break");
@ -53,7 +54,9 @@
AtomColomn = Yap_LookupAtom(":"); AtomColomn = Yap_LookupAtom(":");
AtomCodeSpace = Yap_LookupAtom("code_space"); AtomCodeSpace = Yap_LookupAtom("code_space");
AtomCodes = Yap_LookupAtom("codes"); AtomCodes = Yap_LookupAtom("codes");
AtomCoInductive = Yap_LookupAtom("coinductive");
AtomComma = Yap_LookupAtom(","); AtomComma = Yap_LookupAtom(",");
AtomCommentHook = Yap_LookupAtom("comment_hook");
AtomCompound = Yap_LookupAtom("compound"); AtomCompound = Yap_LookupAtom("compound");
AtomConsistencyError = Yap_LookupAtom("consistency_error"); AtomConsistencyError = Yap_LookupAtom("consistency_error");
AtomConsultOnBoot = Yap_FullLookupAtom("$consult_on_boot"); AtomConsultOnBoot = Yap_FullLookupAtom("$consult_on_boot");
@ -296,6 +299,7 @@
AtomStreamPos = Yap_FullLookupAtom("$stream_position"); AtomStreamPos = Yap_FullLookupAtom("$stream_position");
AtomStreamPosition = Yap_LookupAtom("stream_position"); AtomStreamPosition = Yap_LookupAtom("stream_position");
AtomString = Yap_LookupAtom("string"); AtomString = Yap_LookupAtom("string");
AtomSTRING = Yap_FullLookupAtom("String");
AtomSwi = Yap_LookupAtom("swi"); AtomSwi = Yap_LookupAtom("swi");
AtomSyntaxError = Yap_LookupAtom("syntax_error"); AtomSyntaxError = Yap_LookupAtom("syntax_error");
AtomSyntaxErrorHandler = Yap_LookupAtom("syntax_error_handler"); AtomSyntaxErrorHandler = Yap_LookupAtom("syntax_error_handler");
@ -305,6 +309,7 @@
AtomTerm = Yap_LookupAtom("term"); AtomTerm = Yap_LookupAtom("term");
AtomTerms = Yap_LookupAtom("terms"); AtomTerms = Yap_LookupAtom("terms");
AtomTermExpansion = Yap_LookupAtom("term_expansion"); AtomTermExpansion = Yap_LookupAtom("term_expansion");
AtomText = Yap_LookupAtom("text");
AtomTextStream = Yap_LookupAtom("text_stream"); AtomTextStream = Yap_LookupAtom("text_stream");
AtomThreads = Yap_LookupAtom("threads"); AtomThreads = Yap_LookupAtom("threads");
AtomThrow = Yap_LookupAtom("throw"); AtomThrow = Yap_LookupAtom("throw");
@ -358,6 +363,7 @@
FunctorClist = Yap_MkFunctor(AtomWhen,4); FunctorClist = Yap_MkFunctor(AtomWhen,4);
FunctorCodes = Yap_MkFunctor(AtomCodes,2); FunctorCodes = Yap_MkFunctor(AtomCodes,2);
FunctorComma = Yap_MkFunctor(AtomComma,2); FunctorComma = Yap_MkFunctor(AtomComma,2);
FunctorCommentHook = Yap_MkFunctor(AtomCommentHook,3);
FunctorContext2 = Yap_MkFunctor(AtomContext,2); FunctorContext2 = Yap_MkFunctor(AtomContext,2);
FunctorConsistencyError = Yap_MkFunctor(AtomConsistencyError,1); FunctorConsistencyError = Yap_MkFunctor(AtomConsistencyError,1);
FunctorCreep = Yap_MkFunctor(AtomCreep,1); FunctorCreep = Yap_MkFunctor(AtomCreep,1);

1
H/ihstruct.h
View File

@ -141,6 +141,7 @@
PredIs = RepPredProp(PredPropByFunc(FunctorIs,PROLOG_MODULE)); PredIs = RepPredProp(PredPropByFunc(FunctorIs,PROLOG_MODULE));
PredSafeCallCleanup = RepPredProp(PredPropByFunc(FunctorSafeCallCleanup,PROLOG_MODULE)); PredSafeCallCleanup = RepPredProp(PredPropByFunc(FunctorSafeCallCleanup,PROLOG_MODULE));
PredRestoreRegs = RepPredProp(PredPropByFunc(FunctorRestoreRegs,PROLOG_MODULE)); PredRestoreRegs = RepPredProp(PredPropByFunc(FunctorRestoreRegs,PROLOG_MODULE));
PredCommentHook = RepPredProp(PredPropByFunc(FunctorCommentHook,PROLOG_MODULE));
#ifdef YAPOR #ifdef YAPOR
PredGetwork = RepPredProp(PredPropByAtom(AtomGetwork,PROLOG_MODULE)); PredGetwork = RepPredProp(PredPropByAtom(AtomGetwork,PROLOG_MODULE));
PredGetworkSeq = RepPredProp(PredPropByAtom(AtomGetworkSeq,PROLOG_MODULE)); PredGetworkSeq = RepPredProp(PredPropByAtom(AtomGetworkSeq,PROLOG_MODULE));

1
H/ilocals.h
View File

@ -235,4 +235,5 @@ static void InitWorker(int wid) {
REMOTE_CurSlot(wid) = 0; REMOTE_CurSlot(wid) = 0;
REMOTE_SourceModule(wid) = 0; REMOTE_SourceModule(wid) = 0;
REMOTE_MAX_SIZE(wid) = 1024L;
} }

8
H/index.h
View File

@ -47,7 +47,7 @@ typedef struct StructClauseDef {
yamop *WorkPC; /* start of code for clause */ yamop *WorkPC; /* start of code for clause */
Term t_ptr; Term t_ptr;
CELL *c_sreg; CELL *c_sreg;
} u; } ucd;
} ClauseDef; } ClauseDef;
@ -70,7 +70,7 @@ typedef struct {
union { union {
UInt Label; UInt Label;
yamop *labp; yamop *labp;
} u; } u_a;
} AtomSwiEntry; } AtomSwiEntry;
/* switch_on_func */ /* switch_on_func */
@ -79,7 +79,7 @@ typedef struct {
union { union {
UInt Label; UInt Label;
yamop *labp; yamop *labp;
} u; } u_f;
} FuncSwiEntry; } FuncSwiEntry;
/* switch_on_type */ /* switch_on_type */
@ -116,7 +116,7 @@ typedef struct {
ClauseUnion *block; ClauseUnion *block;
yamop **entry_code; yamop **entry_code;
} cle; } cle;
} u; } uip;
} path_stack_entry; } path_stack_entry;
#define MAX_ISTACK_DEPTH 32 #define MAX_ISTACK_DEPTH 32

1
H/iopreds.h
View File

@ -54,3 +54,4 @@ typedef int (*GetsFunc)(int, UInt, char *);
void Yap_InitStdStreams(void); void Yap_InitStdStreams(void);
Term Yap_StreamPosition(struct io_stream *); Term Yap_StreamPosition(struct io_stream *);
void Yap_InitPlIO(void); void Yap_InitPlIO(void);

39
H/pl-incl.h
View File

@ -34,7 +34,7 @@
/* include all stuff that is exported to yap */ /* include all stuff that is exported to yap */
#include "pl-shared.h" #include "pl-shared.h"
#define PLVERSION YAP_VERSION #define PLVERSION YAP_NUMERIC_VERSION
#define PLNAME "yap" #define PLNAME "yap"
#define SWIP "swi_" #define SWIP "swi_"
@ -59,14 +59,6 @@ typedef struct pred_entry * Procedure; /* predicate */
#undef H #undef H
#endif #endif
// used by swi
#ifdef SIZEOF_INT_P
#define SIZEOF_VOIDP SIZEOF_INT_P
#define SIZEOF_LONG SIZEOF_LONG_INT
#else
bad config
#endif
/* swi code called from pl-incl.h */ /* swi code called from pl-incl.h */
/* should have messages here */ /* should have messages here */
#ifdef DEBUG #ifdef DEBUG
@ -511,7 +503,6 @@ typedef struct wakeup_state
Defining built-in predicates using the new interface Defining built-in predicates using the new interface
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define EOS '\0'
#define ESC ((char) 27) #define ESC ((char) 27)
#define streq(s, q) ((strcmp((s), (q)) == 0)) #define streq(s, q) ((strcmp((s), (q)) == 0))
@ -574,6 +565,7 @@ extern void PL_cleanup_fork(void);
extern int PL_rethrow(void); extern int PL_rethrow(void);
extern void PL_get_number(term_t l, number *n); extern void PL_get_number(term_t l, number *n);
extern int PL_unify_atomic(term_t t, PL_atomic_t a); extern int PL_unify_atomic(term_t t, PL_atomic_t a);
extern int PL_unify_termv(term_t l, va_list args);
extern int _PL_unify_atomic(term_t t, PL_atomic_t a); extern int _PL_unify_atomic(term_t t, PL_atomic_t a);
extern int _PL_unify_string(term_t t, word w); extern int _PL_unify_string(term_t t, word w);
@ -726,7 +718,6 @@ extern atom_t lookupUCSAtom(const pl_wchar_t *s, size_t len);
extern int toIntegerNumber(Number n, int flags); extern int toIntegerNumber(Number n, int flags);
extern int get_atom_ptr_text(Atom a, PL_chars_t *text); extern int get_atom_ptr_text(Atom a, PL_chars_t *text);
extern int warning(const char *fm, ...); extern int warning(const char *fm, ...);
extern int raiseSignal(PL_local_data_t *ld, int sig);
/**** stuff from pl-files.c ****/ /**** stuff from pl-files.c ****/
void initFiles(void); void initFiles(void);
@ -884,6 +875,32 @@ extern void unallocStream(IOSTREAM *s);
extern atom_t accessLevel(void); extern atom_t accessLevel(void);
int currentBreakLevel(void); int currentBreakLevel(void);
#ifdef __WINDOWS__
int hasConsole(void);
int PL_wait_for_console_input(void *handle);
void PlMessage(const char *fm, ...);
const char *WinError(void);
word pl_win_exec(term_t cmd, term_t how);
foreign_t pl_win_module_file(term_t module, term_t file);
#ifdef EMULATE_DLOPEN
/* file is in UTF-8, POSIX path */
void *dlopen(const char *file, int flags);
const char *dlerror(void);
void *dlsym(void *handle, char *symbol);
int dlclose(void *handle);
#endif
int ms_snprintf(char *buffer, size_t count, const char *fmt, ...);
void getDefaultsFromRegistry(void);
DWORD RunSilent(const char* strCommand);
FILE *pt_popen(const char *cmd, const char *mode);
int pt_pclose(FILE *fd);
int PL_w32thread_raise(DWORD id, int sig);
#endif
extern const PL_extension PL_predicates_from_ctype[]; extern const PL_extension PL_predicates_from_ctype[];
extern const PL_extension PL_predicates_from_file[]; extern const PL_extension PL_predicates_from_file[];
extern const PL_extension PL_predicates_from_files[]; extern const PL_extension PL_predicates_from_files[];

41
H/pl-shared.h
View File

@ -56,7 +56,7 @@
#endif #endif
#endif #endif
#include <SWI-Stream.h>
#include <SWI-Prolog.h> #include <SWI-Prolog.h>
#define COMMON(X) extern X #define COMMON(X) extern X
@ -128,7 +128,7 @@ typedef int bool;
typedef struct redir_context typedef struct redir_context
{ int magic; /* REDIR_MAGIC */ { int magic; /* REDIR_MAGIC */
IOSTREAM *stream; /* temporary output */ struct io_stream *stream; /* temporary output */
int is_stream; /* redirect to stream */ int is_stream; /* redirect to stream */
int redirected; /* output is redirected */ int redirected; /* output is redirected */
term_t term; /* redirect target */ term_t term; /* redirect target */
@ -141,6 +141,8 @@ typedef struct redir_context
#include "pl-file.h" #include "pl-file.h"
#define EOS '\0'
/******************************** /********************************
* HASH TABLES * * HASH TABLES *
*********************************/ *********************************/
@ -262,9 +264,32 @@ getUnknownModule(module_t m);
COMMON(int) debugmode(debug_type new, debug_type *old); COMMON(int) debugmode(debug_type new, debug_type *old);
COMMON(int) tracemode(debug_type new, debug_type *old); COMMON(int) tracemode(debug_type new, debug_type *old);
COMMON(void) Yap_setCurrentSourceLocation(IOSTREAM **s); COMMON(void) Yap_setCurrentSourceLocation( void *rd );
extern int raiseSignal(PL_local_data_t *ld, int sig);
#ifdef YATOM_H
static inline atom_t
AtomToSWIAtom(Atom at)
{
TranslationEntry *p;
if ((p = Yap_GetTranslationProp(at)) != NULL)
return (atom_t)(p->Translation*2+1);
return (atom_t)at;
}
#endif
static inline Atom
SWIAtomToAtom(atom_t at)
{
if ((CELL)at & 1)
return SWI_Atoms[at/2];
return (Atom)at;
}
#define SWIAtomToAtom(X) SWI_Atoms[(X)>>1]
Atom YAP_AtomFromSWIAtom(atom_t at); Atom YAP_AtomFromSWIAtom(atom_t at);
atom_t YAP_SWIAtomFromAtom(Atom at); atom_t YAP_SWIAtomFromAtom(Atom at);
@ -273,7 +298,7 @@ atom_t YAP_SWIAtomFromAtom(Atom at);
static inline Functor static inline Functor
SWIFunctorToFunctor(functor_t f) SWIFunctorToFunctor(functor_t f)
{ {
if ((CELL)(f) & 2 && ((CELL)f) < N_SWI_FUNCTORS*4+2) if (((CELL)(f) & 2) && ((CELL)f) < N_SWI_FUNCTORS*4+2)
return SWI_Functors[((CELL)f)/4]; return SWI_Functors[((CELL)f)/4];
return (Functor)f; return (Functor)f;
} }
@ -284,14 +309,14 @@ OpenList(int n USES_REGS)
Term t; Term t;
BACKUP_H(); BACKUP_H();
while (H+2*n > ASP-1024) { while (HR+2*n > ASP-1024) {
if (!Yap_dogc( 0, NULL PASS_REGS )) { if (!Yap_dogc( 0, NULL PASS_REGS )) {
RECOVER_H(); RECOVER_H();
return FALSE; return FALSE;
} }
} }
t = AbsPair(H); t = AbsPair(HR);
H += 2*n; HR += 2*n;
RECOVER_H(); RECOVER_H();
return t; return t;

9
H/pl-yap.h
View File

@ -34,8 +34,9 @@ extern Int Yap_GetCurrentPredArity(void);
extern term_t Yap_fetch_module_for_format(term_t args, Term *modp); extern term_t Yap_fetch_module_for_format(term_t args, Term *modp);
extern IOENC Yap_DefaultEncoding(void); extern IOENC Yap_DefaultEncoding(void);
extern void Yap_SetDefaultEncoding(IOENC); extern void Yap_SetDefaultEncoding(IOENC);
extern void Yap_setCurrentSourceLocation(IOSTREAM **s); extern void Yap_setCurrentSourceLocation( void *rd );
extern void *Yap_GetStreamHandle(Atom at); extern void *Yap_GetStreamHandle(Atom at);
extern void Yap_WriteAtom(IOSTREAM *s, Atom atom);
extern atom_t codeToAtom(int chrcode); extern atom_t codeToAtom(int chrcode);
@ -124,7 +125,7 @@ void PL_license(const char *license, const char *module);
#define stringAtom(w) (YAP_AtomFromSWIAtom(w)->StrOfAE) #define stringAtom(w) (YAP_AtomFromSWIAtom(w)->StrOfAE)
#define isInteger(A) (!IsVarTerm(A) && ( IsIntegerTerm((A)) || YAP_IsBigNumTerm((A)) )) #define isInteger(A) (!IsVarTerm(A) && ( IsIntegerTerm((A)) || YAP_IsBigNumTerm((A)) ))
#define isString(A) (!IsVarTerm(A) && Yap_IsStringTerm(A) ) #define isString(A) (!IsVarTerm(A) && IsStringTerm(A) )
#define isAtom(A) (!IsVarTerm(A) && IsAtomTerm((A)) ) #define isAtom(A) (!IsVarTerm(A) && IsAtomTerm((A)) )
#define isList(A) (!IsVarTerm(A) && IsPairTerm((A)) ) #define isList(A) (!IsVarTerm(A) && IsPairTerm((A)) )
#define isNil(A) ((A) == TermNil) #define isNil(A) ((A) == TermNil)
@ -133,7 +134,7 @@ void PL_license(const char *license, const char *module);
#define isVar(A) IsVarTerm((A)) #define isVar(A) IsVarTerm((A))
#define valReal(w) FloatOfTerm((w)) #define valReal(w) FloatOfTerm((w))
#define valFloat(w) FloatOfTerm((w)) #define valFloat(w) FloatOfTerm((w))
#define atomValue(atom) YAP_AtomFromSWIAtom(atom) #define atomValue(atom) AtomOfTerm(atom)
#define atomFromTerm(term) YAP_SWIAtomFromAtom(AtomOfTerm(term)) #define atomFromTerm(term) YAP_SWIAtomFromAtom(AtomOfTerm(term))
inline static char * inline static char *
@ -184,7 +185,7 @@ charCode(Term w)
return -1; return -1;
} }
if (strlen(a->StrOfAE) == 1) if (strlen(a->StrOfAE) == 1)
return a->StrOfAE[0]; return ((unsigned char *)(a->StrOfAE))[0];
return -1; return -1;
} }
return -1; return -1;

9
H/qly.h
View File

@ -56,7 +56,7 @@ typedef struct export_pred_entry_hash_entry_struct {
union { union {
Functor f; Functor f;
Atom a; Atom a;
} u; } u_af;
Atom module; Atom module;
UInt arity; UInt arity;
} export_pred_entry_hash_entry_t; } export_pred_entry_hash_entry_t;
@ -102,15 +102,14 @@ typedef enum {
} qlf_tag_t; } qlf_tag_t;
#define STATIC_PRED_FLAGS (SourcePredFlag|DynamicPredFlag|LogUpdatePredFlag|CompiledPredFlag|MultiFileFlag|TabledPredFlag|MegaClausePredFlag|CountPredFlag|ProfiledPredFlag|ThreadLocalPredFlag|AtomDBPredFlag|ModuleTransparentPredFlag|NumberDBPredFlag|MetaPredFlag|SyncPredFlag|BackCPredFlag) #define STATIC_PRED_FLAGS (SourcePredFlag|DynamicPredFlag|LogUpdatePredFlag|CompiledPredFlag|MultiFileFlag|TabledPredFlag|MegaClausePredFlag|CountPredFlag|ProfiledPredFlag|ThreadLocalPredFlag|AtomDBPredFlag|ModuleTransparentPredFlag|NumberDBPredFlag|MetaPredFlag|SyncPredFlag|BackCPredFlag)
#define EXTRA_PRED_FLAGS (QuasiQuotationPredFlag|NoTracePredFlag|NoDebugPredFlag)
#define SYSTEM_PRED_FLAGS (BackCPredFlag|UserCPredFlag|CArgsPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag) #define SYSTEM_PRED_FLAGS (BackCPredFlag|UserCPredFlag|CArgsPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)
#define NEXTOP(V,TYPE) ((yamop *)(&((V)->u.TYPE.next)))
#define CHECK(F) { size_t r = (F); if (!r) return r; } #define CHECK(F) { size_t r = (F); if (!r) return r; }
#define RCHECK(F) if(!(F)) { QLYR_ERROR(MISMATCH); return; } #define RCHECK(F) if(!(F)) { QLYR_ERROR(MISMATCH); return; }
#define AllocTempSpace() (H) #define AllocTempSpace() (HR)
#define EnoughTempSpace(sz) ((ASP-H)*sizeof(CELL) > sz) #define EnoughTempSpace(sz) ((ASP-HR)*sizeof(CELL) > sz)

6
H/ratoms.h
View File

@ -34,6 +34,7 @@
AtomBatched = AtomAdjust(AtomBatched); AtomBatched = AtomAdjust(AtomBatched);
AtomBetween = AtomAdjust(AtomBetween); AtomBetween = AtomAdjust(AtomBetween);
AtomHugeInt = AtomAdjust(AtomHugeInt); AtomHugeInt = AtomAdjust(AtomHugeInt);
AtomBigNum = AtomAdjust(AtomBigNum);
AtomBinaryStream = AtomAdjust(AtomBinaryStream); AtomBinaryStream = AtomAdjust(AtomBinaryStream);
AtomBraces = AtomAdjust(AtomBraces); AtomBraces = AtomAdjust(AtomBraces);
AtomBreak = AtomAdjust(AtomBreak); AtomBreak = AtomAdjust(AtomBreak);
@ -53,7 +54,9 @@
AtomColomn = AtomAdjust(AtomColomn); AtomColomn = AtomAdjust(AtomColomn);
AtomCodeSpace = AtomAdjust(AtomCodeSpace); AtomCodeSpace = AtomAdjust(AtomCodeSpace);
AtomCodes = AtomAdjust(AtomCodes); AtomCodes = AtomAdjust(AtomCodes);
AtomCoInductive = AtomAdjust(AtomCoInductive);
AtomComma = AtomAdjust(AtomComma); AtomComma = AtomAdjust(AtomComma);
AtomCommentHook = AtomAdjust(AtomCommentHook);
AtomCompound = AtomAdjust(AtomCompound); AtomCompound = AtomAdjust(AtomCompound);
AtomConsistencyError = AtomAdjust(AtomConsistencyError); AtomConsistencyError = AtomAdjust(AtomConsistencyError);
AtomConsultOnBoot = AtomAdjust(AtomConsultOnBoot); AtomConsultOnBoot = AtomAdjust(AtomConsultOnBoot);
@ -296,6 +299,7 @@
AtomStreamPos = AtomAdjust(AtomStreamPos); AtomStreamPos = AtomAdjust(AtomStreamPos);
AtomStreamPosition = AtomAdjust(AtomStreamPosition); AtomStreamPosition = AtomAdjust(AtomStreamPosition);
AtomString = AtomAdjust(AtomString); AtomString = AtomAdjust(AtomString);
AtomSTRING = AtomAdjust(AtomSTRING);
AtomSwi = AtomAdjust(AtomSwi); AtomSwi = AtomAdjust(AtomSwi);
AtomSyntaxError = AtomAdjust(AtomSyntaxError); AtomSyntaxError = AtomAdjust(AtomSyntaxError);
AtomSyntaxErrorHandler = AtomAdjust(AtomSyntaxErrorHandler); AtomSyntaxErrorHandler = AtomAdjust(AtomSyntaxErrorHandler);
@ -305,6 +309,7 @@
AtomTerm = AtomAdjust(AtomTerm); AtomTerm = AtomAdjust(AtomTerm);
AtomTerms = AtomAdjust(AtomTerms); AtomTerms = AtomAdjust(AtomTerms);
AtomTermExpansion = AtomAdjust(AtomTermExpansion); AtomTermExpansion = AtomAdjust(AtomTermExpansion);
AtomText = AtomAdjust(AtomText);
AtomTextStream = AtomAdjust(AtomTextStream); AtomTextStream = AtomAdjust(AtomTextStream);
AtomThreads = AtomAdjust(AtomThreads); AtomThreads = AtomAdjust(AtomThreads);
AtomThrow = AtomAdjust(AtomThrow); AtomThrow = AtomAdjust(AtomThrow);
@ -358,6 +363,7 @@
FunctorClist = FuncAdjust(FunctorClist); FunctorClist = FuncAdjust(FunctorClist);
FunctorCodes = FuncAdjust(FunctorCodes); FunctorCodes = FuncAdjust(FunctorCodes);
FunctorComma = FuncAdjust(FunctorComma); FunctorComma = FuncAdjust(FunctorComma);
FunctorCommentHook = FuncAdjust(FunctorCommentHook);
FunctorContext2 = FuncAdjust(FunctorContext2); FunctorContext2 = FuncAdjust(FunctorContext2);
FunctorConsistencyError = FuncAdjust(FunctorConsistencyError); FunctorConsistencyError = FuncAdjust(FunctorConsistencyError);
FunctorCreep = FuncAdjust(FunctorCreep); FunctorCreep = FuncAdjust(FunctorCreep);

21
H/rclause.h
View File

@ -107,12 +107,8 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
pc = pc->u.OtaLl.n; pc = pc->u.OtaLl.n;
break; break;
/* instructions type OtapFs */ /* instructions type OtapFs */
#ifdef CUT_C
case _cut_c: case _cut_c:
#endif
#ifdef CUT_C
case _cut_userc: case _cut_userc:
#endif
case _retry_c: case _retry_c:
case _retry_userc: case _retry_userc:
case _try_c: case _try_c:
@ -389,6 +385,13 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
pc->u.osc.c = ConstantTermAdjust(pc->u.osc.c); pc->u.osc.c = ConstantTermAdjust(pc->u.osc.c);
pc = NEXTOP(pc,osc); pc = NEXTOP(pc,osc);
break; break;
/* instructions type ou */
case _unify_l_string:
case _unify_string:
pc->u.ou.opcw = OpcodeAdjust(pc->u.ou.opcw);
pc->u.ou.u = BlobTermInCodeAdjust(pc->u.ou.u);
pc = NEXTOP(pc,ou);
break;
/* instructions type ox */ /* instructions type ox */
case _save_appl_x: case _save_appl_x:
case _save_appl_x_write: case _save_appl_x_write:
@ -637,6 +640,12 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
pc->u.xps.s = ConstantAdjust(pc->u.xps.s); pc->u.xps.s = ConstantAdjust(pc->u.xps.s);
pc = NEXTOP(pc,xps); pc = NEXTOP(pc,xps);
break; break;
/* instructions type xu */
case _get_string:
pc->u.xu.x = XAdjust(pc->u.xu.x);
pc->u.xu.u = BlobTermInCodeAdjust(pc->u.xu.u);
pc = NEXTOP(pc,xu);
break;
/* instructions type xx */ /* instructions type xx */
case _get_x_val: case _get_x_val:
case _get_x_var: case _get_x_var:
@ -867,6 +876,7 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
case _trie_do_appl_in_pair: case _trie_do_appl_in_pair:
case _trie_do_atom: case _trie_do_atom:
case _trie_do_atom_in_pair: case _trie_do_atom_in_pair:
case _trie_do_bigint:
case _trie_do_double: case _trie_do_double:
case _trie_do_extension: case _trie_do_extension:
case _trie_do_gterm: case _trie_do_gterm:
@ -882,6 +892,7 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
case _trie_retry_appl_in_pair: case _trie_retry_appl_in_pair:
case _trie_retry_atom: case _trie_retry_atom:
case _trie_retry_atom_in_pair: case _trie_retry_atom_in_pair:
case _trie_retry_bigint:
case _trie_retry_double: case _trie_retry_double:
case _trie_retry_extension: case _trie_retry_extension:
case _trie_retry_gterm: case _trie_retry_gterm:
@ -897,6 +908,7 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
case _trie_trust_appl_in_pair: case _trie_trust_appl_in_pair:
case _trie_trust_atom: case _trie_trust_atom:
case _trie_trust_atom_in_pair: case _trie_trust_atom_in_pair:
case _trie_trust_bigint:
case _trie_trust_double: case _trie_trust_double:
case _trie_trust_extension: case _trie_trust_extension:
case _trie_trust_gterm: case _trie_trust_gterm:
@ -912,6 +924,7 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
case _trie_try_appl_in_pair: case _trie_try_appl_in_pair:
case _trie_try_atom: case _trie_try_atom:
case _trie_try_atom_in_pair: case _trie_try_atom_in_pair:
case _trie_try_bigint:
case _trie_try_double: case _trie_try_double:
case _trie_try_extension: case _trie_try_extension:
case _trie_try_gterm: case _trie_try_gterm:

1
H/rhstruct.h
View File

@ -141,6 +141,7 @@
PredIs = PtoPredAdjust(PredIs); PredIs = PtoPredAdjust(PredIs);
PredSafeCallCleanup = PtoPredAdjust(PredSafeCallCleanup); PredSafeCallCleanup = PtoPredAdjust(PredSafeCallCleanup);
PredRestoreRegs = PtoPredAdjust(PredRestoreRegs); PredRestoreRegs = PtoPredAdjust(PredRestoreRegs);
PredCommentHook = PtoPredAdjust(PredCommentHook);
#ifdef YAPOR #ifdef YAPOR
PredGetwork = PtoPredAdjust(PredGetwork); PredGetwork = PtoPredAdjust(PredGetwork);
PredGetworkSeq = PtoPredAdjust(PredGetworkSeq); PredGetworkSeq = PtoPredAdjust(PredGetworkSeq);

1
H/rlocals.h
View File

@ -233,6 +233,7 @@ static void RestoreWorker(int wid USES_REGS) {
} }

21
H/saveclause.h
View File

@ -117,12 +117,8 @@
pc = NEXTOP(pc,OtaLl); pc = NEXTOP(pc,OtaLl);
break; break;
/* instructions type OtapFs */ /* instructions type OtapFs */
#ifdef CUT_C
case _cut_c: case _cut_c:
#endif
#ifdef CUT_C
case _cut_userc: case _cut_userc:
#endif
case _retry_c: case _retry_c:
case _retry_userc: case _retry_userc:
case _try_c: case _try_c:
@ -406,6 +402,13 @@
CHECK(save_ConstantTerm(stream, pc->u.osc.c)); CHECK(save_ConstantTerm(stream, pc->u.osc.c));
pc = NEXTOP(pc,osc); pc = NEXTOP(pc,osc);
break; break;
/* instructions type ou */
case _unify_l_string:
case _unify_string:
CHECK(save_Opcode(stream, pc->u.ou.opcw));
CHECK(save_BlobTermInCode(stream, pc->u.ou.u));
pc = NEXTOP(pc,ou);
break;
/* instructions type ox */ /* instructions type ox */
case _save_appl_x: case _save_appl_x:
case _save_appl_x_write: case _save_appl_x_write:
@ -653,6 +656,12 @@
CHECK(save_Constant(stream, pc->u.xps.s)); CHECK(save_Constant(stream, pc->u.xps.s));
pc = NEXTOP(pc,xps); pc = NEXTOP(pc,xps);
break; break;
/* instructions type xu */
case _get_string:
CHECK(save_X(stream, pc->u.xu.x));
CHECK(save_BlobTermInCode(stream, pc->u.xu.u));
pc = NEXTOP(pc,xu);
break;
/* instructions type xx */ /* instructions type xx */
case _get_x_val: case _get_x_val:
case _get_x_var: case _get_x_var:
@ -891,6 +900,7 @@
case _trie_do_appl_in_pair: case _trie_do_appl_in_pair:
case _trie_do_atom: case _trie_do_atom:
case _trie_do_atom_in_pair: case _trie_do_atom_in_pair:
case _trie_do_bigint:
case _trie_do_double: case _trie_do_double:
case _trie_do_extension: case _trie_do_extension:
case _trie_do_gterm: case _trie_do_gterm:
@ -906,6 +916,7 @@
case _trie_retry_appl_in_pair: case _trie_retry_appl_in_pair:
case _trie_retry_atom: case _trie_retry_atom:
case _trie_retry_atom_in_pair: case _trie_retry_atom_in_pair:
case _trie_retry_bigint:
case _trie_retry_double: case _trie_retry_double:
case _trie_retry_extension: case _trie_retry_extension:
case _trie_retry_gterm: case _trie_retry_gterm:
@ -921,6 +932,7 @@
case _trie_trust_appl_in_pair: case _trie_trust_appl_in_pair:
case _trie_trust_atom: case _trie_trust_atom:
case _trie_trust_atom_in_pair: case _trie_trust_atom_in_pair:
case _trie_trust_bigint:
case _trie_trust_double: case _trie_trust_double:
case _trie_trust_extension: case _trie_trust_extension:
case _trie_trust_gterm: case _trie_trust_gterm:
@ -936,6 +948,7 @@
case _trie_try_appl_in_pair: case _trie_try_appl_in_pair:
case _trie_try_atom: case _trie_try_atom:
case _trie_try_atom_in_pair: case _trie_try_atom_in_pair:
case _trie_try_bigint:
case _trie_try_double: case _trie_try_double:
case _trie_try_extension: case _trie_try_extension:
case _trie_try_gterm: case _trie_try_gterm:

2
H/sshift.h
View File

@ -1116,7 +1116,7 @@ INLINE_ONLY inline EXTERN int IsGlobal__ (CELL CACHE_TYPE);
INLINE_ONLY inline EXTERN int INLINE_ONLY inline EXTERN int
IsGlobal__ (CELL reg USES_REGS) IsGlobal__ (CELL reg USES_REGS)
{ {
return (int) (IN_BETWEEN (LOCAL_GlobalBase, reg, H)); return (int) (IN_BETWEEN (LOCAL_GlobalBase, reg, HR));
} }

12
H/tatoms.h
View File

@ -66,6 +66,8 @@
#define AtomBetween Yap_heap_regs->AtomBetween_ #define AtomBetween Yap_heap_regs->AtomBetween_
Atom AtomHugeInt_; Atom AtomHugeInt_;
#define AtomHugeInt Yap_heap_regs->AtomHugeInt_ #define AtomHugeInt Yap_heap_regs->AtomHugeInt_
Atom AtomBigNum_;
#define AtomBigNum Yap_heap_regs->AtomBigNum_
Atom AtomBinaryStream_; Atom AtomBinaryStream_;
#define AtomBinaryStream Yap_heap_regs->AtomBinaryStream_ #define AtomBinaryStream Yap_heap_regs->AtomBinaryStream_
Atom AtomBraces_; Atom AtomBraces_;
@ -104,8 +106,12 @@
#define AtomCodeSpace Yap_heap_regs->AtomCodeSpace_ #define AtomCodeSpace Yap_heap_regs->AtomCodeSpace_
Atom AtomCodes_; Atom AtomCodes_;
#define AtomCodes Yap_heap_regs->AtomCodes_ #define AtomCodes Yap_heap_regs->AtomCodes_
Atom AtomCoInductive_;
#define AtomCoInductive Yap_heap_regs->AtomCoInductive_
Atom AtomComma_; Atom AtomComma_;
#define AtomComma Yap_heap_regs->AtomComma_ #define AtomComma Yap_heap_regs->AtomComma_
Atom AtomCommentHook_;
#define AtomCommentHook Yap_heap_regs->AtomCommentHook_
Atom AtomCompound_; Atom AtomCompound_;
#define AtomCompound Yap_heap_regs->AtomCompound_ #define AtomCompound Yap_heap_regs->AtomCompound_
Atom AtomConsistencyError_; Atom AtomConsistencyError_;
@ -590,6 +596,8 @@
#define AtomStreamPosition Yap_heap_regs->AtomStreamPosition_ #define AtomStreamPosition Yap_heap_regs->AtomStreamPosition_
Atom AtomString_; Atom AtomString_;
#define AtomString Yap_heap_regs->AtomString_ #define AtomString Yap_heap_regs->AtomString_
Atom AtomSTRING_;
#define AtomSTRING Yap_heap_regs->AtomSTRING_
Atom AtomSwi_; Atom AtomSwi_;
#define AtomSwi Yap_heap_regs->AtomSwi_ #define AtomSwi Yap_heap_regs->AtomSwi_
Atom AtomSyntaxError_; Atom AtomSyntaxError_;
@ -608,6 +616,8 @@
#define AtomTerms Yap_heap_regs->AtomTerms_ #define AtomTerms Yap_heap_regs->AtomTerms_
Atom AtomTermExpansion_; Atom AtomTermExpansion_;
#define AtomTermExpansion Yap_heap_regs->AtomTermExpansion_ #define AtomTermExpansion Yap_heap_regs->AtomTermExpansion_
Atom AtomText_;
#define AtomText Yap_heap_regs->AtomText_
Atom AtomTextStream_; Atom AtomTextStream_;
#define AtomTextStream Yap_heap_regs->AtomTextStream_ #define AtomTextStream Yap_heap_regs->AtomTextStream_
Atom AtomThreads_; Atom AtomThreads_;
@ -714,6 +724,8 @@
#define FunctorCodes Yap_heap_regs->FunctorCodes_ #define FunctorCodes Yap_heap_regs->FunctorCodes_
Functor FunctorComma_; Functor FunctorComma_;
#define FunctorComma Yap_heap_regs->FunctorComma_ #define FunctorComma Yap_heap_regs->FunctorComma_
Functor FunctorCommentHook_;
#define FunctorCommentHook Yap_heap_regs->FunctorCommentHook_
Functor FunctorContext2_; Functor FunctorContext2_;
#define FunctorContext2 Yap_heap_regs->FunctorContext2_ #define FunctorContext2 Yap_heap_regs->FunctorContext2_
Functor FunctorConsistencyError_; Functor FunctorConsistencyError_;

4
H/trim_trail.h
View File

@ -27,7 +27,7 @@
/* skip, this is a problem because we lose information, /* skip, this is a problem because we lose information,
namely active references */ namely active references */
pt1 = (tr_fr_ptr)pt; pt1 = (tr_fr_ptr)pt;
} else if (IN_BETWEEN(H0,pt,H) && IsAttVar(pt)) { } else if (IN_BETWEEN(H0,pt,HR) && IsAttVar(pt)) {
CELL val = Deref(*pt); CELL val = Deref(*pt);
if (IsVarTerm(val)) { if (IsVarTerm(val)) {
Bind(pt, MkAtomTerm(AtomCut)); Bind(pt, MkAtomTerm(AtomCut));
@ -128,7 +128,7 @@
} else if (IsPairTerm(d1)) { } else if (IsPairTerm(d1)) {
CELL *pt = RepPair(d1); CELL *pt = RepPair(d1);
if (IN_BETWEEN(H0,pt,H) && IsAttVar(pt)) { if (IN_BETWEEN(H0,pt,HR) && IsAttVar(pt)) {
CELL val = Deref(*pt); CELL val = Deref(*pt);
if (IsVarTerm(val)) { if (IsVarTerm(val)) {
Bind(VarOfTerm(val), MkAtomTerm(AtomCut)); Bind(VarOfTerm(val), MkAtomTerm(AtomCut));

17
H/walkclause.h
View File

@ -67,12 +67,8 @@
pc = pc->u.OtaLl.n; pc = pc->u.OtaLl.n;
break; break;
/* instructions type OtapFs */ /* instructions type OtapFs */
#ifdef CUT_C
case _cut_c: case _cut_c:
#endif
#ifdef CUT_C
case _cut_userc: case _cut_userc:
#endif
case _retry_c: case _retry_c:
case _retry_userc: case _retry_userc:
case _try_c: case _try_c:
@ -293,6 +289,11 @@
case _unify_n_atoms_write: case _unify_n_atoms_write:
pc = NEXTOP(pc,osc); pc = NEXTOP(pc,osc);
break; break;
/* instructions type ou */
case _unify_l_string:
case _unify_string:
pc = NEXTOP(pc,ou);
break;
/* instructions type ox */ /* instructions type ox */
case _save_appl_x: case _save_appl_x:
case _save_appl_x_write: case _save_appl_x_write:
@ -478,6 +479,10 @@
case _commit_b_x: case _commit_b_x:
pc = NEXTOP(pc,xps); pc = NEXTOP(pc,xps);
break; break;
/* instructions type xu */
case _get_string:
pc = NEXTOP(pc,xu);
break;
/* instructions type xx */ /* instructions type xx */
case _get_x_val: case _get_x_val:
case _get_x_var: case _get_x_var:
@ -657,6 +662,7 @@
case _trie_do_appl_in_pair: case _trie_do_appl_in_pair:
case _trie_do_atom: case _trie_do_atom:
case _trie_do_atom_in_pair: case _trie_do_atom_in_pair:
case _trie_do_bigint:
case _trie_do_double: case _trie_do_double:
case _trie_do_extension: case _trie_do_extension:
case _trie_do_gterm: case _trie_do_gterm:
@ -672,6 +678,7 @@
case _trie_retry_appl_in_pair: case _trie_retry_appl_in_pair:
case _trie_retry_atom: case _trie_retry_atom:
case _trie_retry_atom_in_pair: case _trie_retry_atom_in_pair:
case _trie_retry_bigint:
case _trie_retry_double: case _trie_retry_double:
case _trie_retry_extension: case _trie_retry_extension:
case _trie_retry_gterm: case _trie_retry_gterm:
@ -687,6 +694,7 @@
case _trie_trust_appl_in_pair: case _trie_trust_appl_in_pair:
case _trie_trust_atom: case _trie_trust_atom:
case _trie_trust_atom_in_pair: case _trie_trust_atom_in_pair:
case _trie_trust_bigint:
case _trie_trust_double: case _trie_trust_double:
case _trie_trust_extension: case _trie_trust_extension:
case _trie_trust_gterm: case _trie_trust_gterm:
@ -702,6 +710,7 @@
case _trie_try_appl_in_pair: case _trie_try_appl_in_pair:
case _trie_try_atom: case _trie_try_atom:
case _trie_try_atom_in_pair: case _trie_try_atom_in_pair:
case _trie_try_bigint:
case _trie_try_double: case _trie_try_double:
case _trie_try_extension: case _trie_try_extension:
case _trie_try_gterm: case _trie_try_gterm:

2
H/yapio.h
View File

@ -240,7 +240,7 @@ Term Yap_Variables(VarEntry *,Term);
Term Yap_Singletons(VarEntry *,Term); Term Yap_Singletons(VarEntry *,Term);
/* routines in scanner.c */ /* routines in scanner.c */
TokEntry *Yap_tokenizer(struct io_stream *, int, Term *); TokEntry *Yap_tokenizer(struct io_stream *, int, Term *, void *rd);
void Yap_clean_tokenizer(TokEntry *, VarEntry *, VarEntry *,Term); void Yap_clean_tokenizer(TokEntry *, VarEntry *, VarEntry *,Term);
Term Yap_scan_num(struct io_stream *); Term Yap_scan_num(struct io_stream *);
char *Yap_AllocScannerMemory(unsigned int); char *Yap_AllocScannerMemory(unsigned int);

110
ICLP2014_examples.yap Normal file
View File

@ -0,0 +1,110 @@
:- initialization(yap_flag(tabling_mode, load_answers)).
% Required to activate rational term support within the table space.
/*
ICLP2014 submission - instack/2
*/
instack(E, [H|T]) :- E == H.
instack(E, [_H|T]) :- instack(E, T).
/*
ICLP2014 submission - Example 1. member_1/2
Cyclic safe predicate with the use of instack/2 predicate.
*/
member_1(E, L) :-
member(E, L, []).
member(E, [E|_T], _).
member(_E, L, S) :-
instack(L, S),
!,
fail.
member(E, [H|T], S) :-
member(E, T, [[H|T]|S]).
/*
ICLP2014 submission - Example 2. member_2/2
Cyclic safe predicate with the use of tabling.
*/
:- table member_2/2.
member_2(E, [E|_T]).
member_2(E, [_H|T]) :-
member_2(E, T).
/*
ICLP2014 submission - Example 3. bin/1
*/
:- table bin/1.
:- tabling_mode(bin/1, coinductive).
% The two above directives are the equivalent of the :- coinductive bin/1 directive
bin([0|T]) :- bin(T).
bin([1|T]) :- bin(T).
/*
ICLP2014 submission - Example 4. comember/2
*/
:- table comember/2.
:- tabling_mode(comember/2, coinductive).
% The two above directives are the equivalent of the :- coinductive comember/2 directive
comember(H, L) :-
drop(H, L, L1),
comember(H, L1).
:- table(drop/3).
drop(H, [H|T], T).
drop(H, [_|T], T1) :- drop(H, T, T1).
%%%%%%%%%%
/*
ICLP2014 submission - Example 5. alternative drop_2/3 definition.
This definition uses instack instead of tabling.
*/
drop_2(E, L, NL) :-
drop(E, L, NL, []).
drop(_E, L, _NL, S) :-
instack(L, S),
!,
fail.
drop(E, [E|T], T, _).
drop(E, [H|T], T1, S) :-
drop(E, T, T1, [[H|T]|S]).
/*
ICLP2014 submission - Example 6. canonical_term/2
The following predicate takes a rational term and returns
the same rational term in canonical form.
*/
canonical_term(Term, Canonical) :-
Term =.. InList,
decompose_cyclic_term(Term, InList, OutList, OpenEnd, [Term]),
Canonical =.. OutList,
Canonical = OpenEnd.
decompose_cyclic_term(_CyclicTerm, [], [], _OpenEnd, _Stack).
decompose_cyclic_term(CyclicTerm, [Term|Tail], [Term|NewTail], OpenEnd, Stack) :-
acyclic_term(Term), !,
decompose_cyclic_term(CyclicTerm, Tail, NewTail, OpenEnd, Stack).
decompose_cyclic_term(CyclicTerm, [Term|Tail], [OpenEnd|NewTail], OpenEnd, Stack) :-
CyclicTerm == Term, !,
decompose_cyclic_term(CyclicTerm, Tail, NewTail, OpenEnd, Stack).
decompose_cyclic_term(CyclicTerm, [Term|Tail], [Canonical|NewTail], OpenEnd, Stack) :-
\+ instack(Term, Stack), !,
Term =.. InList,
decompose_cyclic_term(Term, InList, OutList, OpenEnd2, [Term|Stack]),
Canonical =.. OutList,
( Canonical = OpenEnd2,
Canonical == Term,
!
; OpenEnd2 = OpenEnd
),
decompose_cyclic_term(CyclicTerm, Tail, NewTail, OpenEnd, Stack).
decompose_cyclic_term(CyclicTerm, [_Term|Tail], [OpenEnd|NewTail], OpenEnd, Stack) :-
decompose_cyclic_term(CyclicTerm, Tail, NewTail, OpenEnd, Stack).

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