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

miscellaneous fixes 

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@556 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-07-17 20:25:30 +00:00
parent e476bc0abc
commit c27b23f3a5
12 changed files with 531 additions and 143 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* comments: allocating space *
* version:$Id: alloc.c,v 1.19 2002-05-19 19:04:33 vsc Exp $ *
* version:$Id: alloc.c,v 1.20 2002-07-17 20:25:30 vsc Exp $ *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
@ -844,7 +844,11 @@ mallinfo(void)
/* user should ask for a lot of memory first */
#ifdef __linux
#define MAX_SPACE 420*1024*1024
#else
#define MAX_SPACE 128*1024*1024
#endif
static int total_space;
@ -856,10 +860,13 @@ InitWorkSpace(Int s)
#ifdef M_MMAP_MAX
mallopt(M_MMAP_MAX, 0);
#endif
ptr = (MALLOC_T)malloc(MAX_SPACE);
if (s < MAX_SPACE)
ptr = (MALLOC_T)malloc(MAX_SPACE);
else
ptr = (MALLOC_T)malloc(s);
total_space = s;
if (ptr == ((MALLOC_T) - 1)) {
if (ptr == NULL) {
Error(FATAL_ERROR, TermNil, "could not allocate %d bytes", s);
return(NULL);
}
@ -874,7 +881,7 @@ ExtendWorkSpace(Int s)
if (total_space < MAX_SPACE) return(TRUE);
ptr = (MALLOC_T)realloc((void *)HeapBase, total_space);
if (ptr == ((MALLOC_T) - 1)) {
if (ptr == NULL) {
Error(SYSTEM_ERROR, TermNil, "could not expand stacks %d bytes", s);
return(FALSE);
}

14
C/attvar.c
View File

@ -615,6 +615,17 @@ p_is_attvar(void)
((attvar_record *)VarOfTerm(t))->sus_id == attvars_ext);
}
/* check if we are not redoing effort */
static Int
p_attvar_bound(void)
{
Term t = Deref(ARG1);
return(IsVarTerm(t) &&
IsAttachedTerm(t) &&
((attvar_record *)VarOfTerm(t))->sus_id == attvars_ext &&
!IsUnboundVar(((attvar_record *)VarOfTerm(t))->Done));
}
void InitAttVarPreds(void)
{
attas[attvars_ext].bind_op = WakeAttVar;
@ -633,7 +644,8 @@ void InitAttVarPreds(void)
InitCPred("n_of_atts", 1, p_n_atts, SafePredFlag);
InitCPred("bind_attvar", 1, p_bind_attvar, SafePredFlag);
InitCPred("all_attvars", 1, p_all_attvars, SafePredFlag);
InitCPred("$is_att_variable", 1, p_is_attvar, SafePredFlag);
InitCPred("$is_att_variable", 1, p_is_attvar, SafePredFlag|TestPredFlag);
InitCPred("$att_bound", 1, p_attvar_bound, SafePredFlag|TestPredFlag);
}
#endif /* COROUTINING */

2
C/dbase.c
View File

@ -2065,7 +2065,9 @@ GetDBTerm(DBRef DBSP)
#endif
#ifdef COROUTINING
if (DBSP->attachments != 0L) {
*--ASP = (CELL)HOld;
copy_attachments((CELL *)AdjustIDBPtr(DBSP->attachments,(CELL)(HOld-1)));
HOld = CellPtr(*ASP++);
}
#endif
return (AdjustIDBPtr((Term)(DBSP->Entry),Unsigned(HOld)-sizeof(CELL)));

594
C/exec.c
View File

@ -568,14 +568,34 @@ p_execute_0(void)
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG2));
Prop pe;
Atom a;
if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/1");
return(FALSE);
if (IsAtomTerm(t)) {
Atom a;
a = AtomOfTerm(t);
pe = PredPropByAtom(a, mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/1");
return(FALSE);
}
pe = PredPropByFunc(f, mod);
Arity = ArityOfFunctor(f);
ptr = RepAppl(t)+1;
for (i=1;i<=Arity;i++) {
XREGS[i] = *ptr++;
}
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,2), mod);
ptr = RepPair(t);
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
a = AtomOfTerm(t);
pe = PredPropByAtom(a, mod);
return (CallPredicate(RepPredProp(pe), B));
}
@ -585,15 +605,43 @@ p_execute_1(void)
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG3));
Prop pe;
Atom a;
if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/2");
return(FALSE);
}
a = AtomOfTerm(t);
ARG1 = ARG2;
pe = PredPropByFunc(MkFunctor(a,1),mod);
if (IsAtomTerm(t)) {
Atom a;
a = AtomOfTerm(t);
ARG1 = ARG2;
pe = PredPropByFunc(MkFunctor(a,1),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
Atom a;
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/2");
return(FALSE);
}
Arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+1), mod);
XREGS[Arity+1] = ARG2;
ptr = RepAppl(t)+1;
for (i=1;i<=Arity;i++) {
XREGS[i] = *ptr++;
}
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,3), mod);
ptr = RepPair(t);
XREGS[3] = ARG2;
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
return (CallPredicate(RepPredProp(pe), B));
}
@ -603,16 +651,42 @@ p_execute_2(void)
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG4));
Prop pe;
Atom a;
if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/3");
return(FALSE);
if (IsAtomTerm(t)) {
Atom a;
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
pe = PredPropByFunc(MkFunctor(a,2),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
Atom a;
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/3");
return(FALSE);
}
Arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+2), mod);
XREGS[Arity+2] = ARG3;
XREGS[Arity+1] = ARG2;
ptr = RepAppl(t)+1;
for (i=1;i<=Arity;i++) {
XREGS[i] = *ptr++;
}
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,4), mod);
ptr = RepPair(t);
XREGS[4] = ARG3;
XREGS[3] = ARG2;
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
pe = PredPropByFunc(MkFunctor(a, 2),mod);
return (CallPredicate(RepPredProp(pe), B));
}
@ -622,17 +696,49 @@ p_execute_3(void)
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG5));
Prop pe;
Atom a;
if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/4");
return(FALSE);
}
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
pe = PredPropByFunc(MkFunctor(a, 3),mod);
if (IsAtomTerm(t)) {
Atom a;
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
pe = PredPropByFunc(MkFunctor(a,3),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
Atom a;
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/2");
return(FALSE);
}
Arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+3), mod);
XREGS[Arity+3] = ARG4;
XREGS[Arity+2] = ARG3;
XREGS[Arity+1] = ARG2;
ptr = RepAppl(t)+1;
for (i=1;i<=Arity;i++) {
XREGS[i] = *ptr++;
}
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,5), mod);
ptr = RepPair(t);
XREGS[5] = ARG4;
XREGS[4] = ARG3;
XREGS[3] = ARG2;
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
return (CallPredicate(RepPredProp(pe), B));
}
@ -642,18 +748,48 @@ p_execute_4(void)
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG6));
Prop pe;
Atom a;
if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/5");
return(FALSE);
if (IsAtomTerm(t)) {
Atom a;
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
pe = PredPropByFunc(MkFunctor(a,4),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
Atom a;
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/5");
return(FALSE);
}
Arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+4), mod);
XREGS[Arity+4] = ARG5;
XREGS[Arity+3] = ARG4;
XREGS[Arity+2] = ARG3;
XREGS[Arity+1] = ARG2;
ptr = RepAppl(t)+1;
for (i=1;i<=Arity;i++) {
XREGS[i] = *ptr++;
}
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,6), mod);
ptr = RepPair(t);
XREGS[6] = ARG5;
XREGS[5] = ARG4;
XREGS[4] = ARG3;
XREGS[3] = ARG2;
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
pe = PredPropByFunc(MkFunctor(a, 4),mod);
return (CallPredicate(RepPredProp(pe), B));
}
@ -663,19 +799,51 @@ p_execute_5(void)
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG7));
Prop pe;
Atom a;
if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/6");
return(FALSE);
if (IsAtomTerm(t)) {
Atom a;
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
ARG5 = ARG6;
pe = PredPropByFunc(MkFunctor(a,5),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
Atom a;
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/6");
return(FALSE);
}
Arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+5), mod);
XREGS[Arity+5] = ARG6;
XREGS[Arity+4] = ARG5;
XREGS[Arity+3] = ARG4;
XREGS[Arity+2] = ARG3;
XREGS[Arity+1] = ARG2;
ptr = RepAppl(t)+1;
for (i=1;i<=Arity;i++) {
XREGS[i] = *ptr++;
}
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,7), mod);
ptr = RepPair(t);
XREGS[7] = ARG6;
XREGS[6] = ARG5;
XREGS[5] = ARG4;
XREGS[4] = ARG3;
XREGS[3] = ARG2;
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
ARG5 = ARG6;
pe = PredPropByFunc(MkFunctor(a, 5),mod);
return (CallPredicate(RepPredProp(pe), B));
}
@ -685,20 +853,54 @@ p_execute_6(void)
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG8));
Prop pe;
Atom a;
if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/7");
return(FALSE);
if (IsAtomTerm(t)) {
Atom a;
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
ARG5 = ARG6;
ARG6 = ARG7;
pe = PredPropByFunc(MkFunctor(a,6),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
Atom a;
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/7");
return(FALSE);
}
Arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+6), mod);
XREGS[Arity+6] = ARG7;
XREGS[Arity+5] = ARG6;
XREGS[Arity+4] = ARG5;
XREGS[Arity+3] = ARG4;
XREGS[Arity+2] = ARG3;
XREGS[Arity+1] = ARG2;
ptr = RepAppl(t)+1;
for (i=1;i<=Arity;i++) {
XREGS[i] = *ptr++;
}
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,8), mod);
ptr = RepPair(t);
XREGS[8] = ARG7;
XREGS[7] = ARG6;
XREGS[6] = ARG5;
XREGS[5] = ARG4;
XREGS[4] = ARG3;
XREGS[3] = ARG2;
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
ARG5 = ARG6;
ARG6 = ARG7;
pe = PredPropByFunc(MkFunctor(a, 6),mod);
return (CallPredicate(RepPredProp(pe), B));
}
@ -708,21 +910,57 @@ p_execute_7(void)
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG9));
Prop pe;
Atom a;
if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/8");
return(FALSE);
if (IsAtomTerm(t)) {
Atom a;
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
ARG5 = ARG6;
ARG6 = ARG7;
ARG7 = ARG8;
pe = PredPropByFunc(MkFunctor(a,7),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
Atom a;
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/8");
return(FALSE);
}
Arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+7), mod);
XREGS[Arity+7] = ARG8;
XREGS[Arity+6] = ARG7;
XREGS[Arity+5] = ARG6;
XREGS[Arity+4] = ARG5;
XREGS[Arity+3] = ARG4;
XREGS[Arity+2] = ARG3;
XREGS[Arity+1] = ARG2;
ptr = RepAppl(t)+1;
for (i=1;i<=Arity;i++) {
XREGS[i] = *ptr++;
}
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,9), mod);
ptr = RepPair(t);
XREGS[9] = ARG8;
XREGS[8] = ARG7;
XREGS[7] = ARG6;
XREGS[6] = ARG5;
XREGS[5] = ARG4;
XREGS[4] = ARG3;
XREGS[3] = ARG2;
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
ARG5 = ARG6;
ARG6 = ARG7;
ARG7 = ARG8;
pe = PredPropByFunc(MkFunctor(a, 7),mod);
return (CallPredicate(RepPredProp(pe), B));
}
@ -732,22 +970,60 @@ p_execute_8(void)
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG10));
Prop pe;
Atom a;
if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/9");
return(FALSE);
if (IsAtomTerm(t)) {
Atom a;
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
ARG5 = ARG6;
ARG6 = ARG7;
ARG7 = ARG8;
ARG8 = ARG9;
pe = PredPropByFunc(MkFunctor(a,8),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
Atom a;
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/9");
return(FALSE);
}
Arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+8), mod);
XREGS[Arity+8] = ARG9;
XREGS[Arity+7] = ARG8;
XREGS[Arity+6] = ARG7;
XREGS[Arity+5] = ARG6;
XREGS[Arity+4] = ARG5;
XREGS[Arity+3] = ARG4;
XREGS[Arity+2] = ARG3;
XREGS[Arity+1] = ARG2;
ptr = RepAppl(t)+1;
for (i=1;i<=Arity;i++) {
XREGS[i] = *ptr++;
}
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,10), mod);
ptr = RepPair(t);
XREGS[10] = ARG9;
XREGS[9] = ARG8;
XREGS[8] = ARG7;
XREGS[7] = ARG6;
XREGS[6] = ARG5;
XREGS[5] = ARG4;
XREGS[4] = ARG3;
XREGS[3] = ARG2;
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
ARG5 = ARG6;
ARG6 = ARG7;
ARG7 = ARG8;
ARG8 = ARG9;
pe = PredPropByFunc(MkFunctor(a, 8),mod);
return (CallPredicate(RepPredProp(pe), B));
}
@ -757,23 +1033,63 @@ p_execute_9(void)
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG11));
Prop pe;
Atom a;
if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/10");
return(FALSE);
if (IsAtomTerm(t)) {
Atom a;
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
ARG5 = ARG6;
ARG6 = ARG7;
ARG7 = ARG8;
ARG8 = ARG9;
ARG9 = ARG10;
pe = PredPropByFunc(MkFunctor(a,9),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
Atom a;
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/10");
return(FALSE);
}
Arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+9), mod);
XREGS[Arity+9] = ARG10;
XREGS[Arity+8] = ARG9;
XREGS[Arity+7] = ARG8;
XREGS[Arity+6] = ARG7;
XREGS[Arity+5] = ARG6;
XREGS[Arity+4] = ARG5;
XREGS[Arity+3] = ARG4;
XREGS[Arity+2] = ARG3;
XREGS[Arity+1] = ARG2;
ptr = RepAppl(t)+1;
for (i=1;i<=Arity;i++) {
XREGS[i] = *ptr++;
}
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,11), mod);
ptr = RepPair(t);
XREGS[11] = ARG10;
XREGS[10] = ARG9;
XREGS[9] = ARG8;
XREGS[8] = ARG7;
XREGS[7] = ARG6;
XREGS[6] = ARG5;
XREGS[5] = ARG4;
XREGS[4] = ARG3;
XREGS[3] = ARG2;
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
ARG5 = ARG6;
ARG6 = ARG7;
ARG7 = ARG8;
ARG8 = ARG9;
ARG9 = ARG10;
pe = PredPropByFunc(MkFunctor(a, 9),mod);
return (CallPredicate(RepPredProp(pe), B));
}
@ -783,24 +1099,66 @@ p_execute_10(void)
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG12));
Prop pe;
Atom a;
if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/11");
return(FALSE);
if (IsAtomTerm(t)) {
Atom a;
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
ARG5 = ARG6;
ARG6 = ARG7;
ARG7 = ARG8;
ARG8 = ARG9;
ARG9 = ARG10;
ARG10 = ARG11;
pe = PredPropByFunc(MkFunctor(a,10),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
Atom a;
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/11");
return(FALSE);
}
Arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+10), mod);
XREGS[Arity+10] = ARG11;
XREGS[Arity+9] = ARG10;
XREGS[Arity+8] = ARG9;
XREGS[Arity+7] = ARG8;
XREGS[Arity+6] = ARG7;
XREGS[Arity+5] = ARG6;
XREGS[Arity+4] = ARG5;
XREGS[Arity+3] = ARG4;
XREGS[Arity+2] = ARG3;
XREGS[Arity+1] = ARG2;
ptr = RepAppl(t)+1;
for (i=1;i<=Arity;i++) {
XREGS[i] = *ptr++;
}
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,12), mod);
ptr = RepPair(t);
XREGS[12] = ARG11;
XREGS[11] = ARG10;
XREGS[10] = ARG9;
XREGS[9] = ARG8;
XREGS[8] = ARG7;
XREGS[7] = ARG6;
XREGS[6] = ARG5;
XREGS[5] = ARG4;
XREGS[4] = ARG3;
XREGS[3] = ARG2;
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
ARG5 = ARG6;
ARG6 = ARG7;
ARG7 = ARG8;
ARG8 = ARG9;
ARG9 = ARG10;
ARG10 = ARG11;
pe = PredPropByFunc(MkFunctor(a, 10),mod);
return (CallPredicate(RepPredProp(pe), B));
}
@ -1204,19 +1562,15 @@ p_restore_regs2(void)
Error(INSTANTIATION_ERROR,t,"support for coroutining");
return(FALSE);
}
d0 = Deref(ARG2);
if (!IsAtomTerm(t)) {
restore_regs(t);
}
d0 = Deref(ARG2);
if (IsVarTerm(d0)) {
Error(INSTANTIATION_ERROR,d0,"support for coroutining");
return(FALSE);
}
#if SBA
if (!IsIntegerTerm(d0)) {
#else
if (!IsIntTerm(d0)) {
#endif
return(FALSE);
}
#if SBA

1
C/save.c
View File

@ -1475,6 +1475,7 @@ Restore(char *s)
break;
case DO_ONLY_CODE:
UnmarkTrEntries();
InitYaamRegs();
break;
}
ReOpenLoadForeign();

2
C/unify.c
View File

@ -408,9 +408,9 @@ oc_unify_var_nvar:
/* d0 and pt1 are unbound */
UnifyCells(pt0, pt1, uc1, uc2);
#ifdef COROUTINING
uc1:
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) WakeUp(pt0);
uc1:
#endif
return (TRUE);
#ifdef COROUTINING

16
C/utilpreds.c
View File

@ -86,7 +86,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
*ptf = AbsPair(H);
ptf++;
#ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)H0) {
if (to_visit + 4 >= (CELL **)GlobalBase) {
goto heap_overflow;
}
to_visit[0] = pt0;
@ -98,7 +98,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
to_visit += 4;
#else
if (pt0 < pt0_end) {
if (to_visit + 3 >= (CELL **)H0) {
if (to_visit + 3 >= (CELL **)GlobalBase) {
goto heap_overflow;
}
to_visit[0] = pt0;
@ -136,7 +136,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
ptf++;
/* store the terms to visit */
#ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)H0) {
if (to_visit + 4 >= (CELL **)GlobalBase) {
goto heap_overflow;
}
to_visit[0] = pt0;
@ -148,7 +148,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
to_visit += 4;
#else
if (pt0 < pt0_end) {
if (to_visit + 3 >= (CELL **)H0) {
if (to_visit + 3 >= (CELL **)GlobalBase) {
goto heap_overflow;
}
to_visit[0] = pt0;
@ -422,7 +422,7 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
*ptf = AbsPair(H);
ptf++;
#ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)H0) {
if (to_visit + 4 >= (CELL **)GlobalBase) {
goto heap_overflow;
}
to_visit[0] = pt0;
@ -434,7 +434,7 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
to_visit += 4;
#else
if (pt0 < pt0_end) {
if (to_visit + 3 >= (CELL **)H0) {
if (to_visit + 3 >= (CELL **)GlobalBase) {
goto heap_overflow;
}
to_visit[0] = pt0;
@ -470,7 +470,7 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
ptf++;
/* store the terms to visit */
#ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)H0) {
if (to_visit + 4 >= (CELL **)GlobalBase) {
goto heap_overflow;
}
to_visit[0] = pt0;
@ -481,7 +481,7 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
*pt0 = AbsAppl(H);
to_visit += 4;
#else
if (to_visit + 3 >= (CELL **)H0) {
if (to_visit + 3 >= (CELL **)GlobalBase) {
goto heap_overflow;
}
if (pt0 < pt0_end) {

5
H/absmi.h
View File

@ -978,7 +978,7 @@ Macros to check the limits of stacks
if((b) <= H) { BIND_GLOBAL2((b),(CELL) (a),l2,l1); } \
else if ((a) <= H) { Bind_Local((b),(CELL) (a)); goto l1;} \
else { Bind_Local((a),(CELL) (b)); goto l1;} \
}
} else goto l1;
/* I know (a) <= H */
#define UnifyGlobalRegCells(a, b, l1, l2) \
@ -987,7 +987,8 @@ Macros to check the limits of stacks
} else if((a) < (b)){ \
if((b) <= H) { BIND_GLOBAL2((b),(CELL) (a),l2,l1); } \
Bind_Local((b),(CELL) (a)); \
}
goto l1; \
} else goto l1;
#else
#define UnifyCells(a, b, l1, l2) \

12
H/rheap.h
View File

@ -327,12 +327,12 @@ restore_codes(void)
if (heap_regs->spy_code != NULL)
heap_regs->spy_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->spy_code));
#ifdef COROUTINING
if (heap_regs->wake_up_code != NULL)
heap_regs->wake_up_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->wake_up_code));
heap_regs->mutable_list =
AbsAppl(PtoGloAdjust(RepAppl(heap_regs->mutable_list)));
heap_regs->atts_mutable_list =
AbsAppl(PtoGloAdjust(RepAppl(heap_regs->atts_mutable_list)));
if (heap_regs->wake_up_code != NULL)
heap_regs->wake_up_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->wake_up_code));
heap_regs->mutable_list =
AbsAppl(PtoGloAdjust(RepAppl(heap_regs->mutable_list)));
heap_regs->atts_mutable_list =
AbsAppl(PtoGloAdjust(RepAppl(heap_regs->atts_mutable_list)));
#endif
if (heap_regs->last_wtime != NULL)
heap_regs->last_wtime = (void *)PtoHeapCellAdjust((CELL *)(heap_regs->last_wtime));

2
changes4.3.html
View File

@ -17,6 +17,8 @@
<h2>Yap-4.3.23:</h2>
<ul>
<li>NEW: call_with_args/n simulates call/n.</li>
<li>FIXED: have different types for Atom,Term, and Functor in c_interface.</li>
<li>FIXED: make call_with_args/* check if first arg is atom.</li>
<li>FIXED: make cd/1 complain on bugs.</li>
<li>FIXED: always do something on gmp allocation (request from

8
docs/yap.tex
View File

@ -2239,6 +2239,14 @@ Meta-call where @var{Name} is the name of the procedure to be called and
the @var{Ai} are the arguments. The number of arguments varies between 0
and 10.
If @var{Name} is a complex term, then @code{call_with_args/n} behaves as
@code{call/n}:
@example
call(p(X1,...,Xm), Y1,...,Yn) :- p(X1,...,Xm,Y1,...,Yn).
@end example
@item +@var{P}
The same as @code{call(@var{P})}. This feature has been kept to provide
compatibility with C-Prolog. When compiling a goal, YAP

3
pl/corout.yap
View File

@ -107,7 +107,8 @@
'$execute_woken_system_goal'('$redo_ground'(Done, X, Goal), _) :-
'$redo_ground'(Done, X, Goal).
'$execute_woken_system_goal'('$att_do'(V,New), _) :-
attributes:woken_att_do(V,New).
% make sure we are not trying to wake up again a bound variable.
( '$att_bound'(V) -> attributes:woken_att_do(V,New) ; true ).
freeze(V, G) :-
var(V), !,