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

imore SWI compat, including string fixes

Browse Source
This commit is contained in:
Vítor Santos Costa 2010-06-19 00:38:49 +01:00
parent d1d149b9fd
commit bd50f087e9
4 changed files with 142 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
C/bignum.c
View File

@ -242,6 +242,86 @@ p_rational(void)
#endif
}
Term
Yap_MkBlobStringTerm(const char *s, size_t len)
{
CELL *ret = H;
size_t sz;
MP_INT *dst = (MP_INT *)(H+2);
blob_string_t *sp;
size_t siz;
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 = (sizeof(size_t)+len+sizeof(CELL))/sizeof(CELL);
dst->_mp_size = siz;
dst->_mp_alloc = 0L;
sp = (blob_string_t *)(dst+1);
sp->len = sz;
strncpy((char *)(sp+1), s, sz);
H += siz;
H[0] = EndSpecials;
H++;
return AbsAppl(ret);
}
Term
Yap_MkBlobWideStringTerm(const wchar_t *s, size_t len)
{
CELL *ret = H;
size_t sz;
MP_INT *dst = (MP_INT *)(H+2);
blob_string_t *sp;
size_t siz;
sz = wcslen(s);
if (len > 0 && sz > len) sz = len;
if (len/sizeof(CELL) > (ASP-ret)-1024) {
return TermNil;
}
H[0] = (CELL)FunctorBigInt;
H[1] = BLOB_WIDE_STRING;
siz = (sizeof(size_t)+(len+2)*sizeof(wchar_t))/sizeof(CELL);
dst->_mp_size = siz;
dst->_mp_alloc = 0L;
sp = (blob_string_t *)(dst+1);
sp->len = sz;
wcsncpy((wchar_t *)(sp+1), s, sz);
H += siz;
H[0] = EndSpecials;
H++;
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)
{

31
H/TermExt.h
View File

@ -75,7 +75,8 @@ typedef enum
ARRAY_INT = 0x21,
ARRAY_FLOAT = 0x22,
CLAUSE_LIST = 0x40,
STRING = 0x80, /* unsupported, reserved */
BLOB_STRING = 0x80, /* SWI style strings */
BLOB_WIDE_STRING = 0x81, /* SWI style strings */
EXTERNAL_BLOB = 0x100 /* for SWI emulation */
}
big_blob_type;
@ -385,6 +386,34 @@ IsLargeIntTerm (Term t)
#endif
typedef struct string_struct {
size_t len;
} blob_string_t;
Term STD_PROTO (Yap_MkBlobStringTerm, (const char *, size_t len));
Term STD_PROTO (Yap_MkBlobWideStringTerm, (const wchar_t *, size_t len));
char *STD_PROTO (Yap_BlobStringOfTerm, (Term));
wchar_t *STD_PROTO (Yap_BlobWideStringOfTerm, (Term));
char *STD_PROTO (Yap_BlobStringOfTermAndLength, (Term, size_t *));
inline EXTERN int IsBlobStringTerm (Term);
inline EXTERN int
IsBlobStringTerm (Term t)
{
return (int) (IsApplTerm (t) &&
FunctorOfTerm (t) == FunctorBigInt &&
(RepAppl(t)[1] & BLOB_STRING) == BLOB_STRING);
}
inline EXTERN int
IsWideBlobString (Term t)
{
return (int) (IsApplTerm (t) &&
FunctorOfTerm (t) == FunctorBigInt &&
RepAppl(t)[1] == BLOB_WIDE_STRING);
}
/* extern Functor FunctorLongInt; */
inline EXTERN int IsLargeNumTerm (Term);

2
include/SWI-Prolog.h
View File

@ -380,7 +380,6 @@ extern X_API int PL_get_name_arity(term_t, atom_t *, int *);
extern X_API int PL_get_nil(term_t);
extern X_API int PL_get_pointer(term_t, void **);
extern X_API int PL_get_intptr(term_t, intptr_t *);
extern X_API int PL_get_string(term_t, char **, int *);
extern X_API int PL_get_tail(term_t, term_t);
/* end PL_get_* functions =============================*/
/* begin PL_new_* functions =============================*/
@ -409,6 +408,7 @@ extern X_API int PL_put_list_chars(term_t, const char *);
extern X_API void PL_put_nil(term_t);
extern X_API int PL_put_pointer(term_t, void *);
extern X_API int PL_put_string_chars(term_t, const char *);
extern X_API int PL_put_string_nchars(term_t, size_t, const char *);
extern X_API int PL_put_term(term_t, term_t);
extern X_API int PL_put_variable(term_t);
extern X_API int PL_compare(term_t, term_t);

67
library/yap2swi/yap2swi.c
View File

@ -417,22 +417,22 @@ X_API int PL_get_atom_chars(term_t ts, char **a) /* SAM check type */
BUF_MALLOC Data is copied to a new buffer returned by malloc(3)
*/
static int CvtToStringTerm(YAP_Term t, char *buf, char *buf_max)
static int CvtToStringTerm(Term t, char *buf, char *buf_max)
{
while (YAP_IsPairTerm(t)) {
YAP_Term hd = YAP_HeadOfTerm(t);
while (IsPairTerm(t)) {
YAP_Term hd = HeadOfTerm(t);
long int i;
if (!YAP_IsIntTerm(hd))
if (!IsVarTerm(hd) || !IsIntTerm(hd))
return 0;
i = YAP_IntOfTerm(hd);
i = IntOfTerm(hd);
if (i <= 0 || i >= 255)
return 0;
if (!YAP_IsIntTerm(hd))
if (!IsIntTerm(hd))
return 0;
*buf++ = i;
if (buf == buf_max)
return 0;
t = YAP_TailOfTerm(t);
t = TailOfTerm(t);
}
if (t != TermNil)
return 0;
@ -534,7 +534,10 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
if (!(flags & (CVT_FLOAT|CVT_ATOMIC|CVT_NUMBER|CVT_ALL)))
return 0;
snprintf(tmp,BUF_SIZE,"%f",YAP_FloatOfTerm(t));
} else if (flags & (CVT_LIST|CVT_LIST)) {
} else if (flags & (CVT_STRING)) {
char *s = Yap_BlobStringOfTerm(t);
strncat(tmp, s, BUF_SIZE-1);
} else if (flags & CVT_LIST) {
if (CvtToStringTerm(t,tmp,tmp+BUF_SIZE) == 0)
return 0;
} else {
@ -669,6 +672,17 @@ X_API int PL_get_head(term_t ts, term_t h)
return 1;
}
X_API int PL_get_string_chars(term_t t, char **s, size_t *len)
{
Term tt = Yap_GetFromSlot(t);
if (!IsBlobStringTerm(tt)) {
return 0;
}
*s = Yap_BlobStringOfTermAndLength(tt, len);
return TRUE;
}
/* SWI: int PL_get_integer(term_t t, int *i)
YAP: long int YAP_IntOfTerm(Term) */
X_API int PL_get_integer(term_t ts, int *i)
@ -875,24 +889,6 @@ X_API int PL_get_pointer(term_t ts, void **i)
return 1;
}
/* SWI: int PL_get_atom_chars(term_t t, char **s)
YAP: char* AtomName(Atom) */
X_API int PL_get_string(term_t ts, char **sp, int *lenp) /* SAM check type */
{
YAP_Term t = Yap_GetFromSlot(ts);
char *to;
int len;
if (!YAP_IsPairTerm(t))
return 0;
if (!YAP_StringToBuffer(t, buffers, TMP_BUF_SIZE))
return(FALSE);
len = strlen(buffers);
to = (char *)Yap_NewSlots((len/sizeof(YAP_Term))+1);
strncpy(to, buffers, TMP_BUF_SIZE);
*sp = to;
return 1;
}
X_API int PL_get_tail(term_t ts, term_t tl)
{
YAP_Term t = Yap_GetFromSlot(ts);
@ -1244,9 +1240,13 @@ X_API int PL_put_pointer(term_t t, void *ptr)
return TRUE;
}
X_API int PL_put_string_chars(term_t t, const char *s)
X_API int PL_put_string_nchars(term_t t, size_t len, const char *chars)
{
Yap_PutInSlot(t,YAP_BufferToString((char *)s));
Term tt;
if ((tt = Yap_MkBlobStringTerm(chars, len)) == TermNil)
return FALSE;
Yap_PutInSlot(t,tt);
return TRUE;
}
@ -1796,6 +1796,8 @@ X_API int PL_unify_wchars(term_t t, int type, size_t len, const pl_wchar_t *char
}
break;
case PL_STRING:
chterm = Yap_MkBlobWideStringTerm(chars, len);
break;
case PL_CODE_LIST:
chterm = YAP_NWideBufferToString(chars, len);
break;
@ -1824,7 +1826,6 @@ X_API int PL_unify_wchars_diff(term_t t, term_t tail, int type, size_t len, cons
len = wcslen(chars);
switch (type) {
case PL_STRING:
case PL_CODE_LIST:
chterm = YAP_NWideBufferToDiffList(chars, Yap_GetFromSlot(tail), len);
break;
@ -1963,7 +1964,7 @@ X_API int PL_unify_term(term_t l,...)
*pt++ = MkFloatTerm(va_arg(ap, double));
break;
case PL_STRING:
*pt++ = YAP_BufferToString(va_arg(ap, char *));
*pt++ = Yap_MkBlobStringTerm(va_arg(ap, char *), -1);
break;
case PL_CHARS:
{
@ -2149,12 +2150,6 @@ X_API void PL_unregister_atom(atom_t atom)
Yap_AtomDecreaseHold(SWIAtomToAtom(atom));
}
X_API int PL_get_string_chars(term_t t, char **s, size_t *len)
{
/* there are no such objects in Prolog */
return FALSE;
}
X_API int PL_term_type(term_t t)
{
/* YAP_ does not support strings as different objects */