From e1866e2917b2a69c625387cbac9579d0f4d723c6 Mon Sep 17 00:00:00 2001 From: vsc Date: Thu, 24 Jul 2008 16:02:04 +0000 Subject: [PATCH] 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 --- C/adtdefs.c | 97 ++++++++++++++++++++++- C/c_interface.c | 146 ++++++++++++++++++++++++++++++++++- C/iopreds.c | 2 +- C/parser.c | 4 +- C/stdpreds.c | 13 ++-- H/YapOpcodes.h | 7 +- H/Yapproto.h | 11 ++- docs/yap.tex | 25 +++++- include/SWI-Prolog.h | 5 ++ include/SWI-Stream.h | 11 +++ include/YapInterface.h | 36 ++++++++- library/yap2swi/yap2swi.c | 158 ++++++++++++++++++++++++++++++++++++-- 12 files changed, 489 insertions(+), 26 deletions(-) diff --git a/C/adtdefs.c b/C/adtdefs.c index d642889d0..ec6f362cb 100644 --- a/C/adtdefs.c +++ b/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) { diff --git a/C/c_interface.c b/C/c_interface.c index 786e8c25a..e4dfa0f3d 100644 --- a/C/c_interface.c +++ b/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,...) diff --git a/C/iopreds.c b/C/iopreds.c index 8de18c27e..5cce80a91 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -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; diff --git a/C/parser.c b/C/parser.c index 160551c06..3a7d18659 100644 --- a/C/parser.c +++ b/C/parser.c @@ -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; diff --git a/C/stdpreds.c b/C/stdpreds.c index 8782b5976..96636f2d3 100644 --- a/C/stdpreds.c +++ b/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); } diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index 6bca20c9f..2268a4be6 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -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), diff --git a/H/Yapproto.h b/H/Yapproto.h index eb57b73ec..a3c369c64 100644 --- a/H/Yapproto.h +++ b/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)); diff --git a/docs/yap.tex b/docs/yap.tex index 6d25338f2..47b49d3f6 100644 --- a/docs/yap.tex +++ b/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 diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index d990d75d0..d47c94eda 100644 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -28,11 +28,13 @@ #include #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); diff --git a/include/SWI-Stream.h b/include/SWI-Stream.h index 52e68c256..5ebf080d0 100644 --- a/include/SWI-Stream.h +++ b/include/SWI-Stream.h @@ -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*/ diff --git a/include/YapInterface.h b/include/YapInterface.h index a517a483b..6da69c5bc 100644 --- a/include/YapInterface.h +++ b/include/YapInterface.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)); diff --git a/library/yap2swi/yap2swi.c b/library/yap2swi/yap2swi.c index f19865873..051005ae5 100644 --- a/library/yap2swi/yap2swi.c +++ b/library/yap2swi/yap2swi.c @@ -15,6 +15,7 @@ #include #include +#include #ifdef USE_GMP #include @@ -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 +