diff --git a/C/bignum.c b/C/bignum.c index 3430c74bc..c38ee385a 100755 --- a/C/bignum.c +++ b/C/bignum.c @@ -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) { diff --git a/H/TermExt.h b/H/TermExt.h index 320dac9a5..5a68e9690 100644 --- a/H/TermExt.h +++ b/H/TermExt.h @@ -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); diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index e7d697ab8..0a60ca54c 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -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); diff --git a/library/yap2swi/yap2swi.c b/library/yap2swi/yap2swi.c index 03cd7deb9..857a22e2f 100755 --- a/library/yap2swi/yap2swi.c +++ b/library/yap2swi/yap2swi.c @@ -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 */