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

cmake & text support

Browse Source
This commit is contained in:
Vítor Santos Costa 2015-06-19 01:29:16 +01:00
parent edbd2654e8
commit 84b5fcce77
5 changed files with 1039 additions and 870 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
library/dialect/swi/CMakeLists.txt
View File

@ -8,4 +8,3 @@ set (SDIALECTS_PL
install(FILES ${SDIALECTS_PL}
DESTINATION ${libpl}/dialect/swi
)

98
library/dialect/swi/fli/blobs.c
View File

@ -23,8 +23,10 @@
*
*/
#include <stdio.h>
#include <Yap.h>
#include <Yatom.h>
#include <iopreds.h>
#include <string.h>
@ -32,7 +34,9 @@
#define _WITH_DPRINTF
#include <stdio.h>
#include <pl-shared.h>
//#include <SWI-Stream.h>
//#include <pl-shared.h>
#include "swi.h"
@ -42,8 +46,7 @@ static PL_blob_t unregistered_blob_atom =
"unregistered"
};
PL_EXPORT(int)
int
PL_is_blob(term_t t, PL_blob_t **type)
{
CACHE_REGS
@ -59,76 +62,12 @@ PL_is_blob(term_t t, PL_blob_t **type)
if (!IsBlob(a))
return FALSE;
b = RepBlobProp(a->PropsOfAE);
*type = b->blob_t;
*type = (struct PL_blob_t *)b->blob_type;
return TRUE;
}
/* void check_chain(void); */
/* void check_chain(void) { */
/* AtomEntry *ae, *old; */
/* ae = SWI_Blobs; */
/* old = NULL; */
/* while (ae) { */
/* old = ae; */
/* ae = RepAtom(ae->NextOfAE); */
/* } */
/* } */
AtomEntry *
Yap_lookupBlob(void *blob, size_t len, void *type0, int *new)
{
BlobPropEntry *b;
AtomEntry *ae;
PL_blob_t *type = type0;
if (new)
*new = FALSE;
LOCK(SWI_Blobs_Lock);
if (type->flags & PL_BLOB_UNIQUE) {
/* just keep a linked chain for now */
ae = SWI_Blobs;
while (ae) {
if (ae->PropsOfAE &&
RepBlobProp(ae->PropsOfAE)->blob_t == type &&
ae->rep.blob->length == len &&
!memcmp(ae->rep.blob->data, blob, len)) {
UNLOCK(SWI_Blobs_Lock);
return ae;
}
ae = RepAtom(ae->NextOfAE);
}
}
if (new)
*new = TRUE;
b = (BlobPropEntry *)Yap_AllocCodeSpace(sizeof(BlobPropEntry));
if (!b) {
UNLOCK(SWI_Blobs_Lock);
return NULL;
}
b->NextOfPE = NIL;
b->KindOfPE = BlobProperty;
b->blob_t = type;
ae = (AtomEntry *)Yap_AllocCodeSpace(sizeof(AtomEntry)+len+sizeof(size_t));
if (!ae) {
UNLOCK(SWI_Blobs_Lock);
return NULL;
}
NOfBlobs++;
INIT_RWLOCK(ae->ARWLock);
ae->PropsOfAE = AbsBlobProp(b);
ae->NextOfAE = AbsAtom(SWI_Blobs);
ae->rep.blob->length = len;
memcpy(ae->rep.blob->data, blob, len);
SWI_Blobs = ae;
if (NOfBlobs > NOfBlobsMax) {
Yap_signal(YAP_CDOVF_SIGNAL);
}
UNLOCK(SWI_Blobs_Lock);
return ae;
}
PL_EXPORT(int)
PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
{
@ -185,7 +124,7 @@ PL_get_blob(term_t t, void **blob, size_t *len, PL_blob_t **type)
return FALSE;
ae = RepAtom(a);
if (type)
*type = RepBlobProp(ae->PropsOfAE)->blob_t;
*type = (struct PL_blob_t *)RepBlobProp(ae->PropsOfAE)->blob_type;
if (len)
*len = ae->rep.blob[0].length;
if (blob)
@ -215,7 +154,7 @@ PL_blob_data(atom_t a, size_t *len, struct PL_blob_t **type)
if ( len )
*len = x->rep.blob[0].length;
if ( type )
*type = RepBlobProp(x->PropsOfAE)->blob_t;
*type = (struct PL_blob_t *)RepBlobProp(x->PropsOfAE)->blob_type;
return x->rep.blob[0].data;
}
@ -223,8 +162,8 @@ PL_blob_data(atom_t a, size_t *len, struct PL_blob_t **type)
PL_EXPORT(void)
PL_register_blob_type(PL_blob_t *type)
{
type->next = SWI_BlobTypes;
SWI_BlobTypes = type;
type->next = (PL_blob_t *)BlobTypes;
BlobTypes = (struct YAP_blob_t *)type;
}
PL_EXPORT(PL_blob_t*)
@ -235,16 +174,6 @@ PL_find_blob_type(const char* name)
return YAP_find_blob_type((YAP_Atom)at);
}
PL_EXPORT(PL_blob_t*)
YAP_find_blob_type(YAP_Atom at)
{
AtomEntry *a = RepAtom((Atom)at);
if (!IsBlob(a)) {
return &unregistered_blob_atom;
}
return RepBlobProp(a->PropsOfAE)->blob_t;
}
PL_EXPORT(int)
PL_unregister_blob_type(PL_blob_t *type)
{
@ -252,11 +181,6 @@ PL_unregister_blob_type(PL_blob_t *type)
return FALSE;
}
void
Yap_install_blobs(void)
{
}
/**
* @}

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

@ -1,4 +1,4 @@
/* yap2swi.c */
/* xsswi.c */
/*
* Project: jpl for Yap Prolog
* Author: Steve Moyle and Vitor Santos Costa
@ -27,12 +27,16 @@
#include <wchar.h>
#include <assert.h>
#include <Yap.h>
#include <Yatom.h>
#include <YapHeap.h>
#include <eval.h>
#include <YapHeap.h>
#include <yapio.h>
#include <YapText.h>
#include <pl-utf8.h>
#include "swi.h"
#if HAVE_MATH_H
#include <math.h>
#endif
@ -49,10 +53,6 @@
#define PL_KERNEL 1
#include <pl-shared.h>
#include <yapio.h>
#include <YapText.h>
#ifdef USE_GMP
#include <gmp.h>
@ -63,9 +63,7 @@
#include <fcntl.h>
#endif
#include "swi.h"
#include "pl-error.h"
//#include "pl-error.h"
extern int PL_unify_termv(term_t l, va_list args);
@ -147,7 +145,7 @@ UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int f
* */
/* SWI: void PL_agc_hook(void) */
/* void PL_agc_hook(void) */
/** @brief Atom garbage collection hook
*
*/
@ -157,6 +155,257 @@ PL_agc_hook(PL_agc_hook_t entry)
return (PL_agc_hook_t)YAP_AGCRegisterHook((YAP_agc_hook)entry);
}
/* void PL_get_nchars(term_t ref, size_t *length, char **output, unsigned flags) */
/** @brief extract a text representing the term _ref_. A pointer to a string with the text will
* be output to *_s_, and the size of the string will be written to *_length_,
* if _length_ is not null.
*
* The following flags are recognised (as in the SWI manual )
* *CVT_ATOM* Convert if term is an atom.
* *CVT_STRING* Convert if term is a string.
* *CVT_LIST* Convert if term is a list of of character codes.
* *CVT_INTEGER* Convert if term is an integer.
* *CVT_FLOAT* Convert if term is a float. The characters returned are the same as write/1 would write for the floating point number.
* *CVT_NUMBER* Convert if term is an integer or float.
* *CVT_ATOMIC* Convert if term is atomic.
* *CVT_VARIABLE* Convert variable to print-name
* *CVT_WRITE* Convert any term that is not converted by any of the other flags using write/1. * If no BUF_* is provided, BUF_RING is implied.
* *CVT_WRITE_CANONICAL* As CVT_WRITE, but using write_canonical/2.
* *CVT_WRITEQ* As CVT_WRITE, but using writeq/2.
* *CVT_ALL* Convert if term is any of the above, except for CVT_VARIABLE and CVT_WRITE*.
*
* *CVT_EXCEPTION* If conversion fails due to a type error, raise a Prolog type error exception in addition to failure
* *BUF_DISCARDABLE* Data must copied immediately
* *BUF_RING* Data is stored in a ring of buffers, currenty implemented as BUF_DISCARDABLE
* *BUF_MALLOC* Data is copied to a new buffer returned by PL_malloc(3). When no longer needed the user must call PL_free() on the data.
*
* *REP_ISO_LATIN_1
Text is in ISO Latin-1 encoding and the call fails if text cannot be represented. This flag has the value 0 and is thus the default.
* *REP_UTF8* Convert the text to a UTF-8 string. This works for all text.
* *REP_MB* Convert the text using the current locale
*/
X_API int
PL_get_nchars(term_t l, size_t *lengthp, char **s, unsigned flags)
{ CACHE_REGS
seq_tv_t inp;
size_t leng;
encoding_t enc;
int minimal;
void *buf;
char b[1024];
buf = b;
inp.val.t = Yap_GetFromSlot( l );
inp.type = 0;
if (flags & CVT_ATOM) {
inp.type |= YAP_STRING_ATOM;
}
if (flags & CVT_ATOM) {
inp.type |= YAP_STRING_STRING;
}
if (flags & CVT_LIST) {
inp.type |= YAP_STRING_CODES;
}
if (flags & CVT_INTEGER) {
inp.type |= YAP_STRING_INT|YAP_STRING_BIG;
}
if (flags & CVT_FLOAT) {
inp.type |= YAP_STRING_FLOAT;
}
if (flags & CVT_VARIABLE) {
inp.type |= YAP_STRING_TERM;
}
if (flags & CVT_WRITE) {
inp.type |= YAP_STRING_TERM;
}
if (flags & CVT_WRITEQ) {
inp.type |= YAP_STRING_TERM|YAP_STRING_WQ;
}
if (flags & CVT_WRITE_CANONICAL) {
inp.type |= YAP_STRING_TERM|YAP_STRING_WC;
}
if (flags & (BUF_DISCARDABLE|BUF_RING)) {
inp.val.c = LOCAL_FileNameBuf;
leng = YAP_FILENAME_MAX-1;
}
if (flags & BUF_MALLOC) {
inp.val.c = PL_malloc(1024);
leng = 1023;
}
if (!Yap_readText( buf , &inp, & enc, &minimal, & leng PASS_REGS) )
return false;
if (enc == ENC_ISO_UTF8) {
if (flags & REP_UTF8) {
*s = buf;
*lengthp = leng;
return true;
} else if (flags & REP_ISO_LATIN_1) {
char *nptr = buf;
const char *optr = buf;
int chr;
while ((optr = _PL__utf8_get_char(optr, &chr))) {
if (chr > 255) {
if (flags & BUF_MALLOC) {
return false;
}
}
*nptr++ = chr;
}
*nptr = '\0';
*s = buf;
*lengthp = leng;
} else /* wide */ {
size_t sz = utf8_strlen1(buf)+1;
const char *optr = buf;
wchar_t *nptr, *n = buf;
int chr;
if (sz <= 1024)
n = nptr = (wchar_t *)malloc(sz);
while ((optr = _PL__utf8_get_char(optr, &chr))) {
*nptr++ = chr;
}
*nptr = '\0';
*s = buf;
*lengthp = leng;
// handle encodings ltaer
}
}
return false;
}
int
PL_get_chars(term_t t, char **s, unsigned flags)
{ return PL_get_nchars(t, NULL, s, flags);
}
int PL_get_wchars(term_t l, size_t *lengthp, wchar_t **s, unsigned flags)
{
CACHE_REGS
seq_tv_t inp;
size_t leng;
encoding_t enc;
int minimal;
void *buf;
char b[1024];
buf = b;
inp.val.t = Yap_GetFromSlot( l );
inp.type = 0;
if (flags & CVT_ATOM) {
inp.type |= YAP_STRING_ATOM;
}
if (flags & CVT_ATOM) {
inp.type |= YAP_STRING_STRING;
}
if (flags & CVT_LIST) {
inp.type |= YAP_STRING_CODES;
}
if (flags & CVT_INTEGER) {
inp.type |= YAP_STRING_INT|YAP_STRING_BIG;
}
if (flags & CVT_FLOAT) {
inp.type |= YAP_STRING_FLOAT;
}
if (flags & CVT_VARIABLE) {
inp.type |= YAP_STRING_TERM;
}
if (flags & CVT_WRITE) {
inp.type |= YAP_STRING_TERM;
}
if (flags & CVT_WRITEQ) {
inp.type |= YAP_STRING_TERM|YAP_STRING_WQ;
}
if (flags & CVT_WRITE_CANONICAL) {
inp.type |= YAP_STRING_TERM|YAP_STRING_WC;
}
if (flags & (BUF_DISCARDABLE|BUF_RING)) {
inp.val.c = LOCAL_FileNameBuf;
leng = YAP_FILENAME_MAX-1;
}
if (flags & BUF_MALLOC) {
inp.val.w = PL_malloc(1024*SIZEOF_WCHAR_T);
leng = 1023;
}
if (!Yap_readText( buf , &inp, & enc, &minimal, & leng PASS_REGS) )
return false;
if (enc == ENC_ISO_UTF8) {
if (flags & REP_UTF8) {
*s = buf;
*lengthp = leng;
return true;
} else if (flags & REP_ISO_LATIN_1) {
char *nptr = buf;
const char *optr = buf;
int chr;
while ((optr = _PL__utf8_get_char(optr, &chr))) {
if (chr > 255) {
if (flags & BUF_MALLOC) {
return false;
}
}
*nptr++ = chr;
}
*nptr = '\0';
*s = buf;
*lengthp = leng;
} else /* wide */ {
size_t sz = utf8_strlen1(buf)+1;
const char *optr = buf;
wchar_t *nptr, *n = buf;
int chr;
if (sz <= 1024)
n = nptr = (wchar_t *)malloc(sz*SIZEOF_WCHAR_T);
while ((optr = _PL__utf8_get_char(optr, &chr))) {
*nptr++ = chr;
}
*nptr = '\0';
*s = buf;
*lengthp = leng;
// handle encodings later
}
}
return false;
}
X_API int
PL_unify_chars(term_t l, int flags, size_t length, const char *s)
{ CACHE_REGS
seq_tv_t inp, out;
if (flags & REP_UTF8) {
inp.val.c = s;
if (length != (size_t)-1) {
inp.sz = length;
inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS;
} else {
inp.type = YAP_STRING_CHARS;
}
}
if (flags & PL_ATOM) {
out.type = YAP_STRING_ATOM;
} else if (flags & PL_STRING) {
out.type = YAP_STRING_STRING;
} else if (flags & PL_CODE_LIST) {
out.type = YAP_STRING_CODES;
} else if (flags & PL_CHAR_LIST) {
out.type = YAP_STRING_ATOMS;
}
if (length != (size_t)-1) {
out.max = length;
}
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
return out.val.t;
}
/** @brief extract the text representation from atom
*
*/
@ -186,6 +435,17 @@ X_API char* PL_atom_nchars(atom_t a, size_t *len) /* SAM check type */
* @ingroup swi-c-interface
* */
/** @brief create a clean term reference
*
*/
X_API term_t PL_new_term_ref(void)
{
CACHE_REGS
term_t to = Yap_NewSlots(1);
return to;
}
/** @brief duplicate a term reference
*
*/
@ -195,16 +455,6 @@ X_API term_t PL_copy_term_ref(term_t from)
return Yap_InitSlot(Yap_GetFromSlot(from));
}
/** @brief create a new term reference
*
*/
X_API term_t PL_new_term_ref(void)
{
CACHE_REGS
term_t to = Yap_NewSlots(1);
return to;
}
/** @brief create several new term references
*
@ -347,7 +597,7 @@ X_API int PL_get_atom(term_t ts, atom_t *a)
/** @brief *i is assigned the int in term ts, or the operation fails
*
*/
/* SWI: int PL_get_integer(term_t t, int *i)
/* int PL_get_integer(term_t t, int *i)
YAP: long int YAP_IntOfTerm(Term) */
X_API int PL_get_integer(term_t ts, int *i)
{
@ -380,7 +630,7 @@ X_API int PL_get_long(term_t ts, long *i)
return 1;
}
/* SWI: int PL_get_bool(term_t t, int *i)
/* int PL_get_bool(term_t t, int *i)
YAP: long int YAP_AtomOfTerm(Term) */
X_API int PL_get_bool(term_t ts, int *i)
{
@ -452,6 +702,11 @@ X_API int PL_get_int64(term_t ts, int64_t *i)
return 1;
}
X_API int PL_get_int64_ex(term_t ts, int64_t *i)
{
return PL_get_int64( ts,i);
}
/** @brief *a is assigned the intptr_t in term ts, or the operation fails
*
*/
@ -477,7 +732,7 @@ X_API int PL_get_uintptr(term_t ts, uintptr_t *a)
*a = (uintptr_t)(IntegerOfTerm(t));
return 1;
}
#ifdef do_not_ld
/** @brief a is assigned the argument index from term ts
*
*/
@ -500,7 +755,7 @@ X_API int _PL_get_arg(int index, term_t ts, term_t a)
Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS);
return 1;
}
#endif
/** @brief *a is assigned the string representation of the atom in term ts, or the operation fails
*
@ -709,7 +964,7 @@ X_API int PL_unify_mpq(term_t t, mpq_t mpq)
#endif
/* SWI: int PL_get_module(term_t t, module_t *m) */
/* int PL_get_module(term_t t, module_t *m) */
X_API int PL_get_module(term_t ts, module_t *m)
{
CACHE_REGS
@ -720,7 +975,7 @@ X_API int PL_get_module(term_t ts, module_t *m)
return TRUE;
}
/* SWI: int PL_new_module(term_t t, module_t *m) */
/* int PL_new_module(term_t t, module_t *m) */
X_API module_t PL_new_module(atom_t swiat)
{
Atom at = SWIAtomToAtom(swiat);
@ -732,7 +987,7 @@ X_API module_t PL_new_module(atom_t swiat)
return Yap_GetModuleEntry(t);
}
/* SWI: int PL_get_atom(term_t t, YAP_Atom *a)
/* int PL_get_atom(term_t t, YAP_Atom *a)
YAP: YAP_Atom YAP_AtomOfTerm(Term) */
X_API int PL_get_nil(term_t ts)
{
@ -741,7 +996,7 @@ X_API int PL_get_nil(term_t ts)
return ( t == TermNil );
}
/* SWI: int PL_get_pointer(term_t t, int *i)
/* int PL_get_pointer(term_t t, int *i)
YAP: NO EQUIVALENT */
/* SAM TO DO */
X_API int PL_get_pointer(term_t ts, void **i)
@ -769,7 +1024,7 @@ X_API int PL_get_tail(term_t ts, term_t tl)
/* begin PL_new_* functions =============================*/
/* SWI: atom_t PL_new_atom(const char *)
/* atom_t PL_new_atom(const char *)
YAP: YAP_Atom LookupAtom(char *) */
/* SAM should the following be used instead?
YAP_Atom FullLookupAtom(char *)
@ -1077,7 +1332,7 @@ X_API void PL_put_nil(term_t t)
Yap_PutInSlot(t,TermNil PASS_REGS);
}
/* SWI: void PL_put_pointer(term_t -t, void *ptr)
/* void PL_put_pointer(term_t -t, void *ptr)
YAP: NO EQUIVALENT */
/* SAM TO DO */
X_API int PL_put_pointer(term_t t, void *ptr)
@ -1116,7 +1371,7 @@ X_API int PL_put_variable(term_t t)
/* end PL_put_* functions =============================*/
/* SWI: int PL_raise_exception(term_t exception)
/* int PL_raise_exception(term_t exception)
YAP: NO EQUIVALENT */
/* SAM TO DO */
@ -1161,7 +1416,7 @@ X_API int PL_unify(term_t t1, term_t t2)
return Yap_unify(Yap_GetFromSlot(t1 ),Yap_GetFromSlot(t2 ));
}
/* SWI: int PL_unify_atom(term_t ?t, atom *at)
/* int PL_unify_atom(term_t ?t, atom *at)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_atom(term_t t, atom_t at)
{
@ -1170,7 +1425,7 @@ X_API int PL_unify_atom(term_t t, atom_t at)
return YAP_Unify(Yap_GetFromSlot(t),cterm);
}
/* SWI: int PL_unify_atom_chars(term_t ?t, const char *chars)
/* int PL_unify_atom_chars(term_t ?t, const char *chars)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_atom_chars(term_t t, const char *s)
{
@ -1184,7 +1439,7 @@ X_API int PL_unify_atom_chars(term_t t, const char *s)
return Yap_unify(Yap_GetFromSlot(t), MkAtomTerm(at));
}
/* SWI: int PL_unify_atom_chars(term_t ?t, const char *chars)
/* int PL_unify_atom_chars(term_t ?t, const char *chars)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_atom_nchars(term_t t, size_t len, const char *s)
{
@ -1198,7 +1453,7 @@ X_API int PL_unify_atom_nchars(term_t t, size_t len, const char *s)
return Yap_unify(Yap_GetFromSlot(t), MkAtomTerm(at));
}
/* SWI: int PL_unify_float(term_t ?t, double f)
/* int PL_unify_float(term_t ?t, double f)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_float(term_t t, double f)
{
@ -1207,7 +1462,7 @@ X_API int PL_unify_float(term_t t, double f)
return Yap_unify(Yap_GetFromSlot(t),fterm);
}
/* SWI: int PL_unify_integer(term_t ?t, long n)
/* int PL_unify_integer(term_t ?t, long n)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_integer(term_t t, long n)
{
@ -1230,7 +1485,7 @@ X_API int PL_unify_uintptr(term_t t, uintptr_t n)
return Yap_unify(Yap_GetFromSlot(t),iterm);
}
/* SWI: int PL_unify_integer(term_t ?t, long n)
/* int PL_unify_integer(term_t ?t, long n)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_functor(term_t t, functor_t f)
{
@ -1252,7 +1507,7 @@ X_API int PL_unify_functor(term_t t, functor_t f)
return ff == FunctorOfTerm(tt);
}
/* SWI: int PL_unify_integer(term_t ?t, long n)
/* int PL_unify_integer(term_t ?t, long n)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_int64(term_t t, int64_t n)
{
@ -1291,7 +1546,7 @@ X_API int PL_unify_int64(term_t t, int64_t n)
}
/* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
/* int PL_unify_list(term_t ?t, term_t +h, term_t -t)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_list(term_t tt, term_t h, term_t tail)
{
@ -1316,7 +1571,7 @@ X_API int PL_unify_list(term_t tt, term_t h, term_t tail)
return TRUE;
}
/* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
/* int PL_unify_list(term_t ?t, term_t +h, term_t -t)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_arg(int index, term_t tt, term_t arg)
{
@ -1344,7 +1599,7 @@ X_API int PL_unify_arg(int index, term_t tt, term_t arg)
return Yap_unify(Yap_GetFromSlot(arg),to);
}
/* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
/* int PL_unify_list(term_t ?t, term_t +h, term_t -t)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_list_chars(term_t t, const char *chars)
{
@ -1357,7 +1612,7 @@ X_API int PL_unify_list_chars(term_t t, const char *chars)
return Yap_unify(Yap_GetFromSlot(t), chterm);
}
/* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
/* int PL_unify_list(term_t ?t, term_t +h, term_t -t)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_list_ncodes(term_t t, size_t len, const char *chars)
{
@ -1382,7 +1637,7 @@ PL_unify_list_codes(term_t t, const char *chars)
return Yap_unify(Yap_GetFromSlot(t), chterm);
}
/* SWI: int PL_unify_nil(term_t ?l)
/* int PL_unify_nil(term_t ?l)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_nil(term_t t)
{
@ -1390,7 +1645,7 @@ X_API int PL_unify_nil(term_t t)
return Yap_unify(Yap_GetFromSlot(t), TermNil);
}
/* SWI: int PL_unify_pointer(term_t ?t, void *ptr)
/* int PL_unify_pointer(term_t ?t, void *ptr)
YAP: NO EQUIVALENT */
/* SAM TO DO */
X_API int PL_unify_pointer(term_t t, void *ptr)
@ -1400,7 +1655,7 @@ X_API int PL_unify_pointer(term_t t, void *ptr)
return YAP_Unify(Yap_GetFromSlot(t ), ptrterm);
}
/* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
/* int PL_unify_list(term_t ?t, term_t +h, term_t -t)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_string_chars(term_t t, const char *chars)
{
@ -1424,7 +1679,7 @@ X_API int PL_unify_string_nchars(term_t t, size_t len, 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)
/* 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)
{
@ -1510,7 +1765,7 @@ typedef struct {
CELL *ptr;
} stack_el;
/* SWI: int PL_unify_term(term_t ?t1, term_t ?t2)
/* int PL_unify_term(term_t ?t1, term_t ?t2)
YAP long int YAP_Unify(YAP_Term* a, Term* b) */
int PL_unify_termv(term_t l, va_list ap)
{
@ -1775,13 +2030,13 @@ PL_unify_term(term_t t, ...)
/* end PL_unify_* functions =============================*/
/* SWI: void PL_register_atom(atom_t atom) */
/* void PL_register_atom(atom_t atom) */
X_API void PL_register_atom(atom_t atom)
{
Yap_AtomIncreaseHold(SWIAtomToAtom(atom));
}
/* SWI: void PL_unregister_atom(atom_t atom) */
/* void PL_unregister_atom(atom_t atom) */
X_API void PL_unregister_atom(atom_t atom)
{
Yap_AtomDecreaseHold(SWIAtomToAtom(atom));
@ -2591,12 +2846,14 @@ alertThread(int tid)
#endif
}
#endif
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PL_thread_raise() is used for re-routing interrupts in the Windows
version, where the signal handler is running from a different thread as
Prolog.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#if 0
int
PL_thread_raise(int tid, int sig)
{
@ -2610,10 +2867,6 @@ PL_thread_raise(int tid, int sig)
goto error;
if ( !raiseSignal(REMOTE_PL_local_data_p(tid), sig) ||
!alertThread(tid) )
goto error;
PL_UNLOCK(L_THREAD);
return TRUE;
@ -2623,7 +2876,9 @@ PL_thread_raise(int tid, int sig)
int
PL_thread_raise(int tid, int sig)
{
#if 0
if ( !raiseSignal(NULL, sig) )
#endif
return FALSE;
return TRUE;
@ -2832,7 +3087,7 @@ PL_eval_expression_to_int64_ex(term_t t, int64_t *val)
YAP_BigNumOfTerm(t, (void *)&g);
if (mpz_sizeinbase(&g,2) > 64) {
return PL_error(NULL,0,NULL, ERR_EVALUATION, AtomToSWIAtom(Yap_LookupAtom("int_overflow")));
Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, Yap_GetFromSlot(t), "integer_overflow");
}
mpz_get_str (s, 10, &g);
#ifdef _WIN32
@ -2843,7 +3098,7 @@ PL_eval_expression_to_int64_ex(term_t t, int64_t *val)
return 1;
#endif
}
PL_error(NULL,0,NULL, ERR_TYPE, AtomToSWIAtom(Yap_LookupAtom("integer_expression")));
Yap_Error(TYPE_ERROR_ATOM, Yap_GetFromSlot(t), "integer_expression");
return FALSE;
}
@ -2899,23 +3154,27 @@ PL_foreign_context_address(control_t ctx)
X_API int
PL_get_signum_ex(term_t sig, int *n)
{
CACHE_REGS
char *s;
int i = -1;
if ( PL_get_integer(sig, &i) )
{
} else if ( PL_get_chars(sig, &s, CVT_ATOM) )
{ i = Yap_signal_index(s);
} else
{ return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_signal, sig);
} else if ( IsAtomTerm(Yap_GetFromSlot(sig) ) )
{ s = RepAtom(AtomOfTerm(Yap_GetFromSlot(sig)))->StrOfAE;
i = Yap_signal_index(s);
}
else
{ Yap_Error(TYPE_ERROR_ATOM, Yap_GetFromSlot(sig), "signal handling");
return FALSE;
}
if ( i > 0 && i < 32 ) /* where to get these? */
{ *n = i;
return TRUE;
}
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_signal, sig);
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, Yap_GetFromSlot(sig) , "signal handling");
return FALSE;
}
typedef struct blob {
@ -2985,28 +3244,18 @@ str_prefix(const char *p0, char *s)
static int
atom_generator(const char *prefix, char **hit, int state)
{
CACHE_REGS
struct scan_atoms *index;
Atom catom;
Int i;
#ifdef O_PLMT
if ( !atomgen_key ) {
pthread_key_create(&atomgen_key, NULL);
state = FALSE;
}
#endif
if ( !state )
{ index = (struct scan_atoms *)malloc(sizeof(struct scan_atoms));
i = 0;
catom = NIL;
} else
{
#ifdef O_PLMT
index = (struct scan_atoms *)pthread_getspecific(atomgen_key);
#else
index = LOCAL_search_atoms;
#endif
catom = index->atom;
i = index->pos;
}
@ -3026,13 +3275,10 @@ atom_generator(const char *prefix, char **hit, int state)
ap = RepAtom(catom);
READ_LOCK(ap->ARWLock);
if ( str_prefix(prefix, ap->StrOfAE) ) {
CACHE_REGS
index->pos = i;
index->atom = ap->NextOfAE;
#ifdef O_PLMT
pthread_setspecific(atomgen_key,index);
#else
LOCAL_search_atoms = index;
#endif
*hit = ap->StrOfAE;
READ_UNLOCK(ap->ARWLock);
return TRUE;
@ -3041,11 +3287,7 @@ atom_generator(const char *prefix, char **hit, int state)
READ_UNLOCK(ap->ARWLock);
}
}
#ifdef O_PLMT
pthread_setspecific(atomgen_key,NULL);
#else
LOCAL_search_atoms = NULL;
#endif
free(index);
return FALSE;
}
@ -3097,51 +3339,6 @@ Yap_swi_install(void)
}
extern atom_t fileNameStream(IOSTREAM *s);
extern Atom Yap_FileName(IOSTREAM *s);
Atom
Yap_FileName(IOSTREAM *s)
{
atom_t a = fileNameStream(s);
if (!a) {
return AtomEmptyAtom;
}
return SWIAtomToAtom(a);
}
extern void closeFiles(int);
void
Yap_CloseStreams(int loud)
{
closeFiles(FALSE);
}
Int Yap_StreamToFileNo(Term t) {
CACHE_REGS
IOSTREAM *s;
int rc;
if ( (rc=PL_get_stream_handle(Yap_InitSlot(t), &s)) ) {
return Sfileno(s);
}
return -1;
}
FILE *Yap_FileDescriptorFromStream(Term t)
{
CACHE_REGS
IOSTREAM *s;
int rc;
if ( (rc=PL_get_stream_handle(Yap_InitSlot(t), &s)) ) {
fprintf(stderr,"Unimplemented\n");
// return Sfileno(s);
}
return NULL;
}
X_API int
PL_raise(int sig)
{
@ -3150,9 +3347,12 @@ PL_raise(int sig)
}
int
raiseSignal(PL_local_data_t *ld, int sig)
raiseSignal(void *ld, int sig);
int
raiseSignal(void *ld, int sig)
{
#if THREADS
#if THREADSX
if (sig == SIG_THREAD_SIGNAL) {
Yap_signal(YAP_ITI_SIGNAL);
return TRUE;
@ -3164,14 +3364,14 @@ raiseSignal(PL_local_data_t *ld, int sig)
#if THREADS
void Yap_LockStream(IOSTREAM *s)
void Yap_LockStream(void *s)
{
if ( s->mutex ) recursiveMutexLock(s->mutex);
// if ( s->mutex ) recursiveMutexLock(s->mutex);
}
void Yap_UnLockStream(IOSTREAM *s)
void Yap_UnLockStream(void *s)
{
if ( s->mutex ) recursiveMutexUnlock(s->mutex);
// if ( s->mutex ) recursiveMutexUnlock(s->mutex);
}
#endif
@ -3226,6 +3426,11 @@ term_t Yap_CvtTerm(term_t ts)
return ts;
}
char * PL_cwd(char *cwd, size_t cwdlen)
{
return (char *)Yap_getcwd( (const char *)cwd, cwdlen );
}
/**
* @}
* @}

42
library/dialect/swi/fli/swi.h
View File

@ -34,6 +34,12 @@
* from the C programmer.
*/
#ifndef SWI_H
#define SWI_H 1
#include "SWI-Prolog.h"
void Yap_swi_install(void);
void Yap_install_blobs(void);
@ -75,6 +81,39 @@ SWIModuleToModule(module_t m)
return USER_MODULE;
}
#ifdef YATOM_H
static inline atom_t
AtomToSWIAtom(Atom at)
{
TranslationEntry *p;
if ((p = Yap_GetTranslationProp(at)) != NULL)
return (atom_t)(p->Translation*2+1);
return (atom_t)at;
}
#endif
static inline Atom
SWIAtomToAtom(atom_t at)
{
if ((CELL)at & 1)
return SWI_Atoms[at/2];
return (Atom)at;
}
/* This is silly, but let's keep it like that for now */
static inline Functor
SWIFunctorToFunctor(functor_t f)
{
if (((CELL)(f) & 2) && ((CELL)f) < N_SWI_FUNCTORS*4+2)
return SWI_Functors[((CELL)f)/4];
return (Functor)f;
}
static inline functor_t
FunctorToSWIFunctor(Functor at)
{
@ -86,6 +125,9 @@ FunctorToSWIFunctor(Functor at)
#define isDefinedProcedure(pred) TRUE // TBD
int Yap_write_blob(AtomEntry *ref, FILE *stream);
#endif
/**
@}
*/

1
library/dialect/swi/listing.pl
View File

@ -2,4 +2,3 @@
% SWI compatibility only
:- module(listing, []).