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

improve string support

Browse Source 
fix non-thread compilation.
This commit is contained in:
Vítor Santos Costa 2011-03-11 23:21:23 +00:00
parent d42db0dc5c
commit 0d6be2d858
12 changed files with 92 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
C/bignum.c
View File

@ -245,6 +245,36 @@ p_rational( USES_REGS1 )
#endif
}
int
Yap_IsStringTerm(Term t)
{
CELL fl;
if (IsVarTerm(t))
return FALSE;
if (!IsApplTerm(t))
return FALSE;
if (FunctorOfTerm(t) != FunctorBigInt)
return FALSE;
fl = RepAppl(t)[1];
return fl == BLOB_STRING || fl == BLOB_WIDE_STRING;
}
int
Yap_IsWideStringTerm(Term t)
{
CELL fl;
if (IsVarTerm(t))
return FALSE;
if (!IsApplTerm(t))
return FALSE;
if (FunctorOfTerm(t) != FunctorBigInt)
return FALSE;
fl = RepAppl(t)[1];
return fl == BLOB_WIDE_STRING;
}
Term
Yap_MkBlobStringTerm(const char *s, size_t len)
{
@ -267,8 +297,10 @@ Yap_MkBlobStringTerm(const char *s, size_t len)
dst->_mp_size = siz;
dst->_mp_alloc = 0L;
sp = (blob_string_t *)(dst+1);
H = (CELL *)sp;
sp->len = sz;
strncpy((char *)(sp+1), s, sz);
strncpy((char *)(sp+1), s, sz+1);
fprintf(stderr,"%s\n", (char *)(sp+1));
H += siz;
H[0] = EndSpecials;
H++;
@ -297,6 +329,7 @@ Yap_MkBlobWideStringTerm(const wchar_t *s, size_t len)
dst->_mp_size = siz;
dst->_mp_alloc = 0L;
sp = (blob_string_t *)(dst+1);
H = (CELL *)sp;
sp->len = sz;
wcsncpy((wchar_t *)(sp+1), s, sz);
H += siz;

4
C/c_interface.c
View File

@ -3498,14 +3498,14 @@ X_API int
YAP_Erase(void *handle)
{
DBRecordList *dbr = (DBRecordList *)handle;
Yap_ReleaseTermFromDB(dbr->dbrecord);
if (dbr->next_rec)
dbr->next_rec->prev_rec = dbr->prev_rec;
if (dbr->prev_rec)
dbr->next_rec->prev_rec = dbr->next_rec;
dbr->prev_rec->next_rec = dbr->next_rec;
else if (Yap_Records == dbr) {
Yap_Records = dbr->next_rec;
}
Yap_ReleaseTermFromDB(dbr->dbrecord);
Yap_FreeCodeSpace(handle);
return 1;
}

6
C/init.c
View File

@ -1257,16 +1257,20 @@ InitCodes(void)
{
CACHE_REGS
int wid;
for (wid = 1; wid < MAX_INITS; wid++) {
#if THREADS
for (wid = 1; wid < MAX_INITS; wid++) {
Yap_WLocal[wid] = NULL;
}
#endif
#include "ihstruct.h"
#if THREADS
Yap_InitThread(0);
#endif
InitGlobal();
InitWorker(0);
#if THREADS
InitFirstWorkerThreadHandle();
#endif
/* make sure no one else can use these two atoms */
CurrentModule = 0;
Yap_ReleaseAtom(AtomOfTerm(TermReFoundVar));

19
C/stdpreds.c
View File

@ -1652,15 +1652,22 @@ p_atom_codes( USES_REGS1 )
Term NewT;
Atom at;
if (!IsAtomTerm(t1)) {
if (Yap_IsStringTerm(t1)) {
if (Yap_IsWideStringTerm(t1)) {
NewT = Yap_WideStringToList(Yap_BlobWideStringOfTerm(t1));
} else {
NewT = Yap_StringToList(Yap_BlobStringOfTerm(t1));
}
} else if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1, "atom_codes/2");
return(FALSE);
}
at = AtomOfTerm(t1);
if (IsWideAtom(at)) {
NewT = Yap_WideStringToList((wchar_t *)RepAtom(at)->StrOfAE);
} else {
NewT = Yap_StringToList(RepAtom(at)->StrOfAE);
at = AtomOfTerm(t1);
if (IsWideAtom(at)) {
NewT = Yap_WideStringToList((wchar_t *)RepAtom(at)->StrOfAE);
} else {
NewT = Yap_StringToList(RepAtom(at)->StrOfAE);
}
}
return (Yap_unify(NewT, ARG2));
} else {

2
H/Yapproto.h
View File

@ -116,6 +116,8 @@ void STD_PROTO(Yap_InitBBPreds,(void));
/* bignum.c */
Term STD_PROTO(Yap_MkULLIntTerm, (YAP_ULONG_LONG));
int STD_PROTO(Yap_IsStringTerm, (Term));
int STD_PROTO(Yap_IsWideStringTerm, (Term));
Term STD_PROTO(Yap_RatTermToApplTerm, (Term));
void STD_PROTO(Yap_InitBigNums, (void));

2
include/SWI-Prolog.h
View File

@ -142,6 +142,8 @@ typedef wchar_t pl_wchar_t; /* wide character support */
typedef uintptr_t PL_fid_t; /* opaque foreign context handle */
#endif
#define O_STRING 1
typedef void *pl_function_t;
#define fid_t PL_fid_t /* avoid AIX name-clash */

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

@ -1792,22 +1792,8 @@ X_API int PL_is_number(term_t ts)
X_API int PL_is_string(term_t ts)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
while (YAP_IsPairTerm(t)) {
YAP_Term hd = YAP_HeadOfTerm(t);
long int i;
if (!YAP_IsIntTerm(hd))
return 0;
i = YAP_IntOfTerm(hd);
if (i <= 0 || i >= 255)
return 0;
if (!YAP_IsIntTerm(hd))
return 0;
t = YAP_TailOfTerm(t);
}
if (t != TermNil)
return 0;
return FALSE;
Term t = Yap_GetFromSlot(ts PASS_REGS);
return Yap_IsStringTerm(t);
}
X_API int PL_is_variable(term_t ts)

3
packages/PLStream/pl-file.c
View File

@ -4672,6 +4672,7 @@ EndPredDefs
#if __YAP_PROLOG__
static int
pl_get_time(term_t t)
{ return PL_unify_float(t, WallTime());
}
@ -4728,10 +4729,12 @@ struct PL_local_data *Yap_InitThreadIO(int wid)
Yap_Error(OUT_OF_HEAP_ERROR, 0L, "Creating thread %d\n", wid);
return p;
}
#if THREADS
if (wid) {
/* copy from other worker */
memcpy(p, Yap_WLocal[worker_id]->Yap_ld_, sizeof(struct PL_local_data));
}
#endif
return p;
}

4
packages/PLStream/pl-incl.h
View File

@ -597,9 +597,11 @@ extern void PL_cleanup_fork(void);
extern int PL_rethrow(void);
extern void PL_get_number(term_t l, number *n);
extern int PL_unify_atomic(term_t t, PL_atomic_t a);
extern int _PL_unify_atomic(term_t t, PL_atomic_t a);
extern int _PL_unify_string(term_t t, word w);
#define _PL_get_arg(X,Y,Z) PL_get_arg(X,Y,Z)
#define _PL_unify_atomic PL_unify_atomic
extern IOSTREAM ** /* provide access to Suser_input, */
_PL_streams(void); /* Suser_output and Suser_error */

2
packages/PLStream/pl-text.c
View File

@ -353,7 +353,7 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
{ word w = textToString(text);
if ( w )
return _PL_unify_atomic(term, w);
return _PL_unify_string(term, w);
else
return FALSE;
}

41
packages/PLStream/pl-yap.c
View File

@ -77,15 +77,13 @@ codeToAtom(int chrcode)
word
globalString(size_t size, char *s)
{
// return YAP_MkBlobStringTerm(s, size);
return 0L;
return Yap_MkBlobStringTerm(s, size);
}
word
globalWString(size_t size, wchar_t *s)
{
// return YAP_MkBlobWideStringTerm(size, s);
return 0L;
return Yap_MkBlobWideStringTerm(s, size);
}
int
@ -282,6 +280,13 @@ _PL_unify_atomic(term_t t, PL_atomic_t a)
return PL_unify_atom(t, a);
}
int
_PL_unify_string(term_t t, word w)
{
GET_LD
return Yap_unify(Yap_GetFromSlot(t PASS_REGS), w);
}
word lookupAtom(const char *s, size_t len)
{
/* dirty trick to ensure s is null terminated */
@ -377,7 +382,21 @@ get_atom_text(atom_t atom, PL_chars_t *text)
int
get_string_text(word w, PL_chars_t *text ARG_LD)
{ fail;
{
CELL fl = RepAppl(w)[1];
if (fl == BLOB_STRING) {
fprintf(stderr,"%s\n", Yap_BlobStringOfTerm(w));
text->text.t = Yap_BlobStringOfTerm(w);
text->encoding = ENC_ISO_LATIN_1;
text->length = strlen(text->text.t);
} else {
text->text.w = Yap_BlobWideStringOfTerm(w);
text->encoding = ENC_WCHAR;
text->length = wcslen(text->text.w);
}
text->storage = PL_CHARS_STACK;
text->canonical = TRUE;
return TRUE;
}
void
@ -1067,18 +1086,6 @@ recursiveMutexInit(recursiveMutex *m)
}
word
pl_sleep(term_t time)
{ double t;
if ( PL_get_float_ex(time, &t) )
return Pause(t);
fail;
}
counting_mutex _PL_mutexes[] =
{ COUNT_MUTEX_INITIALIZER("L_MISC"),
COUNT_MUTEX_INITIALIZER("L_ALLOC"),

2
packages/PLStream/pl-yap.h
View File

@ -115,7 +115,7 @@ void PL_license(const char *license, const char *module);
#define stringAtom(w) YAP_AtomName((YAP_Atom)(w))
#define isInteger(A) (YAP_IsIntTerm((A)) || YAP_IsBigNumTerm((A)))
#define isString(A) FALSE
#define isString(A) Yap_IsStringTerm(A)
#define isAtom(A) YAP_IsAtomTerm((A))
#define isList(A) YAP_IsPairTerm((A))
#define isNil(A) ((A) == YAP_TermNil())