improve C-interface and SWI comptaibility a bit.
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2292 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
778215b85c
commit
e1866e2917
97
C/adtdefs.c
97
C/adtdefs.c
|
|
@ -1009,7 +1009,20 @@ Yap_StringToList(char *s)
|
|||
}
|
||||
|
||||
Term
|
||||
Yap_WStringToList(wchar_t *s)
|
||||
Yap_NStringToList(char *s, size_t len)
|
||||
{
|
||||
Term t;
|
||||
char *cp = s + len;
|
||||
|
||||
t = MkAtomTerm(AtomNil);
|
||||
while (cp > s) {
|
||||
t = MkPairTerm(MkIntegerTerm(*--cp), t);
|
||||
}
|
||||
return t;
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_WideStringToList(wchar_t *s)
|
||||
{
|
||||
Term t;
|
||||
wchar_t *cp = s + wcslen(s);
|
||||
|
|
@ -1021,6 +1034,19 @@ Yap_WStringToList(wchar_t *s)
|
|||
return t;
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_NWideStringToList(wchar_t *s, size_t len)
|
||||
{
|
||||
Term t;
|
||||
wchar_t *cp = s + len;
|
||||
|
||||
t = MkAtomTerm(AtomNil);
|
||||
while (cp > s) {
|
||||
t = MkPairTerm(MkIntegerTerm(*--cp), t);
|
||||
}
|
||||
return t;
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_StringToDiffList(char *s, Term t)
|
||||
{
|
||||
|
|
@ -1032,6 +1058,39 @@ Yap_StringToDiffList(char *s, Term t)
|
|||
return t;
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_NStringToDiffList(char *s, Term t, size_t len)
|
||||
{
|
||||
register unsigned char *cp = (unsigned char *)s + len;
|
||||
|
||||
while (cp > (unsigned char *)s) {
|
||||
t = MkPairTerm(MkIntTerm(*--cp), t);
|
||||
}
|
||||
return t;
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_WideStringToDiffList(wchar_t *s, Term t)
|
||||
{
|
||||
wchar_t *cp = s + wcslen(s);
|
||||
|
||||
while (cp > s) {
|
||||
t = MkPairTerm(MkIntegerTerm(*--cp), t);
|
||||
}
|
||||
return t;
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_NWideStringToDiffList(wchar_t *s, Term t, size_t len)
|
||||
{
|
||||
wchar_t *cp = s + len;
|
||||
|
||||
while (cp > s) {
|
||||
t = MkPairTerm(MkIntegerTerm(*--cp), t);
|
||||
}
|
||||
return t;
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_StringToListOfAtoms(char *s)
|
||||
{
|
||||
|
|
@ -1045,11 +1104,27 @@ Yap_StringToListOfAtoms(char *s)
|
|||
so[0] = *--cp;
|
||||
t = MkPairTerm(MkAtomTerm(LookupAtom(so)), t);
|
||||
}
|
||||
return (t);
|
||||
return t;
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_WStringToListOfAtoms(wchar_t *s)
|
||||
Yap_NStringToListOfAtoms(char *s, size_t len)
|
||||
{
|
||||
register Term t;
|
||||
char so[2];
|
||||
register unsigned char *cp = (unsigned char *)s + len;
|
||||
|
||||
so[1] = '\0';
|
||||
t = MkAtomTerm(AtomNil);
|
||||
while (cp > (unsigned char *)s) {
|
||||
so[0] = *--cp;
|
||||
t = MkPairTerm(MkAtomTerm(LookupAtom(so)), t);
|
||||
}
|
||||
return t;
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_WideStringToListOfAtoms(wchar_t *s)
|
||||
{
|
||||
register Term t;
|
||||
wchar_t so[2];
|
||||
|
|
@ -1064,6 +1139,22 @@ Yap_WStringToListOfAtoms(wchar_t *s)
|
|||
return t;
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_NWideStringToListOfAtoms(wchar_t *s, size_t len)
|
||||
{
|
||||
register Term t;
|
||||
wchar_t so[2];
|
||||
wchar_t *cp = s + len;
|
||||
|
||||
so[1] = '\0';
|
||||
t = MkAtomTerm(AtomNil);
|
||||
while (cp > s) {
|
||||
so[0] = *--cp;
|
||||
t = MkPairTerm(MkAtomTerm(LookupWideAtom(so)), t);
|
||||
}
|
||||
return t;
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_ArrayToList(register Term *tp, int nof)
|
||||
{
|
||||
|
|
|
|||
146
C/c_interface.c
146
C/c_interface.c
|
|
@ -10,8 +10,12 @@
|
|||
* File: c_interface.c *
|
||||
* comments: c_interface primitives definition *
|
||||
* *
|
||||
* Last rev: $Date: 2008-07-11 17:02:07 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-07-24 16:02:00 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.120 2008/07/11 17:02:07 vsc
|
||||
* fixes by Bart and Tom: mostly libraries but nasty one in indexing
|
||||
* compilation.
|
||||
*
|
||||
* Revision 1.119 2008/06/17 13:37:48 vsc
|
||||
* fix c_interface not to crash when people try to recover slots that are
|
||||
* not there.
|
||||
|
|
@ -411,7 +415,17 @@ X_API void STD_PROTO(YAP_FreeSpaceFromYap,(void *));
|
|||
X_API int STD_PROTO(YAP_StringToBuffer, (Term, char *, unsigned int));
|
||||
X_API Term STD_PROTO(YAP_ReadBuffer, (char *,Term *));
|
||||
X_API Term STD_PROTO(YAP_BufferToString, (char *));
|
||||
X_API Term STD_PROTO(YAP_NBufferToString, (char *, size_t));
|
||||
X_API Term STD_PROTO(YAP_WideBufferToString, (wchar_t *));
|
||||
X_API Term STD_PROTO(YAP_NWideBufferToString, (wchar_t *, size_t));
|
||||
X_API Term STD_PROTO(YAP_BufferToAtomList, (char *));
|
||||
X_API Term STD_PROTO(YAP_NBufferToAtomList, (char *,size_t));
|
||||
X_API Term STD_PROTO(YAP_WideBufferToAtomList, (wchar_t *));
|
||||
X_API Term STD_PROTO(YAP_NWideBufferToAtomList, (wchar_t *, size_t));
|
||||
X_API Term STD_PROTO(YAP_BufferToDiffList, (char *, Term));
|
||||
X_API Term STD_PROTO(YAP_NBufferToDiffList, (char *, Term, size_t));
|
||||
X_API Term STD_PROTO(YAP_WideBufferToDiffList, (wchar_t *, Term));
|
||||
X_API Term STD_PROTO(YAP_NWideBufferToDiffList, (wchar_t *, Term, size_t));
|
||||
X_API void STD_PROTO(YAP_Error,(int, Term, char *, ...));
|
||||
X_API Term STD_PROTO(YAP_RunGoal,(Term));
|
||||
X_API Term STD_PROTO(YAP_RunGoalOnce,(Term));
|
||||
|
|
@ -1230,6 +1244,45 @@ YAP_BufferToString(char *s)
|
|||
return t;
|
||||
}
|
||||
|
||||
/* copy a string to a buffer */
|
||||
X_API Term
|
||||
YAP_NBufferToString(char *s, size_t len)
|
||||
{
|
||||
Term t;
|
||||
BACKUP_H();
|
||||
|
||||
t = Yap_NStringToList(s, len);
|
||||
|
||||
RECOVER_H();
|
||||
return t;
|
||||
}
|
||||
|
||||
/* copy a string to a buffer */
|
||||
X_API Term
|
||||
YAP_WideBufferToString(wchar_t *s)
|
||||
{
|
||||
Term t;
|
||||
BACKUP_H();
|
||||
|
||||
t = Yap_WideStringToList(s);
|
||||
|
||||
RECOVER_H();
|
||||
return t;
|
||||
}
|
||||
|
||||
/* copy a string to a buffer */
|
||||
X_API Term
|
||||
YAP_NWideBufferToString(wchar_t *s, size_t len)
|
||||
{
|
||||
Term t;
|
||||
BACKUP_H();
|
||||
|
||||
t = Yap_NWideStringToList(s, len);
|
||||
|
||||
RECOVER_H();
|
||||
return t;
|
||||
}
|
||||
|
||||
/* copy a string to a buffer */
|
||||
X_API Term
|
||||
YAP_ReadBuffer(char *s, Term *tp)
|
||||
|
|
@ -1258,6 +1311,97 @@ YAP_BufferToAtomList(char *s)
|
|||
return t;
|
||||
}
|
||||
|
||||
/* copy a string of size len to a buffer */
|
||||
X_API Term
|
||||
YAP_NBufferToAtomList(char *s, size_t len)
|
||||
{
|
||||
Term t;
|
||||
BACKUP_H();
|
||||
|
||||
t = Yap_NStringToListOfAtoms(s, len);
|
||||
|
||||
RECOVER_H();
|
||||
return t;
|
||||
}
|
||||
|
||||
/* copy a string to a buffer */
|
||||
X_API Term
|
||||
YAP_WideBufferToAtomList(wchar_t *s)
|
||||
{
|
||||
Term t;
|
||||
BACKUP_H();
|
||||
|
||||
t = Yap_WideStringToListOfAtoms(s);
|
||||
|
||||
RECOVER_H();
|
||||
return t;
|
||||
}
|
||||
|
||||
/* copy a string of size len to a buffer */
|
||||
X_API Term
|
||||
YAP_NWideBufferToAtomList(wchar_t *s, size_t len)
|
||||
{
|
||||
Term t;
|
||||
BACKUP_H();
|
||||
|
||||
t = Yap_NWideStringToListOfAtoms(s, len);
|
||||
|
||||
RECOVER_H();
|
||||
return t;
|
||||
}
|
||||
|
||||
/* copy a string to a buffer */
|
||||
X_API Term
|
||||
YAP_BufferToDiffList(char *s, Term t0)
|
||||
{
|
||||
Term t;
|
||||
BACKUP_H();
|
||||
|
||||
t = Yap_StringToDiffList(s, t0);
|
||||
|
||||
RECOVER_H();
|
||||
return t;
|
||||
}
|
||||
|
||||
/* copy a string of size len to a buffer */
|
||||
X_API Term
|
||||
YAP_NBufferToDiffList(char *s, Term t0, size_t len)
|
||||
{
|
||||
Term t;
|
||||
BACKUP_H();
|
||||
|
||||
t = Yap_NStringToDiffList(s, t0, len);
|
||||
|
||||
RECOVER_H();
|
||||
return t;
|
||||
}
|
||||
|
||||
/* copy a string to a buffer */
|
||||
X_API Term
|
||||
YAP_WideBufferToDiffList(wchar_t *s, Term t0)
|
||||
{
|
||||
Term t;
|
||||
BACKUP_H();
|
||||
|
||||
t = Yap_WideStringToDiffList(s, t0);
|
||||
|
||||
RECOVER_H();
|
||||
return t;
|
||||
}
|
||||
|
||||
/* copy a string of size len to a buffer */
|
||||
X_API Term
|
||||
YAP_NWideBufferToDiffList(wchar_t *s, Term t0, size_t len)
|
||||
{
|
||||
Term t;
|
||||
BACKUP_H();
|
||||
|
||||
t = Yap_NWideStringToDiffList(s, t0, len);
|
||||
|
||||
RECOVER_H();
|
||||
return t;
|
||||
}
|
||||
|
||||
|
||||
X_API void
|
||||
YAP_Error(int myerrno, Term t, char *buf,...)
|
||||
|
|
|
|||
|
|
@ -3660,7 +3660,7 @@ syntax_error (TokEntry * tokptr, int sno)
|
|||
break;
|
||||
case WString_tok:
|
||||
{
|
||||
Term t0 = Yap_WStringToList((wchar_t *)info);
|
||||
Term t0 = Yap_WideStringToList((wchar_t *)info);
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("string"),1),1,&t0);
|
||||
}
|
||||
break;
|
||||
|
|
|
|||
|
|
@ -546,11 +546,11 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
|
|||
if (*p == 0)
|
||||
t = MkAtomTerm(AtomNil);
|
||||
else if (yap_flags[YAP_DOUBLE_QUOTES_FLAG] == STRING_AS_CHARS)
|
||||
t = Yap_WStringToListOfAtoms(p);
|
||||
t = Yap_WideStringToListOfAtoms(p);
|
||||
else if (yap_flags[YAP_DOUBLE_QUOTES_FLAG] == STRING_AS_ATOM)
|
||||
t = MkAtomTerm(Yap_LookupWideAtom(p));
|
||||
else
|
||||
t = Yap_WStringToList(p);
|
||||
t = Yap_WideStringToList(p);
|
||||
NextToken;
|
||||
}
|
||||
break;
|
||||
|
|
|
|||
13
C/stdpreds.c
13
C/stdpreds.c
|
|
@ -11,8 +11,11 @@
|
|||
* File: stdpreds.c *
|
||||
* comments: General-purpose C implemented system predicates *
|
||||
* *
|
||||
* Last rev: $Date: 2008-06-12 10:55:52 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-07-24 16:02:00 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.131 2008/06/12 10:55:52 vsc
|
||||
* fix syntax error messages
|
||||
*
|
||||
* Revision 1.130 2008/04/06 11:53:02 vsc
|
||||
* fix some restore bugs
|
||||
*
|
||||
|
|
@ -890,7 +893,7 @@ p_name(void)
|
|||
if (IsAtomTerm(AtomNameT)) {
|
||||
Atom at = AtomOfTerm(AtomNameT);
|
||||
if (IsWideAtom(at)) {
|
||||
NewT = Yap_WStringToList((wchar_t *)(RepAtom(at)->StrOfAE));
|
||||
NewT = Yap_WideStringToList((wchar_t *)(RepAtom(at)->StrOfAE));
|
||||
return Yap_unify(NewT, ARG2);
|
||||
} else
|
||||
String = RepAtom(at)->StrOfAE;
|
||||
|
|
@ -1051,9 +1054,9 @@ p_atom_chars(void)
|
|||
at = AtomOfTerm(t1);
|
||||
if (IsWideAtom(at)) {
|
||||
if (yap_flags[YAP_TO_CHARS_FLAG] == QUINTUS_TO_CHARS) {
|
||||
NewT = Yap_WStringToList((wchar_t *)RepAtom(at)->StrOfAE);
|
||||
NewT = Yap_WideStringToList((wchar_t *)RepAtom(at)->StrOfAE);
|
||||
} else {
|
||||
NewT = Yap_WStringToListOfAtoms((wchar_t *)RepAtom(AtomOfTerm(t1))->StrOfAE);
|
||||
NewT = Yap_WideStringToListOfAtoms((wchar_t *)RepAtom(AtomOfTerm(t1))->StrOfAE);
|
||||
}
|
||||
} else {
|
||||
if (yap_flags[YAP_TO_CHARS_FLAG] == QUINTUS_TO_CHARS) {
|
||||
|
|
@ -1606,7 +1609,7 @@ p_atom_codes(void)
|
|||
}
|
||||
at = AtomOfTerm(t1);
|
||||
if (IsWideAtom(at)) {
|
||||
NewT = Yap_WStringToList((wchar_t *)RepAtom(at)->StrOfAE);
|
||||
NewT = Yap_WideStringToList((wchar_t *)RepAtom(at)->StrOfAE);
|
||||
} else {
|
||||
NewT = Yap_StringToList(RepAtom(at)->StrOfAE);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -11,8 +11,11 @@
|
|||
* File: YapOpcodes.h *
|
||||
* comments: Central Table with all YAP opcodes *
|
||||
* *
|
||||
* Last rev: $Date: 2008-07-16 10:58:59 $ *
|
||||
* Last rev: $Date: 2008-07-24 16:02:01 $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.45 2008/07/16 10:58:59 vsc
|
||||
* small fixes
|
||||
*
|
||||
* Revision 1.44 2008/03/25 22:03:13 vsc
|
||||
* fix some icc warnings
|
||||
*
|
||||
|
|
@ -206,7 +209,7 @@
|
|||
OPCODE(unify_y_val ,oy),
|
||||
OPCODE(unify_atom ,oc),
|
||||
OPCODE(unify_float ,od),
|
||||
OPCODE(unify_longint ,oc),
|
||||
OPCODE(unify_longint ,oi),
|
||||
OPCODE(unify_bigint ,oc),
|
||||
OPCODE(unify_dbterm ,oc),
|
||||
OPCODE(unify_list ,o),
|
||||
|
|
|
|||
11
H/Yapproto.h
11
H/Yapproto.h
|
|
@ -10,7 +10,7 @@
|
|||
* File: Yap.proto *
|
||||
* mods: *
|
||||
* comments: Function declarations for YAP *
|
||||
* version: $Id: Yapproto.h,v 1.87 2008-06-17 13:37:49 vsc Exp $ *
|
||||
* version: $Id: Yapproto.h,v 1.88 2008-07-24 16:02:02 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* prototype file for Yap */
|
||||
|
|
@ -41,8 +41,17 @@ void STD_PROTO(Yap_MkFunctorWithAddress,(Atom,unsigned int,FunctorEntry *));
|
|||
void STD_PROTO(Yap_PutValue,(Atom,Term));
|
||||
void STD_PROTO(Yap_ReleaseAtom,(Atom));
|
||||
Term STD_PROTO(Yap_StringToList,(char *));
|
||||
Term STD_PROTO(Yap_NStringToList,(char *, size_t));
|
||||
Term STD_PROTO(Yap_WideStringToList,(wchar_t *));
|
||||
Term STD_PROTO(Yap_NWideStringToList,(wchar_t *, size_t));
|
||||
Term STD_PROTO(Yap_StringToDiffList,(char *,Term));
|
||||
Term STD_PROTO(Yap_NStringToDiffList,(char *,Term, size_t));
|
||||
Term STD_PROTO(Yap_WideStringToDiffList,(wchar_t *,Term));
|
||||
Term STD_PROTO(Yap_NWideStringToDiffList,(wchar_t *,Term, size_t));
|
||||
Term STD_PROTO(Yap_StringToListOfAtoms,(char *));
|
||||
Term STD_PROTO(Yap_NStringToListOfAtoms,(char *, size_t));
|
||||
Term STD_PROTO(Yap_WideStringToListOfAtoms,(wchar_t *));
|
||||
Term STD_PROTO(Yap_NWideStringToListOfAtoms,(wchar_t *, size_t));
|
||||
struct hold_entry *STD_PROTO(Yap_InitAtomHold,(void));
|
||||
int STD_PROTO(Yap_AtomGetHold,(Atom));
|
||||
int STD_PROTO(Yap_AtomReleaseHold,(Atom));
|
||||
|
|
|
|||
25
docs/yap.tex
25
docs/yap.tex
|
|
@ -14142,16 +14142,35 @@ otherwise the routine will simply fail. The @var{StringToBuffer} routine
|
|||
fails and generates an exception if @var{String} is not a valid string.
|
||||
|
||||
@findex YAP_BufferToString (C-Interface function)
|
||||
@findex YAP_NBufferToString (C-Interface function)
|
||||
@findex YAP_WideBufferToString (C-Interface function)
|
||||
@findex YAP_NWideBufferToString (C-Interface function)
|
||||
@findex YAP_BufferToAtomList (C-Interface function)
|
||||
@findex YAP_NBufferToAtomList (C-Interface function)
|
||||
@findex YAP_WideBufferToAtomList (C-Interface function)
|
||||
@findex YAP_NWideBufferToAtomList (C-Interface function)
|
||||
@findex YAP_BufferToDiffList (C-Interface function)
|
||||
@findex YAP_NBufferToDiffList (C-Interface function)
|
||||
@findex YAP_WideBufferToDiffList (C-Interface function)
|
||||
@findex YAP_NWideBufferToDiffList (C-Interface function)
|
||||
The C-interface also includes utility routines to do the reverse, that
|
||||
is, to copy a from a buffer to a list of character codes or to a list of
|
||||
character atoms
|
||||
is, to copy a from a buffer to a list of character codes, to a
|
||||
difference list, or to a list of
|
||||
character atoms. The routines work either on strings of characters or
|
||||
strings of wide characters:
|
||||
@example
|
||||
YAP_Term YAP_BufferToString(char *@var{buf})
|
||||
YAP_Term YAP_NBufferToString(char *@var{buf}, size_t @var{len})
|
||||
YAP_Term YAP_WideBufferToString(wchar_t *@var{buf})
|
||||
YAP_Term YAP_NWideBufferToString(wchar_t *@var{buf}, size_t @var{len})
|
||||
YAP_Term YAP_BufferToAtomList(char *@var{buf})
|
||||
YAP_Term YAP_NBufferToAtomList(char *@var{buf}, size_t @var{len})
|
||||
YAP_Term YAP_WideBufferToAtomList(wchar_t *@var{buf})
|
||||
YAP_Term YAP_NWideBufferToAtomList(wchar_t *@var{buf}, size_t @var{len})
|
||||
@end example
|
||||
@noindent
|
||||
The user-provided string must include a terminating null character.
|
||||
Users are advised to use the @var{N} version of the routines. Otherwise,
|
||||
the user-provided string must include a terminating null character.
|
||||
|
||||
@findex YAP_ReadBuffer (C-Interface function)
|
||||
The C-interface function calls the parser on a sequence of characters
|
||||
|
|
|
|||
|
|
@ -28,11 +28,13 @@
|
|||
#include <time.h>
|
||||
#endif
|
||||
|
||||
#ifndef X_API
|
||||
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
|
||||
#define X_API __declspec(dllexport)
|
||||
#else
|
||||
#define X_API
|
||||
#endif
|
||||
#endif
|
||||
|
||||
typedef unsigned long fid_t;
|
||||
typedef unsigned long term_t;
|
||||
|
|
@ -115,6 +117,8 @@ typedef void *PL_engine_t;
|
|||
#define CVT_ALL (CVT_ATOMIC|CVT_LIST)
|
||||
#define CVT_MASK 0x00ff
|
||||
|
||||
#define CVT_EXCEPTION 0x10000
|
||||
|
||||
#define BUF_DISCARDABLE 0x0000
|
||||
#define BUF_RING 0x0100
|
||||
#define BUF_MALLOC 0x0200
|
||||
|
|
@ -216,6 +220,7 @@ extern X_API int PL_unify_nil(term_t);
|
|||
extern X_API int PL_unify_pointer(term_t, void *);
|
||||
extern X_API int PL_unify_string_chars(term_t, const char *);
|
||||
extern X_API int PL_unify_term(term_t,...);
|
||||
extern X_API int PL_unify_wchars(term_t, int, size_t, const pl_wchar_t *);
|
||||
/* end PL_unify_* functions =============================*/
|
||||
/* begin PL_is_* functions =============================*/
|
||||
extern X_API int PL_is_atom(term_t);
|
||||
|
|
|
|||
|
|
@ -2,6 +2,14 @@
|
|||
#ifndef _PL_STREAM_H
|
||||
#define _PL_STREAM_H
|
||||
|
||||
#ifndef X_API
|
||||
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
|
||||
#define X_API __declspec(dllexport)
|
||||
#else
|
||||
#define X_API
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* This appears to make the wide-character support compile and work
|
||||
on HPUX 11.23. There really should be a cleaner way ...
|
||||
*/
|
||||
|
|
@ -138,5 +146,8 @@ typedef struct io_stream
|
|||
intptr_t reserved[3]; /* reserved for extension */
|
||||
} IOSTREAM;
|
||||
|
||||
#define PL_EXPORT(type) extern X_API type
|
||||
|
||||
extern X_API int PL_unify_stream(term_t t, IOSTREAM *s);
|
||||
|
||||
#endif /*_PL_STREAM_H*/
|
||||
|
|
|
|||
|
|
@ -287,7 +287,7 @@ extern X_API YAP_Term PROTO(YAP_Read,(int (*)(void)));
|
|||
/* void YAP_Write(YAP_Term,void (*)(int),int) */
|
||||
extern X_API void PROTO(YAP_Write,(YAP_Term,void (*)(int),int));
|
||||
|
||||
/* void YAP_WriteBuffer(YAP_Term,char *,unsgined int,int) */
|
||||
/* void YAP_WriteBufffer(YAP_Term,char *,unsgined int,int) */
|
||||
extern X_API void PROTO(YAP_WriteBuffer,(YAP_Term,char *,unsigned int,int));
|
||||
|
||||
/* void YAP_Term(YAP_Term) */
|
||||
|
|
@ -323,12 +323,42 @@ extern X_API int PROTO(YAP_StringToBuffer,(YAP_Term,char *,unsigned int));
|
|||
/* int BufferToString(const char *) */
|
||||
extern X_API YAP_Term PROTO(YAP_BufferToString,(CONST char *));
|
||||
|
||||
/* YAP_Term BufferToTerm(const char *) */
|
||||
extern X_API YAP_Term PROTO(YAP_ReadBuffer,(CONST char *,YAP_Term *));
|
||||
/* int BufferToString(const char *) */
|
||||
extern X_API YAP_Term PROTO(YAP_NBufferToString,(CONST char *, size_t len));
|
||||
|
||||
/* int BufferToString(const char *) */
|
||||
extern X_API YAP_Term PROTO(YAP_WideBufferToString,(CONST wchar_t *));
|
||||
|
||||
/* int BufferToString(const char *) */
|
||||
extern X_API YAP_Term PROTO(YAP_NWideBufferToString,(CONST wchar_t *, size_t len));
|
||||
|
||||
/* int BufferToAtomList(const char *) */
|
||||
extern X_API YAP_Term PROTO(YAP_BufferToAtomList,(CONST char *));
|
||||
|
||||
/* int BufferToAtomList(const char *) */
|
||||
extern X_API YAP_Term PROTO(YAP_NBufferToAtomList,(CONST char *, size_t len));
|
||||
|
||||
/* int BufferToAtomList(const char *) */
|
||||
extern X_API YAP_Term PROTO(YAP_WideBufferToAtomList,(CONST wchar_t *));
|
||||
|
||||
/* int BufferToAtomList(const char *) */
|
||||
extern X_API YAP_Term PROTO(YAP_NWideBufferToAtomList,(CONST wchar_t *, size_t len));
|
||||
|
||||
/* int BufferToDiffList(const char *) */
|
||||
extern X_API YAP_Term PROTO(YAP_BufferToDiffList,(CONST char *));
|
||||
|
||||
/* int BufferToDiffList(const char *) */
|
||||
extern X_API YAP_Term PROTO(YAP_NBufferToDiffList,(CONST char *, size_t len));
|
||||
|
||||
/* int BufferToDiffList(const char *) */
|
||||
extern X_API YAP_Term PROTO(YAP_WideBufferToDiffList,(CONST wchar_t *));
|
||||
|
||||
/* int BufferToDiffList(const char *) */
|
||||
extern X_API YAP_Term PROTO(YAP_NWideBufferToDiffList,(CONST wchar_t *, size_t len));
|
||||
|
||||
/* YAP_Term BufferToTerm(const char *) */
|
||||
extern X_API YAP_Term PROTO(YAP_ReadBuffer,(CONST char *,YAP_Term *));
|
||||
|
||||
/* void YAP_InitSocks(const char *,long) */
|
||||
extern X_API int PROTO(YAP_InitSocks,(CONST char *,long));
|
||||
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@
|
|||
#include <stdio.h>
|
||||
|
||||
#include <SWI-Prolog.h>
|
||||
#include <SWI-Stream.h>
|
||||
|
||||
#ifdef USE_GMP
|
||||
#include <gmp.h>
|
||||
|
|
@ -270,28 +271,42 @@ X_API int PL_get_wchars(term_t l, size_t *len, wchar_t **wsp, unsigned flags)
|
|||
int res = PL_get_chars(l, &sp, ((flags & ~(BUF_MALLOC|BUF_DISCARDABLE))|BUF_RING));
|
||||
size_t sz;
|
||||
|
||||
if (!res)
|
||||
return FALSE;
|
||||
if (!res) {
|
||||
if (flags & CVT_EXCEPTION)
|
||||
YAP_Error(0, 0L, "PL_get_wchars");
|
||||
return 0;
|
||||
}
|
||||
sz = wcstombs(sp,NULL,BUF_SIZE);
|
||||
if (flags & BUF_MALLOC) {
|
||||
wchar_t *nbf = (wchar_t *)YAP_AllocSpaceFromYap(sz+1);
|
||||
if (nbf == NULL)
|
||||
if (nbf == NULL) {
|
||||
if (flags & CVT_EXCEPTION)
|
||||
YAP_Error(0, 0L, "PL_get_wchars: lack of memory");
|
||||
return 0;
|
||||
}
|
||||
*wsp = nbf;
|
||||
} else if (flags & BUF_DISCARDABLE) {
|
||||
wchar_t *buf = (wchar_t *)buffers;
|
||||
|
||||
if (wcstombs(sp,buf,BUF_SIZE) == -1)
|
||||
if (wcstombs(sp,buf,BUF_SIZE) == -1) {
|
||||
if (flags & CVT_EXCEPTION)
|
||||
YAP_Error(0, 0L, "PL_get_wchars: wcstombs");
|
||||
return 0;
|
||||
}
|
||||
*wsp = buf;
|
||||
} else {
|
||||
wchar_t *tmp = (wchar_t *)alloc_ring_buf();
|
||||
if (wcstombs(sp, tmp, BUF_SIZE) == -1)
|
||||
if (wcstombs(sp, tmp, BUF_SIZE) == -1) {
|
||||
if (flags & CVT_EXCEPTION)
|
||||
YAP_Error(0, 0L, "PL_get_wchars: wcstombs");
|
||||
return 0;
|
||||
}
|
||||
*wsp = tmp;
|
||||
}
|
||||
return res;
|
||||
}
|
||||
if (flags & CVT_EXCEPTION)
|
||||
YAP_Error(0, 0L, "PL_get_wchars");
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
|
@ -845,6 +860,33 @@ X_API int PL_unify_string_chars(term_t t, const char *chars)
|
|||
return YAP_Unify(YAP_GetFromSlot(t), chterm);
|
||||
}
|
||||
|
||||
/* SWI: int PL_unify_wchars(term_t ?t, int type, size_t len,, const pl_wchar_t *s)
|
||||
*/
|
||||
X_API int PL_unify_wchars(term_t t, int type, size_t len, const pl_wchar_t *chars)
|
||||
{
|
||||
YAP_Term chterm;
|
||||
|
||||
if (len == (size_t)-1)
|
||||
len = wcslen(chars);
|
||||
|
||||
switch (type) {
|
||||
case PL_ATOM:
|
||||
chterm = YAP_MkAtomTerm(YAP_LookupWideAtom(chars));
|
||||
break;
|
||||
case PL_STRING:
|
||||
case PL_CODE_LIST:
|
||||
chterm = YAP_NWideBufferToString(chars, len);
|
||||
break;
|
||||
case PL_CHAR_LIST:
|
||||
chterm = YAP_NWideBufferToAtomList(chars, len);
|
||||
break;
|
||||
default:
|
||||
/* should give error?? */
|
||||
return FALSE;
|
||||
}
|
||||
return YAP_Unify(YAP_GetFromSlot(t), chterm);
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
int type;
|
||||
union {
|
||||
|
|
@ -1566,6 +1608,111 @@ SWI_ctime(void)
|
|||
#endif
|
||||
}
|
||||
|
||||
|
||||
/***** SWI IO ***************/
|
||||
|
||||
#define GET_LD
|
||||
#define LOCK()
|
||||
#define UNLOCK()
|
||||
#define FUNCTOR_dstream1 (functor_t)YAP_MkFunctor(YAP_LookupAtom("stream"),1)
|
||||
#define succeed return 1
|
||||
#define fail return 0
|
||||
|
||||
typedef struct symbol * Symbol; /* symbol of hash table */
|
||||
|
||||
struct symbol
|
||||
{ Symbol next; /* next in chain */
|
||||
void * name; /* name entry of symbol */
|
||||
void * value; /* associated value with name */
|
||||
};
|
||||
|
||||
static Symbol *streamContext;
|
||||
|
||||
#define NULL_ATOM 0L
|
||||
|
||||
#define allocHeap(size) YAP_AllocSpaceFromYap(size)
|
||||
|
||||
// FIX THIS
|
||||
#define PL_error(A,B,C,D,E,F) 0
|
||||
|
||||
static Symbol lookupHTable(Symbol *htp, void *name)
|
||||
{
|
||||
Symbol ht = *htp;
|
||||
while (ht) {
|
||||
if (ht->name == name) return ht;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static void addHTable(Symbol *htp, void *name, void *val)
|
||||
{
|
||||
Symbol s = (Symbol)allocHeap(sizeof(Symbol));
|
||||
if (!s)
|
||||
return;
|
||||
s->next = *htp;
|
||||
s->name = name;
|
||||
s->value = val;
|
||||
*htp = s;
|
||||
}
|
||||
|
||||
typedef struct _alias
|
||||
{ struct _alias *next;
|
||||
atom_t name;
|
||||
} alias;
|
||||
|
||||
typedef struct
|
||||
{ alias *alias_head;
|
||||
alias *alias_tail;
|
||||
atom_t filename; /* associated filename */
|
||||
unsigned flags;
|
||||
} stream_context;
|
||||
|
||||
|
||||
static stream_context *
|
||||
getStreamContext(IOSTREAM *s)
|
||||
{ Symbol symb;
|
||||
|
||||
if ( !(symb = lookupHTable(streamContext, s)) )
|
||||
{ GET_LD
|
||||
stream_context *ctx = allocHeap(sizeof(*ctx));
|
||||
|
||||
// DEBUG(1, Sdprintf("Created ctx=%p for stream %p\n", ctx, s));
|
||||
|
||||
ctx->alias_head = ctx->alias_tail = NULL;
|
||||
ctx->filename = NULL_ATOM;
|
||||
ctx->flags = 0;
|
||||
addHTable(streamContext, s, ctx);
|
||||
|
||||
return ctx;
|
||||
}
|
||||
|
||||
return symb->value;
|
||||
}
|
||||
|
||||
X_API int
|
||||
PL_unify_stream(term_t t, IOSTREAM *s)
|
||||
{ GET_LD
|
||||
stream_context *ctx;
|
||||
term_t a = PL_new_term_ref();
|
||||
|
||||
LOCK();
|
||||
ctx = getStreamContext(s);
|
||||
UNLOCK();
|
||||
|
||||
PL_put_pointer(a, s);
|
||||
PL_cons_functor(a, FUNCTOR_dstream1, a);
|
||||
|
||||
if ( PL_unify(t, a) )
|
||||
succeed;
|
||||
if ( PL_is_functor(t, FUNCTOR_dstream1) )
|
||||
fail;
|
||||
|
||||
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_stream, t);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
void Yap_swi_install(void);
|
||||
|
||||
void
|
||||
|
|
@ -1596,3 +1743,4 @@ int WINAPI win_yap2swi(HANDLE hinst, DWORD reason, LPVOID reserved)
|
|||
return 1;
|
||||
}
|
||||
#endif
|
||||
|
||||
|
|
|
|||
Reference in New Issue