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
[submodule "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"]
path = packages/archive
url = git://git.code.sf.net/p/yap/archive
@ -51,4 +51,4 @@
url = git://git.code.sf.net/p/yap/ltx2htm
[submodule "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);
#include "Yatom.h"
#include "yapio.h"
#include "pl-shared.h"
#include <stdio.h>
#include <wchar.h>
#if HAVE_STRING_H
@ -301,45 +302,61 @@ Yap_LookupMaybeWideAtom(wchar_t *atom)
}
Atom
Yap_LookupMaybeWideAtomWithLength(wchar_t *atom, size_t len)
Yap_LookupMaybeWideAtomWithLength(wchar_t *atom, size_t len0)
{ /* lookup atom in atom table */
wchar_t *p = atom, c;
size_t len0 = 0;
size_t len = 0;
Atom at;
int wide = FALSE;
while ((c = *p++)) {
if (c > 255) wide = TRUE;
len0++;
if (len0 == len) break;
len++;
if (len == len0) break;
}
if (p[0] == '\0' && wide) return LookupWideAtom(atom);
else if (wide) {
wchar_t *ptr, *ptr0;
p = atom;
ptr0 = ptr = (wchar_t *)Yap_AllocCodeSpace(sizeof(wchar_t)*(len+1));
if (!ptr)
if (wide) {
wchar_t *ptr0;
ptr0 = (wchar_t *)Yap_AllocCodeSpace(sizeof(wchar_t)*(len0+1));
if (!ptr0)
return NIL;
while (len--) {*ptr++ = *p++;}
ptr[0] = '\0';
memcpy(ptr0, atom, len0*sizeof(wchar_t));
ptr0[len0] = '\0';
at = LookupWideAtom(ptr0);
Yap_FreeCodeSpace((char *)ptr0);
return at;
} else {
char *ptr, *ptr0;
/* not really a wide atom */
p = atom;
ptr0 = ptr = Yap_AllocCodeSpace(len+1);
if (!ptr)
char *ptr0;
Int i;
ptr0 = (char *)Yap_AllocCodeSpace((len0+1));
if (!ptr0)
return NIL;
while (len--) {*ptr++ = *p++;}
ptr[0] = '\0';
for (i=0; i < len0; i++) ptr0[i] = atom[i];
ptr0[len0] = '\0';
at = LookupAtom(ptr0);
Yap_FreeCodeSpace(ptr0);
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
Yap_LookupAtom(char *atom)
{ /* lookup atom in atom table */
@ -770,7 +787,7 @@ ExpandPredHash(void)
/* fe is supposed to be locked */
Prop
Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
{
{ GET_LD
PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
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.NOfClauses = 0;
p->PredFlags = 0L;
#if SIZEOF_INT_P==4
p->ExtraPredFlags = 0L;
#endif
p->src.OwnerFile = AtomNil;
p->OpcodeOfPred = UNDEF_OPCODE;
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
@ -849,6 +869,9 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
p->PredFlags |= GoalExPredFlag;
}
}
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
p->ExtraPredFlags |= NoDebugPredFlag;
}
p->FunctorOfPred = fe;
WRITE_UNLOCK(fe->FRWLock);
{
@ -863,7 +886,7 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
#if THREADS
Prop
Yap_NewThreadPred(PredEntry *ap USES_REGS)
{
{ LD_FROM_REGS
PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
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.NOfClauses = 0;
p->PredFlags = ap->PredFlags & ~(IndexedPredFlag|SpiedPredFlag);
#if SIZEOF_INT_P==4
p->ExtraPredFlags = 0L;
#endif
p->src.OwnerFile = ap->src.OwnerFile;
p->OpcodeOfPred = UNDEF_OPCODE;
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;
p->FunctorOfPred = ap->FunctorOfPred;
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))) {
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
Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
{
{ GET_LD
Prop p0;
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.NOfClauses = 0;
p->PredFlags = 0L;
#if SIZEOF_INT_P==4
p->ExtraPredFlags = 0L;
#endif
p->src.OwnerFile = AtomNil;
p->OpcodeOfPred = UNDEF_OPCODE;
p->cs.p_code.ExpandCode = EXPAND_OP_CODE;
@ -963,6 +995,9 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
AddPropToAtom(ae, (PropEntry *)p);
p0 = AbsPredProp(p);
p->FunctorOfPred = (Functor)AbsAtom(ae);
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
p->ExtraPredFlags |= NoDebugPredFlag;
}
WRITE_UNLOCK(ae->ARWLock);
{
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) {
CACHE_REGS
out = MkLongIntTerm(LongIntOfTerm(out));
} else if (f == FunctorString) {
CACHE_REGS
out = MkStringTerm(StringOfTerm(out));
}
#ifdef USE_GMP
else {
@ -1167,6 +1205,21 @@ Yap_PutValue(Atom a, Term v)
memcpy((void *)pt, (void *)ap, sz);
p->ValueOfVE = AbsAppl(pt);
#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 {
if (IsApplTerm(t0)) {
/* recover space */
@ -1201,209 +1254,6 @@ Yap_PutAtomTranslation(Atom a, Int i)
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
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_OldTR = TR;
LOCAL_OldGlobalBase = (CELL *)LOCAL_GlobalBase;
LOCAL_OldH = H;
LOCAL_OldH = HR;
LOCAL_OldH0 = H0;
LOCAL_OldTrailBase = LOCAL_TrailBase;
LOCAL_OldTrailTop = LOCAL_TrailTop;
@ -319,11 +319,13 @@ mark_global_cell(CELL *pt)
/* skip bitmaps */
switch(reg) {
case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
return pt + 4;
#else
return pt + 3;
#endif
case (CELL)FunctorString:
return pt + 3 + pt[1];
case (CELL)FunctorBigInt:
{
Int sz = 3 +
@ -376,7 +378,7 @@ mark_global(USES_REGS1)
* the code
*/
pt = H0;
while (pt < H) {
while (pt < HR) {
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 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)))
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;
}
// 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 *
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;
}
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 *
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;
}
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
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:
code_p = a_rb(_get_bigint, clause_has_blobsp, code_p, pass_no, cip);
break;
case get_string_op:
code_p = a_rstring(_get_string, clause_has_blobsp, code_p, pass_no, cip);
break;
case get_dbterm_op:
code_p = a_dbt(_get_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
break;
@ -3258,6 +3297,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case put_bigint_op:
code_p = a_rb(_put_bigint, clause_has_blobsp, code_p, pass_no, cip);
break;
case put_string_op:
code_p = a_rstring(_put_bigint, clause_has_blobsp, code_p, pass_no, cip);
break;
case put_dbterm_op:
code_p = a_dbt(_put_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
break;
@ -3318,6 +3360,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case unify_bigint_op:
code_p = a_ublob(cip->cpc->rnd1, _unify_bigint, _unify_atom_write, clause_has_blobsp, code_p, pass_no, cip);
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:
code_p = a_udbt(cip->cpc->rnd1, _unify_dbterm, _unify_atom_write, clause_has_dbtermp, code_p, pass_no, cip);
break;
@ -3336,6 +3381,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
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);
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:
code_p = a_udbt(cip->cpc->rnd1, _unify_l_dbterm, _unify_l_atom_write, clause_has_dbtermp, code_p, pass_no, cip);
break;
@ -3354,6 +3402,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case write_bigint_op:
code_p = a_wblob(cip->cpc->rnd1, _write_bigint, clause_has_blobsp, code_p, pass_no, cip);
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:
code_p = a_wdbt(cip->cpc->rnd1, _write_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
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->op == mark_initialised_pvars_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;
code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip);
}
if (!pass_no) {
#if !USE_SYSTEM_MALLOC
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();
siglongjmp(cip->CompilerBotch, 3);
}
@ -3737,7 +3789,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
break;
case align_float_op:
/* install a blob */
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
if (!((CELL)code_p & 0x4))
GONEXT(e);
#endif
@ -3746,6 +3798,10 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
/* install a blob */
code_p = copy_blob(code_p, pass_no, cip->cpc);
break;
case string_op:
/* install a blob */
code_p = copy_string(code_p, pass_no, cip->cpc);
break;
case empty_call_op:
/* create an empty call */
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 *
fetch_clause_space(Term* tp, UInt size, struct intermediates *cip, UInt *osizep USES_REGS)
{
CELL *h0 = H;
CELL *h0 = HR;
DBTerm *x;
/* This stuff should be just about fetching the space from the data-base,
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) {
H = h0;
HR = h0;
switch (LOCAL_Error_TYPE) {
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();
siglongjmp(cip->CompilerBotch,3);
case OUT_OF_TRAIL_ERROR:
@ -3827,10 +3883,10 @@ fetch_clause_space(Term* tp, UInt size, struct intermediates *cip, UInt *osizep
default:
return NULL;
}
h0 = H;
H = (CELL *)cip->freep;
h0 = HR;
HR = (CELL *)cip->freep;
}
H = h0;
HR = h0;
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->lusl.ClSource = x;
cl->ClFlags |= SrcMask;
x->ag.line_number = Yap_source_line_no();
cl->ClSize = osize;
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);
/* make sure we copy after second pass */
cl->usc.ClSource = x;
cl->ClFlags |= SrcMask;
x->ag.line_number = Yap_source_line_no();
cl->ClSize = osize;
LOCAL_ProfEnd=code_p;

6
C/arith0.c
View File

@ -138,12 +138,12 @@ eval0(Int fi) {
RINT(((CELL *)TR)-LCL0);
#endif
case op_stackfree:
RINT(Unsigned(ASP) - Unsigned(H));
RINT(Unsigned(ASP) - Unsigned(HR));
case op_globalsp:
#if YAPOR_SBA
RINT((Int)H);
RINT((Int)HR);
#else
RINT(H - H0);
RINT(HR - H0);
#endif
}
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)
return 0L;
#if SIZEOF_LONG_INT == 8
#if SIZEOF_INT_P == 8
if (!(inp & 0xffffffffLL)) {inp >>= 32; out += 32;}
#endif
if (!(inp & 0xffffL)) {inp >>= 16; out += 16;}
@ -373,10 +373,10 @@ eval1(Int fi, Term t USES_REGS) {
}
case op_lgamma:
{
#if HAVE_LGAMMA
Float dbl;
dbl = get_float(t);
#if HAVE_LGAMMA
RFLOAT(lgamma(dbl));
#else
RERROR();
@ -384,8 +384,8 @@ eval1(Int fi, Term t USES_REGS) {
}
case op_erf:
{
Float dbl = get_float(t), out;
#if HAVE_ERF
Float dbl = get_float(t), out;
out = erf(dbl);
RFLOAT(out);
#else
@ -394,8 +394,8 @@ eval1(Int fi, Term t USES_REGS) {
}
case op_erfc:
{
Float dbl = get_float(t), out;
#if HAVE_ERF
Float dbl = get_float(t), out;
out = erfc(dbl);
RFLOAT(out);
#else

201
C/arrays.c
View File

@ -330,7 +330,7 @@ AccessNamedArray(Atom a, Int indx USES_REGS)
StaticArrayEntry *ptr = (StaticArrayEntry *)pp;
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");*/
READ_UNLOCK(ptr->ArRWLock);
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
* we backtrack or when we abort */
/* place terms in reverse order */
Bind_Global(&(p->ValueOfVE),AbsAppl(H));
tp = H;
Bind_Global(&(p->ValueOfVE),AbsAppl(HR));
tp = HR;
tp[0] = (CELL)Yap_MkFunctor(AtomArray, dim);
tp++;
p->ArrayEArity = dim;
/* Initialise the array as a set of variables */
H = tp+dim;
for (; tp < H; tp++) {
HR = tp+dim;
for (; tp < HR; tp++) {
RESET_VARIABLE(tp);
}
WRITE_UNLOCK(p->ArRWLock);
@ -566,6 +566,7 @@ CreateNamedArray(PropEntry * pp, Int dim, AtomEntry *ae USES_REGS)
p = (ArrayEntry *) Yap_AllocAtomSpace(sizeof(*p));
p->KindOfPE = ArrayProperty;
p->TypeOfAE = DYNAMIC_ARRAY;
AddPropToAtom(ae, (PropEntry *)p);
INIT_RWLOCK(p->ArRWLock);
#if THREADS
@ -578,9 +579,9 @@ CreateNamedArray(PropEntry * pp, Int dim, AtomEntry *ae USES_REGS)
}
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) {
case array_of_doubles:
asize = array_size*sizeof(Float);
@ -606,22 +607,33 @@ AllocateStaticArraySpace(StaticArrayEntry *p, static_array_types atype, Int arra
asize = array_size*sizeof(DBRef);
break;
}
while ((p->ValueOfVE.floats = (Float *) Yap_AllocAtomSpace(asize) ) == NULL) {
YAPLeaveCriticalSection();
if (!Yap_growheap(FALSE, asize, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
return;
if (old == NULL) {
while ((p->ValueOfVE.floats = (Float *) Yap_AllocCodeSpace(asize) ) == NULL) {
YAPLeaveCriticalSection();
if (!Yap_growheap(FALSE, asize, NULL)) {
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 */
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)) {
while ((p = (StaticArrayEntry *) Yap_AllocAtomSpace(sizeof(*p))) == NULL) {
while ((p = (StaticArrayEntry *) Yap_AllocCodeSpace(sizeof(*p))) == NULL) {
if (!Yap_growheap(FALSE, sizeof(*p), NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
return NULL;
@ -634,12 +646,13 @@ CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR star
LOCAL_StaticArrays = p;
}
WRITE_LOCK(p->ArRWLock);
p->ArrayEArity = -dim;
p->ArrayEArity = dim;
p->ArrayType = type;
p->TypeOfAE = STATIC_ARRAY;
if (start_addr == NULL) {
Int i;
AllocateStaticArraySpace(p, type, dim PASS_REGS);
AllocateStaticArraySpace(p, type, NULL, dim PASS_REGS);
if (p->ValueOfVE.ints == NULL) {
WRITE_UNLOCK(p->ArRWLock);
return p;
@ -683,6 +696,7 @@ CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR star
}
} else {
/* external array */
p->TypeOfAE |= MMAP_ARRAY;
p->ValueOfVE.chars = (char *)start_addr;
}
WRITE_UNLOCK(p->ArRWLock);
@ -690,86 +704,64 @@ CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR star
}
static void
ResizeStaticArray(StaticArrayEntry *pp, Int dim USES_REGS)
ResizeStaticArray(StaticArrayEntry *pp, size_t dim USES_REGS)
{
statarray_elements old_v = pp->ValueOfVE;
static_array_types type = pp->ArrayType;
Int old_dim = - pp->ArrayEArity;
Int mindim = (dim < old_dim ? dim : old_dim), i;
size_t old_dim = pp->ArrayEArity;
size_t mindim = (dim < old_dim ? dim : old_dim), i;
/* change official size */
if (pp->ArrayEArity >= 0){
if (pp->ArrayEArity == 0){
return;
}
WRITE_LOCK(pp->ArRWLock);
pp->ArrayEArity = -dim;
pp->ArrayEArity = dim;
#if HAVE_MMAP
if (pp->ValueOfVE.chars < (char *)Yap_HeapBase ||
pp->ValueOfVE.chars > (char *)HeapTop) {
if (pp->TypeOfAE & MMAP_ARRAY) {
ResizeMmappedArray(pp, dim, (void *)(pp->ValueOfVE.chars) PASS_REGS);
WRITE_UNLOCK(pp->ArRWLock);
return;
}
#endif
AllocateStaticArraySpace(pp, type, dim PASS_REGS);
AllocateStaticArraySpace(pp, type, old_v.chars, dim PASS_REGS);
switch(type) {
case array_of_ints:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.ints[i] = old_v.ints[i];
for (i = mindim; i<dim; i++)
pp->ValueOfVE.ints[i] = 0;
break;
case array_of_chars:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.chars[i] = old_v.chars[i];
for (i = mindim; i<dim; i++)
pp->ValueOfVE.chars[i] = '\0';
break;
case array_of_uchars:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.uchars[i] = old_v.uchars[i];
for (i = mindim; i<dim; i++)
pp->ValueOfVE.uchars[i] = '\0';
break;
case array_of_doubles:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.floats[i] = old_v.floats[i];
for (i = mindim; i<dim; i++)
pp->ValueOfVE.floats[i] = 0.0;
break;
case array_of_ptrs:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.ptrs[i] = old_v.ptrs[i];
for (i = mindim; i<dim; i++)
pp->ValueOfVE.ptrs[i] = NULL;
break;
case array_of_atoms:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.atoms[i] = old_v.atoms[i];
for (i = mindim; i<dim; i++)
pp->ValueOfVE.atoms[i] = TermNil;
break;
case array_of_dbrefs:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.dbrefs[i] = old_v.dbrefs[i];
for (i = mindim; i<dim; i++)
pp->ValueOfVE.dbrefs[i] = 0L;
break;
case array_of_terms:
for (i = 0; i <mindim; i++)
pp->ValueOfVE.terms[i] = old_v.terms[i];
for (i = mindim; i<dim; i++)
pp->ValueOfVE.terms[i] = NULL;
break;
case array_of_nb_terms:
for (i = 0; i <mindim; i++) {
Term tlive = pp->ValueOfVE.lterms[i].tlive;
if (IsVarTerm(tlive) && IsUnboundVar(&(pp->ValueOfVE.lterms[i].tlive))) {
RESET_VARIABLE(&(pp->ValueOfVE.lterms[i].tlive));
} else {
pp->ValueOfVE.lterms[i].tlive = tlive;
}
pp->ValueOfVE.lterms[i].tstore = old_v.lterms[i].tstore;
for (i = mindim; i <dim; i++) {
RESET_VARIABLE(&(pp->ValueOfVE.lterms[i].tlive));
pp->ValueOfVE.lterms[i].tstore = TermNil;
}
break;
}
@ -781,10 +773,10 @@ ClearStaticArray(StaticArrayEntry *pp)
{
statarray_elements old_v = pp->ValueOfVE;
static_array_types type = pp->ArrayType;
Int dim = - pp->ArrayEArity, i;
Int dim = pp->ArrayEArity, i;
/* change official size */
if (pp->ArrayEArity >= 0){
if (pp->ArrayEArity == 0){
return;
}
WRITE_LOCK(pp->ArRWLock);
@ -895,13 +887,13 @@ p_create_array( USES_REGS1 )
Functor farray;
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))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage);
return(FALSE);
} else {
if (H+1+size > ASP-1024) {
if (!Yap_growstack( sizeof(CELL) * (size+1-(H-ASP-1024)))) {
if (HR+1+size > ASP-1024) {
if (!Yap_growstack( sizeof(CELL) * (size+1-(HR-ASP-1024)))) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
return FALSE;
}
@ -909,11 +901,11 @@ p_create_array( USES_REGS1 )
}
goto restart;
}
t = AbsAppl(H);
*H++ = (CELL) farray;
t = AbsAppl(HR);
*HR++ = (CELL) farray;
for (; size >= 0; size--) {
RESET_VARIABLE(H);
H++;
RESET_VARIABLE(HR);
HR++;
}
return (Yap_unify(t, ARG1));
}
@ -932,7 +924,7 @@ p_create_array( USES_REGS1 )
)
pp = RepProp(pp->NextOfPE);
if (EndOfPAEntr(pp)) {
if (H+1+size > ASP-1024) {
if (HR+1+size > ASP-1024) {
WRITE_UNLOCK(ae->ARWLock);
if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage);
@ -949,13 +941,12 @@ p_create_array( USES_REGS1 )
WRITE_UNLOCK(ae->ARWLock);
if (!IsVarTerm(app->ValueOfVE)
|| !IsUnboundVar(&app->ValueOfVE)) {
if (size == app->ArrayEArity ||
size == -app->ArrayEArity)
if (size == app->ArrayEArity)
return TRUE;
Yap_Error(PERMISSION_ERROR_CREATE_ARRAY,t,"create_array",
ae->StrOfAE);
} 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))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage);
return(FALSE);
@ -1064,7 +1055,7 @@ p_create_static_array( USES_REGS1 )
return FALSE;
}
} else {
if (pp->ArrayEArity == -size &&
if (pp->ArrayEArity == size &&
pp->ArrayType == props) {
WRITE_UNLOCK(ae->ARWLock);
return TRUE;
@ -1101,7 +1092,7 @@ p_static_array_properties( USES_REGS1 )
return (FALSE);
} else {
static_array_types tp = pp->ArrayType;
Int dim = -pp->ArrayEArity;
Int dim = pp->ArrayEArity;
READ_UNLOCK(ae->ARWLock);
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");
return(FALSE);
} else {
Int osize = - pp->ArrayEArity;
size_t osize = pp->ArrayEArity;
ResizeStaticArray(pp, size PASS_REGS);
return(Yap_unify(ARG2,MkIntegerTerm(osize)));
}
@ -1237,14 +1228,14 @@ p_close_static_array( USES_REGS1 )
StaticArrayEntry *ptr = (StaticArrayEntry *)pp;
if (ptr->ValueOfVE.ints != NULL) {
#if HAVE_MMAP
if (ptr->ValueOfVE.chars < (char *)Yap_HeapBase ||
ptr->ValueOfVE.chars > (char *)HeapTop) {
Int val = CloseMmappedArray(ptr, (void *)ptr->ValueOfVE.chars PASS_REGS);
Int val = CloseMmappedArray(ptr, (void *)ptr->ValueOfVE.chars PASS_REGS);
#if USE_SYSTEM_MALLOC
if (val)
if (val) {
#endif
return(val);
#if USE_SYSTEM_MALLOC
}
#endif
#endif
Yap_FreeAtomSpace((char *)(ptr->ValueOfVE.ints));
ptr->ValueOfVE.ints = NULL;
@ -1422,7 +1413,7 @@ loop:
}
else if (IsPairTerm(d0)) {
/* store the terms to visit */
*ptn++ = AbsPair(H);
*ptn++ = AbsPair(HR);
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
@ -1441,8 +1432,8 @@ loop:
pt0 = RepPair(d0) - 1;
pt0_end = RepPair(d0) + 1;
/* write the head and tail of the list */
ptn = H;
H += 2;
ptn = HR;
HR += 2;
}
else if (IsApplTerm(d0)) {
register Functor f;
@ -1455,7 +1446,7 @@ loop:
continue;
}
}
*ptn++ = AbsAppl(H);
*ptn++ = AbsAppl(HR);
/* store the terms to visit */
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
@ -1476,9 +1467,9 @@ loop:
d0 = ArityOfFunctor(f);
pt0_end = pt0 + d0;
/* start writing the compound term */
ptn = H;
ptn = HR;
*ptn++ = (CELL) f;
H += d0 + 1;
HR += d0 + 1;
}
else { /* AtomOrInt */
*ptn++ = d0;
@ -1527,19 +1518,19 @@ replace_array_references(Term t0 USES_REGS)
return (MkPairTerm(t, TermNil));
} else if (IsPairTerm(t)) {
Term VList = MkVarTerm();
CELL *h0 = H;
CELL *h0 = HR;
H += 2;
HR += 2;
replace_array_references_complex(RepPair(t) - 1, RepPair(t) + 1, h0,
VList PASS_REGS);
return MkPairTerm(AbsPair(h0), VList);
} else {
Term VList = MkVarTerm();
CELL *h0 = H;
CELL *h0 = HR;
Functor f = FunctorOfTerm(t);
*H++ = (CELL) (f);
H += ArityOfFunctor(f);
*HR++ = (CELL) (f);
HR += ArityOfFunctor(f);
replace_array_references_complex(RepAppl(t),
RepAppl(t) + ArityOfFunctor(FunctorOfTerm(t)), h0 + 1,
VList PASS_REGS);
@ -1651,7 +1642,7 @@ p_assign_static( USES_REGS1 )
WRITE_LOCK(ptr->ArRWLock);
READ_UNLOCK(ae->ARWLock);
/* a static array */
if (indx < 0 || indx >= - ptr->ArrayEArity) {
if (indx < 0 || indx >= ptr->ArrayEArity) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
return FALSE;
@ -1980,7 +1971,7 @@ p_assign_dynamic( USES_REGS1 )
WRITE_LOCK(ptr->ArRWLock);
/* a static array */
if (indx < 0 || indx >= - ptr->ArrayEArity) {
if (indx < 0 || indx >= ptr->ArrayEArity) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
return FALSE;
@ -2179,7 +2170,7 @@ p_add_to_array_element( USES_REGS1 )
WRITE_LOCK(ptr->ArRWLock);
/* a static array */
if (indx < 0 || indx >= - ptr->ArrayEArity) {
if (indx < 0 || indx >= ptr->ArrayEArity) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"add_to_array_element");
return FALSE;
@ -2271,16 +2262,16 @@ p_static_array_to_term( USES_REGS1 )
return (FALSE);
} else {
static_array_types tp = pp->ArrayType;
Int dim = -pp->ArrayEArity, indx;
Int dim = pp->ArrayEArity, indx;
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))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage);
return(FALSE);
} else {
if (H+1+dim > ASP-1024) {
if (!Yap_growstack( sizeof(CELL) * (dim+1-(H-ASP-1024)))) {
if (HR+1+dim > ASP-1024) {
if (!Yap_growstack( sizeof(CELL) * (dim+1-(HR-ASP-1024)))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return FALSE;
}
@ -2289,13 +2280,13 @@ p_static_array_to_term( USES_REGS1 )
}
READ_LOCK(pp->ArRWLock);
READ_UNLOCK(ae->ARWLock);
base = H;
*H++ = (CELL)Yap_MkFunctor(AbsAtom(ae),dim);
base = HR;
*HR++ = (CELL)Yap_MkFunctor(AbsAtom(ae),dim);
switch(tp) {
case array_of_ints:
{
CELL *sptr = H;
H += dim;
CELL *sptr = HR;
HR += dim;
for (indx=0; indx < dim; indx++) {
*sptr++ = MkIntegerTerm(pp->ValueOfVE.ints[indx]);
}
@ -2322,13 +2313,13 @@ p_static_array_to_term( USES_REGS1 )
} else {
TRef = TermNil;
}
*H++ = TRef;
*HR++ = TRef;
}
break;
case array_of_doubles:
{
CELL *sptr = H;
H += dim;
CELL *sptr = HR;
HR += dim;
for (indx=0; indx < dim; indx++) {
*sptr++ = MkEvalFl(pp->ValueOfVE.floats[indx]);
}
@ -2336,8 +2327,8 @@ p_static_array_to_term( USES_REGS1 )
break;
case array_of_ptrs:
{
CELL *sptr = H;
H += dim;
CELL *sptr = HR;
HR += dim;
for (indx=0; indx < dim; indx++) {
*sptr++ = MkIntegerTerm((Int)(pp->ValueOfVE.ptrs[indx]));
}
@ -2345,8 +2336,8 @@ p_static_array_to_term( USES_REGS1 )
break;
case array_of_chars:
{
CELL *sptr = H;
H += dim;
CELL *sptr = HR;
HR += dim;
for (indx=0; indx < dim; indx++) {
*sptr++ = MkIntegerTerm((Int)(pp->ValueOfVE.chars[indx]));
}
@ -2354,8 +2345,8 @@ p_static_array_to_term( USES_REGS1 )
break;
case array_of_uchars:
{
CELL *sptr = H;
H += dim;
CELL *sptr = HR;
HR += dim;
for (indx=0; indx < dim; indx++) {
*sptr++ = MkIntegerTerm((Int)(pp->ValueOfVE.uchars[indx]));
}
@ -2363,8 +2354,8 @@ p_static_array_to_term( USES_REGS1 )
break;
case array_of_terms:
{
CELL *sptr = H;
H += dim;
CELL *sptr = HR;
HR += dim;
for (indx=0; indx < dim; indx++) {
/* The object is now in use */
DBTerm *ref = pp->ValueOfVE.terms[indx];
@ -2381,8 +2372,8 @@ p_static_array_to_term( USES_REGS1 )
break;
case array_of_nb_terms:
{
CELL *sptr = H;
H += dim;
CELL *sptr = HR;
HR += dim;
for (indx=0; indx < dim; indx++) {
/* The object is now in use */
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];
if (out == 0L)
out = TermNil;
*H++ = out;
*HR++ = out;
}
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;
/* add a new attributed variable */
newv = (attvar_record *)H;
H = (CELL *)(newv+1);
newv = (attvar_record *)HR;
HR = (CELL *)(newv+1);
newv->AttFunc = FunctorAttVar;
RESET_VARIABLE(&(newv->Value));
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->end_cp = vt;
if (IsVarTerm(attv->Atts)) {
Bind_Global_NonAtt(&newv->Atts, (CELL)H);
to_visit->to = H;
H++;
Bind_Global_NonAtt(&newv->Atts, (CELL)HR);
to_visit->to = HR;
HR++;
} else {
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 */
attvar_record *attv = RepAttVar(pt1);
CELL *myH = H;
CELL *myH = HR;
CELL *bind_ptr;
if (IsVarTerm(Deref(attv->Atts))) {
@ -201,9 +201,9 @@ WakeAttVar(CELL* pt1, CELL reg2 USES_REGS)
bind_ptr = AddToQueue(attv PASS_REGS);
if (IsNonVarTerm(reg2)) {
if (IsPairTerm(reg2) && RepPair(reg2) == myH)
reg2 = AbsPair(H);
reg2 = AbsPair(HR);
else if (IsApplTerm(reg2) && RepAppl(reg2) == myH)
reg2 = AbsAppl(H);
reg2 = AbsAppl(HR);
}
*bind_ptr = reg2;
Bind_Global_NonAtt(&(attv->Value), reg2);
@ -227,19 +227,19 @@ mark_attvar(CELL *orig)
static Term
BuildAttTerm(Functor mfun, UInt ar USES_REGS)
{
CELL *h0 = H;
CELL *h0 = HR;
UInt i;
if (H+(1024+ar) > ASP) {
if (HR+(1024+ar) > ASP) {
LOCAL_Error_Size=ar*sizeof(CELL);
return 0L;
}
H[0] = (CELL)mfun;
RESET_VARIABLE(H+1);
H += 2;
HR[0] = (CELL)mfun;
RESET_VARIABLE(HR+1);
HR += 2;
for (i = 1; i< ar; i++) {
*H = TermVoidAtt;
H++;
*HR = TermVoidAtt;
HR++;
}
return AbsAppl(h0);
}
@ -390,7 +390,7 @@ DelAtts(attvar_record *attv, Term oatt USES_REGS)
static void
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 */
Term tnew = MkVarTerm();
Bind_NonAtt(VarOfTerm(att), tnew);
@ -850,23 +850,23 @@ p_modules_with_atts( USES_REGS1 ) {
if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) {
attvar_record *attv = RepAttVar(VarOfTerm(inp));
CELL *h0 = H;
CELL *h0 = HR;
Term tatt;
if (IsVarTerm(tatt = attv->Atts))
return Yap_unify(ARG2,TermNil);
while (!IsVarTerm(tatt)) {
Functor f = FunctorOfTerm(tatt);
if (H != h0)
H[-1] = AbsPair(H);
if (HR != h0)
HR[-1] = AbsPair(HR);
if (ActiveAtt(tatt, ArityOfFunctor(f))) {
*H = MkAtomTerm(NameOfFunctor(f));
H+=2;
*HR = MkAtomTerm(NameOfFunctor(f));
HR+=2;
}
tatt = ArgOfTerm(1,tatt);
}
if (h0 != H) {
H[-1] = TermNil;
if (h0 != HR) {
HR[-1] = TermNil;
return Yap_unify(ARG2,AbsPair(h0));
}
}
@ -887,7 +887,7 @@ p_swi_all_atts( USES_REGS1 ) {
if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) {
attvar_record *attv = RepAttVar(VarOfTerm(inp));
CELL *h0 = H;
CELL *h0 = HR;
Term tatt;
if (IsVarTerm(tatt = attv->Atts))
@ -896,21 +896,21 @@ p_swi_all_atts( USES_REGS1 ) {
Functor f = FunctorOfTerm(tatt);
UInt ar = ArityOfFunctor(f);
if (H != h0)
H[-1] = AbsAppl(H);
H[0] = (CELL) attf;
H[1] = MkAtomTerm(NameOfFunctor(f));
if (HR != h0)
HR[-1] = AbsAppl(HR);
HR[0] = (CELL) attf;
HR[1] = MkAtomTerm(NameOfFunctor(f));
/* SWI */
if (ar == 2)
H[2] = ArgOfTerm(2,tatt);
HR[2] = ArgOfTerm(2,tatt);
else
H[2] = tatt;
H += 4;
H[-1] = AbsAppl(H);
HR[2] = tatt;
HR += 4;
HR[-1] = AbsAppl(HR);
tatt = ArgOfTerm(1,tatt);
}
if (h0 != H) {
H[-1] = TermNil;
if (h0 != HR) {
HR[-1] = TermNil;
return Yap_unify(ARG2,AbsAppl(h0));
}
}
@ -925,17 +925,17 @@ p_swi_all_atts( USES_REGS1 ) {
static Term
AllAttVars( USES_REGS1 ) {
CELL *pt = H0;
CELL *myH = H;
CELL *myH = HR;
while (pt < myH) {
switch(*pt) {
case (CELL)FunctorAttVar:
if (IsUnboundVar(pt+1)) {
if (ASP - myH < 1024) {
LOCAL_Error_Size = (ASP-H)*sizeof(CELL);
LOCAL_Error_Size = (ASP-HR)*sizeof(CELL);
return 0L;
}
if (myH != H) {
if (myH != HR) {
myH[-1] = AbsPair(myH);
}
myH[0] = AbsAttVar((attvar_record *)pt);
@ -944,12 +944,15 @@ AllAttVars( USES_REGS1 ) {
pt += (1+ATT_RECORD_ARITY);
break;
case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
pt += 4;
#else
pt += 3;
#endif
break;
case (CELL)FunctorString:
pt += 3+pt[1];
break;
case (CELL)FunctorBigInt:
{
Int sz = 3 +
@ -965,10 +968,10 @@ AllAttVars( USES_REGS1 ) {
pt++;
}
}
if (myH != H) {
Term out = AbsPair(H);
if (myH != HR) {
Term out = AbsPair(HR);
myH[-1] = TermNil;
H = myH;
HR = myH;
return out;
} else {
return TermNil;

273
C/bignum.c
View File

@ -26,6 +26,7 @@ static char SccsId[] = "%W% %G%";
#endif
#include "YapHeap.h"
#include "pl-utf8.h"
#ifdef USE_GMP
@ -37,8 +38,8 @@ Yap_MkBigIntTerm(MP_INT *big)
{
CACHE_REGS
Int nlimbs;
MP_INT *dst = (MP_INT *)(H+2);
CELL *ret = H;
MP_INT *dst = (MP_INT *)(HR+2);
CELL *ret = HR;
Int bytes;
if (mpz_fits_slong_p(big)) {
@ -53,15 +54,15 @@ Yap_MkBigIntTerm(MP_INT *big)
if (nlimbs > (ASP-ret)-1024) {
return TermNil;
}
H[0] = (CELL)FunctorBigInt;
H[1] = BIG_INT;
HR[0] = (CELL)FunctorBigInt;
HR[1] = BIG_INT;
dst->_mp_size = big->_mp_size;
dst->_mp_alloc = nlimbs*(CellSize/sizeof(mp_limb_t));
memmove((void *)(dst+1), (const void *)(big->_mp_d), bytes);
H = (CELL *)(dst+1)+nlimbs;
H[0] = EndSpecials;
H++;
HR = (CELL *)(dst+1)+nlimbs;
HR[0] = EndSpecials;
HR++;
return AbsAppl(ret);
}
@ -80,19 +81,19 @@ Yap_MkBigRatTerm(MP_RAT *big)
{
CACHE_REGS
Int nlimbs;
MP_INT *dst = (MP_INT *)(H+2);
MP_INT *dst = (MP_INT *)(HR+2);
MP_INT *num = mpq_numref(big);
MP_INT *den = mpq_denref(big);
MP_RAT *rat;
CELL *ret = H;
CELL *ret = HR;
if (mpz_cmp_si(den, 1) == 0)
return Yap_MkBigIntTerm(num);
if ((num->_mp_alloc+den->_mp_alloc)*(sizeof(mp_limb_t)/CellSize) > (ASP-ret)-1024) {
return TermNil;
}
H[0] = (CELL)FunctorBigInt;
H[1] = BIG_RATIONAL;
HR[0] = (CELL)FunctorBigInt;
HR[1] = BIG_RATIONAL;
dst->_mp_size = 0;
rat = (MP_RAT *)(dst+1);
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);
rat->_mp_den._mp_size = den->_mp_size;
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);
memmove((void *)(H), (const void *)(den->_mp_d), nlimbs*CellSize);
H += nlimbs;
dst->_mp_alloc = (H-(CELL *)(dst+1));
H[0] = EndSpecials;
H++;
memmove((void *)(HR), (const void *)(den->_mp_d), nlimbs*CellSize);
HR += nlimbs;
dst->_mp_alloc = (HR-(CELL *)(dst+1));
HR[0] = EndSpecials;
HR++;
return AbsAppl(ret);
}
@ -141,20 +142,20 @@ Yap_AllocExternalDataInStack(CELL tag, size_t bytes)
{
CACHE_REGS
Int nlimbs;
MP_INT *dst = (MP_INT *)(H+2);
CELL *ret = H;
MP_INT *dst = (MP_INT *)(HR+2);
CELL *ret = HR;
nlimbs = ALIGN_YAPTYPE(bytes,CELL)/CellSize;
if (nlimbs > (ASP-ret)-1024) {
return TermNil;
}
H[0] = (CELL)FunctorBigInt;
H[1] = tag;
HR[0] = (CELL)FunctorBigInt;
HR[1] = tag;
dst->_mp_size = 0;
dst->_mp_alloc = nlimbs;
H = (CELL *)(dst+1)+nlimbs;
H[0] = EndSpecials;
H++;
HR = (CELL *)(dst+1)+nlimbs;
HR[0] = EndSpecials;
HR++;
if (tag != EXTERNAL_BLOB) {
TrailTerm(TR) = AbsPair(ret);
TR++;
@ -332,6 +333,82 @@ Yap_MkULLIntTerm(YAP_ULONG_LONG n)
#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
p_is_bignum( USES_REGS1 )
{
@ -348,6 +425,17 @@ p_is_bignum( USES_REGS1 )
#endif
}
static Int
p_is_string( USES_REGS1 )
{
Term t = Deref(ARG1);
return(
IsNonVarTerm(t) &&
IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorString
);
}
static Int
p_nb_set_bit( USES_REGS1 )
{
@ -469,142 +557,6 @@ p_rational( USES_REGS1 )
#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
Yap_InitBigNums(void)
{
@ -612,6 +564,7 @@ Yap_InitBigNums(void)
Yap_InitCPred("$bignum", 1, p_is_bignum, SafePredFlag);
Yap_InitCPred("rational", 3, p_rational, 0);
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("nb_set_bit", 2, p_nb_set_bit, SafePredFlag);
}

321
C/c_interface.c
View File

@ -354,6 +354,7 @@
#include "yap_structs.h"
#define _yap_c_interface_h 1
#include "pl-shared.h"
#include "YapText.h"
#include "pl-read.h"
#ifdef TABLING
#include "tab.macros.h"
@ -362,9 +363,7 @@
#include "or.macros.h"
#endif /* YAPOR */
#include "threads.h"
#ifdef CUT_C
#include "cut_c.h"
#endif /* CUT_C */
#if HAVE_MALLOC_H
#include <malloc.h>
#endif
@ -378,8 +377,6 @@
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
#define X_API __declspec(dllexport)
#else
#define X_API
#endif
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_UserBackCPredicate(char *,CPredicate,CPredicate,UInt,unsigned int);
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_ExtraSpaceCut(void);
#endif
X_API Term YAP_SetCurrentModule(Term);
X_API Term YAP_CurrentModule(void);
X_API Term YAP_CreateModule(Atom);
@ -566,6 +561,7 @@ X_API void *YAP_ExternalDataInStackFromTerm(Term);
X_API int YAP_NewOpaqueType(void *);
X_API Term YAP_NewOpaqueObject(int, size_t);
X_API void *YAP_OpaqueObjectFromTerm(Term);
X_API CELL *YAP_HeapStoreOpaqueTerm(Term t);
X_API int YAP_Argv(char *** argvp);
X_API YAP_tag_t YAP_TagOfTerm(Term);
X_API size_t YAP_ExportTerm(Term, char *, size_t);
@ -800,21 +796,21 @@ YAP_MkBlobTerm(unsigned int sz)
MP_INT *dst;
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))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, "YAP failed to grow the stack while constructing a blob: %s", LOCAL_ErrorMessage);
return TermNil;
}
}
I = AbsAppl(H);
H[0] = (CELL)FunctorBigInt;
H[1] = ARRAY_INT;
dst = (MP_INT *)(H+2);
I = AbsAppl(HR);
HR[0] = (CELL)FunctorBigInt;
HR[1] = ARRAY_INT;
dst = (MP_INT *)(HR+2);
dst->_mp_size = 0L;
dst->_mp_alloc = sz;
H += (2+sizeof(MP_INT)/sizeof(CELL));
H[sz] = EndSpecials;
H += sz+1;
HR += (2+sizeof(MP_INT)/sizeof(CELL));
HR[sz] = EndSpecials;
HR += sz+1;
RECOVER_H();
return I;
@ -980,7 +976,7 @@ YAP_MkPairTerm(Term t1, Term t2)
Term t;
BACKUP_H();
while (H > ASP-1024) {
while (HR > ASP-1024) {
Int sl1 = Yap_InitSlot(t1 PASS_REGS);
Int sl2 = Yap_InitSlot(t2 PASS_REGS);
RECOVER_H();
@ -1006,7 +1002,7 @@ YAP_MkListFromTerms(Term *ta, Int sz)
if (sz == 0)
return TermNil;
BACKUP_H();
while (H+sz*2 > ASP-1024) {
while (HR+sz*2 > ASP-1024) {
Int sl1 = Yap_InitSlot((CELL)ta PASS_REGS);
RECOVER_H();
if (!Yap_dogc( 0, NULL PASS_REGS )) {
@ -1016,7 +1012,7 @@ YAP_MkListFromTerms(Term *ta, Int sz)
ta = (CELL *)Yap_GetFromSlot(sl1 PASS_REGS);
Yap_RecoverSlots(1 PASS_REGS);
}
h = H;
h = HR;
t = AbsPair(h);
while (sz--) {
Term ti = *ta++;
@ -1030,7 +1026,7 @@ YAP_MkListFromTerms(Term *ta, Int sz)
h += 2;
}
h[-1] = TermNil;
H = h;
HR = h;
RECOVER_H();
return t;
}
@ -1042,7 +1038,7 @@ YAP_MkNewPairTerm()
Term t;
BACKUP_H();
if (H > ASP-1024)
if (HR > ASP-1024)
t = TermNil;
else
t = Yap_MkNewPairTerm();
@ -1100,7 +1096,7 @@ YAP_MkApplTerm(Functor f,UInt arity, Term args[])
Term t;
BACKUP_H();
if (H+arity > ASP-1024)
if (HR+arity > ASP-1024)
t = TermNil;
else
t = Yap_MkApplTerm(f, arity, args);
@ -1116,7 +1112,7 @@ YAP_MkNewApplTerm(Functor f,UInt arity)
Term t;
BACKUP_H();
if (H+arity > ASP-1024)
if (HR+arity > ASP-1024)
t = TermNil;
else
t = Yap_MkNewApplTerm(f, arity);
@ -1166,7 +1162,6 @@ YAP_ArityOfFunctor(Functor f)
return (ArityOfFunctor(f));
}
#ifdef CUT_C
X_API void *
YAP_ExtraSpaceCut(void)
{
@ -1179,7 +1174,6 @@ YAP_ExtraSpaceCut(void)
RECOVER_B();
return(ptr);
}
#endif /*CUT_C*/
X_API void *
YAP_ExtraSpace(void)
@ -1191,7 +1185,7 @@ YAP_ExtraSpace(void)
/* find a pointer to extra space allocable */
ptr = (void *)((CELL *)(B+1)+P->u.OtapFs.s);
B->cp_h = H;
B->cp_h = HR;
RECOVER_H();
RECOVER_B();
@ -1203,14 +1197,12 @@ YAP_cut_up(void)
{
CACHE_REGS
BACKUP_B();
#ifdef CUT_C
{
while (POP_CHOICE_POINT(B->cp_b))
{
POP_EXECUTE();
}
}
#endif /* CUT_C */
/* This is complicated: make sure we can restore the ASP
pointer back to where cut_up called it. Slots depend on it. */
if (ENV > B->cp_env) {
@ -1644,7 +1636,7 @@ complete_fail(choiceptr ptr, int has_cp USES_REGS)
static int
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)) {
if (cut_all || B->cp_ap == NOCODE) {/* separator */
do_cut( TRUE ); // pushes B up
@ -1780,6 +1772,7 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
}
} else {
Int ret = (exec_code)( PASS_REGS1 );
LOCAL_CurSlot = CurSlot;
if (!ret) {
Term t;
@ -1907,6 +1900,7 @@ YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
return TRUE;
} else {
Int ret = (exec_code)( PASS_REGS1 );
LOCAL_CurSlot = CurSlot;
if (!ret) {
Term t;
@ -1984,42 +1978,16 @@ YAP_FreeSpaceFromYap(void *ptr)
X_API int
YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize)
{
unsigned int j = 0;
while (t != TermNil) {
register Term Head;
register Int i;
Head = HeadOfTerm(t);
if (IsVarTerm(Head)) {
Yap_Error(INSTANTIATION_ERROR,Head,"user defined procedure");
return(FALSE);
} 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);
CACHE_REGS
seq_tv_t inp, out;
inp.val.t = t;
inp.type = YAP_STRING_CODES|YAP_STRING_TRUNC;
inp.max = bufsize;
out.type = YAP_STRING_CHARS;
out.val.c = buf;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return FALSE;
return TRUE;
}
@ -2030,7 +1998,14 @@ YAP_BufferToString(char *s)
Term t;
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();
return t;
@ -2043,7 +2018,16 @@ YAP_NBufferToString(char *s, size_t len)
Term t;
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();
return t;
@ -2056,7 +2040,14 @@ YAP_WideBufferToString(wchar_t *s)
Term t;
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();
return t;
@ -2069,7 +2060,16 @@ YAP_NWideBufferToString(wchar_t *s, size_t len)
Term t;
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();
return t;
@ -2131,7 +2131,14 @@ YAP_BufferToAtomList(char *s)
Term t;
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();
return t;
@ -2144,7 +2151,16 @@ YAP_NBufferToAtomList(char *s, size_t len)
Term t;
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();
return t;
@ -2157,7 +2173,14 @@ YAP_WideBufferToAtomList(wchar_t *s)
Term t;
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();
return t;
@ -2170,7 +2193,16 @@ YAP_NWideBufferToAtomList(wchar_t *s, size_t len)
Term t;
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();
return t;
@ -2183,7 +2215,17 @@ YAP_NWideBufferToAtomDiffList(wchar_t *s, Term t0, size_t len)
Term t;
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();
return t;
@ -2193,11 +2235,18 @@ YAP_NWideBufferToAtomDiffList(wchar_t *s, Term t0, size_t len)
X_API Term
YAP_BufferToDiffList(char *s, Term t0)
{
CACHE_REGS
Term t;
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();
return t;
@ -2210,7 +2259,17 @@ YAP_NBufferToDiffList(char *s, Term t0, size_t len)
Term t;
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();
return t;
@ -2223,7 +2282,15 @@ YAP_WideBufferToDiffList(wchar_t *s, Term t0)
Term t;
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();
return t;
@ -2236,7 +2303,17 @@ YAP_NWideBufferToDiffList(wchar_t *s, Term t0, size_t len)
Term t;
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();
return t;
@ -2300,9 +2377,9 @@ run_emulator(YAP_dogoalinfo *dgi USES_REGS)
{
int out;
LOCAL_PrologMode = UserMode;
LOCAL_PrologMode &= ~(UserCCallMode|CCallMode);
out = Yap_absmi(0);
LOCAL_PrologMode = UserCCallMode;
LOCAL_PrologMode |= UserCCallMode;
return out;
}
@ -2313,6 +2390,7 @@ YAP_EnterGoal(PredEntry *pe, Term *ptr, YAP_dogoalinfo *dgi)
int out;
BACKUP_MACHINE_REGS();
LOCAL_PrologMode = UserMode;
dgi->p = P;
dgi->cp = CP;
dgi->CurSlot = LOCAL_CurSlot;
@ -2380,7 +2458,7 @@ YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi)
P = FAILCODE;
Yap_exec_absmi(TRUE);
/* recover stack space */
H = B->cp_h;
HR = B->cp_h;
TR = B->cp_tr;
#ifdef DEPTH_LIMIT
DEPTH = B->cp_depth;
@ -2506,6 +2584,12 @@ YAP_OpaqueObjectFromTerm(Term t)
return ExternalBlobFromTerm (t);
}
X_API CELL *
YAP_HeapStoreOpaqueTerm(Term t)
{
return Yap_HeapStoreOpaqueTerm(t);
}
X_API Int
YAP_RunGoalOnce(Term t)
{
@ -2610,7 +2694,7 @@ YAP_ShutdownGoal(int backtrack)
P = FAILCODE;
Yap_exec_absmi(TRUE);
/* recover stack space */
H = cut_pt->cp_h;
HR = cut_pt->cp_h;
TR = cut_pt->cp_tr;
}
/* we can always recover the stack */
@ -2767,7 +2851,7 @@ YAP_Read(IOSTREAM *inp)
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)
{
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
@ -3087,7 +3171,11 @@ YAP_Init(YAP_init_args *yap_init)
#endif /* YAPOR || TABLING */
#ifdef YAPOR
Yap_init_yapor_workers();
#if YAPOR_THREADS
if (Yap_thread_self() != 0) {
#else
if (worker_id != 0) {
#endif
#if defined(YAPOR_COPY) || defined(YAPOR_SBA)
/*
In the SBA we cannot just happily inherit registers
@ -3131,21 +3219,6 @@ YAP_Init(YAP_init_args *yap_init)
*/
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) {
Yap_PutValue(AtomTopLevelGoal, MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologTopLevelGoal)));
}
@ -3168,12 +3241,13 @@ YAP_Init(YAP_init_args *yap_init)
Yap_AttsSize = Atts*1024;
else
Yap_AttsSize = 2048*sizeof(CELL);
/* reset stacks */
// Yap_StartSlots( PASS_REGS1 );
if (restore_result == DO_ONLY_CODE) {
/* first, initialise the saved state */
Term t_goal = MkAtomTerm(AtomInitProlog);
YAP_RunGoalOnce(t_goal);
// Yap_InitYaamRegs( 0 );
/* reset stacks */
Yap_InitYaamRegs( 0 );
return YAP_BOOT_FROM_SAVED_CODE;
} else {
return YAP_BOOT_FROM_SAVED_STACKS;
@ -3284,9 +3358,6 @@ YAP_Reset(void)
{
CACHE_REGS
int res = TRUE;
#if !defined(YAPOR) && !defined(THREADS)
int worker_id = 0;
#endif
BACKUP_MACHINE_REGS();
YAP_ClearExceptions();
@ -3304,6 +3375,9 @@ YAP_Reset(void)
/* the first real choice-point will also have AP=FAIL */
/* always have an empty slots for people to use */
P = CP = YESCODE;
// ensure that we have slots where we need them
LOCAL_CurSlot = 0;
Yap_StartSlots( PASS_REGS1 );
RECOVER_MACHINE_REGS();
return res;
}
@ -3423,23 +3497,16 @@ X_API void
YAP_UserBackCPredicate(char *name, CPredicate init, CPredicate cont,
UInt arity, unsigned int extra)
{
#ifdef CUT_C
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
YAP_UserBackCutCPredicate(char *name, CPredicate init, CPredicate cont, CPredicate cut,
UInt arity, unsigned int extra)
{
Yap_InitCPredBackCut(name, arity, extra, init, cont, cut, UserCPredFlag);
}
#endif
X_API void
YAP_UserCPredicateWithArgs(char *a, CPredicate f, UInt arity, Term mod)
@ -3607,8 +3674,8 @@ YAP_FloatsToList(double *dblp, size_t sz)
if (!sz)
return TermNil;
while (ASP-1024 < H + sz*(2+2+SIZEOF_DOUBLE/SIZEOF_LONG_INT)) {
if ((CELL *)dblp > H0 && (CELL *)dblp < H) {
while (ASP-1024 < HR + sz*(2+2+SIZEOF_DOUBLE/SIZEOF_INT_P)) {
if ((CELL *)dblp > H0 && (CELL *)dblp < HR) {
/* we are in trouble */
LOCAL_OpenArray = (CELL *)dblp;
}
@ -3619,12 +3686,12 @@ YAP_FloatsToList(double *dblp, size_t sz)
dblp = (double *)LOCAL_OpenArray;
LOCAL_OpenArray = NULL;
}
t = AbsPair(H);
t = AbsPair(HR);
while (sz) {
oldH = H;
H +=2;
oldH = HR;
HR +=2;
oldH[0] = MkFloatTerm(*dblp++);
oldH[1] = AbsPair(H);
oldH[1] = AbsPair(HR);
sz--;
}
oldH[1] = TermNil;
@ -3679,8 +3746,8 @@ YAP_IntsToList(Int *dblp, size_t sz)
if (!sz)
return TermNil;
while (ASP-1024 < H + sz*3) {
if ((CELL *)dblp > H0 && (CELL *)dblp < H) {
while (ASP-1024 < HR + sz*3) {
if ((CELL *)dblp > H0 && (CELL *)dblp < HR) {
/* we are in trouble */
LOCAL_OpenArray = (CELL *)dblp;
}
@ -3691,12 +3758,12 @@ YAP_IntsToList(Int *dblp, size_t sz)
dblp = (Int *)LOCAL_OpenArray;
LOCAL_OpenArray = NULL;
}
t = AbsPair(H);
t = AbsPair(HR);
while (sz) {
oldH = H;
H +=2;
oldH = HR;
HR +=2;
oldH[0] = MkIntegerTerm(*dblp++);
oldH[1] = AbsPair(H);
oldH[1] = AbsPair(HR);
sz--;
}
oldH[1] = TermNil;
@ -3735,14 +3802,14 @@ YAP_OpenList(int n)
Term t;
BACKUP_H();
while (H+2*n > ASP-1024) {
while (HR+2*n > ASP-1024) {
if (!Yap_dogc( 0, NULL PASS_REGS )) {
RECOVER_H();
return FALSE;
}
}
t = AbsPair(H);
H += 2*n;
t = AbsPair(HR);
HR += 2*n;
RECOVER_H();
return t;
@ -3955,7 +4022,7 @@ YAP_SetYAPFlag(yap_flag_t flag, int val)
Int YAP_VarSlotToNumber(Int s) {
CACHE_REGS
Term *t = (CELL *)Deref(Yap_GetFromSlot(s PASS_REGS));
if (t < H)
if (t < HR)
return t-H0;
return t-LCL0;
}
@ -4165,11 +4232,11 @@ YAP_RequiresExtraStack(size_t sz) {
if (sz < 16*1024)
sz = 16*1024;
if (H <= ASP-sz) {
if (HR <= ASP-sz) {
return FALSE;
}
BACKUP_H();
while (H > ASP-sz) {
while (HR > ASP-sz) {
CACHE_REGS
RECOVER_H();
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_reset( 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 void kill_first_log_iblock(LogUpdIndex *, LogUpdIndex *, PredEntry *);
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 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) && \
(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 */ {
retract_all(p, static_in_use(p,TRUE));
}
p->src.OwnerFile = YapConsultingFile( PASS_REGS1 );
p->src.OwnerFile = Yap_ConsultingFile( PASS_REGS1 );
}
return TRUE; /* careful */
}
@ -2363,7 +2361,7 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
if (pflags & MultiFileFlag) {
/* add Info on new clause for multifile predicates to the DB */
Term t[5], tn;
t[0] = MkAtomTerm(YapConsultingFile( PASS_REGS1 ));
t[0] = MkAtomTerm(Yap_ConsultingFile( PASS_REGS1 ));
t[1] = MkAtomTerm(at);
t[2] = MkIntegerTerm(Arity);
t[3] = mod;
@ -2571,8 +2569,8 @@ p_compile_dynamic( USES_REGS1 )
return TRUE;
}
static Atom
YapConsultingFile ( USES_REGS1 )
Atom
Yap_ConsultingFile ( USES_REGS1 )
{
if (LOCAL_consult_level == 0) {
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 */
static void
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
p_setspy( USES_REGS1 )
{ /* '$set_spy'(+Fun,+M) */
@ -2941,6 +2983,7 @@ p_new_multifile( USES_REGS1 )
/* static */
pe->PredFlags |= (SourcePredFlag|CompiledPredFlag);
}
pe->src.OwnerFile = Yap_ConsultingFile( PASS_REGS1 );
UNLOCKPE(43,pe);
return (TRUE);
}
@ -3049,7 +3092,7 @@ p_mk_d( USES_REGS1 )
if (pe->OpcodeOfPred == UNDEF_OPCODE) {
pe->OpcodeOfPred = FAIL_OPCODE;
}
pe->src.OwnerFile = YapConsultingFile( PASS_REGS1 );
pe->src.OwnerFile = Yap_ConsultingFile( PASS_REGS1 );
UNLOCKPE(50,pe);
return TRUE;
}
@ -3468,26 +3511,26 @@ Yap_find_owner_index(yamop *ipc, PredEntry *ap)
static Term
all_envs(CELL *env_ptr USES_REGS)
{
Term tf = AbsPair(H);
CELL *start = H;
Term tf = AbsPair(HR);
CELL *start = HR;
CELL *bp = NULL;
/* walk the environment chain */
while (env_ptr) {
bp = H;
H += 2;
bp = HR;
HR += 2;
/* notice that MkIntegerTerm may increase the Heap */
bp[0] = MkIntegerTerm(LCL0-env_ptr);
if (H >= ASP-1024) {
H = start;
LOCAL_Error_Size = (ASP-1024)-H;
if (HR >= ASP-1024) {
HR = start;
LOCAL_Error_Size = (ASP-1024)-HR;
while (env_ptr) {
LOCAL_Error_Size += 2;
env_ptr = (CELL *)(env_ptr[E_E]);
}
return 0L;
} else {
bp[1] = AbsPair(H);
bp[1] = AbsPair(HR);
}
env_ptr = (CELL *)(env_ptr[E_E]);
}
@ -3499,24 +3542,24 @@ static Term
all_cps(choiceptr b_ptr USES_REGS)
{
CELL *bp = NULL;
CELL *start = H;
Term tf = AbsPair(H);
CELL *start = HR;
Term tf = AbsPair(HR);
while (b_ptr) {
bp = H;
H += 2;
bp = HR;
HR += 2;
/* notice that MkIntegerTerm may increase the Heap */
bp[0] = MkIntegerTerm((Int)(LCL0-(CELL *)b_ptr));
if (H >= ASP-1024) {
H = start;
LOCAL_Error_Size = (ASP-1024)-H;
if (HR >= ASP-1024) {
HR = start;
LOCAL_Error_Size = (ASP-1024)-HR;
while (b_ptr) {
LOCAL_Error_Size += 2;
b_ptr = b_ptr->cp_b;
}
return 0L;
} else {
bp[1] = AbsPair(H);
bp[1] = AbsPair(HR);
}
b_ptr = b_ptr->cp_b;
}
@ -4940,7 +4983,7 @@ Yap_UpdateTimestamps(PredEntry *ap)
if (bptr->cp_ap->u.OtaLl.d->ClPred == ap) {
UInt ts = IntegerOfTerm(bptr->cp_args[ar]);
if (ts != arp[0]) {
if (arp-H < 1024) {
if (arp-HR < 1024) {
goto overflow;
}
/* 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)) {
UInt ts = IntegerOfTerm(bptr->cp_args[5]);
if (ts != arp[0]) {
if (arp-H < 1024) {
if (arp-HR < 1024) {
goto overflow;
}
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);
}
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) */
p_continue_static_clause( USES_REGS1 )
{
@ -5583,7 +5553,7 @@ BuildActivePred(PredEntry *ap, CELL *vect)
if (IsVarTerm(t)) {
CELL *pt = VarOfTerm(t);
/* one stack */
if (pt > H) {
if (pt > HR) {
Term nt = MkVarTerm();
Yap_unify(t, nt);
}
@ -6154,6 +6124,42 @@ p_instance_property( USES_REGS1 )
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) {
@ -6214,6 +6220,213 @@ p_instance_property( USES_REGS1 )
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
Yap_InitCdMgr(void)
{
@ -6249,6 +6462,8 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$kill_dynamic", 2, p_kill_dynamic, 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_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("$profile_info", 3, p_profile_info, 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("$continue_static_clause", 5, p_continue_static_clause, SafePredFlag|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("$instance_property", 3, p_instance_property, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$fetch_nth_clause", 4, p_nth_instance, SyncPredFlag);
CurrentModule = HACKS_MODULE;
Yap_InitCPred("current_choicepoints", 1, p_all_choicepoints, 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;
H[0] = (CELL)FunctorBigInt;
H[1] = CLAUSE_LIST;
dst = (MP_INT *)(H+2);
HR[0] = (CELL)FunctorBigInt;
HR[1] = CLAUSE_LIST;
dst = (MP_INT *)(HR+2);
dst->_mp_size = 0L;
dst->_mp_alloc = sz;
H += (1+sizeof(MP_INT)/sizeof(CELL));
H[sz] = EndSpecials;
H += sz+1;
HR += (1+sizeof(MP_INT)/sizeof(CELL));
HR[sz] = EndSpecials;
HR += sz+1;
}
static CELL *
@ -29,14 +29,14 @@ extend_blob(CELL *start, int sz USES_REGS)
UInt osize;
MP_INT *dst;
if (H + sz > ASP)
if (HR + sz > ASP)
return NULL;
dst = (MP_INT *)(start+2);
osize = dst->_mp_alloc;
start += (1+sizeof(MP_INT)/sizeof(CELL));
start[sz+osize] = EndSpecials;
dst->_mp_alloc += sz;
H += sz;
HR += sz;
return start+osize;
}
@ -46,9 +46,9 @@ Yap_ClauseListInit(clause_list_t in)
{
CACHE_REGS
in->n = 0;
in->start = H;
in->start = HR;
mk_blob(0 PASS_REGS);
in->end = H;
in->end = HR;
return in;
}
@ -61,7 +61,7 @@ Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred)
PredEntry *ap = (PredEntry *)pred;
/* fprintf(stderr,"cl=%p\n",clause); */
if (cl->end != H)
if (cl->end != HR)
return FALSE;
if (cl->n == 0) {
void **ptr;
@ -112,7 +112,7 @@ Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred)
code_p = PREVOP(code_p,Otapl);
code_p->opc = Yap_opcode(_retry);
}
cl->end = H;
cl->end = HR;
cl->n++;
return TRUE;
}
@ -129,9 +129,9 @@ X_API int
Yap_ClauseListDestroy(clause_list_t cl)
{
CACHE_REGS
if (cl->end != H)
if (cl->end != HR)
return FALSE;
H = cl->start;
HR = cl->start;
return TRUE;
}
@ -141,7 +141,7 @@ Yap_ClauseListToClause(clause_list_t cl)
{
CACHE_REGS
void **ptr;
if (cl->end != H)
if (cl->end != HR)
return NULL;
if (cl->n != 1)
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)
{
CACHE_REGS
register CELL **to_visit = (CELL **)H;
register CELL **to_visit = (CELL **)HR;
register int out = 0;
loop:
@ -141,6 +141,26 @@ static int compare_complex(register CELL *pt0, register CELL *pt0_end, register
}
if (out != 0)
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)) {
if (IsIntTerm(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 */
if (to_visit > (CELL **)H) {
if (to_visit > (CELL **)HR) {
#ifdef RATIONAL_TREES
to_visit -= 4;
pt0 = to_visit[0];
@ -288,7 +308,7 @@ static int compare_complex(register CELL *pt0, register CELL *pt0_end, register
done:
/* failure */
#ifdef RATIONAL_TREES
while (to_visit > (CELL **)H) {
while (to_visit > (CELL **)HR) {
to_visit -= 4;
pt0 = to_visit[0];
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));
if (IsPrimitiveTerm(t2))
return 1;
if (IsStringTerm(t2))
return 1;
return -1;
} else {
if (IsIntTerm(t2)) {
return IntOfTerm(t1) - IntOfTerm(t2);
}
if (IsFloatTerm(t2)) {
return 1;
}
if (IsLongIntTerm(t2)) {
return IntOfTerm(t1) - LongIntOfTerm(t2);
}
if (IsApplTerm(t2)) {
Functor fun2 = FunctorOfTerm(t2);
switch ((CELL)fun2) {
case double_e:
return 1;
case long_int_e:
return IntOfTerm(t1) - LongIntOfTerm(t2);
#ifdef USE_GMP
if (IsBigIntTerm(t2)) {
return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2);
}
case big_int_e:
return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2);
#endif
if (IsRefTerm(t2))
return 1;
case db_ref_e:
return 1;
case string_e:
return -1;
}
}
return -1;
}
} else if (IsPairTerm(t1)) {
@ -408,6 +434,28 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
return -1;
}
#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:
if (IsRefTerm(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)))
return (t);
while (p != NULL) {
CELL *oldH = H;
H = (CELL *)cglobs->cint.freep;
CELL *oldH = HR;
HR = (CELL *)cglobs->cint.freep;
cmp = Yap_compare_terms(t, (p->TermOfCE));
H = oldH;
HR = oldH;
if (cmp) {
p = p->NextCE;
@ -533,7 +533,7 @@ optimize_ce(Term t, unsigned int arity, unsigned int level, compiler_struct *cgl
p->TermOfCE = t;
p->VarOfCE = MkVarTerm();
if (H >= (CELL *)cglobs->cint.freep0) {
if (HR >= (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
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
DBTerm *dbt;
int g;
CELL *h0 = H;
CELL *h0 = HR;
while ((g=Yap_SizeGroundTerm(t,TRUE)) < 0) {
/* 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)
return FALSE;
/* store ground term away */
H = CellPtr(cglobs->cint.freep);
HR = CellPtr(cglobs->cint.freep);
if ((dbt = Yap_StoreTermInDB(t, -1)) == NULL) {
H = h0;
HR = h0;
switch(LOCAL_Error_TYPE) {
case OUT_OF_STACK_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);
}
}
H = h0;
HR = h0;
if (level == 0)
Yap_emit((cglobs->onhead ? get_dbterm_op : put_dbterm_op), dbt->Entry, argno, &cglobs->cint);
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
: unify_atom_op) :
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 (IsFloatTerm(t)) {
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
: unify_longint_op) :
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 {
/* we are taking a blob, that is a binary that is supposed to be
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)
c_eq(t1, t3, cglobs);
else {
CELL *hi = H;
CELL *hi = HR;
Int i;
if (t1 == TermDot && i2 == 2) {
if (H+2 >= (CELL *)cglobs->cint.freep0) {
if (HR+2 >= (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
}
RESET_VARIABLE(H);
RESET_VARIABLE(H+1);
H += 2;
c_eq(AbsPair(H-2),t3, cglobs);
RESET_VARIABLE(HR);
RESET_VARIABLE(HR+1);
HR += 2;
c_eq(AbsPair(HR-2),t3, cglobs);
} 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++) {
if (H >= (CELL *)cglobs->cint.freep0) {
if (HR >= (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
}
RESET_VARIABLE(H);
H++;
RESET_VARIABLE(HR);
HR++;
}
c_eq(AbsAppl(hi),t3, cglobs);
} else {
@ -1232,16 +1267,16 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
save_machine_regs();
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 */
save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
}
tnew = AbsAppl(H);
*H++ = (CELL)Yap_MkFunctor(AtomOfTerm(t1),arity);
tnew = AbsAppl(HR);
*HR++ = (CELL)Yap_MkFunctor(AtomOfTerm(t1),arity);
while (arity--) {
RESET_VARIABLE(H);
H++;
RESET_VARIABLE(HR);
HR++;
}
c_eq(tnew, t3, cglobs);
} 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 (Op == _arg) {
Term tmpvar = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) {
if (HR == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
@ -1681,7 +1716,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
cglobs->goalno = savegoalno;
commitflag = cglobs->labelno;
commitvar = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) {
if (HR == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
@ -1765,7 +1800,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
/* for now */
cglobs->needs_env = TRUE;
commitvar = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) {
if (HR == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
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;
commitvar = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) {
if (HR == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
@ -1928,7 +1963,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
}
else {
Term t2 = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) {
if (HR == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
@ -1941,7 +1976,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
} else {
Term a2 = ArgOfTerm(2,Goal);
Term t1 = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) {
if (HR == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
@ -1955,7 +1990,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
}
else {
Term t2 = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) {
if (HR == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
@ -2585,6 +2620,7 @@ CheckVoids(compiler_struct *cglobs)
case get_float_op:
case get_dbterm_op:
case get_longint_op:
case get_string_op:
case get_bigint_op:
case get_list_op:
case get_struct_op:
@ -2935,6 +2971,7 @@ c_layout(compiler_struct *cglobs)
case get_num_op:
case get_float_op:
case get_longint_op:
case get_string_op:
case get_dbterm_op:
case get_bigint_op:
--cglobs->Uses[rn];
@ -3013,6 +3050,7 @@ c_layout(compiler_struct *cglobs)
case put_num_op:
case put_float_op:
case put_longint_op:
case put_string_op:
case put_dbterm_op:
case put_bigint_op:
rn = checkreg(arg, rn, ic, FALSE, cglobs);
@ -3311,10 +3349,13 @@ c_optimize(PInstr *pc)
case unify_last_float_op:
case write_float_op:
case unify_longint_op:
case unify_string_op:
case unify_bigint_op:
case unify_last_longint_op:
case unify_last_string_op:
case unify_last_bigint_op:
case write_longint_op:
case write_string_op:
case write_bigint_op:
case unify_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:
/* 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;
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_Term = inp_clause;
}
if (osize > ASP-H) {
if (!Yap_growstack(2*sizeof(CELL)*(ASP-H))) {
if (osize > ASP-HR) {
if (!Yap_growstack(2*sizeof(CELL)*(ASP-HR))) {
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;
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;
HB = H;
HB = HR;
LOCAL_ErrorMessage = NULL;
LOCAL_Error_Size = 0;
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.freep =
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;
if (ASP <= CellPtr (cglobs.cint.freep) + 256) {
cglobs.vtable = NULL;
@ -3470,8 +3511,8 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src)
save_machine_regs();
siglongjmp(cglobs.cint.CompilerBotch,3);
}
cglobs.Uses = (Int *)(H+maxvnum);
cglobs.Contents = (Term *)(H+maxvnum+(sizeof(Int)/sizeof(CELL))*MaxTemps);
cglobs.Uses = (Int *)(HR+maxvnum);
cglobs.Contents = (Term *)(HR+maxvnum+(sizeof(Int)/sizeof(CELL))*MaxTemps);
cglobs.curbranch = cglobs.onbranch = 0;
cglobs.branch_pointer = cglobs.parent_branches;
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);
H = HB;
HR = HB;
if (B != NULL) {
HB = B->cp_h;
}

20
C/computils.c
View File

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

8
C/corout.c
View File

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

4
C/cut_c.c
View File

@ -1,5 +1,3 @@
#ifdef CUT_C
#include "Yap.h"
#include "cut_c.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;
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))
#endif
#define DEAD_REF(ref) FALSE
#ifdef SFUNC
#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 */
st[0] = (CELL)FunctorDouble;
st[1] = pt[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
st[2] = pt[2];
st[3] = EndSpecials;
#else
st[2] = EndSpecials;
#endif
/* 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
@ -637,13 +645,13 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
#endif
register visitel *visited = (visitel *)AuxSp;
/* store this in H */
register CELL **to_visit = (CELL **)H;
register CELL **to_visit = (CELL **)HR;
CELL **to_visit_base = to_visit;
/* where we are going to add a new pair */
int vars_found = 0;
#ifdef COROUTINING
Term ConstraintsTerm = TermNil;
CELL *origH = H;
CELL *origH = HR;
#endif
CELL *CodeMaxBase = CodeMax;
@ -711,6 +719,17 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
++pt0;
continue;
#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:
{
CELL *st = CodeMax;
@ -900,7 +919,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
Term t[4];
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
the variable, the constraint in some cannonical form, what type
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[3] = ConstraintsTerm;
ConstraintsTerm = Yap_MkApplTerm(FunctorClist, 4, t);
if (H+sz >= ASP) {
if (HR+sz >= ASP) {
goto error2;
}
memcpy((void *)H, (void *)(to_visit_base), sz*sizeof(CELL *));
to_visit_base = (CELL **)H;
memcpy((void *)HR, (void *)(to_visit_base), sz*sizeof(CELL *));
to_visit_base = (CELL **)HR;
to_visit = to_visit_base+sz;
}
#endif
@ -969,7 +988,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
*vars_foundp = vars_found;
DB_UNWIND_CUNIF();
#ifdef COROUTINING
H = origH;
HR = origH;
#endif
return CodeMax;
@ -988,7 +1007,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
#endif
DB_UNWIND_CUNIF();
#ifdef COROUTINING
H = origH;
HR = origH;
#endif
return NULL;
@ -1006,7 +1025,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
#endif
DB_UNWIND_CUNIF();
#ifdef COROUTINING
H = origH;
HR = origH;
#endif
return NULL;
@ -1024,7 +1043,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
#endif
DB_UNWIND_CUNIF();
#ifdef COROUTINING
H = origH;
HR = origH;
#endif
return NULL;
#if THREADS
@ -1478,6 +1497,9 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
case (CELL)FunctorDouble:
ntp = copy_double(ntp0, RepAppl(Tm));
break;
case (CELL)FunctorString:
ntp = copy_string(ntp0, RepAppl(Tm));
break;
case (CELL)FunctorDBRef:
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return CreateDBWithDBRef(Tm, p, dbg);
@ -2449,6 +2471,22 @@ UnifyDBNumber(DBRef DBSP, Term 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
GetDBTerm(DBTerm *DBSP, int src USES_REGS)
@ -2464,7 +2502,7 @@ GetDBTerm(DBTerm *DBSP, int src USES_REGS)
} else if (IsAtomOrIntTerm(t)) {
return t;
} else {
CELL *HOld = H;
CELL *HOld = HR;
CELL *HeapPtr;
CELL *pt;
CELL NOf;
@ -2473,9 +2511,10 @@ GetDBTerm(DBTerm *DBSP, int src USES_REGS)
return t;
}
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 (H+NOf > ASP)
if (HR+NOf > ASP)
fprintf(GLOBAL_stderr, "\n\n [ FATAL ERROR: No Stack for Error Handling ]\n");
Yap_exit( 1);
} else {
@ -2486,7 +2525,7 @@ GetDBTerm(DBTerm *DBSP, int src USES_REGS)
}
HeapPtr = cpcells(HOld, pt, NOf);
pt += HeapPtr - HOld;
H = HeapPtr;
HR = HeapPtr;
{
link_entry *lp = (link_entry *)pt;
linkblk(lp, HOld-1, (CELL)HOld-(CELL)(DBSP->Contents));
@ -2494,7 +2533,7 @@ GetDBTerm(DBTerm *DBSP, int src USES_REGS)
#ifdef COROUTINING
if (DBSP->ag.attachments != 0L && !src) {
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_Size = 0;
return (Term)0;
@ -2925,17 +2964,16 @@ lu_nth_recorded(PredEntry *pe, Int Count USES_REGS)
if (cl == NULL)
return FALSE;
#if MULTIPLE_STACKS
PELOCK(65,pe);
TRAIL_CLREF(cl); /* So that fail will erase it */
INC_CLREF_COUNT(cl);
UNLOCK(pe->PELock);
#else
if (!(cl->ClFlags & InUseMask)) {
cl->ClFlags |= InUseMask;
TRAIL_CLREF(cl); /* So that fail will erase it */
}
#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);
#endif
return Yap_unify(MkDBRefTerm(ref),ARG3);
return Yap_unify(MkDBRefTerm(ref),ARG4);
}
static Int
p_nth_instance( USES_REGS1 )
Int
Yap_db_nth_recorded( PredEntry *pe, Int Count USES_REGS )
{
DBProp AtProp;
Term TCount;
Int Count;
PredEntry *pe;
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);
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) {
if (pe == NULL) {
return lu_nth_recorded(pe,Count PASS_REGS);
}
if (EndOfPAEntr(AtProp = FetchDBPropFromKey(Deref(ARG1), 0, FALSE, "nth_instance/3"))) {
UNLOCK(pe->PELock);
return FALSE;
}
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);
return nth_recorded(AtProp, Count PASS_REGS);
}
static Int
@ -3184,7 +3069,7 @@ i_recorded(DBProp AtProp, Term t3 USES_REGS)
if (IsVarTerm(twork)) {
EXTRA_CBACK_ARG(3,2) = 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) {
/* make sure the garbage collector sees what we want it to see! */
EXTRA_CBACK_ARG(3,1) = (CELL)ref;
@ -3212,7 +3097,7 @@ i_recorded(DBProp AtProp, Term t3 USES_REGS)
} else if (IsAtomOrIntTerm(twork)) {
EXTRA_CBACK_ARG(3,2) = MkIntegerTerm(0);
EXTRA_CBACK_ARG(3,3) = MkIntegerTerm((Int)twork);
B->cp_h = H;
B->cp_h = HR;
READ_LOCK(AtProp->DBRWLock);
do {
if (((twork == ref->DBT.Entry) || IsVarTerm(ref->DBT.Entry)) &&
@ -3229,7 +3114,7 @@ i_recorded(DBProp AtProp, Term t3 USES_REGS)
CELL key;
CELL mask = EvalMasks(twork, &key);
B->cp_h = H;
B->cp_h = HR;
READ_LOCK(AtProp->DBRWLock);
do {
while ((mask & ref->Key) != (key & ref->Mask) && !DEAD_REF(ref)) {
@ -3244,7 +3129,7 @@ i_recorded(DBProp AtProp, Term t3 USES_REGS)
/* success */
EXTRA_CBACK_ARG(3,2) = MkIntegerTerm(((Int)mask));
EXTRA_CBACK_ARG(3,3) = MkIntegerTerm(((Int)key));
B->cp_h = H;
B->cp_h = HR;
break;
} else {
while ((ref = NextDBRef(ref)) != NULL
@ -3302,7 +3187,7 @@ c_recorded(int flags USES_REGS)
{
Term TermDB, TRef;
Register DBRef ref, ref0;
CELL *PreviousHeap = H;
CELL *PreviousHeap = HR;
CELL mask, key;
Term t1;
@ -3371,7 +3256,7 @@ c_recorded(int flags USES_REGS)
}
}
LOCAL_Error_Size = 0;
PreviousHeap = H;
PreviousHeap = HR;
}
Yap_unify(ARG2, TermDB);
} else if (mask == 0) { /* ARG2 is a constant */
@ -3387,7 +3272,7 @@ c_recorded(int flags USES_REGS)
}
} else
do { /* ARG2 is a structure */
H = PreviousHeap;
HR = PreviousHeap;
while ((mask & ref->Key) != (key & ref->Mask)) {
while ((ref = NextDBRef(ref)) != NIL
&& DEAD_REF(ref));
@ -3414,7 +3299,7 @@ c_recorded(int flags USES_REGS)
}
}
LOCAL_Error_Size = 0;
PreviousHeap = H;
PreviousHeap = HR;
}
if (Yap_unify(ARG2, TermDB))
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
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);
}
if (FunctorOfTerm(t1) == FunctorExoClause) {
return Yap_unify(ARG2,ArgOfTerm(2,t1));
return exo_instance(Yap_ExoClauseFromTerm(t1), Yap_ExoClausePredicateFromTerm(t1) PASS_REGS);
}
}
return FALSE;
@ -4802,6 +4717,8 @@ p_instance( USES_REGS1 )
}
}
Term
Yap_LUInstance(LogUpdClause *cl, UInt arity)
{
@ -5010,7 +4927,7 @@ cont_current_key( USES_REGS1 )
term = AtT = MkAtomTerm(a);
} else {
unsigned int j;
CELL *p = H;
CELL *p = HR;
for (j = 0; j < arity; j++) {
p[j] = MkVarTerm();
@ -5593,8 +5510,6 @@ Yap_InitDBPreds(void)
Yap_InitCPred("total_erased", 4, p_total_erased, 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("$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("$install_thread_local", 2, p_install_thread_local, SafePredFlag);
}

168
C/errors.c
View File

@ -29,6 +29,84 @@
#endif
#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
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 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
hidden (Atom at)
@ -285,13 +363,13 @@ dump_stack( USES_REGS1 )
if (handled_exception( PASS_REGS1 ))
return;
#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);
if (LOCAL_ErrorMessage)
fprintf(stderr,"%% LOCAL_ErrorMessage: %s\n",LOCAL_ErrorMessage);
#endif
if (H > ASP || H > LCL0) {
fprintf(stderr,"%% YAP ERROR: Global Collided against Local (%p--%p)\n",H,ASP);
if (HR > ASP || HR > LCL0) {
fprintf(stderr,"%% YAP ERROR: Global Collided against Local (%p--%p)\n",HR,ASP);
} else if (HeapTop > (ADDR)LOCAL_GlobalBase) {
fprintf(stderr,"%% YAP ERROR: Code Space Collided against Global (%p--%p)\n", HeapTop, LOCAL_GlobalBase);
} else {
@ -308,11 +386,11 @@ dump_stack( USES_REGS1 )
}
#endif
#endif
detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, (char *)H, 256);
fprintf (stderr,"%%\n%% PC: %s\n",(char *)H);
detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, (char *)H, 256);
fprintf (stderr,"%% Continuation: %s\n",(char *)H);
fprintf (stderr,"%% %luKB of Global Stack (%p--%p)\n",(unsigned long int)(sizeof(CELL)*(H-H0))/1024,H0,H);
detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256);
fprintf (stderr,"%%\n%% PC: %s\n",(char *)HR);
detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256);
fprintf (stderr,"%% Continuation: %s\n",(char *)HR);
fprintf (stderr,"%% %luKB of Global Stack (%p--%p)\n",(unsigned long int)(sizeof(CELL)*(HR-H0))/1024,H0,HR);
fprintf (stderr,"%% %luKB of Local Stack (%p--%p)\n",(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,"%% Performed %ld garbage collections\n", (unsigned long int)LOCAL_GcCalls);
@ -390,8 +468,8 @@ void
Yap_bug_location(yamop *pc)
{
CACHE_REGS
detect_bug_location(pc, FIND_PRED_FROM_ANYWHERE, (char *)H, 256);
fprintf(stderr,"%s\n",(char *)H);
detect_bug_location(pc, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256);
fprintf(stderr,"%s\n",(char *)HR);
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,"%%\n%%\n");
}
detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, (char *)H, 256);
fprintf (stderr,"%%\n%% PC: %s\n",(char *)H);
detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, (char *)H, 256);
fprintf (stderr,"%% Continuation: %s\n",(char *)H);
detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256);
fprintf (stderr,"%%\n%% PC: %s\n",(char *)HR);
detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256);
fprintf (stderr,"%% Continuation: %s\n",(char *)HR);
DumpActiveGoals( PASS_REGS1 );
error_exit_yap (1);
}
@ -1382,6 +1460,19 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
serious = TRUE;
}
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:
{
int i;
@ -1450,11 +1541,8 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
case SYNTAX_ERROR:
{
int i;
Term ti[1];
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomSyntaxError);
nt[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, ti);
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1535,6 +1623,20 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
serious = TRUE;
}
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:
{
int i;
@ -1745,6 +1847,20 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
serious = TRUE;
}
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:
{
int i;
@ -1759,6 +1875,20 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
serious = TRUE;
}
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:
{
int i;
@ -1847,7 +1977,7 @@ E);
if (serious) {
/* disable active signals at this point */
LOCAL_ActiveSignals = 0;
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
LOCAL_PrologMode &= ~InErrorMode;
LOCK(LOCAL_SignalLock);
/* 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);
tn = add_int(i1, 1 PASS_REGS);
EXTRA_CBACK_ARG(3,1) = tn;
HB = B->cp_h = H;
HB = B->cp_h = HR;
return TRUE;
} else {
Term t[2];
@ -380,7 +380,7 @@ static Int cont_between( USES_REGS1 )
t[1] = MkIntTerm(1);
tn = Eval(Yap_MkApplTerm(FunctorPlus, 2, t) PASS_REGS);
EXTRA_CBACK_ARG(3,1) = tn;
HB = B->cp_h = H;
HB = B->cp_h = HR;
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 "yapio.h"
#include "attvar.h"
#ifdef CUT_C
#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 EnterCreepMode(Term, Term CACHE_TYPE);
@ -166,13 +161,14 @@ do_execute(Term t, Term mod USES_REGS)
if (PRED_GOAL_EXPANSION_ALL) {
LOCK(LOCAL_SignalLock);
/* disable creeping when we do goal expansion */
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
CreepFlag = CalculateStackGap();
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
CalculateStackGap( PASS_REGS1 );
}
UNLOCK(LOCAL_SignalLock);
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);
}
restart_exec:
@ -254,34 +250,34 @@ do_execute(Term t, Term mod USES_REGS)
static Term
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;
unsigned int i;
if (arity == 2 &&
NameOfFunctor(f) == AtomDot) {
for (i = 0; i<arity-n;i++) {
*H++ = pt[i];
*HR++ = pt[i];
}
for (i=0; i< n; i++) {
*H++ = h0[(int)(i-n)];
*HR++ = h0[(int)(i-n)];
}
tf = AbsPair(h0);
} else {
*H++ = (CELL)f;
*HR++ = (CELL)f;
for (i = 0; i<arity-n;i++) {
*H++ = pt[i];
*HR++ = pt[i];
}
for (i=0; i< n; i++) {
*H++ = h0[(int)(i-n)];
*HR++ = h0[(int)(i-n)];
}
tf = AbsAppl(h0);
}
if (mod != CurrentModule) {
CELL *h0 = H;
*H++ = (CELL)FunctorModule;
*H++ = mod;
*H++ = tf;
CELL *h0 = HR;
*HR++ = (CELL)FunctorModule;
*HR++ = mod;
*HR++ = tf;
tf = AbsAppl(h0);
}
return tf;
@ -338,9 +334,9 @@ do_execute_n(Term t, Term mod, unsigned int n USES_REGS)
if (PRED_GOAL_EXPANSION_ALL) {
LOCK(LOCAL_SignalLock);
/* disable creeping when we do goal expansion */
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
CreepFlag = CalculateStackGap();
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
CalculateStackGap( PASS_REGS1 );
}
UNLOCK(LOCAL_SignalLock);
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
}
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);
}
@ -404,7 +400,7 @@ EnterCreepMode(Term t, Term mod USES_REGS) {
}
}
LOCK(LOCAL_SignalLock);
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock);
P_before_spy = P;
return CallPredicate(PredCreep, B, PredCreep->CodeOfPred PASS_REGS);
@ -421,15 +417,15 @@ static void
heap_store(Term t USES_REGS)
{
if (IsVarTerm(t)) {
if (VarOfTerm(t) < H) {
*H++ = t;
if (VarOfTerm(t) < HR) {
*HR++ = t;
} else {
RESET_VARIABLE(H);
Bind_Local(VarOfTerm(t), (CELL)H);
H++;
RESET_VARIABLE(HR);
Bind_Local(VarOfTerm(t), (CELL)HR);
HR++;
}
} else {
*H++ = t;
*HR++ = t;
}
}
@ -640,8 +636,8 @@ p_execute_clause( USES_REGS1 )
} else {
code = Yap_ClauseFromTerm(clt)->ClCode;
}
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL)) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL)) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
Yap_signal(YAP_CREEP_SIGNAL);
}
return CallPredicate(RepPredProp(pe), cut_cp, code PASS_REGS);
@ -656,7 +652,7 @@ p_execute_in_mod( USES_REGS1 )
static Int
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;
PredEntry *pe;
Term cmod = Deref(ARG2);
@ -664,9 +660,9 @@ p_do_goal_expansion( USES_REGS1 )
ARG2 = ARG3;
/* disable creeping */
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock);
/* CurMod:goal_expansion(A,B) */
@ -719,16 +715,16 @@ p_do_goal_expansion( USES_REGS1 )
static Int
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;
PredEntry *pe;
Term cmod = CurrentModule;
/* disable creeping */
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock);
/* CurMod:term_expansion(A,B) */
@ -902,8 +898,8 @@ p_execute_nonstop( USES_REGS1 )
/* N = arity; */
/* call may not define new system predicates!! */
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
Yap_signal(YAP_CREEP_SIGNAL);
}
#if defined(YAPOR) || defined(THREADS)
@ -1092,7 +1088,7 @@ exec_absmi(int top USES_REGS)
LOCK(LOCAL_SignalLock);
/* forget any signals active, we're reborne */
LOCAL_ActiveSignals = 0;
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
LOCAL_PrologMode = UserMode;
UNLOCK(LOCAL_SignalLock);
P = (yamop *)FAILCODE;
@ -1126,7 +1122,7 @@ exec_absmi(int top USES_REGS)
/* make sure we don't leave a FAIL signal hanging around */
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
return out;
}
@ -1162,7 +1158,7 @@ Yap_PrepGoal(UInt arity, CELL *pt, choiceptr saved_b USES_REGS)
}
B = (choiceptr)ASP;
B--;
B->cp_h = H;
B->cp_h = HR;
B->cp_tr = TR;
B->cp_cp = CP;
B->cp_ap = NOCODE;
@ -1173,7 +1169,7 @@ Yap_PrepGoal(UInt arity, CELL *pt, choiceptr saved_b USES_REGS)
#endif /* DEPTH_LIMIT */
YENV = ASP = (CELL *)B;
YENV[E_CB] = (CELL)B;
HB = H;
HB = HR;
CP = YESCODE;
}
@ -1231,7 +1227,6 @@ execute_pred(PredEntry *ppe, CELL *pt USES_REGS)
/* restore the old environment */
/* get to previous environment */
cut_B = (choiceptr)ENV[E_CB];
#ifdef CUT_C
{
/* Note that
cut_B == (choiceptr)ENV[E_CB] */
@ -1240,7 +1235,6 @@ execute_pred(PredEntry *ppe, CELL *pt USES_REGS)
POP_EXECUTE();
}
}
#endif /* CUT_C */
#ifdef YAPOR
CUT_prune_to(cut_B);
#endif /* YAPOR */
@ -1271,7 +1265,7 @@ execute_pred(PredEntry *ppe, CELL *pt USES_REGS)
} else if (out == 0) {
P = saved_p;
CP = saved_cp;
H = B->cp_h;
HR = B->cp_h;
#ifdef DEPTH_LIMIT
DEPTH= B->cp_depth;
#endif
@ -1337,7 +1331,7 @@ Yap_trust_last(void)
CACHE_REGS
ASP = B->cp_env;
CP = B->cp_cp;
H = B->cp_h;
HR = B->cp_h;
#ifdef DEPTH_LIMIT
DEPTH= B->cp_depth;
#endif
@ -1756,7 +1750,7 @@ Yap_InitYaamRegs( int myworker_id )
Yap_ResetExceptionTerm ( myworker_id );
Yap_PutValue (AtomBreak, MkIntTerm (0));
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);
CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id)-MinTrailGap);
/* notice that an initial choice-point and environment
@ -1769,7 +1763,7 @@ Yap_InitYaamRegs( int myworker_id )
#endif
STATIC_PREDICATES_MARKED = FALSE;
#ifdef FROZEN_STACKS
H_FZ = H;
H_FZ = HR;
#ifdef YAPOR_SBA
BSEG =
#endif /* YAPOR_SBA */
@ -1777,7 +1771,7 @@ Yap_InitYaamRegs( int myworker_id )
TR = TR_FZ = (tr_fr_ptr) REMOTE_TrailBase(myworker_id);
#endif /* FROZEN_STACKS */
LOCK(REMOTE_SignalLock(myworker_id));
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
/* the first real choice-point will also have AP=FAIL */
/* always have an empty slots for people to use */
REMOTE_GlobalArena(myworker_id) = TermNil;
@ -1801,12 +1795,7 @@ Yap_InitYaamRegs( int myworker_id )
#endif
Yap_AllocateDefaultArena(128*1024, 2, myworker_id);
Yap_InitPreAllocCodeSpace( myworker_id );
#ifdef CUT_C
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);
#ifdef TABLING
/* 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);
#endif
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

12
C/exo.c
View File

@ -36,8 +36,6 @@
//void do_write(void) { exo_write=TRUE;}
#define NEXTOP(V,TYPE) ((yamop *)(&((V)->u.TYPE.next)))
#define MAX_ARITY 256
#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);
return NULL;
}
bzero(base, dsz);
memset(base, 0, dsz);
}
i->size = sz+dsz+sizeof(struct index_t);
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))
return FALSE;
bzero(base, sz);
memset(base, 0, sz);
i->key = (BITS32 *)base;
i->links = (BITS32 *)(base+i->hsize);
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))
return FALSE;
bzero(base, sz);
memset(base, 0, sz);
i->key = (BITS32 *)base;
i->links = (BITS32 *)base+i->hsize;
i->ncollisions = i->nentries = i->ntrys = 0;
@ -562,7 +560,7 @@ Yap_NextExo(choiceptr cptr, struct index_t *it)
return next;
}
MegaClause *
static MegaClause *
exodb_get_space( Term t, Term mod, Term tn )
{
UInt arity;
@ -668,7 +666,7 @@ store_exo(yamop *pc, UInt arity, Term t0)
return TRUE;
}
void
static void
exoassert( void *handle, Int n, Term term )
{ /* '$number_of_clauses'(Predicate,M,N) */
PredEntry *pe;

308
C/globals.c
View File

@ -108,15 +108,15 @@ NewArena(UInt size, UInt arity, CELL *where USES_REGS)
Term t;
UInt new_size;
if (where == NULL || where == H) {
while (H+size > ASP-1024) {
if (where == NULL || where == HR) {
while (HR+size > ASP-1024) {
if (!Yap_gcl(size*sizeof(CELL), arity, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return TermNil;
}
}
t = CreateNewArena(H, size);
H += size;
t = CreateNewArena(HR, size);
HR += size;
} else {
if ((new_size=Yap_InsertInGlobal(where, size*sizeof(CELL)))==0) {
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 */
choiceptr b_ptr = B;
while (b_ptr->cp_h == H) {
while (b_ptr->cp_h == HR) {
b_ptr->cp_h += size;
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) {
size = 4096;
}
if (pt == H) {
if (H+size > ASP-1024) {
if (pt == HR) {
if (HR+size > ASP-1024) {
XREGS[arity+1] = arena;
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);
}
adjust_cps(size PASS_REGS);
H += size;
HR += size;
} else {
XREGS[arity+1] = arena;
/* 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))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage);
return FALSE;
@ -231,9 +231,9 @@ Yap_GetFromArena(Term *arenap, UInt cells, UInt arity)
CELL *newH;
UInt old_sz = ArenaSz(arena), new_size;
if (IN_BETWEEN(base, H, max)) {
base = H;
H += cells;
if (IN_BETWEEN(base, HR, max)) {
base = HR;
HR += cells;
return base;
}
if (base+cells > max-1024) {
@ -254,11 +254,11 @@ CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP, UInt old_size
{
UInt new_size;
if (H == oldH)
if (HR == oldH)
return;
new_size = old_size - (H-RepAppl(*oldArenaP));
*oldArenaP = CreateNewArena(H, new_size);
H = oldH;
new_size = old_size - (HR-RepAppl(*oldArenaP));
*oldArenaP = CreateNewArena(HR, new_size);
HR = oldH;
HB = oldHB;
ASP = oldASP;
}
@ -308,12 +308,12 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
if (IsPairTerm(d0)) {
CELL *ap2 = RepPair(d0);
if ((share && ap2 < HB) ||
(ap2 >= HB && ap2 < H)) {
(ap2 >= HB && ap2 < HR)) {
/* If this is newer than the current term, just reuse */
*ptf++ = d0;
continue;
}
*ptf = AbsPair(H);
*ptf = AbsPair(HR);
ptf++;
#ifdef RATIONAL_TREES
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->ground = ground;
/* fool the system into thinking we had a variable there */
*pt0 = AbsPair(H);
*pt0 = AbsPair(HR);
to_visit ++;
#else
if (pt0 < pt0_end) {
@ -342,9 +342,9 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
ground = TRUE;
pt0 = ap2 - 1;
pt0_end = ap2 + 1;
ptf = H;
H += 2;
if (H > ASP - MIN_ARENA_SIZE) {
ptf = HR;
HR += 2;
if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow;
}
} 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 */
ap2 = RepAppl(d0);
if ((share && ap2 < HB) ||
(ap2 >= HB && ap2 < H)) {
(ap2 >= HB && ap2 < HR)) {
/* If this is newer than the current term, just reuse */
*ptf++ = d0;
continue;
@ -367,54 +367,62 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
*ptf++ = d0;
break;
case (CELL)FunctorLongInt:
if (H > ASP - (MIN_ARENA_SIZE+3)) {
if (HR > ASP - (MIN_ARENA_SIZE+3)) {
goto overflow;
}
*ptf++ = AbsAppl(H);
H[0] = (CELL)f;
H[1] = ap2[1];
H[2] = EndSpecials;
H += 3;
if (H > ASP - MIN_ARENA_SIZE) {
*ptf++ = AbsAppl(HR);
HR[0] = (CELL)f;
HR[1] = ap2[1];
HR[2] = EndSpecials;
HR += 3;
if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow;
}
break;
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;
}
*ptf++ = AbsAppl(H);
H[0] = (CELL)f;
H[1] = ap2[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
H[2] = ap2[2];
H[3] = EndSpecials;
H += 4;
*ptf++ = AbsAppl(HR);
HR[0] = (CELL)f;
HR[1] = ap2[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
HR[2] = ap2[2];
HR[3] = EndSpecials;
HR += 4;
#else
H[2] = EndSpecials;
H += 3;
HR[2] = EndSpecials;
HR += 3;
#endif
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:
{
/* big int */
UInt sz = (sizeof(MP_INT)+3*CellSize+
((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;
}
*ptf++ = AbsAppl(H);
H[0] = (CELL)f;
*ptf++ = AbsAppl(HR);
HR[0] = (CELL)f;
for (i = 1; i < sz; i++) {
H[i] = ap2[i];
HR[i] = ap2[i];
}
H += sz;
HR += sz;
}
}
continue;
}
*ptf = AbsAppl(H);
*ptf = AbsAppl(HR);
ptf++;
/* store the terms to visit */
#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->ground = ground;
/* fool the system into thinking we had a variable there */
*pt0 = AbsAppl(H);
*pt0 = AbsAppl(HR);
to_visit ++;
#else
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_end = ap2 + d0;
/* store the functor for the new term */
H[0] = (CELL)f;
ptf = H+1;
H += 1+d0;
if (H > ASP - MIN_ARENA_SIZE) {
HR[0] = (CELL)f;
ptf = HR+1;
HR += 1+d0;
if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow;
}
} else {
@ -463,7 +471,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
ground = FALSE;
/* don't need to copy variables if we want to share the global term */
if ((share && ptd0 < HB && ptd0 > H0) ||
(ptd0 >= HLow && ptd0 < H)) {
(ptd0 >= HLow && ptd0 < HR)) {
/* we have already found this cell */
*ptf++ = (CELL) ptd0;
} else {
@ -522,7 +530,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
overflow:
/* oops, we're in trouble */
H = HLow;
HR = HLow;
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
@ -540,7 +548,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
heap_overflow:
/* oops, we're in trouble */
H = HLow;
HR = HLow;
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
@ -558,7 +566,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
trail_overflow:
/* oops, we're in trouble */
H = HLow;
HR = HLow;
/* we've done it */
/* restore our nice, friendly, term to its original state */
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)
{
UInt old_size = ArenaSz(arena);
CELL *oldH = H;
CELL *oldH = HR;
CELL *oldHB = HB;
CELL *oldASP = ASP;
int res = 0;
@ -589,14 +597,14 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
t = Deref(t);
if (IsVarTerm(t)) {
ASP = ArenaLimit(arena);
H = HB = ArenaPt(arena);
HR = HB = ArenaPt(arena);
#if COROUTINING
if (GlobalIsAttachedTerm(t)) {
CELL *Hi;
*H = t;
Hi = H+1;
H += 2;
*HR = t;
Hi = HR+1;
HR += 2;
if ((res = copy_complex_term(Hi-2, Hi-1, share, copy_att_vars, Hi, Hi PASS_REGS)) < 0)
goto error_handler;
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;
}
tn = MkVarTerm();
if (H > ASP - MIN_ARENA_SIZE) {
if (HR > ASP - MIN_ARENA_SIZE) {
res = -1;
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)) {
return t;
}
H = HB = ArenaPt(arena);
HR = HB = ArenaPt(arena);
ASP = ArenaLimit(arena);
ap = RepPair(t);
Hi = H;
tf = AbsPair(H);
H += 2;
Hi = HR;
tf = AbsPair(HR);
HR += 2;
if ((res = copy_complex_term(ap-1, ap+1, share, copy_att_vars, Hi, Hi PASS_REGS)) < 0) {
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)) {
return t;
}
H = HB = ArenaPt(arena);
HR = HB = ArenaPt(arena);
ASP = ArenaLimit(arena);
f = FunctorOfTerm(t);
HB0 = H;
HB0 = HR;
ap = RepAppl(t);
tf = AbsAppl(H);
H[0] = (CELL)f;
tf = AbsAppl(HR);
HR[0] = (CELL)f;
if (IsExtensionFunctor(f)) {
switch((CELL)f) {
case (CELL)FunctorDBRef:
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
return t;
case (CELL)FunctorLongInt:
if (H > ASP - (MIN_ARENA_SIZE+3)) {
if (HR > ASP - (MIN_ARENA_SIZE+3)) {
res = -1;
goto error_handler;
}
H[1] = ap[1];
H[2] = EndSpecials;
H += 3;
HR[1] = ap[1];
HR[2] = EndSpecials;
HR += 3;
break;
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;
goto error_handler;
}
H[1] = ap[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
H[2] = ap[2];
H[3] = EndSpecials;
H += 4;
HR[1] = ap[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
HR[2] = ap[2];
HR[3] = EndSpecials;
HR += 4;
#else
H[2] = EndSpecials;
H += 3;
HR[2] = EndSpecials;
HR += 3;
#endif
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:
{
UInt sz = ArenaSz(t), i;
if (H > ASP - (MIN_ARENA_SIZE+sz)) {
if (HR > ASP - (MIN_ARENA_SIZE+sz)) {
res = -1;
goto error_handler;
}
for (i = 1; i < sz; i++) {
H[i] = ap[i];
HR[i] = ap[i];
}
H += sz;
HR += sz;
}
}
} else {
H += 1+ArityOfFunctor(f);
if (H > ASP-MIN_ARENA_SIZE) {
HR += 1+ArityOfFunctor(f);
if (HR > ASP-MIN_ARENA_SIZE) {
res = -1;
goto error_handler;
}
@ -708,7 +724,7 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
return tf;
}
error_handler:
H = HB;
HR = HB;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
XREGS[arity+1] = t;
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);
ASP = oldASP;
H = oldH;
HR = oldH;
HB = oldHB;
switch (res) {
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;
oldASP = ASP;
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)
{
UInt old_size = ArenaSz(arena);
CELL *oldH = H;
CELL *oldH = HR;
CELL *oldHB = HB;
CELL *oldASP = ASP;
Term tf;
@ -757,22 +773,22 @@ CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity, Term *newarena, Ter
UInt i;
restart:
H = HB = ArenaPt(arena);
HR = HB = ArenaPt(arena);
ASP = ArenaLimit(arena);
HB0 = H;
tf = AbsAppl(H);
H[0] = (CELL)f;
H += 1+ArityOfFunctor(f);
if (H > ASP-MIN_ARENA_SIZE) {
HB0 = HR;
tf = AbsAppl(HR);
HR[0] = (CELL)f;
HR += 1+ArityOfFunctor(f);
if (HR > ASP-MIN_ARENA_SIZE) {
/* overflow */
H = HB;
HR = HB;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
XREGS[arity+1] = arena;
XREGS[arity+2] = (CELL)newarena;
{
CELL *old_top = ArenaLimit(*newarena);
ASP = oldASP;
H = oldH;
HR = oldH;
HB = oldHB;
if (arena == LOCAL_GlobalArena)
LOCAL_GlobalArenaOverflows++;
@ -781,7 +797,7 @@ CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity, Term *newarena, Ter
return 0L;
}
}
oldH = H;
oldH = HR;
oldHB = HB;
oldASP = ASP;
newarena = (CELL *)XREGS[arity+2];
@ -1108,7 +1124,7 @@ p_nb_add_to_accumulator( USES_REGS1 )
CELL *target = RepAppl(t0);
CELL *source = RepAppl(new);
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
target[2] = source[2];
#endif
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! */
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();
Bind_Local(VarOfTerm(t), tn);
t = tn;
@ -1476,7 +1492,7 @@ nb_queue(UInt arena_sz USES_REGS)
static Int
p_nb_queue( USES_REGS1 )
{
UInt arena_sz = (ASP-H)/16;
UInt arena_sz = (ASP-HR)/16;
if (LOCAL_DepthArenas > 1)
arena_sz /= LOCAL_DepthArenas;
if (arena_sz < MIN_ARENA_SIZE)
@ -1547,8 +1563,8 @@ RecoverArena(Term arena USES_REGS)
CELL *pt = ArenaPt(arena),
*max = ArenaLimit(arena);
if (max == H) {
H = pt;
if (max == HR) {
HR = pt;
}
}
@ -1610,14 +1626,14 @@ p_nb_queue_enqueue( USES_REGS1 )
qd = GetQueue(ARG1,"enqueue");
arena = GetQueueArena(qd,"enqueue");
/* garbage collection ? */
oldH = H;
oldH = HR;
oldHB = HB;
H = HB = ArenaPt(arena);
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
while (old_sz < MIN_ARENA_SIZE) {
UInt gsiz = H-RepPair(qd[QUEUE_HEAD]);
H = oldH;
UInt gsiz = HR-RepPair(qd[QUEUE_HEAD]);
HR = oldH;
HB = oldHB;
if (gsiz > 1024*1024) {
gsiz = 1024*1024;
@ -1633,21 +1649,21 @@ p_nb_queue_enqueue( USES_REGS1 )
to = ARG3;
qd = RepAppl(Deref(ARG1))+1;
arena = GetQueueArena(qd,"enqueue");
oldH = H;
oldH = HR;
oldHB = HB;
H = HB = ArenaPt(arena);
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
}
qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsize+1);
if (qsize == 0) {
qd[QUEUE_HEAD] = AbsPair(H);
qd[QUEUE_HEAD] = AbsPair(HR);
} else {
*VarOfTerm(qd[QUEUE_TAIL]) = AbsPair(H);
*VarOfTerm(qd[QUEUE_TAIL]) = AbsPair(HR);
}
*H++ = to;
RESET_VARIABLE(H);
qd[QUEUE_TAIL] = (CELL)H;
H++;
*HR++ = to;
RESET_VARIABLE(HR);
qd[QUEUE_TAIL] = (CELL)HR;
HR++;
CloseArena(oldH, oldHB, ASP, qd+QUEUE_ARENA, old_sz PASS_REGS);
return TRUE;
}
@ -1672,7 +1688,7 @@ p_nb_queue_dequeue( USES_REGS1 )
out = HeadOfTerm(qd[QUEUE_HEAD]);
qd[QUEUE_HEAD] = TailOfTerm(qd[QUEUE_HEAD]);
/* garbage collection ? */
oldH = H;
oldH = HR;
oldHB = HB;
qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsz-1);
CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS);
@ -1771,16 +1787,16 @@ MkZeroApplTerm(Functor f, UInt sz USES_REGS)
Term t0, tf;
CELL *pt;
if (H+(sz+1) > ASP-1024)
if (HR+(sz+1) > ASP-1024)
return TermNil;
tf = AbsAppl(H);
*H = (CELL)f;
tf = AbsAppl(HR);
*HR = (CELL)f;
t0 = MkIntTerm(0);
pt = H+1;
pt = HR+1;
while (sz--) {
*pt++ = t0;
}
H = pt;
HR = pt;
return tf;
}
@ -1790,7 +1806,7 @@ p_nb_heap( USES_REGS1 )
Term heap_arena, heap, *ar, *nar;
UInt hsize;
Term tsize = Deref(ARG1);
UInt arena_sz = (H-H0)/16;
UInt arena_sz = (HR-H0)/16;
if (IsVarTerm(tsize)) {
Yap_Error(INSTANTIATION_ERROR,tsize,"nb_heap");
@ -1941,9 +1957,9 @@ p_nb_heap_add_to_heap( USES_REGS1 )
}
arena = qd[HEAP_ARENA];
old_sz = ArenaSz(arena);
oldH = H;
oldH = HR;
oldHB = HB;
H = HB = ArenaPt(arena);
HR = HB = ArenaPt(arena);
qd[HEAP_MAX] = Global_MkIntegerTerm(hmsize);
CloseArena(oldH, oldHB, ASP, qd+HEAP_ARENA, old_sz PASS_REGS);
goto restart;
@ -1963,14 +1979,14 @@ p_nb_heap_add_to_heap( USES_REGS1 )
qd = GetHeap(ARG1,"add_to_heap");
arena = qd[HEAP_ARENA];
/* garbage collection ? */
oldH = H;
oldH = HR;
oldHB = HB;
H = HB = ArenaPt(arena);
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
while (old_sz < MIN_ARENA_SIZE) {
UInt gsiz = hsize*2;
H = oldH;
HR = oldH;
HB = oldHB;
if (gsiz > 1024*1024) {
gsiz = 1024*1024;
@ -1985,9 +2001,9 @@ p_nb_heap_add_to_heap( USES_REGS1 )
to = ARG3;
qd = RepAppl(Deref(ARG1))+1;
arena = qd[HEAP_ARENA];
oldH = H;
oldH = HR;
oldHB = HB;
H = HB = ArenaPt(arena);
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
}
pt = qd+HEAP_START;
@ -2018,7 +2034,7 @@ p_nb_heap_del( USES_REGS1 )
return FALSE;
old_sz = ArenaSz(arena);
/* garbage collection ? */
oldH = H;
oldH = HR;
oldHB = HB;
qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz-1);
CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS);
@ -2073,7 +2089,7 @@ p_nb_beam( USES_REGS1 )
Term beam_arena, beam, *ar, *nar;
UInt hsize;
Term tsize = Deref(ARG1);
UInt arena_sz = (H-H0)/16;
UInt arena_sz = (HR-H0)/16;
if (IsVarTerm(tsize)) {
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");
arena = qd[HEAP_ARENA];
/* garbage collection ? */
oldH = H;
oldH = HR;
oldHB = HB;
H = HB = ArenaPt(arena);
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
while (old_sz < MIN_ARENA_SIZE) {
UInt gsiz = hsize*2;
H = oldH;
HR = oldH;
HB = oldHB;
if (gsiz > 1024*1024) {
gsiz = 1024*1024;
@ -2374,9 +2390,9 @@ p_nb_beam_add_to_beam( USES_REGS1 )
to = ARG3;
qd = RepAppl(Deref(ARG1))+1;
arena = qd[HEAP_ARENA];
oldH = H;
oldH = HR;
oldHB = HB;
H = HB = ArenaPt(arena);
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
}
pt = qd+HEAP_START;
@ -2405,7 +2421,7 @@ p_nb_beam_del( USES_REGS1 )
return FALSE;
old_sz = ArenaSz(arena);
/* garbage collection ? */
oldH = H;
oldH = HR;
oldHB = HB;
qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz-1);
CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS);
@ -2472,25 +2488,25 @@ p_nb_beam_keys( USES_REGS1 )
if (!qd)
return FALSE;
qsz = IntegerOfTerm(qd[HEAP_SIZE]);
ho = H;
ho = HR;
pt = qd+HEAP_START;
if (qsz == 0)
return Yap_unify(ARG2, TermNil);
for (i=0; i < qsz; i++) {
if (H > ASP-1024) {
H = ho;
if (!Yap_gcl(((ASP-H)-1024)*sizeof(CELL), 2, ENV, P)) {
if (HR > ASP-1024) {
HR = ho;
if (!Yap_gcl(((ASP-HR)-1024)*sizeof(CELL), 2, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return TermNil;
}
goto restart;
}
*H++ = pt[0];
*H = AbsPair(H+1);
H++;
*HR++ = pt[0];
*HR = AbsPair(HR+1);
HR++;
pt += 2;
}
H[-1] = TermNil;
HR[-1] = TermNil;
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;
} else if (pt1[1] == BIG_RATIONAL) {
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 {
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 *
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 "compile.h"
#include "attvar.h"
#ifdef CUT_C
#include "cut_c.h"
#endif /* CUT_C */
#if HAVE_STRING_H
#include <string.h>
#endif
@ -100,7 +98,7 @@ SetHeapRegs(int copying_threads USES_REGS)
LOCAL_OldLCL0 = LCL0;
LOCAL_OldASP = ASP;
LOCAL_OldGlobalBase = (CELL *)LOCAL_GlobalBase;
LOCAL_OldH = H;
LOCAL_OldH = HR;
LOCAL_OldH0 = H0;
LOCAL_OldTrailBase = LOCAL_TrailBase;
LOCAL_OldTrailTop = LOCAL_TrailTop;
@ -135,18 +133,26 @@ SetHeapRegs(int copying_threads USES_REGS)
if (LCL0)
LCL0 = PtoLocAdjust(LCL0);
UNLOCK(LOCAL_SignalLock);
if (H)
H = PtoGloAdjust(H);
#ifdef CUT_C
if (HR)
HR = PtoGloAdjust(HR);
if (Yap_REGS.CUT_C_TOP)
Yap_REGS.CUT_C_TOP = CutCAdjust(Yap_REGS.CUT_C_TOP);
#endif
if (HB)
HB = PtoGloAdjust(HB);
if (LOCAL_OpenArray)
LOCAL_OpenArray = PtoGloAdjust(LOCAL_OpenArray);
if (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
if (B_FZ)
B_FZ = ChoicePtrAdjust(B_FZ);
@ -220,7 +226,7 @@ static CELL
worker_p_binding(int worker_p, CELL *aux_ptr)
{
CACHE_REGS
if (aux_ptr > H) {
if (aux_ptr > HR) {
CELL reg = REMOTE_ThreadHandle(worker_p).current_yaam_regs->LCL0_[aux_ptr-LCL0];
reg = AdjustGlobTerm(reg PASS_REGS);
return reg;
@ -245,7 +251,7 @@ RestoreTrail(int worker_p USES_REGS)
if (aux_tr < TR){
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) {
CELL aux_cell = TrailTerm(--aux_tr);
if (IsVarTerm(aux_cell)) {
@ -532,7 +538,7 @@ AdjustGlobal(long sz, int thread_copying USES_REGS)
} else {
#endif
pt = H0;
pt_max = (H-sz/CellSize);
pt_max = (HR-sz/CellSize);
#if defined(YAPOR_THREADS)
}
#endif
@ -553,12 +559,15 @@ AdjustGlobal(long sz, int thread_copying USES_REGS)
/* skip bitmaps */
switch((CELL)f) {
case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
pt += 3;
#else
pt += 2;
#endif
break;
case (CELL)FunctorString:
pt += 3+pt[1];
break;
case (CELL)FunctorBigInt:
{
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 */
if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) {
LOCK(LOCAL_SignalLock);
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock);
}
ASP -= 256;
@ -888,19 +897,19 @@ static_growglobal(long request, CELL **ptr, CELL *hsplit USES_REGS)
do_grow = FALSE;
}
} else if (hsplit < (CELL*)omax ||
hsplit > H)
hsplit > HR)
return FALSE;
else if (hsplit == (CELL *)omax)
hsplit = NULL;
if (size < 0 ||
(Unsigned(H)+size < Unsigned(ASP)-CreepFlag &&
(Unsigned(HR)+size < Unsigned(ASP)-StackGap( PASS_REGS1 ) &&
hsplit > H0)) {
/* don't need to expand stacks */
insert_in_delays = FALSE;
do_grow = FALSE;
}
} else {
if (Unsigned(H)+size < Unsigned(ASP)-CreepFlag) {
if (Unsigned(HR)+size < Unsigned(ASP)-CreepFlag) {
/* we can just ask for more room */
do_grow = FALSE;
}
@ -1082,7 +1091,9 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS)
case get_float_op:
case put_float_op:
case get_longint_op:
case get_string_op:
case put_longint_op:
case put_string_op:
case unify_float_op:
case unify_last_float_op:
case write_float_op:
@ -1112,8 +1123,11 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS)
case unify_last_num_op:
case write_num_op:
case unify_longint_op:
case unify_string_op:
case unify_last_longint_op:
case unify_last_string_op:
case write_longint_op:
case write_string_op:
case unify_bigint_op:
case unify_last_bigint_op:
case unify_dbterm_op:
@ -1166,6 +1180,7 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS)
case index_dbref_op:
case index_blob_op:
case index_long_op:
case index_string_op:
case if_nonvar_op:
case unify_last_list_op:
case write_last_list_op:
@ -1182,6 +1197,7 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS)
case enter_lu_op:
case empty_call_op:
case blob_op:
case string_op:
case fetch_args_vi_op:
case fetch_args_iv_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);
LOCAL_ActiveSignals &= ~YAP_CDOVF_SIGNAL;
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock);
return TRUE;
}
@ -1361,7 +1377,7 @@ growatomtable( USES_REGS1 )
LOCK(LOCAL_SignalLock);
if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) {
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
}
LOCAL_ActiveSignals &= ~YAP_CDOVF_SIGNAL;
UNLOCK(LOCAL_SignalLock);
@ -1416,6 +1432,18 @@ Yap_growheap(int fix_code, size_t in_size, void *cip)
int res;
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) {
UInt n = NOfAtoms;
if (GLOBAL_AGcThreshold)
@ -1429,7 +1457,7 @@ Yap_growheap(int fix_code, size_t in_size, void *cip)
} else {
LOCK(LOCAL_SignalLock);
if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) {
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
}
LOCAL_ActiveSignals &= ~YAP_CDOVF_SIGNAL;
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);
#endif
LeaveGrowMode(GrowHeapMode);
#endif
return res;
}
@ -1634,7 +1663,7 @@ growstack(size_t size USES_REGS)
fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id);
#endif
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, "%% Trail:%8ld cells (%p-%p)\n",
(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);
#endif
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, "%% Trail:%8ld cells (%p-%p)\n",
(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
fprintf(GLOBAL_stderr, "%% Trail Overflow %d\n", LOCAL_trail_overflows);
#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, "%% Trail:%8ld cells (%p-%p)\n",
(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);
if (LOCAL_ActiveSignals == YAP_TROVF_SIGNAL) {
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
}
LOCAL_ActiveSignals &= ~YAP_TROVF_SIGNAL;
UNLOCK(LOCAL_SignalLock);
@ -1878,11 +1907,59 @@ Yap_CopyThreadStacks(int worker_q, int worker_p, int incremental)
/* make sure both stacks have same size */
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;
if (p_size != q_size) {
if (!(REMOTE_ThreadHandle(worker_q).stack_address = realloc(REMOTE_ThreadHandle(worker_q).stack_address,p_size*K1))) {
exit(1);
if (p_size != q_size) {
UInt start_growth_time, growth_time;
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).tsize = REMOTE_ThreadHandle(worker_p).tsize;
/* 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_XDiff = LOCAL_HDiff = 0;
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_;
B = REMOTE_ThreadHandle(worker_p).current_yaam_regs->B_;
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))
ASP = CellPtr(B);
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;
#endif
LOCAL_DynamicArrays = NULL;
LOCAL_StaticArrays = 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) {
if (curr >= H0 && curr < TrueHB) {
old_vars++;
} else if (curr >= TrueHB && curr < H) {
} else if (curr >= TrueHB && curr < HR) {
new_vars++;
} else {
return;
@ -1163,7 +1163,7 @@ mark_variable(CELL_PTR current USES_REGS)
if (UNMARKED_MARK(current,local_bp)) {
POP_CONTINUATION();
}
if (current >= H0 && current < H) {
if (current >= H0 && current < HR) {
//fprintf(stderr,"%p M\n", current);
LOCAL_total_marked++;
if (current < LOCAL_HGEN) {
@ -1177,7 +1177,7 @@ mark_variable(CELL_PTR current USES_REGS)
next = GET_NEXT(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 (!UNMARKED_MARK(next-1,local_bp)) {
//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) {
UNMARK(current);
*current = cnext;
if (current >= H0 && current < H) {
if (current >= H0 && current < HR) {
//fprintf(stderr,"%p M\n", current-1);
LOCAL_total_marked--;
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 */
*current = UNMARK_CELL(cnext);
UNMARK(current);
if (current >= H0 && current < H ) {
if (current >= H0 && current < HR ) {
//fprintf(stderr,"%p M\n", current);
LOCAL_total_marked--;
if (current < LOCAL_HGEN) {
@ -1365,7 +1365,24 @@ mark_variable(CELL_PTR current USES_REGS)
MARK(next);
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) {
LOCAL_total_oldies+= 1+sz;
} 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.
The ideal solution would be to unbind all variables. The current solution is to
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);
LOCAL_total_marked++;
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)) {
/* cannot safely ignore this */
CELL *cptr = RepPair(trail_cell);
if (IN_BETWEEN(LOCAL_GlobalBase,cptr,H)) {
if (IN_BETWEEN(LOCAL_GlobalBase,cptr,HR)) {
if (GlobalIsAttVar(cptr)) {
TrailTerm(trail_base) = (CELL)cptr;
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 _retry:
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");
exit(1);
}
@ -2600,7 +2617,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR USES_REGS)
if (IsVarTerm(trail_cell)) {
/* 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 */
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)) {
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 flags;
if (IN_BETWEEN(LOCAL_GlobalBase, pt0, H)) {
if (IN_BETWEEN(LOCAL_GlobalBase, pt0, HR)) {
if (GlobalIsAttVar(pt0)) {
TrailTerm(dest) = trail_cell;
/* be careful with partial gc */
@ -3428,12 +3445,12 @@ compact_heap( USES_REGS1 )
next_hb = set_next_hb(gc_B PASS_REGS);
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
, &depfr
#endif /* TABLING */
);
for (current = H - 1; current >= start_from; current--) {
for (current = HR - 1; current >= start_from; current--) {
if (MARKED_PTR(current)) {
CELL ccell = UNMARK_CELL(*current);
@ -3524,7 +3541,7 @@ compact_heap( USES_REGS1 )
*/
dest = (CELL_PTR) start_from;
for (current = start_from; current < H; current++) {
for (current = start_from; current < HR; current++) {
CELL ccur = *current;
if (MARKED_PTR(current)) {
CELL uccur = UNMARK_CELL(ccur);
@ -3560,7 +3577,7 @@ compact_heap( USES_REGS1 )
ccur = *current;
next = GET_NEXT(ccur);
if (HEAP_PTR(ccur) &&
(next = GET_NEXT(ccur)) < H && /* move current cell &
(next = GET_NEXT(ccur)) < HR && /* move current cell &
* push */
next > current) { /* into relocation chain */
*dest = ccur;
@ -3584,7 +3601,7 @@ compact_heap( USES_REGS1 )
(unsigned long int)found_marked);
#endif
H = dest; /* reset H */
HR = dest; /* reset H */
HB = B->cp_h;
#ifdef TABLING
if (B_FZ == (choiceptr)LCL0)
@ -3603,7 +3620,7 @@ compact_heap( USES_REGS1 )
static void
icompact_heap( USES_REGS1 )
{
CELL_PTR *iptr, *ibase = (CELL_PTR *)H;
CELL_PTR *iptr, *ibase = (CELL_PTR *)HR;
CELL_PTR dest;
CELL *next_hb;
#ifdef DEBUG
@ -3628,7 +3645,7 @@ icompact_heap( USES_REGS1 )
#endif /* TABLING */
next_hb = set_next_hb(gc_B PASS_REGS);
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
, &depfr
#endif /* TABLING */
@ -3761,7 +3778,7 @@ icompact_heap( USES_REGS1 )
(unsigned long int)found_marked);
#endif
H = dest; /* reset H */
HR = dest; /* reset H */
HB = B->cp_h;
#ifdef TABLING
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;
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) {
/* 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
#endif
!= 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
#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;
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 );
} else
#endif /* HYBRID_SCHEME */
@ -3930,7 +3947,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS)
UInt alloc_sz;
int jmp_res;
heap_cells = H-H0;
heap_cells = HR-H0;
gc_verbose = is_gc_verbose();
effectiveness = 0;
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);
#endif
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, "%% Trail:%8ld cells (%p-%p)\n",
(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);
#ifdef HYBRID_SCHEME
LOCAL_iptop = (CELL_PTR *)H;
LOCAL_iptop = (CELL_PTR *)HR;
#endif
/* get the number of active registers */
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) {
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",
(unsigned long int)(ASP-H));
(unsigned long int)(ASP-HR));
}
check_global();
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) &&
/* make sure there is a point in collecting the heap */
(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);
if (effectiveness < 0)
return FALSE;
if (effectiveness > 90 && !gc_t) {
while (gc_margin < (H-H0)/sizeof(CELL))
while (gc_margin < (HR-H0)/sizeof(CELL))
gc_margin <<= 1;
}
} else {
effectiveness = 0;
}
/* 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) {
LeaveGCMode( PASS_REGS1 );
#ifndef YAPOR
if (gc_margin < 2*CalculateStackGap())
gc_margin = 2*CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
if (gc_margin < 2*EventFlag)
gc_margin = 2*EventFlag;
return Yap_growstack(gc_margin);
#endif
}
@ -4277,8 +4295,10 @@ Yap_gcl(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
{
CACHE_REGS
int res;
UInt min = CalculateStackGap()*sizeof(CELL);
UInt min;
CalculateStackGap( PASS_REGS1 );
min = EventFlag*sizeof(CELL);
LOCAL_PrologMode |= GCMode;
if (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
#include <string.h>
#endif
#ifdef CUT_C
#include "cut_c.h"
#endif
#if defined(YAPOR) || defined(THREADS)
#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;
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) {
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;
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) {
LogUpdIndex *lcl = ClauseCodeToLogUpdIndex(cpc->rnd2);
@ -1033,7 +1031,7 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
if (ap->ModuleOfPred == IDB_MODULE) {
cl = clause->Code;
} else {
cl = clause->u.WorkPC;
cl = clause->ucd.WorkPC;
}
while (TRUE) {
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:
if (argno == 1) {
clause->Tag = AbsPair(NULL);
clause->u.WorkPC = NEXTOP(cl,o);
clause->ucd.WorkPC = NEXTOP(cl,o);
return;
}
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:
if (argno == 1) {
clause->Tag = AbsAppl((CELL *)FunctorDouble);
clause->u.t_ptr = AbsAppl(cl->u.od.d);
clause->ucd.t_ptr = AbsAppl(cl->u.od.d);
return;
}
cl = NEXTOP(cl,od);
@ -1187,7 +1185,7 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
case _unify_l_longint:
if (argno == 1) {
clause->Tag = AbsAppl((CELL *)FunctorLongInt);
clause->u.t_ptr = AbsAppl(cl->u.oi.i);
clause->ucd.t_ptr = AbsAppl(cl->u.oi.i);
return;
}
argno--;
@ -1197,12 +1195,22 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
case _unify_l_bigint:
if (argno == 1) {
clause->Tag = AbsAppl((CELL *)FunctorBigInt);
clause->u.t_ptr = cl->u.oc.c;
clause->ucd.t_ptr = cl->u.oc.c;
return;
}
cl = NEXTOP(cl,oc);
argno--;
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:
if (argno <= cl->u.osc.s) {
clause->Tag = cl->u.osc.c;
@ -1216,7 +1224,7 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
case _unify_l_struc:
if (argno == 1) {
clause->Tag = AbsAppl((CELL *)cl->u.ofa.f);
clause->u.WorkPC = NEXTOP(cl,ofa);
clause->ucd.WorkPC = NEXTOP(cl,ofa);
return;
}
/* must skip next n arguments */
@ -1246,7 +1254,7 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
case _unify_idb_term:
case _copy_idb_term:
{
Term t = clause->u.c_sreg[argno];
Term t = clause->ucd.c_sreg[argno];
if (IsVarTerm(t)) {
clause->Tag = (CELL)NULL;
@ -1255,15 +1263,15 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
clause->Tag = AbsAppl((CELL *)pt[0]);
if (IsExtensionFunctor(FunctorOfTerm(t))) {
clause->u.t_ptr = t;
clause->ucd.t_ptr = t;
} else {
clause->u.c_sreg = pt;
clause->ucd.c_sreg = pt;
}
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
clause->ucd.c_sreg = pt-1;
} else {
clause->Tag = t;
}
@ -1323,7 +1331,7 @@ skip_to_arg(ClauseDef *clause, PredEntry *ap, UInt argno, int at_point)
*/
case _unify_struct:
case _unify_l_struc:
if (cl == clause->u.WorkPC) {
if (cl == clause->ucd.WorkPC) {
clause->CurrentCode = cl;
} else {
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);
for (i=0; i<n; i++) {
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);
} 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);
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].u.labp = fail_l;
target[n].u_a.labp = fail_l;
Yap_emit(op, Unsigned(n), (CELL)target, cint);
}
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);
for (i=0; i<n; i++) {
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);
} else {
@ -1704,10 +1712,10 @@ emit_fswitch(COUNT n, yamop *fail_l, struct intermediates *cint)
op = if_f_op;
target = (FuncSwiEntry *)emit_switch_space(n+1, sizeof(FuncSwiEntry), cint, FuncSwitchMask);
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].u.labp = fail_l;
target[n].u_f.labp = fail_l;
Yap_emit(op, Unsigned(n), (CELL)target, cint);
}
return target;
@ -2025,17 +2033,17 @@ do_consts(GroupDef *grp, Term t, struct intermediates *cint, int compound_term,
if (min != max) {
if (sreg != NULL) {
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 {
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) {
ics->u.Label = suspend_indexing(min, max, cint->CurrentPred, cint);
ics->u_a.Label = suspend_indexing(min, max, cint->CurrentPred, cint);
} 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 {
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;
}
@ -2064,9 +2072,9 @@ do_blobs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int firs
(max+1)->Tag == min->Tag) max++;
if (min != max &&
(ap->PredFlags & LogUpdatePredFlag)) {
ics->u.Label = suspend_indexing(min, max, ap, cint);
ics->u_a.Label = suspend_indexing(min, max, ap, cint);
} 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;
}
@ -2107,11 +2115,11 @@ do_funcs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int firs
if (IsExtensionFunctor(f)) {
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)
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
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 {
CELL *sreg;
@ -2121,7 +2129,7 @@ do_funcs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int firs
} else {
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;
}
@ -2349,15 +2357,15 @@ cls_head_info(ClauseDef *min, ClauseDef *max, UInt argno, int in_idb)
cl->Tag = AbsAppl((CELL *)pt[0]);
if (IsExtensionFunctor(FunctorOfTerm(t))) {
cl->u.t_ptr = t;
cl->ucd.t_ptr = t;
} else {
cl->u.c_sreg = pt;
cl->ucd.c_sreg = pt;
}
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
cl->Tag = AbsPair(NULL);
cl->u.c_sreg = pt-1;
cl->ucd.c_sreg = pt-1;
} else {
cl->Tag = t;
}
@ -2629,7 +2637,7 @@ do_dbref_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cin
cl = min;
while (cl <= max) {
cl->Tag = cl->u.t_ptr;
cl->Tag = cl->ucd.t_ptr;
cl++;
}
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;
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;
} else if (blob) {
cl->Tag = Yap_Double_key(cl->u.t_ptr);
cl->Tag = Yap_Double_key(cl->ucd.t_ptr);
} else {
cl->Tag = Yap_Int_key(cl->u.t_ptr);
cl->Tag = Yap_Int_key(cl->ucd.t_ptr);
}
cl++;
}
@ -2746,10 +2754,10 @@ compile_index(struct intermediates *cint)
siglongjmp(cint->CompilerBotch,2);
}
}
cint->freep = (char *)H;
cint->freep = (char *)HR;
#else
/* reserve double the space for compiler */
cint->cls = (ClauseDef *)H;
cint->cls = (ClauseDef *)HR;
if (cint->cls+2*NClauses > (ClauseDef *)(ASP-4096)) {
/* tell how much space we need */
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);
if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) {
if (cls->u.t_ptr != sp->extra) break;
if (cls->ucd.t_ptr != sp->extra) break;
} else if (f == FunctorDouble) {
if (cls->u.t_ptr &&
Yap_Double_key(sp->extra) != Yap_Double_key(cls->u.t_ptr))
if (cls->ucd.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;
} else {
if (cls->u.t_ptr &&
Yap_Int_key(sp->extra) != Yap_Int_key(cls->u.t_ptr))
if (cls->ucd.t_ptr &&
Yap_Int_key(sp->extra) != Yap_Int_key(cls->ucd.t_ptr))
break;
}
}
@ -3066,14 +3078,14 @@ install_log_upd_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack)
Functor f = (Functor)RepAppl(cls->Tag);
if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) {
if (cls->u.t_ptr != sp->extra) break;
if (cls->ucd.t_ptr != sp->extra) break;
} else if (f == FunctorDouble) {
if (cls->u.t_ptr &&
Yap_Double_key(sp->extra) != Yap_Double_key(cls->u.t_ptr))
if (cls->ucd.t_ptr &&
Yap_Double_key(sp->extra) != Yap_Double_key(cls->ucd.t_ptr))
break;
} else {
if (cls->u.t_ptr &&
Yap_Int_key(sp->extra) != Yap_Int_key(cls->u.t_ptr))
if (cls->ucd.t_ptr &&
Yap_Int_key(sp->extra) != Yap_Int_key(cls->ucd.t_ptr))
break;
}
}
@ -3665,9 +3677,9 @@ expand_index(struct intermediates *cint) {
} else {
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) {
/* we found it */
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);
}
labp = &(ae->u.labp);
if (ae->u.labp == e_code) {
labp = &(ae->u_a.labp);
if (ae->u_a.labp == e_code) {
/* we found it */
parentcl = code_to_indexcl(ipc->u.sssl.l,is_lu);
ipc = NULL;
} else {
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);
}
}
@ -3795,7 +3807,7 @@ expand_index(struct intermediates *cint) {
}
}
#else
cint->cls = (ClauseDef *)H;
cint->cls = (ClauseDef *)HR;
if (cint->cls+2*nclauses > (ClauseDef *)(ASP-4096)) {
/* tell how much space we need (worst case) */
LOCAL_Error_Size += 2*NClauses*sizeof(ClauseDef);
@ -3823,7 +3835,7 @@ expand_index(struct intermediates *cint) {
}
}
#else
cint->cls = (ClauseDef *)H;
cint->cls = (ClauseDef *)HR;
if (cint->cls+2*NClauses > (ClauseDef *)(ASP-4096)) {
/* tell how much space we need (worst case) */
LOCAL_Error_Size += 2*NClauses*sizeof(ClauseDef);
@ -3852,7 +3864,7 @@ expand_index(struct intermediates *cint) {
return labp;
}
#if USE_SYSTEM_MALLOC
cint->freep = (char *)H;
cint->freep = (char *)HR;
#else
cint->freep = (char *)(max+1);
#endif
@ -4139,11 +4151,11 @@ push_path(path_stack_entry *sp, yamop **pipc, ClauseDef *clp, struct intermediat
siglongjmp(cint->CompilerBotch,4);
}
sp->flag = pc_entry;
sp->u.pce.pi_pc = pipc;
sp->u.pce.code = clp->Code;
sp->u.pce.current_code = clp->CurrentCode;
sp->u.pce.work_pc = clp->u.WorkPC;
sp->u.pce.tag = clp->Tag;
sp->uip.pce.pi_pc = pipc;
sp->uip.pce.code = clp->Code;
sp->uip.pce.current_code = clp->CurrentCode;
sp->uip.pce.work_pc = clp->ucd.WorkPC;
sp->uip.pce.tag = clp->Tag;
return sp+1;
}
@ -4157,11 +4169,11 @@ fetch_new_block(path_stack_entry *sp, yamop **pipc, PredEntry *ap, struct interm
}
/* add current position */
sp->flag = block_entry;
sp->u.cle.entry_code = pipc;
sp->uip.cle.entry_code = pipc;
if (ap->PredFlags & LogUpdatePredFlag) {
sp->u.cle.block = (ClauseUnion *)ClauseCodeToLogUpdIndex(*pipc);
sp->uip.cle.block = (ClauseUnion *)ClauseCodeToLogUpdIndex(*pipc);
} else {
sp->u.cle.block = (ClauseUnion *)ClauseCodeToStaticIndex(*pipc);
sp->uip.cle.block = (ClauseUnion *)ClauseCodeToStaticIndex(*pipc);
}
return sp+1;
}
@ -4172,11 +4184,11 @@ init_block_stack(path_stack_entry *sp, yamop *ipc, PredEntry *ap)
/* add current position */
sp->flag = block_entry;
sp->u.cle.entry_code = NULL;
sp->uip.cle.entry_code = NULL;
if (ap->PredFlags & LogUpdatePredFlag) {
sp->u.cle.block = (ClauseUnion *)ClauseCodeToLogUpdIndex(ipc);
sp->uip.cle.block = (ClauseUnion *)ClauseCodeToLogUpdIndex(ipc);
} else {
sp->u.cle.block = (ClauseUnion *)ClauseCodeToStaticIndex(ipc);
sp->uip.cle.block = (ClauseUnion *)ClauseCodeToStaticIndex(ipc);
}
return sp+1;
}
@ -4191,7 +4203,7 @@ cross_block(path_stack_entry *sp, yamop **pipc, PredEntry *ap, struct intermedia
do {
UInt bsize;
while ((--tsp)->flag != block_entry);
block = tsp->u.cle.block;
block = tsp->uip.cle.block;
if (block->lui.ClFlags & LogUpdMask)
bsize = block->lui.ClSize;
else
@ -4203,18 +4215,18 @@ cross_block(path_stack_entry *sp, yamop **pipc, PredEntry *ap, struct intermedia
if (tsp->flag == pc_entry) {
if (nsp != tsp) {
nsp->flag = pc_entry;
nsp->u.pce.pi_pc = tsp->u.pce.pi_pc;
nsp->u.pce.code = tsp->u.pce.code;
nsp->u.pce.current_code = tsp->u.pce.current_code;
nsp->u.pce.work_pc = tsp->u.pce.work_pc;
nsp->u.pce.tag = tsp->u.pce.tag;
nsp->uip.pce.pi_pc = tsp->uip.pce.pi_pc;
nsp->uip.pce.code = tsp->uip.pce.code;
nsp->uip.pce.current_code = tsp->uip.pce.current_code;
nsp->uip.pce.work_pc = tsp->uip.pce.work_pc;
nsp->uip.pce.tag = tsp->uip.pce.tag;
}
nsp++;
}
}
return nsp;
}
} while (tsp->u.cle.entry_code != NULL);
} while (tsp->uip.cle.entry_code != NULL);
/* moved to a new block */
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);
*spp = sp;
clp->Code = sp->u.pce.code;
clp->CurrentCode = sp->u.pce.current_code;
clp->u.WorkPC = sp->u.pce.work_pc;
clp->Tag = sp->u.pce.tag;
if (sp->u.pce.pi_pc == NULL) {
clp->Code = sp->uip.pce.code;
clp->CurrentCode = sp->uip.pce.current_code;
clp->ucd.WorkPC = sp->uip.pce.work_pc;
clp->Tag = sp->uip.pce.tag;
if (sp->uip.pce.pi_pc == NULL) {
*spp = sp;
return NULL;
}
nipc = *(sp->u.pce.pi_pc);
*spp = cross_block(sp, sp->u.pce.pi_pc, ap, cint);
nipc = *(sp->uip.pce.pi_pc);
*spp = cross_block(sp, sp->uip.pce.pi_pc, ap, cint);
return nipc;
}
@ -4345,10 +4357,10 @@ expand_ctable(yamop *pc, ClauseUnion *blk, struct intermediates *cint, Term at)
n = 1;
for (i = 0; i < pc->u.sssl.s; i++,tmp++) {
if (tmp->Tag != Zero) n++;
else fail_l = tmp->u.Label;
else fail_l = tmp->u_a.Label;
}
} else {
fail_l = old_ae[n].u.Label;
fail_l = old_ae[n].u_a.Label;
n++;
}
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;
for (i=0; i<cases; i++) {
target[i].Tag = Zero;
target[i].u.Label = fail_l;
target[i].u_a.Label = fail_l;
}
} else {
pc->opc = Yap_opcode(_if_cons);
pc->u.sssl.s = n;
target = (AtomSwiEntry *)emit_switch_space(n+1, sizeof(AtomSwiEntry), cint, 0);
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++) {
Term tag = old_ae->Tag;
@ -4379,7 +4391,7 @@ expand_ctable(yamop *pc, ClauseUnion *blk, struct intermediates *cint, Term at)
if (tag != Zero) {
AtomSwiEntry *ics = fetch_centry(target, tag, i, n);
ics->Tag = tag;
ics->u.Label = old_ae->u.Label;
ics->u_a.Label = old_ae->u_a.Label;
}
}
/* support for threads */
@ -4404,10 +4416,10 @@ expand_ftable(yamop *pc, ClauseUnion *blk, struct intermediates *cint, Functor f
n = 1;
for (i = 0; i < pc->u.sssl.s; i++,tmp++) {
if (tmp->Tag != Zero) n++;
else fail_l = tmp->u.Label;
else fail_l = tmp->u_f.Label;
}
} else {
fail_l = old_fe[n].u.Label;
fail_l = old_fe[n].u_f.Label;
n++;
}
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);
for (i=0; i<cases; i++) {
target[i].Tag = NULL;
target[i].u.Label = fail_l;
target[i].u_f.Label = fail_l;
}
} else {
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;
target = (FuncSwiEntry *)emit_switch_space(n+1, sizeof(FuncSwiEntry), cint, FuncSwitchMask);
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++) {
Functor f = old_fe->Tag;
@ -4443,7 +4455,7 @@ expand_ftable(yamop *pc, ClauseUnion *blk, struct intermediates *cint, Functor f
if (f != NULL) {
FuncSwiEntry *ifs = fetch_fentry(target, f, i, n);
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);
@ -4468,21 +4480,21 @@ static ClauseUnion *
current_block(path_stack_entry *sp)
{
while ((--sp)->flag != block_entry);
return sp->u.cle.block;
return sp->uip.cle.block;
}
static path_stack_entry *
kill_block(path_stack_entry *sp, PredEntry *ap)
{
while ((--sp)->flag != block_entry);
if (sp->u.cle.entry_code == NULL) {
Yap_kill_iblock(sp->u.cle.block, NULL, ap);
if (sp->uip.cle.entry_code == NULL) {
Yap_kill_iblock(sp->uip.cle.block, NULL, ap);
} else {
path_stack_entry *nsp = sp;
while ((--nsp)->flag != block_entry);
Yap_kill_iblock(sp->u.cle.block, nsp->u.cle.block, ap);
*sp->u.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
Yap_kill_iblock(sp->uip.cle.block, nsp->uip.cle.block, ap);
*sp->uip.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
}
return sp;
}
@ -4626,7 +4638,7 @@ kill_clause(yamop *ipc, yamop *bg, yamop *lt, path_stack_entry *sp0, PredEntry *
path_stack_entry *sp = sp0;
while ((--sp)->flag != block_entry);
blk = (LogUpdIndex *)(sp->u.cle.block);
blk = (LogUpdIndex *)(sp->uip.cle.block);
start = blk->ClCode;
op0 = Yap_op_from_opcode(start->opc);
while (op0 == _lock_lu) {
@ -4655,8 +4667,8 @@ kill_clause(yamop *ipc, yamop *bg, yamop *lt, path_stack_entry *sp0, PredEntry *
nsp = sp;
while ((--nsp)->flag != block_entry);
/* make us point straight at clause */
*sp->u.cle.entry_code = tgl->ClCode;
Yap_kill_iblock(sp->u.cle.block, nsp->u.cle.block, ap);
*sp->uip.cle.entry_code = tgl->ClCode;
Yap_kill_iblock(sp->uip.cle.block, nsp->uip.cle.block, ap);
return sp;
} else {
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)
{
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;
}
@ -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)
{
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;
}
@ -4784,18 +4796,18 @@ kill_unsafe_block(path_stack_entry *sp, op_numbers op, PredEntry *ap, int first,
{
yamop *ipc;
while ((--sp)->flag != block_entry);
if (sp->u.cle.entry_code == NULL) {
if (sp->uip.cle.entry_code == NULL) {
/* we have reached the top */
Yap_RemoveIndexation(ap);
return sp;
}
ipc = *sp->u.cle.entry_code;
ipc = *sp->uip.cle.entry_code;
if (Yap_op_from_opcode(ipc->opc) == op) {
/* the new block was the current clause */
ClauseDef cld[2];
if (remove) {
*sp->u.cle.entry_code = FAILCODE;
*sp->uip.cle.entry_code = FAILCODE;
return sp;
}
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;
}
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 {
/* 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;
@ -4905,8 +4917,8 @@ add_to_expand_clauses(path_stack_entry **spp, yamop *ipc, ClauseDef *cls, PredEn
} while (compactz_expand_clauses(ipc));
}
while ((--sp)->flag != block_entry);
if (sp->u.cle.entry_code) {
*sp->u.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
if (sp->uip.cle.entry_code) {
*sp->uip.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
}
recover_ecls_block(ipc);
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 (TRUE) {
if (*st && *st != cls->Code) {
*sp->u.cle.entry_code = *st;
*sp->uip.cle.entry_code = *st;
recover_ecls_block(ipc);
return;
}
@ -5329,7 +5341,7 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
if (!IsExtensionFunctor(f)) {
current_arity = ArityOfFunctor(f);
}
newpc = fe->u.labp;
newpc = fe->u_f.labp;
if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
/* we found it */
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++;
}
if (ap->PredFlags & LogUpdatePredFlag) {
fe->u.labp = cls->Code;
fe->u_f.labp = cls->Code;
} else {
fe->u.labp = cls->CurrentCode;
fe->u_f.labp = cls->CurrentCode;
}
ipc = pop_path(&sp, cls, ap, cint);
} else {
yamop *newpc = fe->u.labp;
yamop *newpc = fe->u_f.labp;
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;
}
}
break;
case _index_dbref:
cls->Tag = cls->u.t_ptr;
cls->Tag = cls->ucd.t_ptr;
ipc = NEXTOP(ipc,e);
break;
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);
break;
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);
break;
case _switch_on_cons:
@ -5386,7 +5398,7 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
} else {
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)) {
/* 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++;
}
if (ap->PredFlags & LogUpdatePredFlag) {
ae->u.labp = cls->Code;
ae->u_a.labp = cls->Code;
} else {
ae->u.labp = cls->CurrentCode;
ae->u_a.labp = cls->CurrentCode;
}
ipc = pop_path(&sp, cls, ap, cint);
} else {
yamop *newpc = ae->u.labp;
yamop *newpc = ae->u_a.labp;
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;
}
}
@ -5429,7 +5441,7 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
break;
case _op_fail:
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);
break;
default:
@ -5531,7 +5543,7 @@ contract_ftable(yamop *ipc, ClauseUnion *blk, PredEntry *ap, Functor f) {
fep = (FuncSwiEntry *)(ipc->u.sssl.l);
while (fep->Tag != f) fep++;
}
fep->u.labp = FAILCODE;
fep->u_f.labp = FAILCODE;
}
static void
@ -5545,7 +5557,7 @@ contract_ctable(yamop *ipc, ClauseUnion *blk, PredEntry *ap, Term at) {
cep = (AtomSwiEntry *)(ipc->u.sssl.l);
while (cep->Tag != at) cep++;
}
cep->u.labp = FAILCODE;
cep->u_a.labp = FAILCODE;
}
static void
@ -5828,35 +5840,35 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
} else {
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)) {
/* we found it */
ipc = pop_path(&sp, cls, ap, cint);
} else if (newpc == FAILCODE) {
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 */
contract_ftable(ipc, current_block(sp), ap, f);
ipc = pop_path(&sp, cls, ap, cint);
} else {
yamop *newpc = fe->u.labp;
yamop *newpc = fe->u_f.labp;
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;
}
}
break;
case _index_dbref:
cls->Tag = cls->u.t_ptr;
cls->Tag = cls->ucd.t_ptr;
ipc = NEXTOP(ipc,e);
break;
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);
break;
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);
break;
case _switch_on_cons:
@ -5872,22 +5884,22 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
} else {
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)) {
/* we found it */
ipc = pop_path(&sp, cls, ap, cint);
} else if (newpc == FAILCODE) {
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 */
contract_ctable(ipc, current_block(sp), ap, at);
ipc = pop_path(&sp, cls, ap, cint);
} else {
yamop *newpc = ae->u.labp;
yamop *newpc = ae->u_a.labp;
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;
}
}
@ -6042,7 +6054,7 @@ store_clause_choice_point(Term t1, Term tb, Term tr, yamop *ipc, PredEntry *pe,
tsp[3] = tb;
tsp[4] = tr;
bptr->cp_tr = TR;
HB = bptr->cp_h = H;
HB = bptr->cp_h = HR;
#ifdef DEPTH_LIMIT
bptr->cp_depth = DEPTH;
#endif
@ -6065,7 +6077,7 @@ update_clause_choice_point(yamop *ipc, yamop *ap_pc USES_REGS)
{
Term tpc = MkIntegerTerm((Int)ipc);
B->cp_args[1] = tpc;
B->cp_h = H;
B->cp_h = HR;
B->cp_ap = ap_pc;
}
@ -6186,14 +6198,12 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
#if TABLING
case _table_trust:
#endif
#ifdef CUT_C
{
while (POP_CHOICE_POINT(B->cp_b))
{
POP_EXECUTE();
}
}
#endif /* CUT_C */
#ifdef YAPOR
{
choiceptr cut_pt;
@ -6216,14 +6226,12 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
case _table_trust_me:
#endif
b0 = B;
#ifdef CUT_C
{
while (POP_CHOICE_POINT(B->cp_b))
{
POP_EXECUTE();
}
}
#endif /* CUT_C */
#ifdef YAPOR
{
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;
/* make sure we don't erase the clause we are jumping to, notice that
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))) {
lcl->ClFlags |= InUseMask;
@ -6369,14 +6377,12 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
}
}
#endif
#ifdef CUT_C
{
while (POP_CHOICE_POINT(B->cp_b))
{
POP_EXECUTE();
}
}
#endif /* CUT_C */
#ifdef YAPOR
{
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);
}
#if defined(YAPOR) || defined(THREADS)
jlbl = &(fe->u.labp);
jlbl = &(fe->u_f.labp);
#endif
ipc = fe->u.labp;
ipc = fe->u_f.labp;
}
break;
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);
}
#if defined(YAPOR) || defined(THREADS)
jlbl = &(ae->u.labp);
jlbl = &(ae->u_a.labp);
#endif
ipc = ae->u.labp;
ipc = ae->u_a.labp;
}
break;
case _expand_index:
@ -6643,14 +6649,12 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
return NULL;
default:
if (b0) {
#ifdef CUT_C
{
while (POP_CHOICE_POINT(B->cp_b))
{
POP_EXECUTE();
}
}
#endif /* CUT_C */
#ifdef YAPOR
{
choiceptr cut_pt;
@ -6673,14 +6677,12 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
}
if (b0) {
/* I did a trust */
#ifdef CUT_C
{
while (POP_CHOICE_POINT(B->cp_b))
{
POP_EXECUTE();
}
}
#endif /* CUT_C */
#ifdef YAPOR
{
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 InitOps(void);
static void InitDebug(void);
#ifdef CUT_C
static void CleanBack(PredEntry *, CPredicate, CPredicate, CPredicate);
#else
static void CleanBack(PredEntry *, CPredicate, CPredicate);
#endif
static void InitStdPreds(void);
static void InitFlags(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->PredFlags = flags | StandardPredFlag | CPredFlag;
pe->src.OwnerFile = Yap_ConsultingFile( PASS_REGS1 );
pe->cs.f_code = code;
if (!(flags & SafePredFlag)) {
p_code->opc = Yap_opcode(_allocate);
@ -681,11 +678,7 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def,
static void
#ifdef CUT_C
CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont, CPredicate Cut)
#else
CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
#endif
{
yamop *code;
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);
#endif /* YAPOR */
code->u.OtapFs.f = Cont;
#ifdef CUT_C
code = NEXTOP(code,OtapFs);
if (pe->PredFlags & UserCPredFlag)
code->opc = Yap_opcode(_cut_c);
@ -724,11 +716,8 @@ CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
code->opc = Yap_opcode(_cut_userc);
code->u.OtapFs.p = pe;
code->u.OtapFs.f = Cut;
#endif
}
#ifdef CUT_C
void
Yap_InitCPredBack(char *Name, unsigned long int Arity,
unsigned int Extra, CPredicate Start,
@ -742,24 +731,11 @@ Yap_InitCPredBackCut(char *Name, unsigned long int Arity,
CPredicate Cont,CPredicate Cut, UInt 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
#ifdef CUT_C
Yap_InitCPredBack_(char *Name, unsigned long int Arity,
unsigned int Extra, CPredicate Start,
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
PredEntry *pe = NULL;
@ -795,11 +771,7 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity,
if (pe->cs.p_code.FirstClause != NIL)
{
flags = update_flags_from_prolog(flags, pe);
#ifdef CUT_C
CleanBack(pe, Start, Cont, Cut);
#else
CleanBack(pe, Start, Cont);
#endif /*CUT_C*/
}
else {
StaticClause *cl;
@ -813,11 +785,7 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity,
pe->PredFlags |= SequentialPredFlag;
#endif /* YAPOR */
#ifdef CUT_C
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) {
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->ClNext = NULL;
#ifdef CUT_C
Yap_ClauseSpace += (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),l);
cl->ClSize =
(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();
code = cl->ClCode;
@ -865,7 +827,6 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity,
PUT_YAMOP_SEQ(code);
#endif /* YAPOR */
code = NEXTOP(code,OtapFs);
#ifdef CUT_C
if (flags & UserCPredFlag)
code->opc = Yap_opcode(_cut_userc);
else
@ -875,7 +836,6 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity,
code->u.OtapFs.s = Arity;
code->u.OtapFs.extra = Extra;
code = NEXTOP(code,OtapFs);
#endif /* CUT_C */
code->opc = Yap_opcode(_Ystop);
code->u.l.l = cl->ClCode;
}
@ -1233,11 +1193,7 @@ static void
InitVersion(void)
{
Yap_PutValue(AtomVersionNumber,
MkAtomTerm(Yap_LookupAtom(YAP_SVERSION)));
#if defined MYDDAS_MYSQL || defined MYDDAS_ODBC
Yap_PutValue(AtomMyddasVersionName,
MkAtomTerm(Yap_LookupAtom(MYDDAS_VERSION)));
#endif
MkAtomTerm(Yap_LookupAtom(YAP_FULL_VERSION)));
}
void
@ -1402,9 +1358,6 @@ Yap_exit (int value)
#ifdef LOW_PROF
remove("PROFPREDS");
remove("PROFILING");
#endif
#if defined MYDDAS_MYSQL || defined MYDDAS_ODBC
Yap_MYDDAS_delete_all_myddas_structs();
#endif
run_halt_hooks(value);
Yap_ShutdownLoadForeign();

35
C/inlines.c
View File

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

40
C/iopreds.c
View File

@ -31,6 +31,7 @@ static char SccsId[] = "%W% %G%";
#include "eval.h"
/* stuff we want to use in standard YAP code */
#include "pl-shared.h"
#include "YapText.h"
#include <stdlib.h>
#if HAVE_STDARG_H
#include <stdarg.h>
@ -270,7 +271,7 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
Int start, err = 0, end;
Term tf[7];
Term *error = tf+3;
CELL *Hi = H;
CELL *Hi = HR;
int has_qq = FALSE;
/* make sure to globalise variable */
@ -279,12 +280,12 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
clean_vars(LOCAL_AnonVarTable);
while (1) {
Term ts[2];
if (H > ASP-1024) {
if (HR > ASP-1024) {
tf[3] = TermNil;
err = 0;
end = 0;
/* for some reason moving this earlier confuses gcc on solaris */
H = Hi;
HR = Hi;
break;
}
if (tokptr == LOCAL_toktide) {
@ -301,6 +302,7 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
}
break;
case QuasiQuotes_tok:
case WQuasiQuotes_tok:
{
if (has_qq) {
Term t0[1];
@ -324,7 +326,7 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
VarEntry *varinfo = (VarEntry *)info;
t[0] = MkIntTerm(0);
t[1] = Yap_StringToList(varinfo->VarRep);
t[1] = Yap_CharsToListOfCodes((const char *)varinfo->VarRep PASS_REGS);
if (varinfo->VarAdr == TermNil) {
t[2] = varinfo->VarAdr = MkVarTerm();
} else {
@ -335,13 +337,13 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
break;
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);
}
break;
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);
}
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 */
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);
} else {
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 */
while (TRUE) {
old_H = H;
old_H = HR;
LOCAL_Comments = TermNil;
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) {
H = old_H;
HR = old_H;
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
if (seekable) {
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;
/* preserve value of H after scanning: otherwise we may lose strings
and floats */
old_H = H;
old_H = HR;
if (tokstart != NULL && tokstart->Tok == Ord (eot_tok)) {
/* did we get the end of file from an abort? */
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;
H = old_H;
HR = old_H;
TR = (tr_fr_ptr)LOCAL_ScannerStack;
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) {
LOCAL_ScannerStack = (char *)TR;
TR = old_TR;
old_H = H;
old_H = HR;
LOCAL_tokptr = LOCAL_toktide = tokstart;
LOCAL_ErrorMessage = NULL;
goto repeat_cycle;
@ -610,7 +612,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
return FALSE;
if (rd->varnames) {
while (TRUE) {
CELL *old_H = H;
CELL *old_H = HR;
if (setjmp(LOCAL_IOBotch) == 0) {
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;
/* restart global */
H = old_H;
HR = old_H;
TR = (tr_fr_ptr)LOCAL_ScannerStack;
Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable);
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) {
while (TRUE) {
CELL *old_H = H;
CELL *old_H = HR;
if (setjmp(LOCAL_IOBotch) == 0) {
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;
/* restart global */
H = old_H;
HR = old_H;
TR = (tr_fr_ptr)LOCAL_ScannerStack;
Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable);
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) {
while (TRUE) {
CELL *old_H = H;
CELL *old_H = HR;
if (setjmp(LOCAL_IOBotch) == 0) {
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;
/* restart global */
H = old_H;
HR = old_H;
TR = (tr_fr_ptr)LOCAL_ScannerStack;
Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable);
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 "YapHeap.h"
#include "yapio.h"
#include "pl-shared.h"
#include "YapText.h"
#include <stdlib.h>
#if HAVE_STRING_H
#include <string.h>
@ -81,7 +83,9 @@ p_load_foreign( USES_REGS1 )
/* call the OS specific function for dynamic loading */
if(Yap_LoadForeign(ofiles,libs,InitProcName,&InitProc)==LOAD_SUCCEEDED) {
Int CurSlot = Yap_StartSlots( PASS_REGS1 );
(*InitProc)();
LOCAL_CurSlot = CurSlot;
returncode = TRUE;
}
@ -211,7 +215,7 @@ p_call_shared_object_function( USES_REGS1 ) {
static Int
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

26
C/mavar.c
View File

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

43
C/modules.c
View File

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

30
C/other.c
View File

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

87
C/parser.c
View File

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

31
C/pl-yap.c
View File

@ -7,6 +7,7 @@
#include "Yap.h"
#include "Yatom.h"
#include "pl-incl.h"
#include "YapText.h"
#if HAVE_MATH_H
#include <math.h>
#endif
@ -84,13 +85,17 @@ codeToAtom(int chrcode)
word
globalString(size_t size, char *s)
{
return Yap_MkBlobStringTerm(s, size);
CACHE_REGS
return Yap_CharsToString(s PASS_REGS);
}
word
globalWString(size_t size, wchar_t *s)
{
return Yap_MkBlobWideStringTerm(s, size);
CACHE_REGS
return Yap_WCharsToString(s PASS_REGS);
}
int
@ -385,14 +390,13 @@ typedef union
int
get_atom_ptr_text(Atom a, PL_chars_t *text)
{
YAP_Atom ya = (YAP_Atom)a;
if (YAP_IsWideAtom(ya)) {
pl_wchar_t *name = (pl_wchar_t *)YAP_WideAtomName(ya);
if (IsWideAtom(a)) {
pl_wchar_t *name = (pl_wchar_t *)a->WStrOfAE;
text->text.w = name;
text->length = wcslen(name);
text->encoding = ENC_WCHAR;
} else
{ char *name = (char *)YAP_AtomName(ya);
{ char *name = a->StrOfAE;
text->text.t = name;
text->length = strlen(name);
text->encoding = ENC_ISO_LATIN_1;
@ -406,7 +410,7 @@ get_atom_ptr_text(Atom a, PL_chars_t *text)
int
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);
}
@ -414,16 +418,9 @@ get_atom_text(atom_t atom, PL_chars_t *text)
int
get_string_text(word w, PL_chars_t *text ARG_LD)
{
CELL fl = RepAppl(w)[1];
if (fl == BLOB_STRING) {
text->text.t = Yap_BlobStringOfTerm(w);
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->text.t = (char *)StringOfTerm(w);
text->encoding = ENC_UTF8;
text->length = strlen(text->text.t);
text->storage = PL_CHARS_STACK;
text->canonical = 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
read_pred(IOSTREAM *stream, Term mod) {
UInt flags;
#if SIZEOF_INT_P==4
UInt eflags;
#endif
UInt nclauses, fl1;
PredEntry *ap;
ap = LookupPredEntry((PredEntry *)read_uint(stream));
flags = read_uint(stream);
#if SIZEOF_INT_P==4
eflags = read_uint(stream);
#endif
nclauses = read_uint(stream);
if (ap->PredFlags & IndexedPredFlag) {
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->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) {
ap->src.IndxId = read_uint(stream);
} else {

19
C/qlyw.c
View File

@ -194,7 +194,7 @@ GrowPredTable(void) {
}
newp->val = p->val;
newp->arity = p->arity;
newp->u.f = p->u.f;
newp->u_af.f = p->u_af.f;
newp->module = p->module;
}
LOCAL_ExportPredEntryHashChain = newt;
@ -223,23 +223,23 @@ LookupPredEntry(PredEntry *pe)
p->val = pe;
if (pe->ModuleOfPred != IDB_MODULE) {
if (arity) {
p->u.f = pe->FunctorOfPred;
p->u_af.f = pe->FunctorOfPred;
LookupFunctor(pe->FunctorOfPred);
} else {
p->u.a = (Atom)(pe->FunctorOfPred);
p->u_af.a = (Atom)(pe->FunctorOfPred);
LookupAtom((Atom)(pe->FunctorOfPred));
}
} else {
if (pe->PredFlags & AtomDBPredFlag) {
p->u.a = (Atom)(pe->FunctorOfPred);
p->u_af.a = (Atom)(pe->FunctorOfPred);
p->arity = (CELL)(-2);
LookupAtom((Atom)(pe->FunctorOfPred));
} else if (!(pe->PredFlags & NumberDBPredFlag)) {
p->u.f = pe->FunctorOfPred;
p->u_af.f = pe->FunctorOfPred;
p->arity = (CELL)(-1);
LookupFunctor(pe->FunctorOfPred);
} else {
p->u.f = pe->FunctorOfPred;
p->u_af.f = pe->FunctorOfPred;
}
}
if (pe->ModuleOfPred) {
@ -604,7 +604,7 @@ SaveHash(IOSTREAM *stream)
CHECK(save_uint(stream, (UInt)(p->val)));
CHECK(save_uint(stream, p->arity));
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_uint(stream, LOCAL_ExportDBRefHashTableNum);
@ -688,6 +688,9 @@ static size_t
save_pred(IOSTREAM *stream, PredEntry *ap) {
CHECK(save_uint(stream, (UInt)ap));
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->src.IndxId));
CHECK(save_uint(stream, ap->TimeStampOfPred));
@ -797,7 +800,7 @@ save_header(IOSTREAM *stream)
{
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);
}

27
C/save.c
View File

@ -344,7 +344,7 @@ put_info(int info, int mode USES_REGS)
{
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))
return -1;
if (putout(Unsigned(info)) < 0)
@ -369,7 +369,7 @@ put_info(int info, int mode USES_REGS)
if (putout(Unsigned(LCL0)-Unsigned(ASP)) < 0)
return -1;
/* Space used for global stack */
if (putout(Unsigned(H) - Unsigned(LOCAL_GlobalBase)) < 0)
if (putout(Unsigned(HR) - Unsigned(LOCAL_GlobalBase)) < 0)
return -1;
/* Space used for trail */
if (putout(Unsigned(TR) - Unsigned(LOCAL_TrailBase)) < 0)
@ -396,7 +396,7 @@ save_regs(int mode USES_REGS)
return -1;
if (putcellptr(LCL0) < 0)
return -1;
if (putcellptr(H) < 0)
if (putcellptr(HR) < 0)
return -1;
if (putcellptr(HB) < 0)
return -1;
@ -412,6 +412,8 @@ save_regs(int mode USES_REGS)
return -1;
if (putout(CreepFlag) < 0)
return -1;
if (putout(EventFlag) < 0)
return -1;
if (putcellptr((CELL *)EX) < 0)
return -1;
#if defined(YAPOR_SBA) || defined(TABLING)
@ -533,7 +535,7 @@ save_stacks(int mode USES_REGS)
if (mywrite(splfild, (char *) ASP, j) < 0)
return -1;
/* Save the global stack */
j = Unsigned(H) - Unsigned(LOCAL_GlobalBase);
j = Unsigned(HR) - Unsigned(LOCAL_GlobalBase);
if (mywrite(splfild, (char *) LOCAL_GlobalBase, j) < 0)
return -1;
/* Save the trail */
@ -675,7 +677,7 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap USES_REGS)
}
} while (pp[0] != 1);
/* 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);
while (count < to_read) {
@ -832,7 +834,7 @@ get_regs(int flag USES_REGS)
LCL0 = get_cellptr();
if (LOCAL_ErrorMessage)
return -1;
H = get_cellptr();
HR = get_cellptr();
if (LOCAL_ErrorMessage)
return -1;
HB = get_cellptr();
@ -854,6 +856,9 @@ get_regs(int flag USES_REGS)
if (LOCAL_ErrorMessage)
return -1;
CreepFlag = get_cell();
if (LOCAL_ErrorMessage)
return -1;
EventFlag = get_cell();
if (LOCAL_ErrorMessage)
return -1;
EX = (struct DB_TERM *)get_cellptr();
@ -924,7 +929,7 @@ get_regs(int flag USES_REGS)
LOCAL_OldASP = ASP;
LOCAL_OldLCL0 = LCL0;
LOCAL_OldGlobalBase = (CELL *)LOCAL_GlobalBase;
LOCAL_OldH = H;
LOCAL_OldH = HR;
LOCAL_OldTR = TR;
LOCAL_GDiff = Unsigned(NewGlobalBase) - Unsigned(LOCAL_GlobalBase);
LOCAL_GDiff0 = 0;
@ -972,7 +977,7 @@ CopyStacks( USES_REGS1 )
NewASP = (char *) (Unsigned(ASP) + (Unsigned(LCL0) - Unsigned(LOCAL_OldLCL0)));
if (myread(splfild, (char *) NewASP, j) < 0)
return -1;
j = Unsigned(H) - Unsigned(LOCAL_OldGlobalBase);
j = Unsigned(HR) - Unsigned(LOCAL_OldGlobalBase);
if (myread(splfild, (char *) LOCAL_GlobalBase, j) < 0)
return -1;
j = Unsigned(TR) - Unsigned(LOCAL_OldTrailBase);
@ -1055,7 +1060,7 @@ restore_regs(int flag USES_REGS)
CP = PtoOpAdjust(CP);
ENV = PtoLocAdjust(ENV);
ASP = PtoLocAdjust(ASP);
H = PtoGloAdjust(H);
HR = PtoGloAdjust(HR);
B = (choiceptr)PtoLocAdjust(CellPtr(B));
TR = PtoTRAdjust(TR);
P = PtoOpAdjust(P);
@ -1144,8 +1149,8 @@ rehash(CELL *oldcode, int NOfE, int KindOfEntries USES_REGS)
if (LOCAL_HDiff == 0)
return;
basep = H;
if (H + (NOfE*2) > ASP) {
basep = HR;
if (HR + (NOfE*2) > ASP) {
basep = (CELL *)TR;
if (basep + (NOfE*2) > (CELL *)LOCAL_TrailTop) {
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 */
#include "pl-shared.h"
#include "pl-read.h"
#include "pl-utf8.h"
#include "YapText.h"
#if _MSC_VER || defined(__MINGW32__)
#if HAVE_FINITE==1
#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') {
char cbuff = ch;
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
*sp++ = ch;
ch = getchr(inp_stream);
if (ch == '-') {
cbuff = '-';
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
*sp++ = '-';
ch = getchr(inp_stream);
} else if (ch == '+') {
cbuff = '+';
ch = getchr(inp_stream);
}
if (chtype(ch) != NU) {
@ -719,7 +715,7 @@ Yap_scan_num(IOSTREAM *inp)
return TermNil;
}
cherr = '\0';
if (ASP-H < 1024)
if (ASP-HR < 1024)
return TermNil;
out = get_num(&ch, &cherr, inp, ptr, 4096, sign); /* */
PopScannerMemory(ptr, 4096);
@ -731,7 +727,7 @@ Yap_scan_num(IOSTREAM *inp)
#define CHECK_SPACE() \
if (ASP-H < 1024) { \
if (ASP-HR < 1024) { \
LOCAL_ErrorMessage = "Stack Overflow"; \
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; \
LOCAL_Error_Size = 0L; \
@ -744,8 +740,8 @@ Yap_scan_num(IOSTREAM *inp)
static void
open_comment(int ch, IOSTREAM *inp_stream USES_REGS) {
CELL *h0 = H;
H += 5;
CELL *h0 = HR;
HR += 5;
h0[0] = AbsAppl(h0+2);
h0[1] = TermNil;
if (!LOCAL_CommentsTail) {
@ -780,7 +776,7 @@ extend_comment(int ch USES_REGS) {
static void
close_comment( USES_REGS1 ) {
LOCAL_CommentsBuff[LOCAL_CommentsBuffPos] = '\0';
*LOCAL_CommentsNextChar = Yap_MkBlobWideStringTerm(LOCAL_CommentsBuff, LOCAL_CommentsBuffPos);
*LOCAL_CommentsNextChar = Yap_WCharsToString(LOCAL_CommentsBuff PASS_REGS);
free(LOCAL_CommentsBuff);
LOCAL_CommentsBuff = NULL;
LOCAL_CommentsBuffLim = 0;
@ -820,7 +816,7 @@ ch_to_wide(char *base, char *charp)
{ charp = _PL__utf8_put_char(charp, ch); } }
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
TokEntry *t, *l, *p;
@ -829,6 +825,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
int ch;
wchar_t *wcharp;
struct qq_struct_t *cur_qq = NULL;
struct read_data_t *rd = rd0;
LOCAL_ErrorMessage = NULL;
LOCAL_Error_Size = 0;
@ -843,7 +840,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
ch = getchr(inp_stream);
}
*tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(&inp_stream);
Yap_setCurrentSourceLocation( rd );
LOCAL_StartLine = inp_stream->posbuf.lineno;
do {
wchar_t och;
@ -907,7 +904,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
}
CHECK_SPACE();
*tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(&inp_stream);
Yap_setCurrentSourceLocation( rd );
}
goto restart;
} else {
@ -1230,7 +1227,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
}
CHECK_SPACE();
*tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(&inp_stream);
Yap_setCurrentSourceLocation( rd );
}
}
goto restart;

51
C/signals.c
View File

@ -41,8 +41,11 @@ inline static void
do_signal(yap_signals sig USES_REGS)
{
LOCK(LOCAL_SignalLock);
if (!LOCAL_InterruptsDisabled)
if (!LOCAL_InterruptsDisabled) {
CreepFlag = Unsigned(LCL0);
if (sig != YAP_CREEP_SIGNAL)
EventFlag = Unsigned(LCL0);
}
LOCAL_ActiveSignals |= sig;
UNLOCK(LOCAL_SignalLock);
}
@ -51,8 +54,8 @@ inline static void
undo_signal(yap_signals sig USES_REGS)
{
LOCK(LOCAL_SignalLock);
if ((LOCAL_ActiveSignals & ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL)) == sig) {
CreepFlag = CalculateStackGap();
if ((LOCAL_ActiveSignals & ~(YAP_CREEP_SIGNAL)) == sig) {
CalculateStackGap( PASS_REGS1 );
}
LOCAL_ActiveSignals &= ~sig;
UNLOCK(LOCAL_SignalLock);
@ -72,19 +75,7 @@ p_creep( USES_REGS1 )
}
static Int
p_stop_creeping( 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 )
p_creep_fail( USES_REGS1 )
{
Atom at;
PredEntry *pred;
@ -92,8 +83,18 @@ p_meta_creep( USES_REGS1 )
at = AtomCreep;
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
CreepCode = pred;
do_signal(YAP_CREEP_SIGNAL PASS_REGS);
return FALSE;
}
static Int
p_stop_creeping( USES_REGS1 )
{
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals |= YAP_DELAY_CREEP_SIGNAL;
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
if (!LOCAL_ActiveSignals) {
CalculateStackGap( PASS_REGS1 );
}
UNLOCK(LOCAL_SignalLock);
return TRUE;
}
@ -106,7 +107,7 @@ p_creep_allowed( USES_REGS1 )
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock);
} else {
UNLOCK(LOCAL_SignalLock);
@ -205,12 +206,6 @@ p_first_signal( USES_REGS1 )
UNLOCK(LOCAL_SignalLock);
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) {
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
MUTEX_UNLOCK(&(LOCAL_ThreadHandle.tlock));
@ -286,12 +281,6 @@ p_continue_signals( USES_REGS1 )
if (LOCAL_ActiveSignals & 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) {
Yap_signal(YAP_DEBUG_SIGNAL);
}
@ -316,7 +305,7 @@ Yap_InitSignalCPreds(void)
{
/* Basic predicates for the debugger */
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 ("$first_signal", 1, p_first_signal, 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;
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);
return(FALSE);
}
t = Deref(ARG1);
pt = H;
pt = HR;
out = 0;
goto restart;
}
@ -346,7 +346,7 @@ static Int
p_sort( USES_REGS1 )
{
/* use the heap to build a new list */
CELL *pt = H;
CELL *pt = HR;
Term out;
/* list size */
Int size;
@ -355,13 +355,13 @@ p_sort( USES_REGS1 )
return(FALSE);
if (size < 2)
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 */
H += size*2;
HR += size*2;
/* reserve the necessary space */
size = compact_mergesort(pt, size, M_EVEN);
/* reajust space */
H = pt+size*2;
HR = pt+size*2;
adjust_vector(pt, size);
out = AbsPair(pt);
return(Yap_unify(out, ARG2));
@ -371,7 +371,7 @@ static Int
p_msort( USES_REGS1 )
{
/* use the heap to build a new list */
CELL *pt = H;
CELL *pt = HR;
Term out;
/* list size */
Int size;
@ -380,9 +380,9 @@ p_msort( USES_REGS1 )
return(FALSE);
if (size < 2)
return(Yap_unify(ARG1, ARG2));
pt = H; /* because of possible garbage collection */
pt = HR; /* because of possible garbage collection */
/* reserve the necessary space */
H += size*2;
HR += size*2;
simple_mergesort(pt, size, M_EVEN);
adjust_vector(pt, size);
out = AbsPair(pt);
@ -393,7 +393,7 @@ static Int
p_ksort( USES_REGS1 )
{
/* use the heap to build a new list */
CELL *pt = H;
CELL *pt = HR;
Term out;
/* list size */
Int size;
@ -403,8 +403,8 @@ p_ksort( USES_REGS1 )
if (size < 2)
return(Yap_unify(ARG1, ARG2));
/* reserve the necessary space */
pt = H; /* because of possible garbage collection */
H += size*2;
pt = HR; /* because of possible garbage collection */
HR += size*2;
if (!key_mergesort(pt, size, M_EVEN, FunctorMinus))
return(FALSE);
adjust_vector(pt, size);

89
C/stdpreds.c
View File

@ -634,15 +634,15 @@ p_univ( USES_REGS1 )
}
build_compound:
/* build the term directly on the heap */
Ar = H;
H++;
Ar = HR;
HR++;
while (!IsVarTerm(twork) && IsPairTerm(twork)) {
*H++ = HeadOfTerm(twork);
if (H > ASP - 1024) {
*HR++ = HeadOfTerm(twork);
if (HR > ASP - 1024) {
/* restore space */
H = Ar;
if (!Yap_gcl((ASP-H)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
HR = Ar;
if (!Yap_gcl((ASP-HR)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return FALSE;
}
@ -671,11 +671,11 @@ p_univ( USES_REGS1 )
arity, CellPtr(TR));
}
#else
arity = H-Ar-1;
arity = HR-Ar-1;
if (at == AtomDot && arity == 2) {
Ar[0] = Ar[1];
Ar[1] = Ar[2];
H --;
HR --;
twork = AbsPair(Ar);
} else {
*Ar = (CELL)(Yap_MkFunctor(at, arity));
@ -692,6 +692,10 @@ p_univ( USES_REGS1 )
return (FALSE);
if (IsApplTerm(tin)) {
Functor fun = FunctorOfTerm(tin);
if (IsExtensionFunctor ( fun ) ) {
twork = MkPairTerm(tin, MkAtomTerm(AtomNil));
return (Yap_unify(twork, ARG2));
}
arity = ArityOfFunctor(fun);
at = NameOfFunctor(fun);
#ifdef SFUNC
@ -716,7 +720,7 @@ p_univ( USES_REGS1 )
} else
#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))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return(FALSE);
@ -1301,7 +1305,7 @@ Yap_show_statistics(void)
frag);
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)*(H-H0)),
(unsigned long int)(sizeof(CELL)*(HR-H0)),
(unsigned long int)(sizeof(CELL)*(LCL0-ASP)));
fprintf(GLOBAL_stderr, "Trail Space: %ld (%ld used).\n",
(unsigned long int)(sizeof(tr_fr_ptr)*(Unsigned(LOCAL_TrailTop)-Unsigned(LOCAL_TrailBase))),
@ -1376,7 +1380,7 @@ GlobalMax(void)
CELL *pt;
if (GlobalTide != StkWidth) {
pt = H;
pt = HR;
while (pt+2 < ASP) {
if (pt[0] == 0 &&
pt[1] == 0 &&
@ -1419,7 +1423,7 @@ LocalMax(void)
if (LocalTide != StkWidth) {
pt = LCL0;
while (pt-3 > H) {
while (pt-3 > HR) {
if (pt[-1] == 0 &&
pt[-2] == 0 &&
pt[-3] == 0)
@ -1427,7 +1431,7 @@ LocalMax(void)
else
--pt;
}
if (pt-3 > H)
if (pt-3 > HR)
i = Unsigned(LCL0) - Unsigned(pt);
else
/* so that both Local and Global have reached maximum width */
@ -1477,7 +1481,7 @@ static Int
p_statistics_stacks_info( USES_REGS1 )
{
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));
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;
if (IsMode_LocalTrie(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomLocalTrie), tout);
else // if (IsMode_GlobalTrie(yap_flags[flag]))
else if (IsMode_GlobalTrie(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomGlobalTrie), tout);
if (IsMode_LoadAnswers(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomLoadAnswers), tout);
else // if (IsMode_ExecAnswers(yap_flags[flag]))
else if (IsMode_ExecAnswers(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomExecAnswers), tout);
if (IsMode_Local(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomLocal), tout);
else // if (IsMode_Batched(yap_flags[flag]))
else if (IsMode_Batched(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomBatched), tout);
else if (IsMode_CoInductive(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomCoInductive), tout);
#else
tout = MkAtomTerm(AtomFalse);
#endif /* TABLING */
@ -1818,6 +1824,13 @@ p_set_yap_flags( USES_REGS1 )
tab_ent = TabEnt_next(tab_ent);
}
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;
#endif /* TABLING */
@ -1840,11 +1853,20 @@ p_set_yap_flags( USES_REGS1 )
static Int
p_system_mode( USES_REGS1 )
{
Int i = IntegerOfTerm(Deref(ARG1));
if (i == 0)
LOCAL_PrologMode &= ~SystemMode;
else
LOCAL_PrologMode |= SystemMode;
Term t1 = Deref(ARG1);
if (IsVarTerm(t1)) {
if (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;
}
@ -1948,15 +1970,6 @@ Yap_InitBackCPreds(void)
Yap_InitBackIO();
Yap_InitBackDB();
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);
@ -2002,7 +2015,7 @@ Yap_InitCPreds(void)
Yap_InitCPred("$walltime", 2, p_walltime, SafePredFlag|SyncPredFlag);
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("$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("$break", 1, p_break, SafePredFlag);
#ifdef BEAM
@ -2065,18 +2078,6 @@ Yap_InitCPreds(void)
Yap_InitUnify();
Yap_InitQLY();
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_Interval_init();
Yap_InitSignalCPreds();

20
C/sysbits.c
View File

@ -186,12 +186,14 @@ Yap_InitSysPath(void) {
int commons_done = FALSE;
{
char *dir;
if ((dir = Yap_RegistryGetString("library"))) {
if ((dir = Yap_RegistryGetString("library")) &&
is_directory(dir)) {
Yap_PutValue(AtomSystemLibraryDir,
MkAtomTerm(Yap_LookupAtom(dir)));
dir_done = TRUE;
}
if ((dir = Yap_RegistryGetString("prolog_commons"))) {
if ((dir = Yap_RegistryGetString("prolog_commons")) &&
is_directory(dir)) {
Yap_PutValue(AtomPrologCommonsDir,
MkAtomTerm(Yap_LookupAtom(dir)));
commons_done = TRUE;
@ -203,12 +205,10 @@ Yap_InitSysPath(void) {
strncpy(LOCAL_FileNameBuf, YAP_SHAREDIR, YAP_FILENAME_MAX);
#if _MSC_VER || defined(__MINGW32__)
{
DWORD fatts;
int buflen;
char *pt;
if ((fatts = GetFileAttributes(LOCAL_FileNameBuf)) == 0xFFFFFFFFL ||
!(fatts & FILE_ATTRIBUTE_DIRECTORY)) {
if (!is_directory(LOCAL_FileNameBuf)) {
/* couldn't find it where it was supposed to be,
let's try using the executable */
if (!GetModuleFileNameEx( GetCurrentProcess(), NULL, LOCAL_FileNameBuf, YAP_FILENAME_MAX)) {
@ -2549,7 +2549,7 @@ p_alarm( USES_REGS1 )
if (LOCAL_ActiveSignals & YAP_ALARM_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_ALARM_SIGNAL;
if (!LOCAL_ActiveSignals) {
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
}
}
UNLOCK(LOCAL_SignalLock);
@ -2732,7 +2732,9 @@ set_fpu_exceptions(int flag)
#if HAVE_FETESTEXCEPT
feclearexcept(FE_ALL_EXCEPT);
#endif
#ifndef _WIN32
my_signal (SIGFPE, HandleMatherr);
#endif
} else {
/* do IEEE arithmetic in the way the big boys do */
#if defined(__hpux)
@ -2747,7 +2749,9 @@ set_fpu_exceptions(int flag)
int v = _FPU_IEEE;
_FPU_SETCW(v);
#endif
#ifndef _WIN32
my_signal (SIGFPE, SIG_IGN);
#endif
}
}
@ -2861,6 +2865,8 @@ p_enable_interrupts( USES_REGS1 )
LOCAL_InterruptsDisabled--;
if (LOCAL_ActiveSignals && !LOCAL_InterruptsDisabled) {
CreepFlag = Unsigned(LCL0);
if ( LOCAL_ActiveSignals != YAP_CREEP_SIGNAL )
EventFlag = Unsigned( LCL0 );
}
UNLOCK(LOCAL_SignalLock);
return TRUE;
@ -2872,7 +2878,7 @@ p_disable_interrupts( USES_REGS1 )
LOCK(LOCAL_SignalLock);
LOCAL_InterruptsDisabled++;
if (LOCAL_ActiveSignals) {
CreepFlag = CalculateStackGap();
CalculateStackGap( PASS_REGS1 );
}
UNLOCK(LOCAL_SignalLock);
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_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))) {
return FALSE;
}
@ -200,39 +200,6 @@ kill_thread_engine (int wid, int always_die)
free(REMOTE_ThreadHandle(wid).default_yaam_regs);
REMOTE_ThreadHandle(wid).default_yaam_regs = NULL;
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--;
if (!always_die) {
/* called by thread itself */
@ -337,6 +304,41 @@ thread_run(void *widp)
tgs[1] = LOCAL_ThreadHandle.tdetach;
tgoal = Yap_MkApplTerm(FunctorThreadRun, 2, tgs);
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);
return NULL;
}
@ -915,6 +917,7 @@ p_thread_signal( USES_REGS1 )
}
LOCK(REMOTE_SignalLock(wid));
REMOTE_ThreadHandle(wid).current_yaam_regs->CreepFlag_ =
REMOTE_ThreadHandle(wid).current_yaam_regs->EventFlag_ =
Unsigned(REMOTE_ThreadHandle(wid).current_yaam_regs->LCL0_);
REMOTE_ActiveSignals(wid) |= YAP_ITI_SIGNAL;
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;
Int arity;
/* extern int gc_calls; */
vsc_count++;
// if (!worker_id) return;
LOCK(Yap_heap_regs->low_level_trace_lock);
sc = Yap_heap_regs;
vsc_count++;
//if (vsc_count == 54) jmp_deb(1);
// fprintf(stderr,"B=%p ", B);
#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
* environment */
}
UNLOCK(Yap_heap_regs->low_level_trace_lock);
return;
{
choiceptr b_p = B;

12
C/unify.c
View File

@ -376,6 +376,8 @@ oc_unify_nvar_nvar:
return(pt0[1] == pt1[1]);
case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0);
#ifdef USE_GMP
case (CELL)FunctorBigInt:
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 */
Bind(pt1, d0);
/* local variables cannot be in a term */
if (pt1 > H && pt1 < LCL0)
if (pt1 > HR && pt1 < LCL0)
return TRUE;
if (rational_tree(d0))
return(FALSE);
@ -408,7 +410,7 @@ oc_unify_var_nvar:
/* pt0 is unbound and d1 is bound */
Bind(pt0, d1);
/* local variables cannot be in a term */
if (pt0 > H && pt0 < LCL0)
if (pt0 > HR && pt0 < LCL0)
return TRUE;
if (rational_tree(d1))
return(FALSE);
@ -505,6 +507,8 @@ unify_nvar_nvar:
return(pt0 == pt1);
case (CELL)FunctorLongInt:
return(pt0[1] == pt1[1]);
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0);
case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
#ifdef USE_GMP
@ -583,7 +587,7 @@ InitReverseLookupOpcode(void)
}
}
}
bzero(OP_RTABLE, sz);
memset(OP_RTABLE, 0, sz);
opeptr = OP_RTABLE;
/* clear up table */
{
@ -870,6 +874,8 @@ unifiable_nvar_nvar:
return(pt0 == pt1);
case (CELL)FunctorLongInt:
return(pt0[1] == pt1[1]);
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0);
case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
#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"
#endif
#include "pl-shared.h"
#include "pl-utf8.h"
#if HAVE_STRING_H
#include <string.h>
@ -65,11 +66,11 @@ typedef struct rewind_term {
union {
struct union_slots s;
struct union_direct d;
} u;
} u_sd;
} rwts;
typedef struct write_globs {
void *stream;
IOSTREAM*stream;
int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
int Keep_terms;
int Write_Loops;
@ -166,6 +167,7 @@ wrputn(Int n, struct write_globs *wglb) /* writes an integer */
#define wrputs(s, stream) Sfputs(s, stream)
static void
wrputws(wchar_t *s, wrf stream) /* writes a string */
{
@ -204,7 +206,7 @@ ensure_space(size_t sz) {
}
}
if (!s) {
s = (char *)H;
s = (char *)HR;
if (s+sz >= (char *)ASP) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"not enough space to write bignum: it requires %d bytes", sz);
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 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
if (big_tag == BIG_INT)
} else if (big_tag == BIG_INT)
{
MP_INT *big = Yap_BigIntOfTerm(t);
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);
writeTerm(trat, p, depth, rinfixarg, wglb, rwt);
return;
}
#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) {
Opaque_CallOnWrite f;
CELL blob_info;
@ -391,6 +367,21 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
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 */
static void
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);
}
lastw = alphanum;
return 1;
}
static int
@ -480,7 +472,7 @@ AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
}
static void
write_quoted(int ch, int quote, wrf stream)
write_quoted(wchar_t ch, wchar_t quote, wrf stream)
{
CACHE_REGS
if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) {
@ -494,8 +486,17 @@ write_quoted(int ch, int quote, wrf stream)
} else {
switch (ch) {
case '\\':
case '\'':
wrputc('\\', stream);
wrputc('\\', stream);
break;
case '\'':
if (ch == quote)
wrputc('\\', stream);
wrputc(ch, stream);
break;
case '"':
if (ch == quote)
wrputc('\\', stream);
wrputc(ch, stream);
break;
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 */
static void
@ -552,7 +575,7 @@ putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb)
wrf stream = wglb->stream;
if (IsBlob(atom)) {
wrputblob(RepAtom(atom),wglb->Quote_illegal,wglb);
wrputblob(RepAtom(atom),Quote_illegal,wglb);
return;
}
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
IsStringTerm(Term string) /* checks whether this is a string */
IsCodesTerm(Term string) /* checks whether this is a string */
{
if (IsVarTerm(string))
return FALSE;
@ -628,7 +660,7 @@ putString(Term string, struct write_globs *wglb)
wrf stream = wglb->stream;
wrputc('"', stream);
while (string != TermNil) {
int ch = IntOfTerm(HeadOfTerm(string));
wchar_t ch = IntOfTerm(HeadOfTerm(string));
write_quoted(ch, '"', stream);
string = TailOfTerm(string);
}
@ -664,23 +696,23 @@ from_pointer(CELL *ptr0, struct rewind_term *rwt, struct write_globs *wglb)
if (wglb->Keep_terms) {
struct rewind_term *x = rwt->parent;
rwt->u.s.old = Yap_InitSlot(t PASS_REGS);
rwt->u.s.ptr = Yap_InitSlot((CELL)ptr0 PASS_REGS);
rwt->u_sd.s.old = Yap_InitSlot(t PASS_REGS);
rwt->u_sd.s.ptr = Yap_InitSlot((CELL)ptr0 PASS_REGS);
if (!IsAtomicTerm(t) && !IsVarTerm(t)) {
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;
x = x->parent;
}
}
} else {
rwt->u.d.old = t;
rwt->u.d.ptr = ptr0;
rwt->u_sd.d.old = t;
rwt->u_sd.d.ptr = ptr0;
if ( !IsVarTerm(t) && !IsAtomicTerm(t)) {
struct rewind_term *x = rwt->parent;
while (x) {
if (x->u.d.old == t)
if (x->u_sd.d.old == t)
return TermFoundVar;
x = x->parent;
}
@ -696,12 +728,12 @@ restore_from_write(struct rewind_term *rwt, struct write_globs *wglb)
CELL *ptr;
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);
} 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;
}
@ -722,7 +754,7 @@ write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt)
exts ext = ExtFromCell(t);
struct rewind_term nrwt;
nrwt.parent = rwt;
nrwt.u.s.ptr = 0;
nrwt.u_sd.s.ptr = 0;
wglb->Portray_delays = FALSE;
if (ext == attvars_ext) {
@ -756,13 +788,13 @@ check_infinite_loop(Term t, struct rewind_term *x, struct write_globs *wglb)
CACHE_REGS
if (wglb->Keep_terms) {
while (x) {
if (Yap_GetFromSlot(x->u.s.old PASS_REGS) == t)
if (Yap_GetFromSlot(x->u_sd.s.old PASS_REGS) == t)
return TermFoundVar;
x = x->parent;
}
} else {
while (x) {
if (x->u.d.old == t)
if (x->u_sd.d.old == t)
return TermFoundVar;
x = x->parent;
}
@ -776,7 +808,7 @@ write_list(Term t, int direction, int depth, struct write_globs *wglb, struct re
Term ti;
struct rewind_term nrwt;
nrwt.parent = rwt;
nrwt.u.s.ptr = 0;
nrwt.u_sd.s.ptr = 0;
while (1) {
int ndirection;
@ -845,7 +877,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
CACHE_REGS
struct rewind_term nrwt;
nrwt.parent = rwt;
nrwt.u.s.ptr = 0;
nrwt.u_sd.s.ptr = 0;
if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
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))
return;
}
if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsStringTerm(t)) {
if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsCodesTerm(t)) {
putString(t, wglb);
} else {
wrputc('[', wglb->stream);
@ -909,6 +941,9 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
case (CELL)FunctorDouble:
wrputf(FloatOfTerm(t),wglb);
return;
case (CELL)FunctorString:
write_string(StringOfTerm(t),wglb);
return;
case (CELL)FunctorAttVar:
write_var(RepAppl(t)+1, wglb, &nrwt);
return;
@ -1099,7 +1134,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (lastw == alphanum) {
wrputc(' ', wglb->stream);
}
if (!IsVarTerm(ti) && (IsIntTerm(ti) || IsStringTerm(ti) || IsAtomTerm(ti))) {
if (!IsVarTerm(ti) && (IsIntTerm(ti) || IsCodesTerm(ti) || IsAtomTerm(ti))) {
if (IsIntTerm(ti)) {
Int k = IntOfTerm(ti);
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_LIBS=\"%s\"\n",C_LIBS);
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);
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;
#else
int BootMode = YAP_BOOT_FROM_SAVED_CODE;
#endif
#ifdef MYDDAS_MYSQL
char *myddas_temp;
#endif
unsigned long int *ssize;
@ -199,13 +196,6 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
iap->Argc = argc;
iap->Argv = argv;
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->ErrorCause = NULL;
iap->QuietMode = FALSE;
@ -259,36 +249,6 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
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
case 'J':
switch (p[1]) {
@ -498,7 +458,7 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
iap->PrologShouldHandleInterrupts = FALSE;
break;
}
goto myddas_error_print;
break;
case 'p':
if ((*argv)[0] == '\0')
iap->YapPrologAddPath = *argv;
@ -540,11 +500,7 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
break;
default:
{
myddas_error_print :
fprintf(stderr,"[ YAP unrecoverable error: unknown switch -%c ]\n", *p);
#ifdef MYDDAS_MYSQL
myddas_error :
#endif
print_usage();
exit(EXIT_FAILURE);
}
@ -553,15 +509,6 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
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_argv = argv;
return BootMode;

91
H/Regs.h
View File

@ -16,15 +16,9 @@
/********* abstract machine registers **********************************/
#ifdef YAP_H
#ifdef CUT_C
#include "cut_c.h"
#endif
#if defined MYDDAS_ODBC || defined MYDDAS_MYSQL
#include "myddas.h"
#endif
#endif
#define MaxTemps 512
#define MaxArithms 32
@ -92,6 +86,7 @@ INLINE_ONLY inline EXTERN void save_B(void);
typedef struct regstore_t
{
CELL EventFlag_; /* 13 */
CELL CreepFlag_; /* 13 */
CELL *HB_; /* 4 heap (global) stack top at latest c.p. */
#if defined(YAPOR_SBA) || defined(TABLING)
@ -106,10 +101,8 @@ typedef struct regstore_t
#endif /* DEPTH_LIMIT */
yamop *CP_; /* 28 continuation program counter */
CELL *ENV_; /* 1 current environment */
#ifdef CUT_C
struct cut_c_str *CUT_C_TOP;
#endif
#if defined CUT_C && (defined MYDDAS_ODBC || defined MYDDAS_MYSQL)
#if defined MYDDAS_ODBC || defined MYDDAS_MYSQL
struct myddas_global *MYDDAS_GLOBAL_POINTER;
#endif
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 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 choiceptr B asm ("$11");
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
registers the way they used to be */
INLINE_ONLY EXTERN inline void save_machine_regs(void) {
Yap_REGS.H_ = H;
Yap_REGS.H_ = HR;
Yap_REGS.HB_ = HB;
Yap_REGS.B_ = B;
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) {
H = Yap_REGS.H_;
HR = Yap_REGS.H_;
HB = Yap_REGS.HB_;
B = Yap_REGS.B_;
CP = Yap_REGS.CP_;
@ -286,16 +279,16 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
TR = BK_TR
INLINE_ONLY EXTERN inline void save_H(void) {
Yap_REGS.H_ = H;
Yap_REGS.H_ = HR;
}
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) {
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 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 choiceptr B asm ("$18");
register yamop *CP asm ("$19");
@ -333,7 +326,7 @@ register CELL CreepFlag asm ("$21");
register tr_fr_ptr TR asm ("$22");
INLINE_ONLY EXTERN inline void save_machine_regs(void) {
Yap_REGS.H_ = H;
Yap_REGS.H_ = HR;
Yap_REGS.HB_ = HB;
Yap_REGS.B_ = B;
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) {
H = Yap_REGS.H_;
HR = Yap_REGS.H_;
HB = Yap_REGS.HB_;
B = Yap_REGS.B_;
CP = Yap_REGS.CP_;
@ -351,7 +344,7 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
}
#define BACKUP_MACHINE_REGS() \
CELL *BK_H = H; \
CELL *BK_H = HR; \
CELL *BK_HB = HB; \
choiceptr BK_B = B; \
CELL BK_CreepFlag = CreepFlag; \
@ -361,7 +354,7 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
#define RECOVER_MACHINE_REGS() \
save_machine_regs(); \
H = BK_H; \
HR = BK_H; \
HB = BK_HB; \
B = BK_B; \
CreepFlag = BK_CreepFlag; \
@ -369,16 +362,16 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
TR = BK_TR
INLINE_ONLY EXTERN inline void save_H(void) {
Yap_REGS.H_ = H;
Yap_REGS.H_ = HR;
}
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) {
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 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 choiceptr B asm ("r14");
register yamop *CP asm ("r15");
@ -407,7 +400,7 @@ register CELL CreepFlag asm ("r17");
register tr_fr_ptr TR asm ("r18");
INLINE_ONLY EXTERN inline void save_machine_regs(void) {
Yap_REGS.H_ = H;
Yap_REGS.H_ = HR;
Yap_REGS.HB_ = HB;
Yap_REGS.B_ = B;
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) {
H = Yap_REGS.H_;
HR = Yap_REGS.H_;
HB = Yap_REGS.HB_;
B = Yap_REGS.B_;
CP = Yap_REGS.CP_;
@ -425,7 +418,7 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
}
#define BACKUP_MACHINE_REGS() \
CELL *BK_H = H; \
CELL *BK_H = HR; \
CELL *BK_HB = HB; \
choiceptr BK_B = B; \
CELL BK_CreepFlag = CreepFlag; \
@ -435,7 +428,7 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
#define RECOVER_MACHINE_REGS() \
save_machine_regs(); \
H = BK_H; \
HR = BK_H; \
HB = BK_HB; \
B = BK_B; \
CreepFlag = BK_CreepFlag; \
@ -443,16 +436,16 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
TR = BK_TR
INLINE_ONLY EXTERN inline void save_H(void) {
Yap_REGS.H_ = H;
Yap_REGS.H_ = HR;
}
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) {
Yap_REGS.B_ = B;
@ -500,7 +493,7 @@ register tr_fr_ptr TR asm ("r13");
#else
register tr_fr_ptr TR asm ("r21");
#endif
register CELL *H asm ("r14");
register CELL *HR asm ("r14");
register CELL *HB asm ("r15");
register choiceptr B asm ("r16");
register yamop *CP asm ("r17");
@ -519,7 +512,7 @@ register CELL *YENV asm ("r19");
INLINE_ONLY EXTERN inline void save_machine_regs(void) {
Yap_REGS.H_ = H;
Yap_REGS.H_ = HR;
Yap_REGS.HB_ = HB;
Yap_REGS.B_ = B;
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) {
H = Yap_REGS.H_;
HR = Yap_REGS.H_;
HB = Yap_REGS.HB_;
B = Yap_REGS.B_;
CP = Yap_REGS.CP_;
@ -537,7 +530,7 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
}
#define BACKUP_MACHINE_REGS() \
CELL *BK_H = H; \
CELL *BK_H = HR; \
CELL *BK_HB = HB; \
choiceptr BK_B = B; \
yamop *BK_CP = CP; \
@ -546,23 +539,23 @@ INLINE_ONLY EXTERN inline void restore_machine_regs(void) {
#define RECOVER_MACHINE_REGS() \
save_machine_regs(); \
H = BK_H; \
HR = BK_H; \
HB = BK_HB; \
B = BK_B; \
CP = BK_CP; \
TR = BK_TR
INLINE_ONLY EXTERN inline void save_H(void) {
Yap_REGS.H_ = H;
Yap_REGS.H_ = HR;
}
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) {
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 YENV Yap_REGS.YENV_ /* current environment (may differ from ENV) */
#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 TR Yap_REGS.TR_ /* top of trail */
#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_Floats Yap_REGS.Floats_
#define Yap_Ints Yap_REGS.Ints_
#define EventFlag Yap_REGS.EventFlag_
#define REG_SIZE sizeof(REGS)/sizeof(CELL *)
@ -713,9 +707,8 @@ extern REGSTORE Yap_standard_regs;
/******************* controlling debugging ****************************/
static inline UInt
CalculateStackGap(void)
StackGap( USES_REGS1 )
{
CACHE_REGS
UInt gmin = (LCL0-H0)>>2;
if (gmin < MinStackGap) gmin = MinStackGap;
@ -723,3 +716,9 @@ CalculateStackGap(void)
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,
Error_tok,
QuasiQuotes_tok,
WQuasiQuotes_tok,
eot_tok
} tkinds;

174
H/TermExt.h
View File

@ -45,18 +45,20 @@ typedef enum
{
db_ref_e = sizeof (Functor *),
attvar_e = 2*sizeof (Functor *),
long_int_e = 3 * sizeof (Functor *),
big_int_e = 4 * sizeof (Functor *),
double_e = 5 * sizeof (Functor *)
double_e = 3 * sizeof (Functor *),
long_int_e = 4 * sizeof (Functor *),
big_int_e = 5 * sizeof (Functor *),
string_e = 6 * sizeof (Functor *)
}
blob_type;
#define FunctorDBRef ((Functor)(db_ref_e))
#define FunctorAttVar ((Functor)(attvar_e))
#define FunctorDouble ((Functor)(double_e))
#define FunctorLongInt ((Functor)(long_int_e))
#define FunctorBigInt ((Functor)(big_int_e))
#define FunctorDouble ((Functor)(double_e))
#define EndSpecials (double_e+sizeof(Functor *))
#define FunctorString ((Functor)(string_e))
#define EndSpecials (string_e+sizeof(Functor *))
#include "inline-only.h"
@ -69,7 +71,7 @@ __IsAttVar (CELL *pt USES_REGS)
{
#ifdef YAP_H
return (pt)[-1] == (CELL)attvar_e
&& pt < H;
&& pt < HR;
#else
return (pt)[-1] == (CELL)attvar_e;
#endif
@ -92,8 +94,6 @@ typedef enum
ARRAY_INT = 0x21,
ARRAY_FLOAT = 0x22,
CLAUSE_LIST = 0x40,
BLOB_STRING = 0x80, /* SWI style strings */
BLOB_WIDE_STRING = 0x81, /* SWI style strings */
EXTERNAL_BLOB = 0x100, /* generic data */
USER_BLOB_START = 0x1000, /* 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);
#if SIZEOF_DOUBLE == SIZEOF_LONG_INT
#define MkFloatTerm(fl) __MkFloatTerm((fl) PASS_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
__MkFloatTerm (Float dbl USES_REGS)
{
return (Term) ((H[0] = (CELL) FunctorDouble, *(Float *) (H + 1) =
dbl, H[2] = EndSpecials, H +=
3, AbsAppl (H - 3)));
return (Term) ((HR[0] = (CELL) FunctorDouble, *(Float *) (HR + 1) =
dbl, HR[2] = EndSpecials, HR +=
3, AbsAppl (HR - 3)));
}
INLINE_ONLY inline EXTERN Float FloatOfTerm (Term t);
INLINE_ONLY inline EXTERN Float
FloatOfTerm (Term t)
{
@ -216,7 +216,7 @@ CpFloatUnaligned(CELL *ptr)
#else
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
#define DOUBLE_ALIGNED(ADDR) ((CELL)(ADDR) & 0x4)
@ -228,9 +228,9 @@ AlignGlobalForDouble( USES_REGS1 )
{
/* Force Alignment for floats. Note that garbage collector may
break the alignment; */
if (!DOUBLE_ALIGNED(H)) {
RESET_VARIABLE(H);
H++;
if (!DOUBLE_ALIGNED(HR)) {
RESET_VARIABLE(HR);
HR++;
}
}
@ -258,21 +258,16 @@ CpFloatUnaligned (CELL * ptr)
#endif
INLINE_ONLY inline EXTERN Term MkFloatTerm (Float);
INLINE_ONLY inline EXTERN Term
MkFloatTerm (Float dbl)
__MkFloatTerm (Float dbl USES_REGS)
{
CACHE_REGS
return (Term) ((AlignGlobalForDouble ( PASS_REGS1 ), H[0] =
(CELL) FunctorDouble, *(Float *) (H + 1) = dbl, H[3] =
EndSpecials, H +=
4, AbsAppl (H - 4)));
return (Term) ((AlignGlobalForDouble ( PASS_REGS1 ), HR[0] =
(CELL) FunctorDouble, *(Float *) (HR + 1) = dbl, HR[3] =
EndSpecials, HR +=
4, AbsAppl (HR - 4)));
}
INLINE_ONLY inline EXTERN Float FloatOfTerm (Term t);
INLINE_ONLY inline EXTERN Float
FloatOfTerm (Term t)
{
@ -295,13 +290,6 @@ OOPS
#include <stddef.h>
#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);
@ -312,8 +300,6 @@ IsFloatTerm (Term t)
}
/* extern Functor FunctorLongInt; */
#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
__MkLongIntTerm (Int i USES_REGS)
{
H[0] = (CELL) FunctorLongInt;
H[1] = (CELL) (i);
H[2] = EndSpecials;
H += 3;
return AbsAppl(H - 3);
HR[0] = (CELL) FunctorLongInt;
HR[1] = (CELL) (i);
HR[2] = EndSpecials;
HR += 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
@ -438,30 +471,6 @@ IsLargeIntTerm (Term t)
#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; */
INLINE_ONLY inline EXTERN int IsLargeNumTerm (Term);
@ -470,8 +479,8 @@ INLINE_ONLY inline EXTERN int
IsLargeNumTerm (Term t)
{
return (int) (IsApplTerm (t)
&& ((FunctorOfTerm (t) <= FunctorDouble)
&& (FunctorOfTerm (t) >= FunctorLongInt)));
&& ((FunctorOfTerm (t) <= FunctorBigInt)
&& (FunctorOfTerm (t) >= FunctorDouble)));
}
INLINE_ONLY inline EXTERN int IsExternalBlobTerm (Term, CELL);
@ -523,7 +532,7 @@ INLINE_ONLY inline EXTERN Int IsExtensionFunctor (Functor);
INLINE_ONLY inline EXTERN Int
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
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);
case long_int_e:
return (pt0[1] == RepAppl (d1)[1]);
case string_e:
return strcmp( (char *)(pt0+2), (char *)(RepAppl (d1)+2) ) == 0;
case big_int_e:
#ifdef USE_GMP
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);
return (pt0[1] == pt1[1]
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
&& pt0[2] == pt1[2]
#endif
);
@ -707,7 +718,7 @@ CELL Yap_Int_key(Term t)
static inline
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];
#else
CELL val = pt[0];
@ -721,4 +732,21 @@ CELL Yap_Double_key(Term t)
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

5
H/Yap.h
View File

@ -38,6 +38,9 @@
#endif /* THREADS && (YAPOR_COW || YAPOR_SBA || YAPOR_COPY) */
#include "config.h"
#define FunAdr(X) X
#include "inline-only.h"
#if defined(YAPOR) || defined(TABLING)
#include "opt.config.h"
@ -230,7 +233,6 @@ typedef char *ADDR;
typedef CELL OFFSET;
typedef unsigned char *CODEADDR;
#define ALIGN_YAPTYPE(X,TYPE) (((CELL)(X)+(sizeof(TYPE)-1)) & ~(sizeof(TYPE)-1))
#define TermPtr(V) ((Term *) (V))
#define Addr(V) ((ADDR) (V))
@ -395,7 +397,6 @@ typedef enum
YAP_BREAK_SIGNAL = 0x2000, /* received break signal */
YAP_STACK_DUMP_SIGNAL = 0x4000, /* received stack dump signal */
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_PIPE_SIGNAL = 0x40000, /* call atom garbage collector asap */
YAP_VTALARM_SIGNAL = 0x80000, /* received SIGVTALARM */

5
H/YapHandles.h
View File

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

11
H/YapOpcodes.h
View File

@ -76,6 +76,7 @@
OPCODE(get_list ,x),
OPCODE(get_struct ,xfa),
OPCODE(get_float ,xd),
OPCODE(get_string ,xu),
OPCODE(get_longint ,xi),
OPCODE(get_bigint ,xN),
OPCODE(get_dbterm ,xD),
@ -131,6 +132,8 @@
OPCODE(unify_float_write ,od),
OPCODE(unify_l_float ,od),
OPCODE(unify_l_float_write ,od),
OPCODE(unify_string ,ou),
OPCODE(unify_l_string ,ou),
OPCODE(unify_longint ,oi),
OPCODE(unify_longint_write ,oi),
OPCODE(unify_l_longint ,oi),
@ -200,14 +203,10 @@
OPCODE(call_c_wfail ,slp),
OPCODE(try_c ,OtapFs),
OPCODE(retry_c ,OtapFs),
#ifdef CUT_C
OPCODE(cut_c ,OtapFs),
#endif
OPCODE(try_userc ,OtapFs),
OPCODE(retry_userc ,OtapFs),
#ifdef CUT_C
OPCODE(cut_userc ,OtapFs),
#endif
OPCODE(lock_pred ,e),
OPCODE(index_pred ,e),
#ifdef THREADS
@ -413,6 +412,10 @@
OPCODE(trie_trust_longint ,e),
OPCODE(trie_try_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_trust_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
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
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
MkPairTerm__ (Term head, Term tail USES_REGS)
{
register CELL *p = H;
register CELL *p = HR;
H[0] = head;
H[1] = tail;
H += 2;
HR[0] = head;
HR[1] = tail;
HR += 2;
return (AbsPair (p));
}

3
H/YapTerm.h
View File

@ -21,6 +21,9 @@ typedef void *Atom;
#endif
#define ALIGN_YAPTYPE(X,TYPE) (((CELL)(X)+(sizeof(TYPE)-1)) & ~(sizeof(TYPE)-1))
#ifndef EXTERN
#define EXTERN extern
#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);
struct operator_entry *Yap_GetOpPropForAModuleHavingALock(AtomEntry *, Term);
Atom Yap_LookupAtom(char *);
Atom Yap_LookupAtomWithLength(char *, size_t);
Atom Yap_LookupUTF8Atom(char *);
Atom Yap_LookupMaybeWideAtom(wchar_t *);
Atom Yap_LookupMaybeWideAtomWithLength(wchar_t *, size_t);
Atom Yap_FullLookupAtom(char *);
@ -39,19 +41,6 @@ Functor Yap_MkFunctor(Atom,unsigned int);
void Yap_MkFunctorWithAddress(Atom,unsigned int,FunctorEntry *);
void Yap_PutValue(Atom,Term);
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_AtomDecreaseHold(Atom);
struct operator_entry *Yap_OpPropForModule(Atom, Term);
@ -117,6 +106,8 @@ Term Yap_RatTermToApplTerm(Term);
void Yap_InitBigNums(void);
Term Yap_AllocExternalDataInStack(CELL, size_t);
int Yap_CleanOpaqueVariable(CELL *);
CELL *Yap_HeapStoreOpaqueTerm(Term t);
size_t Yap_OpaqueTermToString(Term t, char *str, size_t max);
/* c_interface.c */
Int YAP_Execute(struct pred_entry *, CPredicate);
@ -127,7 +118,7 @@ Int YAP_RunGoalOnce(Term);
/* cdmgr.c */
Term Yap_all_calls(void);
Atom Yap_ConsultingFile(void);
Atom Yap_ConsultingFile( USES_REGS1 );
struct pred_entry *Yap_PredForChoicePt(choiceptr);
void Yap_InitCdMgr(void);
void Yap_init_consult(int, char *);
@ -138,7 +129,7 @@ void Yap_EraseMegaClause(yamop *,struct pred_entry *);
void Yap_ResetConsultStack(void);
void Yap_AssertzClause(struct pred_entry *, yamop *);
void Yap_HidePred(struct pred_entry *pe);
int Yap_SetNoTrace(char *name, UInt arity, Term tmod);
/* cmppreds.c */
Int Yap_compare_terms(Term,Term);
@ -169,6 +160,8 @@ void Yap_RestartYap(int);
void Yap_exit(int);
yamop *Yap_Error(yap_error_number,Term,char *msg, ...);
yamop *Yap_NilError(yap_error_number,char *msg, ...);
int Yap_HandleError( const char *msg, ... );
int Yap_SWIHandleError( const char *, ... );
/* eval.c */
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_InitCPredBack(char *, unsigned long int, unsigned int, 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);
#endif
void Yap_InitWorkspace(UInt,UInt,UInt,UInt,UInt,int,int,int);
#ifdef YAPOR
@ -348,6 +339,7 @@ void Yap_InitSignalCPreds(void);
/* sort.c */
void Yap_InitSortPreds(void);
/* stdpreds.c */
void Yap_InitBackCPreds(void);
void Yap_InitCPreds(void);
@ -430,81 +422,7 @@ Int Yap_SkipList(Term *, Term **);
/* write.c */
void Yap_plwrite(Term, void *, int, int, int);
/* 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
int Yap_FormatFloat( Float f, const char *s, size_t sz );
/* yap2swi.c */
void Yap_swi_install(void);

16
H/Yatom.h
View File

@ -650,10 +650,14 @@ IsValProperty (int flags)
for the pred.
C_Preds are things write, read, ... implemented in C. In this case
CodeOfPred holds the address of the correspondent C-function.
don;t forget to also add in qly.h
*/
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 */
ThreadLocalPredFlag = 0x40000000L, /* local to a thread */
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 */
@ -1286,6 +1296,7 @@ typedef struct array_entry
Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */
Int ArrayEArity; /* Arity of Array (positive) */
array_type TypeOfAE;
#if defined(YAPOR) || defined(THREADS)
rwlock_t ArRWLock; /* a read-write lock to protect the entry */
#if THREADS
@ -1337,6 +1348,7 @@ typedef struct static_array_entry
Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */
Int ArrayEArity; /* Arity of Array (negative) */
array_type TypeOfAE;
#if defined(YAPOR) || defined(THREADS)
rwlock_t ArRWLock; /* a read-write lock to protect the entry */
#endif
@ -1437,7 +1449,7 @@ INLINE_ONLY inline EXTERN int ArrayIsDynamic (ArrayEntry *);
INLINE_ONLY inline EXTERN int
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
/***************************************************************
* Use bp as PREG for X86 machines *
***************************************************************/
********************************************Term*******************/
#if defined(IN_ABSMI_C)
register struct yami* P1REG asm ("bp"); /* can't use yamop before Yap.h */
#define PREG P1REG
@ -769,9 +769,9 @@ Macros to check the limits of stacks
COUNT_CPS(); \
S_YREG = (CELL *)((choiceptr)((S_YREG)-(I))-1); \
/* Save Information */ \
HBREG = H; \
HBREG = HR; \
B_YREG->cp_tr = TR; \
B_YREG->cp_h = H; \
B_YREG->cp_h = HR; \
B_YREG->cp_b = B; \
store_yaam_reg_cpdepth(B_YREG); \
B_YREG->cp_cp = CPREG; \
@ -783,9 +783,9 @@ Macros to check the limits of stacks
COUNT_CPS(); \
pt1 --; /* Jump to CP_BASE */ \
/* Save Information */ \
HBREG = H; \
HBREG = HR; \
pt1->cp_tr = TR; \
pt1->cp_h = H; \
pt1->cp_h = HR; \
pt1->cp_b = B; \
store_yaam_reg_cpdepth(pt1); \
pt1->cp_cp = d0; \
@ -850,7 +850,7 @@ Macros to check the limits of stacks
#define restore_yaam_regs(AP) \
{ register CELL *x1 = B_YREG->cp_env; \
register yamop *x2; \
H = HBREG = PROTECT_FROZEN_H(B_YREG); \
HR = HBREG = PROTECT_FROZEN_H(B_YREG); \
restore_yaam_reg_cpdepth(B_YREG); \
CPREG = B_YREG->cp_cp; \
/* AP may depend on H */ \
@ -914,7 +914,7 @@ Macros to check the limits of stacks
#define pop_yaam_regs() \
{ \
H = PROTECT_FROZEN_H(B_YREG); \
HR = PROTECT_FROZEN_H(B_YREG); \
B = B_YREG->cp_b; \
pop_yaam_reg_cpdepth(B_YREG); \
CPREG = B_YREG->cp_cp; \
@ -999,20 +999,20 @@ Macros to check the limits of stacks
}
#define UnifyGlobalCellToCell(b, a) \
if ((a) < H) { /* two globals */ \
if ((a) < HR) { /* two globals */ \
UnifyGlobalCells(a,b); \
} else { \
Bind_Local((a),(CELL)(b)); \
}
#define UnifyCells(a, b) \
if ((a) < H) { /* at least one global */ \
if ((b) > H) { Bind_Local((b),(CELL)(a)); } \
if ((a) < HR) { /* at least one global */ \
if ((b) > HR) { Bind_Local((b),(CELL)(a)); } \
else { UnifyGlobalCells(a,b); } \
} else { \
if ((b) > (a)) { Bind_Local((a),(CELL)(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)); } \
} \
}
@ -1597,14 +1597,37 @@ void SET_ASP__(CELL *yreg, Int sz USES_REGS) {
/* l1: bind a, l2 bind b, l3 no binding */
#define UnifyAndTrailCells(a, b) \
if((a) > (b)) { \
if ((a) < H) { *(a) = (CELL)(b); DO_TRAIL((a),(CELL)(b)); } \
else if ((b) <= H) { *(a) =(CELL)(b); DO_TRAIL((a),(CELL)(b));} \
if ((a) < HR) { *(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 if((a) < (b)){ \
if ((b) <= H) { *(b) = (CELL)(a); DO_TRAIL((b),(CELL)(a)); } \
else if ((a) <= H) { *(b) = (CELL) (a); DO_TRAIL((b),(CELL)(a));} \
if ((b) <= HR) { *(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));} \
}
#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 *
s: small integer, COUNT
t: pointer to table entry, used by yaptab, struct table_entry *
u: utf-8 string
x: wam register, wamreg
y: environment slot
@ -558,6 +559,11 @@ typedef struct yami {
COUNT s;
CELL next;
} os;
struct {
OPCODE opcw;
Term u;
CELL next;
} ou;
struct {
OPCODE opcw;
wamreg x;
@ -783,6 +789,11 @@ typedef struct yami {
wamreg xr;
CELL next;
} xx;
struct {
wamreg x;
Term u;
CELL next;
} xu;
struct {
wamreg x;
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_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_Global_NonAtt(A,D) { *(A) = (D); TRAIL_GLOBAL(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
do_cut(int i) {
CACHE_REGS
#ifdef CUT_C
if (POP_CHOICE_POINT(B->cp_b)) {
cut_c_pop();
}
#endif
Yap_TrimTrail();
B = B->cp_b;
return i;

81
H/arith2.h
View File

@ -75,8 +75,29 @@ mul_overflow(Int z, Int i1, Int i2)
}
#ifndef OPTIMIZE_MULTIPLI
#define DO_MULTI() z = i1*i2; \
if (i2 && z/i2 != i1) goto overflow
#if __clang__ && FALSE /* not in OSX yet */
#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
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
p_minus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {

2
H/arrays.h
View File

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

28
H/clause.h
View File

@ -281,6 +281,8 @@ void Yap_ErCl(DynamicClause *);
void Yap_ErLogUpdCl(LogUpdClause *);
void Yap_ErLogUpdIndex(LogUpdIndex *);
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 */
Term Yap_cp_as_integer(choiceptr);
@ -395,6 +397,32 @@ Yap_MegaClausePredicateFromTerm(Term 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 {
FIND_PRED_FROM_ANYWHERE,
FIND_PRED_FROM_CP,

7
H/compile.h
View File

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

1
H/dhstruct.h
View File

@ -141,6 +141,7 @@
#define PredIs Yap_heap_regs->pred_is
#define PredSafeCallCleanup Yap_heap_regs->pred_safe_call_cleanup
#define PredRestoreRegs Yap_heap_regs->pred_restore_regs
#define PredCommentHook Yap_heap_regs->pred_comment_hook
#ifdef YAPOR
#define PredGetwork Yap_heap_regs->pred_getwork
#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 LOCAL_SourceModule LOCAL->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
char *Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base);
Term Yap_gmq_rdiv_int_int(Int, Int);
Term Yap_gmq_rdiv_int_big(Int, Term);
Term Yap_gmq_rdiv_big_int(Term, Int);
@ -345,28 +347,82 @@ __Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS)
}
inline static int
add_overflow(Int x, Int i, Int j)
{
return ((i & j & ~x) | (~i & ~j & x)) < 0;
}
#if __clang__ && FALSE /* not in OSX yet */
#define DO_ADD() if (__builtin_sadd_overflow( i1, i2, & z ) ) { goto overflow; }
#endif
inline static Term
add_int(Int i, Int j USES_REGS)
{
Int x = i+j;
#if USE_GMP
/* Integer overflow, we need to use big integers */
Int overflow = (i & j & ~x) | (~i & ~j & x);
if (overflow < 0) {
return(Yap_gmp_add_ints(i, j));
UInt w = (UInt)i+(UInt)j;
if (i > 0) {
if (j > 0 && (Int)w < 0) goto overflow;
} else {
if (j < 0 && (Int)w > 0) goto overflow;
}
#endif
#ifdef BEAM
RINT(x);
return( MkIntegerTerm (x));
RINT( (Int)w);
/* Integer overflow, we need to use big integers */
overflow:
return Yap_gmp_add_ints(i, j);
#else
RINT(x);
RINT(i+j);
#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)) {
CELL *pt = RepAppl(cl->u.cc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cc.c1;
clause->ucd.t_ptr = cl->u.cc.c1;
} else
clause->Tag = cl->u.cc.c1;
return;
@ -38,7 +38,7 @@
if (IsApplTerm(cl->u.cc.c2)) {
CELL *pt = RepAppl(cl->u.cc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cc.c2;
clause->ucd.t_ptr = cl->u.cc.c2;
} else
clause->Tag = cl->u.cc.c2;
return;
@ -50,7 +50,7 @@
if (IsApplTerm(cl->u.ccc.c1)) {
CELL *pt = RepAppl(cl->u.ccc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccc.c1;
clause->ucd.t_ptr = cl->u.ccc.c1;
} else
clause->Tag = cl->u.ccc.c1;
return;
@ -59,7 +59,7 @@
if (IsApplTerm(cl->u.ccc.c2)) {
CELL *pt = RepAppl(cl->u.ccc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccc.c2;
clause->ucd.t_ptr = cl->u.ccc.c2;
} else
clause->Tag = cl->u.ccc.c2;
return;
@ -68,7 +68,7 @@
if (IsApplTerm(cl->u.ccc.c3)) {
CELL *pt = RepAppl(cl->u.ccc.c3);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccc.c3;
clause->ucd.t_ptr = cl->u.ccc.c3;
} else
clause->Tag = cl->u.ccc.c3;
return;
@ -80,7 +80,7 @@
if (IsApplTerm(cl->u.cccc.c1)) {
CELL *pt = RepAppl(cl->u.cccc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccc.c1;
clause->ucd.t_ptr = cl->u.cccc.c1;
} else
clause->Tag = cl->u.cccc.c1;
return;
@ -89,7 +89,7 @@
if (IsApplTerm(cl->u.cccc.c2)) {
CELL *pt = RepAppl(cl->u.cccc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccc.c2;
clause->ucd.t_ptr = cl->u.cccc.c2;
} else
clause->Tag = cl->u.cccc.c2;
return;
@ -98,7 +98,7 @@
if (IsApplTerm(cl->u.cccc.c3)) {
CELL *pt = RepAppl(cl->u.cccc.c3);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccc.c3;
clause->ucd.t_ptr = cl->u.cccc.c3;
} else
clause->Tag = cl->u.cccc.c3;
return;
@ -107,7 +107,7 @@
if (IsApplTerm(cl->u.cccc.c4)) {
CELL *pt = RepAppl(cl->u.cccc.c4);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccc.c4;
clause->ucd.t_ptr = cl->u.cccc.c4;
} else
clause->Tag = cl->u.cccc.c4;
return;
@ -119,7 +119,7 @@
if (IsApplTerm(cl->u.ccccc.c1)) {
CELL *pt = RepAppl(cl->u.ccccc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c1;
clause->ucd.t_ptr = cl->u.ccccc.c1;
} else
clause->Tag = cl->u.ccccc.c1;
return;
@ -128,7 +128,7 @@
if (IsApplTerm(cl->u.ccccc.c2)) {
CELL *pt = RepAppl(cl->u.ccccc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c2;
clause->ucd.t_ptr = cl->u.ccccc.c2;
} else
clause->Tag = cl->u.ccccc.c2;
return;
@ -137,7 +137,7 @@
if (IsApplTerm(cl->u.ccccc.c3)) {
CELL *pt = RepAppl(cl->u.ccccc.c3);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c3;
clause->ucd.t_ptr = cl->u.ccccc.c3;
} else
clause->Tag = cl->u.ccccc.c3;
return;
@ -146,7 +146,7 @@
if (IsApplTerm(cl->u.ccccc.c4)) {
CELL *pt = RepAppl(cl->u.ccccc.c4);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c4;
clause->ucd.t_ptr = cl->u.ccccc.c4;
} else
clause->Tag = cl->u.ccccc.c4;
return;
@ -155,7 +155,7 @@
if (IsApplTerm(cl->u.ccccc.c5)) {
CELL *pt = RepAppl(cl->u.ccccc.c5);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.ccccc.c5;
clause->ucd.t_ptr = cl->u.ccccc.c5;
} else
clause->Tag = cl->u.ccccc.c5;
return;
@ -167,7 +167,7 @@
if (IsApplTerm(cl->u.cccccc.c1)) {
CELL *pt = RepAppl(cl->u.cccccc.c1);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c1;
clause->ucd.t_ptr = cl->u.cccccc.c1;
} else
clause->Tag = cl->u.cccccc.c1;
return;
@ -176,7 +176,7 @@
if (IsApplTerm(cl->u.cccccc.c2)) {
CELL *pt = RepAppl(cl->u.cccccc.c2);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c2;
clause->ucd.t_ptr = cl->u.cccccc.c2;
} else
clause->Tag = cl->u.cccccc.c2;
return;
@ -185,7 +185,7 @@
if (IsApplTerm(cl->u.cccccc.c3)) {
CELL *pt = RepAppl(cl->u.cccccc.c3);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c3;
clause->ucd.t_ptr = cl->u.cccccc.c3;
} else
clause->Tag = cl->u.cccccc.c3;
return;
@ -194,7 +194,7 @@
if (IsApplTerm(cl->u.cccccc.c4)) {
CELL *pt = RepAppl(cl->u.cccccc.c4);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c4;
clause->ucd.t_ptr = cl->u.cccccc.c4;
} else
clause->Tag = cl->u.cccccc.c4;
return;
@ -203,7 +203,7 @@
if (IsApplTerm(cl->u.cccccc.c5)) {
CELL *pt = RepAppl(cl->u.cccccc.c5);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c5;
clause->ucd.t_ptr = cl->u.cccccc.c5;
} else
clause->Tag = cl->u.cccccc.c5;
return;
@ -212,7 +212,7 @@
if (IsApplTerm(cl->u.cccccc.c6)) {
CELL *pt = RepAppl(cl->u.cccccc.c6);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.cccccc.c6;
clause->ucd.t_ptr = cl->u.cccccc.c6;
} else
clause->Tag = cl->u.cccccc.c6;
return;
@ -236,12 +236,12 @@
CELL *pt = RepAppl(t);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.c_sreg = pt;
clause->ucd.c_sreg = pt;
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
clause->ucd.c_sreg = pt-1;
} else {
clause->Tag = t;
}
@ -271,12 +271,12 @@
CELL *pt = RepAppl(t);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.c_sreg = pt;
clause->ucd.c_sreg = pt;
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
clause->ucd.c_sreg = pt-1;
} else {
clause->Tag = t;
}
@ -409,6 +409,12 @@
case _unify_n_atoms_write:
cl = NEXTOP(cl,osc);
break;
case _unify_l_string:
cl = NEXTOP(cl,ou);
break;
case _unify_string:
cl = NEXTOP(cl,ou);
break;
case _save_appl_x:
if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.ox.x))) {
clause->Tag = (CELL)NULL;
@ -643,7 +649,7 @@
case _get_list:
if (is_regcopy(myregs, nofregs, cl->u.x.x)) {
clause->Tag = AbsPair(NULL);
clause->u.WorkPC = NEXTOP(cl,x);
clause->ucd.WorkPC = NEXTOP(cl,x);
return;
}
cl = NEXTOP(cl,x);
@ -682,7 +688,7 @@
case _get_bigint:
if (is_regcopy(myregs, nofregs, cl->u.xN.x)) {
clause->Tag = AbsAppl((CELL *)FunctorBigInt);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xN);
@ -699,7 +705,7 @@
if (IsApplTerm(cl->u.xc.c)) {
CELL *pt = RepAppl(cl->u.xc.c);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.xc.c;
clause->ucd.t_ptr = cl->u.xc.c;
} else
clause->Tag = cl->u.xc.c;
return;
@ -716,7 +722,7 @@
case _get_float:
if (is_regcopy(myregs, nofregs, cl->u.xd.x)) {
clause->Tag = AbsAppl((CELL *)FunctorDouble);
clause->u.t_ptr = AbsAppl(cl->u.xd.d);
clause->ucd.t_ptr = AbsAppl(cl->u.xd.d);
return;
}
cl = NEXTOP(cl,xd);
@ -731,7 +737,7 @@
case _get_struct:
if (is_regcopy(myregs, nofregs, cl->u.xfa.x)) {
clause->Tag = AbsAppl((CELL *)cl->u.xfa.f);
clause->u.WorkPC = NEXTOP(cl,xfa);
clause->ucd.WorkPC = NEXTOP(cl,xfa);
return;
}
cl = NEXTOP(cl,xfa);
@ -746,7 +752,7 @@
case _get_longint:
if (is_regcopy(myregs, nofregs, cl->u.xi.x)) {
clause->Tag = AbsAppl((CELL *)FunctorLongInt);
clause->u.t_ptr = AbsAppl(cl->u.xi.i);
clause->ucd.t_ptr = AbsAppl(cl->u.xi.i);
return;
}
cl = NEXTOP(cl,xi);
@ -765,7 +771,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = (_atom+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xl);
@ -777,7 +783,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = (_atomic+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xl);
@ -789,7 +795,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = (_compound+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xl);
@ -801,7 +807,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = AbsAppl((CELL *)FunctorDBRef);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xl);
@ -813,7 +819,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = AbsAppl((CELL *)FunctorDouble);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xl);
@ -825,7 +831,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = (_integer+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xl);
@ -844,7 +850,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = (_number+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xl);
@ -856,7 +862,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = (_primitive+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xl);
@ -868,11 +874,19 @@
}
if (is_regcopy(myregs, nofregs, cl->u.xl.x)) {
clause->Tag = (_var+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xl);
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:
if (!(nofregs = link_regcopies(myregs, nofregs, cl->u.xx.xl, cl->u.xx.xr))) {
clause->Tag = (CELL)NULL;
@ -890,7 +904,7 @@
case _gl_void_valx:
if (is_regcopy(myregs, nofregs, cl->u.xx.xl)) {
clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl;
clause->ucd.WorkPC = cl;
return;
}
cl = NEXTOP(cl,xx);
@ -898,7 +912,7 @@
case _gl_void_varx:
if (is_regcopy(myregs, nofregs, cl->u.xx.xl)) {
clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl;
clause->ucd.WorkPC = cl;
return;
}
if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.xx.xr))) {
@ -910,7 +924,7 @@
case _glist_valx:
if (is_regcopy(myregs, nofregs, cl->u.xx.xl)) {
clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl;
clause->ucd.WorkPC = cl;
return;
}
cl = NEXTOP(cl,xx);
@ -1146,7 +1160,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = (_atom+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,yl);
@ -1158,7 +1172,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = (_atomic+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,yl);
@ -1170,7 +1184,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = (_compound+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,yl);
@ -1182,7 +1196,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = AbsAppl((CELL *)FunctorDBRef);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,yl);
@ -1194,7 +1208,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = AbsAppl((CELL *)FunctorDouble);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,yl);
@ -1206,7 +1220,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = (_integer+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,yl);
@ -1225,7 +1239,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = (_number+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,yl);
@ -1237,7 +1251,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = (_primitive+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,yl);
@ -1249,7 +1263,7 @@
}
if (is_regcopy(myregs, nofregs, cl->u.yl.y)) {
clause->Tag = (_var+1)*sizeof(CELL);
clause->u.t_ptr = (CELL)NULL;
clause->ucd.t_ptr = (CELL)NULL;
return;
}
cl = NEXTOP(cl,yl);
@ -1271,7 +1285,7 @@
case _gl_void_valy:
if (is_regcopy(myregs, nofregs, cl->u.yx.y)) {
clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl;
clause->ucd.WorkPC = cl;
return;
}
cl = NEXTOP(cl,yx);
@ -1279,7 +1293,7 @@
case _gl_void_vary:
if (is_regcopy(myregs, nofregs, cl->u.yx.y)) {
clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl;
clause->ucd.WorkPC = cl;
return;
}
if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.yx.y))) {
@ -1291,7 +1305,7 @@
case _glist_valy:
if (is_regcopy(myregs, nofregs, cl->u.yx.x)) {
clause->Tag = AbsPair(NULL);
clause->u.WorkPC = cl;
clause->ucd.WorkPC = cl;
return;
}
cl = NEXTOP(cl,yx);

86
H/headclause.h
View File

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

2
H/heapgc.h
View File

@ -45,7 +45,7 @@
#endif
/* 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? */
#if USE_SYSTEM_MALLOC

1
H/hlocals.h
View File

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

1
H/hstruct.h
View File

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

6
H/iatoms.h
View File

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

1
H/ihstruct.h
View File

@ -141,6 +141,7 @@
PredIs = RepPredProp(PredPropByFunc(FunctorIs,PROLOG_MODULE));
PredSafeCallCleanup = RepPredProp(PredPropByFunc(FunctorSafeCallCleanup,PROLOG_MODULE));
PredRestoreRegs = RepPredProp(PredPropByFunc(FunctorRestoreRegs,PROLOG_MODULE));
PredCommentHook = RepPredProp(PredPropByFunc(FunctorCommentHook,PROLOG_MODULE));
#ifdef YAPOR
PredGetwork = RepPredProp(PredPropByAtom(AtomGetwork,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_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 */
Term t_ptr;
CELL *c_sreg;
} u;
} ucd;
} ClauseDef;
@ -70,7 +70,7 @@ typedef struct {
union {
UInt Label;
yamop *labp;
} u;
} u_a;
} AtomSwiEntry;
/* switch_on_func */
@ -79,7 +79,7 @@ typedef struct {
union {
UInt Label;
yamop *labp;
} u;
} u_f;
} FuncSwiEntry;
/* switch_on_type */
@ -116,7 +116,7 @@ typedef struct {
ClauseUnion *block;
yamop **entry_code;
} cle;
} u;
} uip;
} path_stack_entry;
#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);
Term Yap_StreamPosition(struct io_stream *);
void Yap_InitPlIO(void);

39
H/pl-incl.h
View File

@ -34,7 +34,7 @@
/* include all stuff that is exported to yap */
#include "pl-shared.h"
#define PLVERSION YAP_VERSION
#define PLVERSION YAP_NUMERIC_VERSION
#define PLNAME "yap"
#define SWIP "swi_"
@ -59,14 +59,6 @@ typedef struct pred_entry * Procedure; /* predicate */
#undef H
#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 */
/* should have messages here */
#ifdef DEBUG
@ -511,7 +503,6 @@ typedef struct wakeup_state
Defining built-in predicates using the new interface
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define EOS '\0'
#define ESC ((char) 27)
#define streq(s, q) ((strcmp((s), (q)) == 0))
@ -574,6 +565,7 @@ extern void PL_cleanup_fork(void);
extern int PL_rethrow(void);
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_termv(term_t l, va_list args);
extern int _PL_unify_atomic(term_t t, PL_atomic_t a);
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 get_atom_ptr_text(Atom a, PL_chars_t *text);
extern int warning(const char *fm, ...);
extern int raiseSignal(PL_local_data_t *ld, int sig);
/**** stuff from pl-files.c ****/
void initFiles(void);
@ -884,6 +875,32 @@ extern void unallocStream(IOSTREAM *s);
extern atom_t accessLevel(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_file[];
extern const PL_extension PL_predicates_from_files[];

41
H/pl-shared.h
View File

@ -56,7 +56,7 @@
#endif
#endif
#include <SWI-Stream.h>
#include <SWI-Prolog.h>
#define COMMON(X) extern X
@ -128,7 +128,7 @@ typedef int bool;
typedef struct redir_context
{ int magic; /* REDIR_MAGIC */
IOSTREAM *stream; /* temporary output */
struct io_stream *stream; /* temporary output */
int is_stream; /* redirect to stream */
int redirected; /* output is redirected */
term_t term; /* redirect target */
@ -141,6 +141,8 @@ typedef struct redir_context
#include "pl-file.h"
#define EOS '\0'
/********************************
* HASH TABLES *
*********************************/
@ -262,9 +264,32 @@ getUnknownModule(module_t m);
COMMON(int) debugmode(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_t YAP_SWIAtomFromAtom(Atom at);
@ -273,7 +298,7 @@ atom_t YAP_SWIAtomFromAtom(Atom at);
static inline Functor
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 (Functor)f;
}
@ -284,14 +309,14 @@ OpenList(int n USES_REGS)
Term t;
BACKUP_H();
while (H+2*n > ASP-1024) {
while (HR+2*n > ASP-1024) {
if (!Yap_dogc( 0, NULL PASS_REGS )) {
RECOVER_H();
return FALSE;
}
}
t = AbsPair(H);
H += 2*n;
t = AbsPair(HR);
HR += 2*n;
RECOVER_H();
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 IOENC Yap_DefaultEncoding(void);
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_WriteAtom(IOSTREAM *s, Atom atom);
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 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 isList(A) (!IsVarTerm(A) && IsPairTerm((A)) )
#define isNil(A) ((A) == TermNil)
@ -133,7 +134,7 @@ void PL_license(const char *license, const char *module);
#define isVar(A) IsVarTerm((A))
#define valReal(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))
inline static char *
@ -184,7 +185,7 @@ charCode(Term w)
return -1;
}
if (strlen(a->StrOfAE) == 1)
return a->StrOfAE[0];
return ((unsigned char *)(a->StrOfAE))[0];
return -1;
}
return -1;

9
H/qly.h
View File

@ -56,7 +56,7 @@ typedef struct export_pred_entry_hash_entry_struct {
union {
Functor f;
Atom a;
} u;
} u_af;
Atom module;
UInt arity;
} export_pred_entry_hash_entry_t;
@ -102,15 +102,14 @@ typedef enum {
} qlf_tag_t;
#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 NEXTOP(V,TYPE) ((yamop *)(&((V)->u.TYPE.next)))
#define CHECK(F) { size_t r = (F); if (!r) return r; }
#define RCHECK(F) if(!(F)) { QLYR_ERROR(MISMATCH); return; }
#define AllocTempSpace() (H)
#define EnoughTempSpace(sz) ((ASP-H)*sizeof(CELL) > sz)
#define AllocTempSpace() (HR)
#define EnoughTempSpace(sz) ((ASP-HR)*sizeof(CELL) > sz)

6
H/ratoms.h
View File

@ -34,6 +34,7 @@
AtomBatched = AtomAdjust(AtomBatched);
AtomBetween = AtomAdjust(AtomBetween);
AtomHugeInt = AtomAdjust(AtomHugeInt);
AtomBigNum = AtomAdjust(AtomBigNum);
AtomBinaryStream = AtomAdjust(AtomBinaryStream);
AtomBraces = AtomAdjust(AtomBraces);
AtomBreak = AtomAdjust(AtomBreak);
@ -53,7 +54,9 @@
AtomColomn = AtomAdjust(AtomColomn);
AtomCodeSpace = AtomAdjust(AtomCodeSpace);
AtomCodes = AtomAdjust(AtomCodes);
AtomCoInductive = AtomAdjust(AtomCoInductive);
AtomComma = AtomAdjust(AtomComma);
AtomCommentHook = AtomAdjust(AtomCommentHook);
AtomCompound = AtomAdjust(AtomCompound);
AtomConsistencyError = AtomAdjust(AtomConsistencyError);
AtomConsultOnBoot = AtomAdjust(AtomConsultOnBoot);
@ -296,6 +299,7 @@
AtomStreamPos = AtomAdjust(AtomStreamPos);
AtomStreamPosition = AtomAdjust(AtomStreamPosition);
AtomString = AtomAdjust(AtomString);
AtomSTRING = AtomAdjust(AtomSTRING);
AtomSwi = AtomAdjust(AtomSwi);
AtomSyntaxError = AtomAdjust(AtomSyntaxError);
AtomSyntaxErrorHandler = AtomAdjust(AtomSyntaxErrorHandler);
@ -305,6 +309,7 @@
AtomTerm = AtomAdjust(AtomTerm);
AtomTerms = AtomAdjust(AtomTerms);
AtomTermExpansion = AtomAdjust(AtomTermExpansion);
AtomText = AtomAdjust(AtomText);
AtomTextStream = AtomAdjust(AtomTextStream);
AtomThreads = AtomAdjust(AtomThreads);
AtomThrow = AtomAdjust(AtomThrow);
@ -358,6 +363,7 @@
FunctorClist = FuncAdjust(FunctorClist);
FunctorCodes = FuncAdjust(FunctorCodes);
FunctorComma = FuncAdjust(FunctorComma);
FunctorCommentHook = FuncAdjust(FunctorCommentHook);
FunctorContext2 = FuncAdjust(FunctorContext2);
FunctorConsistencyError = FuncAdjust(FunctorConsistencyError);
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;
break;
/* instructions type OtapFs */
#ifdef CUT_C
case _cut_c:
#endif
#ifdef CUT_C
case _cut_userc:
#endif
case _retry_c:
case _retry_userc:
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 = NEXTOP(pc,osc);
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 */
case _save_appl_x:
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 = NEXTOP(pc,xps);
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 */
case _get_x_val:
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_atom:
case _trie_do_atom_in_pair:
case _trie_do_bigint:
case _trie_do_double:
case _trie_do_extension:
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_atom:
case _trie_retry_atom_in_pair:
case _trie_retry_bigint:
case _trie_retry_double:
case _trie_retry_extension:
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_atom:
case _trie_trust_atom_in_pair:
case _trie_trust_bigint:
case _trie_trust_double:
case _trie_trust_extension:
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_atom:
case _trie_try_atom_in_pair:
case _trie_try_bigint:
case _trie_try_double:
case _trie_try_extension:
case _trie_try_gterm:

1
H/rhstruct.h
View File

@ -141,6 +141,7 @@
PredIs = PtoPredAdjust(PredIs);
PredSafeCallCleanup = PtoPredAdjust(PredSafeCallCleanup);
PredRestoreRegs = PtoPredAdjust(PredRestoreRegs);
PredCommentHook = PtoPredAdjust(PredCommentHook);
#ifdef YAPOR
PredGetwork = PtoPredAdjust(PredGetwork);
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);
break;
/* instructions type OtapFs */
#ifdef CUT_C
case _cut_c:
#endif
#ifdef CUT_C
case _cut_userc:
#endif
case _retry_c:
case _retry_userc:
case _try_c:
@ -406,6 +402,13 @@
CHECK(save_ConstantTerm(stream, pc->u.osc.c));
pc = NEXTOP(pc,osc);
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 */
case _save_appl_x:
case _save_appl_x_write:
@ -653,6 +656,12 @@
CHECK(save_Constant(stream, pc->u.xps.s));
pc = NEXTOP(pc,xps);
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 */
case _get_x_val:
case _get_x_var:
@ -891,6 +900,7 @@
case _trie_do_appl_in_pair:
case _trie_do_atom:
case _trie_do_atom_in_pair:
case _trie_do_bigint:
case _trie_do_double:
case _trie_do_extension:
case _trie_do_gterm:
@ -906,6 +916,7 @@
case _trie_retry_appl_in_pair:
case _trie_retry_atom:
case _trie_retry_atom_in_pair:
case _trie_retry_bigint:
case _trie_retry_double:
case _trie_retry_extension:
case _trie_retry_gterm:
@ -921,6 +932,7 @@
case _trie_trust_appl_in_pair:
case _trie_trust_atom:
case _trie_trust_atom_in_pair:
case _trie_trust_bigint:
case _trie_trust_double:
case _trie_trust_extension:
case _trie_trust_gterm:
@ -936,6 +948,7 @@
case _trie_try_appl_in_pair:
case _trie_try_atom:
case _trie_try_atom_in_pair:
case _trie_try_bigint:
case _trie_try_double:
case _trie_try_extension:
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
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_
Atom AtomHugeInt_;
#define AtomHugeInt Yap_heap_regs->AtomHugeInt_
Atom AtomBigNum_;
#define AtomBigNum Yap_heap_regs->AtomBigNum_
Atom AtomBinaryStream_;
#define AtomBinaryStream Yap_heap_regs->AtomBinaryStream_
Atom AtomBraces_;
@ -104,8 +106,12 @@
#define AtomCodeSpace Yap_heap_regs->AtomCodeSpace_
Atom AtomCodes_;
#define AtomCodes Yap_heap_regs->AtomCodes_
Atom AtomCoInductive_;
#define AtomCoInductive Yap_heap_regs->AtomCoInductive_
Atom AtomComma_;
#define AtomComma Yap_heap_regs->AtomComma_
Atom AtomCommentHook_;
#define AtomCommentHook Yap_heap_regs->AtomCommentHook_
Atom AtomCompound_;
#define AtomCompound Yap_heap_regs->AtomCompound_
Atom AtomConsistencyError_;
@ -590,6 +596,8 @@
#define AtomStreamPosition Yap_heap_regs->AtomStreamPosition_
Atom AtomString_;
#define AtomString Yap_heap_regs->AtomString_
Atom AtomSTRING_;
#define AtomSTRING Yap_heap_regs->AtomSTRING_
Atom AtomSwi_;
#define AtomSwi Yap_heap_regs->AtomSwi_
Atom AtomSyntaxError_;
@ -608,6 +616,8 @@
#define AtomTerms Yap_heap_regs->AtomTerms_
Atom AtomTermExpansion_;
#define AtomTermExpansion Yap_heap_regs->AtomTermExpansion_
Atom AtomText_;
#define AtomText Yap_heap_regs->AtomText_
Atom AtomTextStream_;
#define AtomTextStream Yap_heap_regs->AtomTextStream_
Atom AtomThreads_;
@ -714,6 +724,8 @@
#define FunctorCodes Yap_heap_regs->FunctorCodes_
Functor FunctorComma_;
#define FunctorComma Yap_heap_regs->FunctorComma_
Functor FunctorCommentHook_;
#define FunctorCommentHook Yap_heap_regs->FunctorCommentHook_
Functor FunctorContext2_;
#define FunctorContext2 Yap_heap_regs->FunctorContext2_
Functor FunctorConsistencyError_;

4
H/trim_trail.h
View File

@ -27,7 +27,7 @@
/* skip, this is a problem because we lose information,
namely active references */
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);
if (IsVarTerm(val)) {
Bind(pt, MkAtomTerm(AtomCut));
@ -128,7 +128,7 @@
} else if (IsPairTerm(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);
if (IsVarTerm(val)) {
Bind(VarOfTerm(val), MkAtomTerm(AtomCut));

17
H/walkclause.h
View File

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

2
H/yapio.h
View File

@ -240,7 +240,7 @@ Term Yap_Variables(VarEntry *,Term);
Term Yap_Singletons(VarEntry *,Term);
/* 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);
Term Yap_scan_num(struct io_stream *);
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