diff --git a/C/bignum.c b/C/bignum.c index 63505914e..1957654db 100755 --- a/C/bignum.c +++ b/C/bignum.c @@ -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; diff --git a/C/c_interface.c b/C/c_interface.c index 0026665f0..6fa78626a 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -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; } diff --git a/C/init.c b/C/init.c index a22889bf5..c28504ffd 100755 --- a/C/init.c +++ b/C/init.c @@ -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)); diff --git a/C/stdpreds.c b/C/stdpreds.c index 53397d4cd..b2cb3fdc9 100755 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -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 { diff --git a/H/Yapproto.h b/H/Yapproto.h index ad091cebd..ba1a3b992 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -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)); diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index 539ac9c78..aa0e3b5ce 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -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 */ diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 908a0c3e1..e82ce3ebd 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -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) diff --git a/packages/PLStream/pl-file.c b/packages/PLStream/pl-file.c index 74ca92376..56e9d0378 100755 --- a/packages/PLStream/pl-file.c +++ b/packages/PLStream/pl-file.c @@ -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; } diff --git a/packages/PLStream/pl-incl.h b/packages/PLStream/pl-incl.h index 539ad0a29..ef1052a32 100755 --- a/packages/PLStream/pl-incl.h +++ b/packages/PLStream/pl-incl.h @@ -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 */ diff --git a/packages/PLStream/pl-text.c b/packages/PLStream/pl-text.c index 502369820..1493f5c01 100644 --- a/packages/PLStream/pl-text.c +++ b/packages/PLStream/pl-text.c @@ -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; } diff --git a/packages/PLStream/pl-yap.c b/packages/PLStream/pl-yap.c index 90310f17a..8613056db 100755 --- a/packages/PLStream/pl-yap.c +++ b/packages/PLStream/pl-yap.c @@ -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"), diff --git a/packages/PLStream/pl-yap.h b/packages/PLStream/pl-yap.h index 1b1795c76..5173aa710 100644 --- a/packages/PLStream/pl-yap.h +++ b/packages/PLStream/pl-yap.h @@ -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())