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

fixes for export_term and friends.

Browse Source
This commit is contained in:
Vítor Santos Costa 2012-02-02 23:25:09 +00:00
parent c60514f89b
commit 6eea1fe1ea
4 changed files with 83 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
C/c_interface.c
View File

@ -558,11 +558,22 @@ X_API YAP_tag_t STD_PROTO(YAP_TagOfTerm,(Term));
X_API size_t STD_PROTO(YAP_ExportTerm,(Term, char *, size_t));
X_API Term STD_PROTO(YAP_ImportTerm,(char *));
static UInt
current_arity(void)
{
if (P && PREVOP(P,Osbpp)->opc == Yap_opcode(_call_usercpred)) {
return PREVOP(P,Osbpp)->u.Osbpp.p->ArityOfPE;
} else {
return 0;
}
}
static int
dogc( USES_REGS1 )
dogc( int extra_args, Term *tp USES_REGS )
{
UInt arity;
yamop *nextpc;
int i;
if (P && PREVOP(P,Osbpp)->opc == Yap_opcode(_call_usercpred)) {
arity = PREVOP(P,Osbpp)->u.Osbpp.p->ArityOfPE;
@ -571,9 +582,15 @@ dogc( USES_REGS1 )
arity = 0;
nextpc = CP;
}
if (!Yap_gc(arity, ENV, nextpc)) {
for (i=0; i < extra_args; i++) {
XREGS[arity+i+1] = tp[i];
}
if (!Yap_gc(arity+extra_args, ENV, nextpc)) {
return FALSE;
}
for (i=0; i < extra_args; i++) {
tp[i] = XREGS[arity+i+1];
}
return TRUE;
}
@ -973,7 +990,7 @@ YAP_MkPairTerm(Term t1, Term t2)
Int sl1 = Yap_InitSlot(t1 PASS_REGS);
Int sl2 = Yap_InitSlot(t2 PASS_REGS);
RECOVER_H();
if (!dogc( PASS_REGS1 )) {
if (!dogc( 0, NULL PASS_REGS )) {
return TermNil;
}
BACKUP_H();
@ -998,7 +1015,7 @@ YAP_MkListFromTerms(Term *ta, Int sz)
while (H+sz*2 > ASP-1024) {
Int sl1 = Yap_InitSlot((CELL)ta PASS_REGS);
RECOVER_H();
if (!dogc( PASS_REGS1 )) {
if (!dogc( 0, NULL PASS_REGS )) {
return TermNil;
}
BACKUP_H();
@ -2026,7 +2043,7 @@ YAP_ReadBuffer(char *s, Term *tp)
while ((t = Yap_StringToTerm(s,tp)) == 0L) {
if (LOCAL_ErrorMessage) {
if (!strcmp(LOCAL_ErrorMessage,"Stack Overflow")) {
if (!dogc( PASS_REGS1 )) {
if (!dogc( 0, NULL PASS_REGS )) {
*tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
LOCAL_ErrorMessage = NULL;
RECOVER_H();
@ -3555,7 +3572,7 @@ YAP_FloatsToList(double *dblp, size_t sz)
/* we are in trouble */
LOCAL_OpenArray = (CELL *)dblp;
}
if (!dogc( PASS_REGS1 )) {
if (!dogc( 0, NULL PASS_REGS )) {
RECOVER_H();
return 0L;
}
@ -3583,7 +3600,7 @@ YAP_OpenList(int n)
BACKUP_H();
while (H+2*n > ASP-1024) {
if (!dogc( PASS_REGS1 )) {
if (!dogc( 0, NULL PASS_REGS )) {
RECOVER_H();
return FALSE;
}
@ -3988,9 +4005,13 @@ YAP_IsNumberedVariable(Term t) {
X_API size_t
YAP_ExportTerm(Term inp, char * buf, size_t len) {
size_t res;
if (!len)
return 0;
return Yap_ExportTerm(inp, buf, len);
if ((res = Yap_ExportTerm(inp, buf, len, current_arity())) < 0) {
exit(1);
}
return res;
}
X_API Term

103
C/utilpreds.c
View File

@ -1171,7 +1171,7 @@ CELL *CellDifH(CELL *hptr, CELL *hlow)
#define AdjustSizeAtom(X) ((char *)(((CELL)X+7) & (CELL)(-8)))
static inline
Atom export_atom(Atom at, char **hpp, size_t len)
Atom export_atom(Atom at, char **hpp, char *buf, size_t len)
{
char *ptr, *p0;
size_t sz;
@ -1197,21 +1197,22 @@ Atom export_atom(Atom at, char **hpp, size_t len)
*hpp = ptr+(sz+1);
}
ptr += sz;
return (Atom)p0;
return (Atom)(p0-buf);
}
static inline
Functor export_functor(Functor f, char **hpp, size_t len)
Functor export_functor(Functor f, char **hpp, char *buf, size_t len)
{
CELL *hptr = (UInt *)AdjustSizeAtom(*hpp);
UInt arity = ArityOfFunctor(f);
if (2*sizeof(CELL) >= len)
return (Functor)NULL;
return NULL;
hptr[0] = arity;
*hpp = (char *)(hptr+1);
if (!export_atom(NameOfFunctor(f), hpp, len))
return 0L;
return (Functor)hptr;
if (!export_atom(NameOfFunctor(f), hpp, buf, len))
return NULL;
/* increment so that it cannot be mistaken with a standard functor */
return (Functor)(((char *)hptr-buf)+1);
}
#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \
@ -1229,7 +1230,7 @@ export_term_to_buffer(Term inpt, char *buf, char *bptr, CELL *t0 , CELL *tf, siz
{
char *td = bptr;
CELL *bf = (CELL *)buf;
if (buf + len < (char *)(td + (tf-t0)))
if (buf + len < (char *)((CELL *)td + (tf-t0)))
return FALSE;
memcpy((void *)td, (void *)t0, (tf-t0)* sizeof(CELL));
bf[0] = (td-buf);
@ -1246,7 +1247,7 @@ export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0,
CELL *HB0 = HB;
tr_fr_ptr TR0 = TR;
int ground = TRUE;
char *bptr = buf+ 3*sizeof(CELL), *bptr_end;
char *bptr = buf+ 3*sizeof(CELL);
size_t len = len0;
HB = HLow;
@ -1368,14 +1369,14 @@ export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0,
if (H > ASP - 2048) {
goto overflow;
}
ptf[-1] = (CELL)export_functor(f, &bptr, len);
ptf[-1] = (CELL)export_functor(f, &bptr, buf, len);
len = len0 - (bptr-buf);
if (H > ASP - 2048) {
goto overflow;
}
} else {
if (IsAtomTerm(d0)) {
*ptf = MkAtomTerm(export_atom(AtomOfTerm(d0), &bptr, len));
*ptf = MkAtomTerm(export_atom(AtomOfTerm(d0), &bptr, buf, len));
ptf++;
len = len0 - (bptr-buf);
} else {
@ -1508,24 +1509,27 @@ static size_t
ExportTerm(Term inp, char * buf, size_t len, UInt arity, int newattvs USES_REGS) {
Term t = Deref(inp);
tr_fr_ptr TR0 = TR;
size_t res;
size_t res = 0;
CELL *Hi;
restart:
Hi = H;
if ((res = export_complex_term(inp, &t-1, &t, buf, len, newattvs, Hi, Hi PASS_REGS)) < 0) {
H = Hi;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
goto restart;
}
do {
if ((Int)res < 0) {
H = Hi;
TR = TR0;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return res;
}
Hi = H;
TR0 = TR;
res = export_complex_term(inp, &t-1, &t, buf, len, newattvs, Hi, Hi PASS_REGS);
} while ((Int)res < 0);
return res;
}
size_t
Yap_ExportTerm(Term inp, char * buf, size_t len) {
Yap_ExportTerm(Term inp, char * buf, size_t len, UInt arity) {
CACHE_REGS
return ExportTerm(inp, buf, len, 0, TRUE PASS_REGS);
return ExportTerm(inp, buf, len, arity, TRUE PASS_REGS);
}
@ -1536,9 +1540,9 @@ ShiftPtr(CELL t, char *base)
}
static Atom
AddAtom(Atom t)
AddAtom(Atom t, char *buf)
{
char *s = (char *)t;
char *s = buf+(UInt)t;
if (!*s) {
return Yap_LookupAtom(s+1);
} else {
@ -1548,71 +1552,68 @@ AddAtom(Atom t)
}
static UInt
FetchFunctor(CELL *pt)
FetchFunctor(CELL *pt, char *buf)
{
CELL *ptr = (CELL *)(*pt);
CELL *ptr = (CELL *)(buf+(*pt-1));
// do arity first
UInt arity = *ptr;
char *name;
UInt arity = *ptr++;
Atom name, at;
// and then an atom
++ptr;
name = (char *)ptr;
name = AdjustSizeAtom(name);
*pt = (CELL)Yap_MkFunctor(AddAtom((Atom)name), arity);
ptr = (CELL *)AdjustSizeAtom((char*)ptr);
name = (Atom)((char *)ptr-buf);
at = AddAtom(name, buf);
*pt = (CELL)Yap_MkFunctor(at, arity);
return arity;
}
static CELL *import_compound(CELL *hp, char *abase, CELL *amax);
static CELL *import_pair(CELL *hp, char *abase, CELL *amax);
static CELL *import_compound(CELL *hp, char *abase, char *buf, CELL *amax);
static CELL *import_pair(CELL *hp, char *abase, char *buf, CELL *amax);
static CELL *
import_arg(CELL *hp, char *abase, CELL *amax)
import_arg(CELL *hp, char *abase, char *buf, CELL *amax)
{
Term t = *hp;
fprintf(stderr,"t = %lx\n", t);
if (IsVarTerm(t)) {
hp[0] = (CELL)ShiftPtr(t, abase);
} else if (IsAtomTerm(t)) {
hp[0] = MkAtomTerm(AddAtom(AtomOfTerm(t)));
hp[0] = MkAtomTerm(AddAtom(AtomOfTerm(t), buf));
} else if (IsPairTerm(t)) {
fprintf(stderr,"amax = %p newp=%p\n", amax, RepPair(t));
CELL *newp = ShiftPtr((CELL)RepPair(t), abase);
hp[0] = AbsPair(newp);
if (newp > amax) {
amax = import_pair(newp, abase, newp);
amax = import_pair(newp, abase, buf, newp);
}
} else if (IsApplTerm(t)) {
fprintf(stderr,"amax = %p newp=%p\n", amax, RepAppl(t));
CELL *newp = ShiftPtr((CELL)RepAppl(t), abase);
hp[0] = AbsAppl(newp);
if (newp > amax) {
amax = import_compound(newp, abase, newp);
amax = import_compound(newp, abase, buf, newp);
}
}
return amax;
}
static CELL *
import_compound(CELL *hp, char *abase, CELL *amax)
import_compound(CELL *hp, char *abase, char *buf, CELL *amax)
{
Functor f = (Functor)*hp;
UInt ar, i;
if (IsExtensionFunctor(f))
if (!((CELL)f & 1) && IsExtensionFunctor(f))
return amax;
ar = FetchFunctor(hp);
ar = FetchFunctor(hp, buf);
for (i=1; i<=ar; i++) {
amax = import_arg(hp+i, abase, amax);
amax = import_arg(hp+i, abase, buf, amax);
}
return amax;
}
static CELL *
import_pair(CELL *hp, char *abase, CELL *amax)
import_pair(CELL *hp, char *abase, char *buf, CELL *amax)
{
amax = import_arg(hp, abase, amax);
amax = import_arg(hp+1, abase, amax);
amax = import_arg(hp, abase, buf, amax);
amax = import_arg(hp+1, abase, buf, amax);
return amax;
}
@ -1638,10 +1639,10 @@ Yap_ImportTerm(char * buf) {
memcpy(H, buf+bc[0], sizeof(CELL)*sz);
if (IsApplTerm(tinp)) {
tret = AbsAppl(H);
import_compound(H, (char *)H, H);
import_compound(H, (char *)H, buf, H);
} else {
tret = AbsPair(H);
import_pair(H, (char *)H, H);
import_pair(H, (char *)H, buf, H);
}
H += sz;
return tret;
@ -1656,7 +1657,7 @@ static char export_debug_buf[2048];
static Int
p_export_term( USES_REGS1 )
{
Yap_ExportTerm(ARG1, export_debug_buf, 2048);
Yap_ExportTerm(ARG1, export_debug_buf, 2048, 1);
return TRUE;
}

2
H/Yapproto.h
View File

@ -389,7 +389,7 @@ void STD_PROTO(Yap_InitUserBacks,(void));
/* utilpreds.c */
Term STD_PROTO(Yap_CopyTerm,(Term));
int STD_PROTO(Yap_Variant,(Term, Term));
size_t STD_PROTO(Yap_ExportTerm,(Term, char *, size_t));
size_t STD_PROTO(Yap_ExportTerm,(Term, char *, size_t, UInt));
Term STD_PROTO(Yap_ImportTerm,(char *));
int STD_PROTO(Yap_IsListTerm,(Term));
Term STD_PROTO(Yap_CopyTermNoShare,(Term));

2
library/dialect/swi/fli/swi.c
View File

@ -1853,7 +1853,7 @@ PL_record_external
while(TRUE) {
if (!(s = Yap_AllocCodeSpace(len)))
return NULL;
if ((nsz = Yap_ExportTerm(t, s, len))) {
if ((nsz = Yap_ExportTerm(t, s, len, 0))) {
*sz = nsz;
return s;
} else {