use text routines from current SWI fli.
This commit is contained in:
Vitor Santos Costa
parent
45032cc61e
commit
2451a052cb
@ -435,6 +435,7 @@ extern X_API int PL_get_integer(term_t, int *);
|
||||
extern X_API int PL_get_list(term_t, term_t, term_t);
|
||||
extern X_API int PL_get_long(term_t, long *);
|
||||
extern X_API int PL_get_list_chars(term_t, char **, unsigned);
|
||||
extern X_API int PL_get_list_nchars(term_t, size_t *, char **, unsigned);
|
||||
extern X_API int PL_get_module(term_t, module_t *);
|
||||
extern X_API module_t PL_context(void);
|
||||
extern X_API int PL_strip_module(term_t, module_t *, term_t);
|
||||
|
||||
@ -132,57 +132,6 @@ UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int f
|
||||
CurrentModule = cm;
|
||||
}
|
||||
|
||||
static char *
|
||||
alloc_ring_buf(void)
|
||||
{
|
||||
SWI_buf_index++;
|
||||
if (SWI_buf_index == SWI_BUF_RINGS)
|
||||
SWI_buf_index = 0;
|
||||
if (SWI_buffers_sz[SWI_buf_index+1] == 0) {
|
||||
char * new;
|
||||
if (!(new = malloc(512))) {
|
||||
return NULL;
|
||||
}
|
||||
SWI_buffers_sz[SWI_buf_index+1] = 512;
|
||||
SWI_buffers[SWI_buf_index+1] = new;
|
||||
}
|
||||
return SWI_buffers[SWI_buf_index+1];
|
||||
}
|
||||
|
||||
static char *
|
||||
ensure_space(char **sp, size_t room, unsigned flags) {
|
||||
size_t min = 512;
|
||||
int i = 0;
|
||||
char *ptr = *sp;
|
||||
|
||||
if (room < SWI_BUF_SIZE)
|
||||
return *sp;
|
||||
while (min < room)
|
||||
min += 512;
|
||||
|
||||
if (flags & BUF_MALLOC) {
|
||||
PL_free(*sp);
|
||||
*sp = PL_malloc(room);
|
||||
return *sp;
|
||||
} else if (flags & BUF_RING) {
|
||||
for (i=1; i<= SWI_BUF_RINGS; i++)
|
||||
if (SWI_buffers[i] == ptr)
|
||||
break;
|
||||
} else {
|
||||
i = 0;
|
||||
}
|
||||
if (SWI_buffers_sz[i] >= room)
|
||||
return ptr;
|
||||
free(SWI_buffers[i]);
|
||||
SWI_buffers[i] = malloc(min);
|
||||
if (SWI_buffers[i])
|
||||
SWI_buffers_sz[i] = min;
|
||||
else
|
||||
SWI_buffers_sz[i] = 0;
|
||||
*sp = SWI_buffers[i];
|
||||
return *sp;
|
||||
}
|
||||
|
||||
/* SWI: void PL_agc_hook(void) */
|
||||
|
||||
X_API PL_agc_hook_t
|
||||
@ -373,31 +322,6 @@ X_API int PL_get_atom_nchars(term_t ts, size_t *len, char **s) /* SAM check typ
|
||||
BUF_MALLOC Data is copied to a new buffer returned by malloc(3)
|
||||
*/
|
||||
|
||||
static int CvtToStringTerm(Term t, char *buf, char *buf_max)
|
||||
{
|
||||
while (IsPairTerm(t)) {
|
||||
YAP_Term hd = HeadOfTerm(t);
|
||||
long int i;
|
||||
if (IsVarTerm(hd) || !IsIntTerm(hd))
|
||||
return 0;
|
||||
i = IntOfTerm(hd);
|
||||
if (i <= 0 || i >= 255)
|
||||
return 0;
|
||||
*buf++ = i;
|
||||
if (buf == buf_max)
|
||||
return 0;
|
||||
t = TailOfTerm(t);
|
||||
if (IsVarTerm(t))
|
||||
return 0;
|
||||
}
|
||||
if (t != TermNil)
|
||||
return 0;
|
||||
if (buf+1 == buf_max)
|
||||
return 0;
|
||||
buf[0] = '\0';
|
||||
return 1;
|
||||
}
|
||||
|
||||
#if !HAVE_SNPRINTF
|
||||
#define snprintf(X,Y,Z,A) sprintf(X,Z,A)
|
||||
#endif
|
||||
@ -423,203 +347,6 @@ static int do_yap_putc(int sno, wchar_t ch) {
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
static int
|
||||
CvtToGenericTerm(Term t, char *tmp, unsigned flags, char **sp)
|
||||
{
|
||||
int wflags = 0;
|
||||
|
||||
putc_cur_buf = putc_curp = tmp;
|
||||
putc_cur_flags = flags;
|
||||
if ((flags & BUF_RING)) {
|
||||
putc_cur_lim = tmp+(SWI_TMP_BUF_SIZE-1);
|
||||
} else {
|
||||
putc_cur_lim = tmp+(SWI_BUF_SIZE-1);
|
||||
}
|
||||
if (flags & CVT_WRITE_CANONICAL) {
|
||||
wflags |= (YAP_WRITE_IGNORE_OPS|YAP_WRITE_QUOTED);
|
||||
}
|
||||
Yap_plwrite(t, do_yap_putc, wflags, 1200);
|
||||
if (putc_cur_buf == putc_cur_lim)
|
||||
return 0;
|
||||
*putc_curp = '\0';
|
||||
/* may have changed due to overflows */
|
||||
*sp = putc_cur_buf;
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int
|
||||
cv_error(unsigned flags)
|
||||
{
|
||||
if (flags & CVT_EXCEPTION) {
|
||||
YAP_Error(0, 0L, "PL_get_chars");
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
|
||||
{
|
||||
YAP_Term t = Yap_GetFromSlot(l);
|
||||
char *tmp;
|
||||
|
||||
if ((flags & BUF_RING)) {
|
||||
tmp = alloc_ring_buf();
|
||||
} else if ((flags & BUF_MALLOC)) {
|
||||
tmp = PL_malloc(SWI_BUF_SIZE);
|
||||
} else {
|
||||
tmp = SWI_buffers[0];
|
||||
}
|
||||
*sp = tmp;
|
||||
if (IsVarTerm(t)) {
|
||||
if (!(flags & (CVT_VARIABLE|CVT_WRITE|CVT_WRITE_CANONICAL)))
|
||||
return cv_error(flags);
|
||||
if (!CvtToGenericTerm(t, tmp, flags, sp))
|
||||
return 0;
|
||||
} else if (IsAtomTerm(t)) {
|
||||
Atom at = AtomOfTerm(t);
|
||||
if (!(flags & (CVT_ATOM|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
|
||||
return cv_error(flags);
|
||||
if (IsWideAtom(at)) {
|
||||
wchar_t* s = RepAtom(at)->WStrOfAE;
|
||||
size_t sz = wcslen(s)+1;
|
||||
if (!(tmp = ensure_space(sp, sz*sizeof(wchar_t), flags)))
|
||||
return 0;
|
||||
memcpy(*sp,s,sz*sizeof(wchar_t));
|
||||
} else {
|
||||
char *s = RepAtom(at)->StrOfAE;
|
||||
size_t sz = strlen(s)+1;
|
||||
|
||||
if (!(tmp = ensure_space(sp, sz, flags)))
|
||||
return 0;
|
||||
memcpy(*sp,s,sz);
|
||||
}
|
||||
} else if (IsNumTerm(t)) {
|
||||
if (IsFloatTerm(t)) {
|
||||
if (!(flags & (CVT_FLOAT|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
|
||||
return cv_error(flags);
|
||||
snprintf(tmp,SWI_BUF_SIZE,"%f",FloatOfTerm(t));
|
||||
#if USE_GMP
|
||||
} else if (YAP_IsBigNumTerm(t)) {
|
||||
if (!(flags & (CVT_FLOAT|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
|
||||
return cv_error(flags);
|
||||
MP_INT g;
|
||||
YAP_BigNumOfTerm(t, (void *)&g);
|
||||
if (mpz_sizeinbase(&g,2) > SWI_BUF_SIZE-1) {
|
||||
return 0;
|
||||
}
|
||||
mpz_get_str (tmp, 10, &g);
|
||||
#endif
|
||||
} else {
|
||||
if (!(flags & (CVT_INTEGER|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
|
||||
return cv_error(flags);
|
||||
snprintf(tmp,SWI_BUF_SIZE,Int_FORMAT,IntegerOfTerm(t));
|
||||
}
|
||||
} else if (IsPairTerm(t)) {
|
||||
if (!(flags & (CVT_LIST|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL))) {
|
||||
return cv_error(flags);
|
||||
}
|
||||
if (CvtToStringTerm(t,tmp,tmp+SWI_BUF_SIZE) == 0) {
|
||||
if (flags & (CVT_WRITE|CVT_WRITE_CANONICAL)) {
|
||||
if (!CvtToGenericTerm(t, tmp, flags, sp))
|
||||
return 0;
|
||||
} else {
|
||||
return cv_error(flags);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
#if USE_GMP
|
||||
if (IsBigIntTerm(t)) {
|
||||
if (!(flags & (CVT_INTEGER|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
|
||||
return cv_error(flags);
|
||||
Yap_gmp_to_string(t, tmp, SWI_BUF_SIZE-1, 10);
|
||||
} else
|
||||
#endif
|
||||
if (IsBlobStringTerm(t)) {
|
||||
if (!(flags & (CVT_STRING|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL))) {
|
||||
return cv_error(flags);
|
||||
} else {
|
||||
char *s = Yap_BlobStringOfTerm(t);
|
||||
strncat(tmp, s, SWI_BUF_SIZE-1);
|
||||
}
|
||||
} else {
|
||||
if (!(flags & (CVT_WRITE|CVT_WRITE_CANONICAL))) {
|
||||
return cv_error(flags);
|
||||
}
|
||||
if (!CvtToGenericTerm(t, tmp, flags, sp))
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
if (flags & BUF_MALLOC) {
|
||||
size_t sz = strlen(tmp);
|
||||
char *nbf = PL_malloc(sz+1);
|
||||
if (!nbf)
|
||||
return 0;
|
||||
memcpy(nbf,tmp,sz+1);
|
||||
free(tmp);
|
||||
*sp = nbf;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
X_API int PL_get_nchars(term_t l, size_t *len, char **sp, unsigned flags)
|
||||
{
|
||||
int out = PL_get_chars(l, sp, flags);
|
||||
if (!out) return out;
|
||||
if (len)
|
||||
*len = strlen(*sp);
|
||||
return out;
|
||||
}
|
||||
|
||||
|
||||
/* same as get_chars, but works on buffers of wide chars */
|
||||
X_API int PL_get_wchars(term_t l, size_t *len, wchar_t **wsp, unsigned flags)
|
||||
{
|
||||
unsigned nflags = ((CVT_MASK & flags) | (CVT_EXCEPTION & flags) | BUF_MALLOC);
|
||||
size_t room;
|
||||
wchar_t *buf, *wbuf = NULL;
|
||||
size_t sz, i;
|
||||
char *sp, *sp0;
|
||||
Term t = Yap_GetFromSlot(l);
|
||||
|
||||
if (!IsVarTerm(t) && IsAtomTerm(t) && IsWideAtom(AtomOfTerm(t))) {
|
||||
if (!(flags & (CVT_ATOM|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
|
||||
return cv_error(flags);
|
||||
wbuf = RepAtom(AtomOfTerm(t))->WStrOfAE;
|
||||
sz = wcslen(wbuf);
|
||||
*len = sz;
|
||||
} else {
|
||||
if (!PL_get_nchars(l, &sz, &sp, nflags))
|
||||
return 0;
|
||||
if (len)
|
||||
*len = sz;
|
||||
}
|
||||
room = (sz+1)*sizeof(wchar_t);
|
||||
if (flags & BUF_MALLOC) {
|
||||
*wsp = buf = (wchar_t *)PL_malloc(room);
|
||||
} else if (flags & BUF_RING) {
|
||||
*wsp = (wchar_t *)alloc_ring_buf();
|
||||
buf = (wchar_t *)ensure_space((char **)wsp, room, flags);
|
||||
} else {
|
||||
*wsp = (wchar_t *)SWI_buffers[0];
|
||||
buf = (wchar_t *)ensure_space((char **)wsp, room, flags);
|
||||
}
|
||||
if (!buf) {
|
||||
if (flags & CVT_EXCEPTION)
|
||||
YAP_Error(0, 0L, "PL_get_wchars: buf_discardable too small for %ld wchars", sz);
|
||||
return 0;
|
||||
}
|
||||
if (wbuf) {
|
||||
wcsncpy(buf, wbuf, sz);
|
||||
} else {
|
||||
sp0 = sp;
|
||||
buf[sz] = '\0';
|
||||
for (i=0; i< sz; i++)
|
||||
*buf++ = *sp++;
|
||||
free(sp0);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
/* SWI: int PL_get_functor(term_t t, functor_t *f)
|
||||
YAP: YAP_Functor YAP_FunctorOfTerm(Term) */
|
||||
X_API int PL_get_functor(term_t ts, functor_t *f)
|
||||
@ -807,13 +534,6 @@ X_API int PL_get_list(term_t ts, term_t h, term_t tl)
|
||||
return 1;
|
||||
}
|
||||
|
||||
X_API int PL_get_list_chars(term_t l, char **sp, unsigned flags)
|
||||
{
|
||||
if (flags & (CVT_ATOM|CVT_STRING|CVT_INTEGER|CVT_FLOAT|CVT_NUMBER|CVT_ATOMIC|CVT_VARIABLE|CVT_ALL))
|
||||
return 0;
|
||||
return PL_get_chars(l, sp, CVT_LIST|flags);
|
||||
}
|
||||
|
||||
/* SWI: int PL_get_module(term_t t, module_t *m) */
|
||||
X_API int PL_get_module(term_t ts, module_t *m)
|
||||
{
|
||||
|
||||
@ -593,6 +593,89 @@ promoteToFloatNumber(Number n)
|
||||
|
||||
|
||||
|
||||
int
|
||||
PL_get_list_nchars(term_t l, size_t *length, char **s, unsigned int flags)
|
||||
{ Buffer b;
|
||||
CVT_result result;
|
||||
|
||||
if ( (b = codes_or_chars_to_buffer(l, flags, FALSE, &result)) )
|
||||
{ char *r;
|
||||
size_t len = entriesBuffer(b, char);
|
||||
|
||||
if ( length )
|
||||
*length = len;
|
||||
addBuffer(b, EOS, char);
|
||||
r = baseBuffer(b, char);
|
||||
|
||||
if ( flags & BUF_MALLOC )
|
||||
{ *s = PL_malloc(len+1);
|
||||
memcpy(*s, r, len+1);
|
||||
unfindBuffer(flags);
|
||||
} else
|
||||
*s = r;
|
||||
|
||||
succeed;
|
||||
}
|
||||
|
||||
fail;
|
||||
}
|
||||
|
||||
int
|
||||
PL_get_list_chars(term_t l, char **s, unsigned flags)
|
||||
{ return PL_get_list_nchars(l, NULL, s, flags);
|
||||
}
|
||||
|
||||
|
||||
int
|
||||
PL_get_wchars(term_t l, size_t *length, pl_wchar_t **s, unsigned flags)
|
||||
{ GET_LD
|
||||
PL_chars_t text;
|
||||
|
||||
if ( !PL_get_text(l, &text, flags) )
|
||||
return FALSE;
|
||||
|
||||
PL_promote_text(&text);
|
||||
PL_save_text(&text, flags);
|
||||
|
||||
if ( length )
|
||||
*length = text.length;
|
||||
*s = text.text.w;
|
||||
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
|
||||
int
|
||||
PL_get_nchars(term_t l, size_t *length, char **s, unsigned flags)
|
||||
{ GET_LD
|
||||
PL_chars_t text;
|
||||
|
||||
if ( !PL_get_text(l, &text, flags) )
|
||||
return FALSE;
|
||||
|
||||
if ( PL_mb_text(&text, flags) )
|
||||
{ PL_save_text(&text, flags);
|
||||
|
||||
if ( length )
|
||||
*length = text.length;
|
||||
*s = text.text.t;
|
||||
|
||||
return TRUE;
|
||||
} else
|
||||
{ PL_free_text(&text);
|
||||
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
int
|
||||
PL_get_chars(term_t t, char **s, unsigned flags)
|
||||
{ return PL_get_nchars(t, NULL, s, flags);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
X_API int
|
||||
PL_ttymode(IOSTREAM *s)
|
||||
|
||||
Reference in New Issue
Block a user