more robust support for attributed vars: all_attvars and stack
expansion. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1366 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
101abc67d0
commit
b18224a460
47
C/attvar.c
47
C/attvar.c
@ -437,20 +437,31 @@ GetAllAtts(attvar_record *attv) {
|
|||||||
|
|
||||||
static Term
|
static Term
|
||||||
AllAttVars(Term t) {
|
AllAttVars(Term t) {
|
||||||
if (t == TermNil) {
|
CELL *h0 = H;
|
||||||
return t;
|
|
||||||
} else {
|
while (t != TermNil) {
|
||||||
attvar_record *attv = (attvar_record *)VarOfTerm(t);
|
attvar_record *attv;
|
||||||
if (!IsVarTerm(attv->Done) || !IsUnboundVar(&attv->Done))
|
|
||||||
return AllAttVars(attv->NS);
|
if (ASP - H < 1024) {
|
||||||
else return MkPairTerm(t,AllAttVars(attv->NS));
|
H = h0;
|
||||||
|
return 0L;
|
||||||
|
}
|
||||||
|
attv = (attvar_record *)VarOfTerm(t);
|
||||||
|
if (IsVarTerm(attv->Done) && IsUnboundVar(&attv->Done)) {
|
||||||
|
if (H != h0) {
|
||||||
|
H[-1] = AbsPair(H);
|
||||||
|
}
|
||||||
|
H[0] = t;
|
||||||
|
H += 2;
|
||||||
|
}
|
||||||
|
t = attv->NS;
|
||||||
|
}
|
||||||
|
if (H != h0) {
|
||||||
|
H[-1] = TermNil;
|
||||||
|
return AbsPair(h0);
|
||||||
|
} else {
|
||||||
|
return TermNil;
|
||||||
}
|
}
|
||||||
}
|
|
||||||
|
|
||||||
Term
|
|
||||||
Yap_CurrentAttVars(void) {
|
|
||||||
return(AllAttVars(Yap_ReadTimedVar(AttsMutableList)));
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -650,8 +661,14 @@ p_n_atts(void)
|
|||||||
static Int
|
static Int
|
||||||
p_all_attvars(void)
|
p_all_attvars(void)
|
||||||
{
|
{
|
||||||
Term t = Yap_ReadTimedVar(AttsMutableList);
|
Term t = Yap_ReadTimedVar(AttsMutableList), out;
|
||||||
return Yap_unify(ARG1,AllAttVars(t));
|
while ((out = AllAttVars(t)) == 0L) {
|
||||||
|
if (!Yap_gc(1, ENV, P)) {
|
||||||
|
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return Yap_unify(ARG1,out);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
|
4
C/grow.c
4
C/grow.c
@ -22,6 +22,7 @@
|
|||||||
#include "alloc.h"
|
#include "alloc.h"
|
||||||
#include "sshift.h"
|
#include "sshift.h"
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
|
#include "attvar.h"
|
||||||
#if HAVE_STRING_H
|
#if HAVE_STRING_H
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
#endif
|
#endif
|
||||||
@ -590,8 +591,11 @@ static_growglobal(long size, CELL **ptr)
|
|||||||
{
|
{
|
||||||
UInt start_growth_time, growth_time;
|
UInt start_growth_time, growth_time;
|
||||||
int gc_verbose;
|
int gc_verbose;
|
||||||
|
char *omax = (ADDR)DelayTop();
|
||||||
|
|
||||||
/* adjust to a multiple of 256) */
|
/* adjust to a multiple of 256) */
|
||||||
|
if (size < (omax-Yap_GlobalBase)/8)
|
||||||
|
size = (omax-Yap_GlobalBase)/8;
|
||||||
size = AdjustPageSize(size);
|
size = AdjustPageSize(size);
|
||||||
Yap_ErrorMessage = NULL;
|
Yap_ErrorMessage = NULL;
|
||||||
if (!Yap_ExtendWorkSpace(size)) {
|
if (!Yap_ExtendWorkSpace(size)) {
|
||||||
|
@ -10,7 +10,7 @@
|
|||||||
* File: Yap.proto *
|
* File: Yap.proto *
|
||||||
* mods: *
|
* mods: *
|
||||||
* comments: Function declarations for YAP *
|
* comments: Function declarations for YAP *
|
||||||
* version: $Id: Yapproto.h,v 1.59 2005-08-04 15:45:53 ricroc Exp $ *
|
* version: $Id: Yapproto.h,v 1.60 2005-08-17 20:13:49 vsc Exp $ *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
|
|
||||||
/* prototype file for Yap */
|
/* prototype file for Yap */
|
||||||
@ -91,7 +91,6 @@ void STD_PROTO(Yap_InitAnalystPreds,(void));
|
|||||||
void STD_PROTO(Yap_InitArrayPreds,(void));
|
void STD_PROTO(Yap_InitArrayPreds,(void));
|
||||||
|
|
||||||
/* attvar.c */
|
/* attvar.c */
|
||||||
Term STD_PROTO(Yap_CurrentAttVars,(void));
|
|
||||||
void STD_PROTO(Yap_InitAttVarPreds,(void));
|
void STD_PROTO(Yap_InitAttVarPreds,(void));
|
||||||
|
|
||||||
/* bb.c */
|
/* bb.c */
|
||||||
|
@ -14,14 +14,6 @@
|
|||||||
* comments: boot file for Prolog *
|
* comments: boot file for Prolog *
|
||||||
* *
|
* *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
% process an input clause
|
|
||||||
|
|
||||||
'$test'(I,D,H,[Y|L]) :-
|
|
||||||
arg(I,D,X), ( X=':' ; integer(X)),
|
|
||||||
arg(I,H,Y), var(Y), !,
|
|
||||||
I1 is I-1,
|
|
||||||
'$module_u_vars'(I1,D,H,L).
|
|
||||||
|
|
||||||
|
|
||||||
% This one should come first so that disjunctions and long distance
|
% This one should come first so that disjunctions and long distance
|
||||||
% cuts are compiled right with co-routining.
|
% cuts are compiled right with co-routining.
|
||||||
|
Reference in New Issue
Block a user