From c27b23f3a57c6c851559486d43ff1db4b0ef2bd0 Mon Sep 17 00:00:00 2001 From: vsc Date: Wed, 17 Jul 2002 20:25:30 +0000 Subject: [PATCH] miscellaneous fixes git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@556 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/alloc.c | 15 +- C/attvar.c | 14 +- C/dbase.c | 2 + C/exec.c | 594 ++++++++++++++++++++++++++++++++++++++---------- C/save.c | 1 + C/unify.c | 2 +- C/utilpreds.c | 16 +- H/absmi.h | 5 +- H/rheap.h | 12 +- changes4.3.html | 2 + docs/yap.tex | 8 + pl/corout.yap | 3 +- 12 files changed, 531 insertions(+), 143 deletions(-) diff --git a/C/alloc.c b/C/alloc.c index c3cde8afa..c466893b0 100644 --- a/C/alloc.c +++ b/C/alloc.c @@ -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); } diff --git a/C/attvar.c b/C/attvar.c index 8e639d56f..c8affbaa3 100644 --- a/C/attvar.c +++ b/C/attvar.c @@ -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 */ diff --git a/C/dbase.c b/C/dbase.c index 2df6968cb..1cf3a70cb 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -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))); diff --git a/C/exec.c b/C/exec.c index f85a941d7..12f4ff131 100644 --- a/C/exec.c +++ b/C/exec.c @@ -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 diff --git a/C/save.c b/C/save.c index cc2f36eca..485a07d50 100644 --- a/C/save.c +++ b/C/save.c @@ -1475,6 +1475,7 @@ Restore(char *s) break; case DO_ONLY_CODE: UnmarkTrEntries(); + InitYaamRegs(); break; } ReOpenLoadForeign(); diff --git a/C/unify.c b/C/unify.c index 9f7d4af2b..e83690f01 100644 --- a/C/unify.c +++ b/C/unify.c @@ -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 diff --git a/C/utilpreds.c b/C/utilpreds.c index 9188aef02..5bb6cbfec 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -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) { diff --git a/H/absmi.h b/H/absmi.h index 525db7ac4..eabcefcf7 100644 --- a/H/absmi.h +++ b/H/absmi.h @@ -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) \ diff --git a/H/rheap.h b/H/rheap.h index fbc1b0c42..55e4a489f 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -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)); diff --git a/changes4.3.html b/changes4.3.html index 492764f19..0acef41a0 100644 --- a/changes4.3.html +++ b/changes4.3.html @@ -17,6 +17,8 @@

Yap-4.3.23: