2008-12-22 12:02:22 +00:00
|
|
|
|
|
|
|
/* YAP support for some low-level SWI stuff */
|
|
|
|
|
|
|
|
#include <stdio.h>
|
2011-03-26 15:17:17 +00:00
|
|
|
#include "Yap.h"
|
|
|
|
#include "Yatom.h"
|
2008-12-22 12:02:22 +00:00
|
|
|
#include "pl-incl.h"
|
2011-02-10 21:14:38 +00:00
|
|
|
#if HAVE_MATH_H
|
|
|
|
#include <math.h>
|
|
|
|
#endif
|
2010-07-15 23:35:04 +01:00
|
|
|
|
|
|
|
#define Quote_illegal_f 1
|
|
|
|
#define Ignore_ops_f 2
|
|
|
|
#define Handle_vars_f 4
|
|
|
|
#define Use_portray_f 8
|
|
|
|
#define To_heap_f 16
|
|
|
|
#define Unfold_cyclics_f 32
|
|
|
|
|
2009-06-17 05:26:03 +01:00
|
|
|
#ifdef HAVE_LIMITS_H
|
|
|
|
#include <limits.h>
|
|
|
|
#endif
|
2008-12-22 12:02:22 +00:00
|
|
|
|
2009-03-13 19:37:52 +00:00
|
|
|
int fileerrors;
|
|
|
|
|
|
|
|
PL_local_data_t lds;
|
|
|
|
|
|
|
|
gds_t gds;
|
|
|
|
|
2008-12-22 12:02:22 +00:00
|
|
|
static atom_t
|
|
|
|
uncachedCodeToAtom(int chrcode)
|
|
|
|
{ if ( chrcode < 256 )
|
2011-02-11 14:17:06 +00:00
|
|
|
{ char tmp[2];
|
2008-12-22 12:02:22 +00:00
|
|
|
|
|
|
|
tmp[0] = chrcode;
|
2011-02-11 14:17:06 +00:00
|
|
|
tmp[1] = '\0';
|
2008-12-22 12:02:22 +00:00
|
|
|
return lookupAtom(tmp, 1);
|
|
|
|
} else
|
|
|
|
{ pl_wchar_t tmp[2];
|
|
|
|
|
|
|
|
tmp[0] = chrcode;
|
|
|
|
tmp[1] = '\0';
|
|
|
|
|
|
|
|
return (atom_t)YAP_LookupWideAtom(tmp);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
atom_t
|
|
|
|
codeToAtom(int chrcode)
|
|
|
|
{ atom_t a;
|
|
|
|
|
|
|
|
if ( chrcode == EOF )
|
|
|
|
return ATOM_end_of_file;
|
|
|
|
|
|
|
|
assert(chrcode >= 0);
|
|
|
|
|
|
|
|
if ( chrcode < (1<<15) )
|
|
|
|
{ int page = chrcode / 256;
|
|
|
|
int entry = chrcode % 256;
|
|
|
|
atom_t *pv;
|
|
|
|
|
|
|
|
if ( !(pv=GD->atoms.for_code[page]) )
|
|
|
|
{ pv = PL_malloc(256*sizeof(atom_t));
|
|
|
|
|
|
|
|
memset(pv, 0, 256*sizeof(atom_t));
|
|
|
|
GD->atoms.for_code[page] = pv;
|
|
|
|
}
|
|
|
|
|
|
|
|
if ( !(a=pv[entry]) )
|
|
|
|
{ a = pv[entry] = uncachedCodeToAtom(chrcode);
|
|
|
|
}
|
|
|
|
} else
|
|
|
|
{ a = uncachedCodeToAtom(chrcode);
|
|
|
|
}
|
|
|
|
|
|
|
|
return a;
|
|
|
|
}
|
|
|
|
|
2010-06-23 11:44:44 +01:00
|
|
|
word
|
|
|
|
globalString(size_t size, char *s)
|
|
|
|
{
|
2011-03-11 23:21:23 +00:00
|
|
|
return Yap_MkBlobStringTerm(s, size);
|
2010-06-23 11:44:44 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
word
|
|
|
|
globalWString(size_t size, wchar_t *s)
|
|
|
|
{
|
2011-03-11 23:21:23 +00:00
|
|
|
return Yap_MkBlobWideStringTerm(s, size);
|
2010-06-23 11:44:44 +01:00
|
|
|
}
|
|
|
|
|
2008-12-22 12:02:22 +00:00
|
|
|
int
|
|
|
|
PL_rethrow(void)
|
|
|
|
{ GET_LD
|
|
|
|
|
|
|
|
if ( LD->exception.throw_environment )
|
|
|
|
longjmp(LD->exception.throw_environment->exception_jmp_env, 1);
|
|
|
|
|
|
|
|
fail;
|
|
|
|
}
|
|
|
|
|
2011-02-10 00:01:19 +00:00
|
|
|
int
|
|
|
|
saveWakeup(wakeup_state *state, int forceframe ARG_LD)
|
|
|
|
{
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
void
|
|
|
|
restoreWakeup(wakeup_state *state ARG_LD)
|
|
|
|
{
|
|
|
|
}
|
2008-12-22 12:02:22 +00:00
|
|
|
|
|
|
|
int
|
2011-03-03 11:41:21 +00:00
|
|
|
callProlog(module_t module, term_t goal, int flags, term_t *ex )
|
|
|
|
{ GET_LD
|
|
|
|
term_t g = PL_new_term_ref();
|
2008-12-22 12:02:22 +00:00
|
|
|
functor_t fd;
|
|
|
|
predicate_t proc;
|
|
|
|
|
|
|
|
if ( ex )
|
|
|
|
*ex = 0;
|
|
|
|
|
|
|
|
PL_strip_module(goal, &module, g);
|
|
|
|
if ( !PL_get_functor(g, &fd) )
|
|
|
|
{ PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_callable, goal);
|
|
|
|
if ( ex )
|
|
|
|
*ex = exception_term;
|
|
|
|
|
|
|
|
fail;
|
|
|
|
}
|
|
|
|
|
|
|
|
proc = PL_pred(fd, module);
|
|
|
|
|
|
|
|
{ int arity = arityFunctor(fd);
|
|
|
|
term_t args = PL_new_term_refs(arity);
|
|
|
|
qid_t qid;
|
|
|
|
int n, rval;
|
|
|
|
|
|
|
|
for(n=0; n<arity; n++)
|
|
|
|
_PL_get_arg(n+1, g, args+n);
|
|
|
|
|
|
|
|
qid = PL_open_query(module, flags, proc, args);
|
|
|
|
rval = PL_next_solution(qid);
|
|
|
|
if ( !rval && ex )
|
|
|
|
*ex = PL_exception(qid);
|
|
|
|
PL_cut_query(qid);
|
|
|
|
|
|
|
|
return rval;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2011-02-14 22:13:45 +00:00
|
|
|
extern YAP_Term Yap_InnerEval(YAP_Term t);
|
|
|
|
|
|
|
|
inline static YAP_Term
|
|
|
|
Yap_Eval(YAP_Term t)
|
|
|
|
{
|
|
|
|
if (t == 0L || ( !YAP_IsVarTerm(t) && (YAP_IsIntTerm(t) || YAP_IsFloatTerm(t)) ))
|
|
|
|
return t;
|
|
|
|
return Yap_InnerEval(t);
|
|
|
|
}
|
|
|
|
|
2011-02-15 22:44:06 +00:00
|
|
|
IOENC
|
|
|
|
Yap_DefaultEncoding(void)
|
|
|
|
{
|
2011-03-03 11:41:21 +00:00
|
|
|
GET_LD
|
2011-02-15 22:44:06 +00:00
|
|
|
return LD->encoding;
|
|
|
|
}
|
|
|
|
|
|
|
|
void
|
|
|
|
Yap_SetDefaultEncoding(IOENC new_encoding)
|
|
|
|
{
|
2011-03-03 11:41:21 +00:00
|
|
|
GET_LD
|
2011-02-15 22:44:06 +00:00
|
|
|
LD->encoding = new_encoding;
|
|
|
|
}
|
2011-02-14 22:13:45 +00:00
|
|
|
|
2008-12-22 12:02:22 +00:00
|
|
|
int
|
|
|
|
valueExpression(term_t t, Number r ARG_LD)
|
2011-02-14 22:13:45 +00:00
|
|
|
{
|
|
|
|
YAP_Term t0 = Yap_Eval(YAP_GetFromSlot(t));
|
|
|
|
if (YAP_IsIntTerm(t0)) {
|
|
|
|
r->type = V_INTEGER;
|
|
|
|
r->value.i = YAP_IntOfTerm(t0);
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
if (YAP_IsFloatTerm(t0)) {
|
|
|
|
r->type = V_FLOAT;
|
|
|
|
r->value.f = YAP_FloatOfTerm(t0);
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
#ifdef O_GMP
|
|
|
|
if (YAP_IsBigNumTerm(t0)) {
|
|
|
|
r->type = V_MPZ;
|
2011-03-02 09:20:05 +00:00
|
|
|
mpz_init(r->value.mpz);
|
|
|
|
YAP_BigNumOfTerm(t0, r->value.mpz);
|
2011-02-14 22:13:45 +00:00
|
|
|
return 1;
|
|
|
|
}
|
2011-02-27 10:13:25 +00:00
|
|
|
if (YAP_IsRationalTerm(t0)) {
|
|
|
|
r->type = V_MPQ;
|
2011-03-02 09:20:05 +00:00
|
|
|
mpq_init(r->value.mpq);
|
|
|
|
YAP_RationalOfTerm(t0, r->value.mpq);
|
2011-02-27 10:13:25 +00:00
|
|
|
return 1;
|
|
|
|
}
|
2011-02-14 22:13:45 +00:00
|
|
|
#endif
|
2008-12-22 12:02:22 +00:00
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
toIntegerNumber(Number n, int flags)
|
|
|
|
|
|
|
|
Convert a number to an integer. Default, only rationals that happen to
|
|
|
|
be integer are converted. If TOINT_CONVERT_FLOAT is present, floating
|
|
|
|
point numbers are converted if they represent integers. If also
|
|
|
|
TOINT_TRUNCATE is provided non-integer floats are truncated to integers.
|
|
|
|
|
|
|
|
Note that if a double is out of range for int64_t, it never has a
|
|
|
|
fractional part.
|
|
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
|
|
|
|
2011-02-14 22:13:45 +00:00
|
|
|
static int
|
|
|
|
double_in_int64_range(double x)
|
|
|
|
{ int k;
|
|
|
|
double y = frexp(x, &k);
|
|
|
|
|
|
|
|
if ( k < 8*(int)sizeof(int64_t) ||
|
|
|
|
(y == -0.5 && k == 8*(int)sizeof(int64_t)) )
|
|
|
|
return TRUE;
|
|
|
|
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
|
2008-12-22 12:02:22 +00:00
|
|
|
int
|
|
|
|
toIntegerNumber(Number n, int flags)
|
|
|
|
{
|
|
|
|
switch(n->type)
|
|
|
|
{ case V_INTEGER:
|
|
|
|
succeed;
|
|
|
|
#ifdef O_GMP
|
|
|
|
case V_MPZ:
|
|
|
|
succeed;
|
|
|
|
case V_MPQ: /* never from stacks iff integer */
|
|
|
|
if ( mpz_cmp_ui(mpq_denref(n->value.mpq), 1L) == 0 )
|
|
|
|
{ mpz_clear(mpq_denref(n->value.mpq));
|
|
|
|
n->value.mpz[0] = mpq_numref(n->value.mpq)[0];
|
|
|
|
n->type = V_MPZ;
|
|
|
|
succeed;
|
|
|
|
}
|
|
|
|
fail;
|
|
|
|
#endif
|
2011-02-14 22:13:45 +00:00
|
|
|
case V_FLOAT:
|
2008-12-22 12:02:22 +00:00
|
|
|
if ( (flags & TOINT_CONVERT_FLOAT) )
|
|
|
|
{ if ( double_in_int64_range(n->value.f) )
|
|
|
|
{ int64_t l = (int64_t)n->value.f;
|
|
|
|
|
|
|
|
if ( (flags & TOINT_TRUNCATE) ||
|
|
|
|
(double)l == n->value.f )
|
|
|
|
{ n->value.i = l;
|
|
|
|
n->type = V_INTEGER;
|
|
|
|
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
return FALSE;
|
|
|
|
#ifdef O_GMP
|
|
|
|
} else
|
|
|
|
{ mpz_init_set_d(n->value.mpz, n->value.f);
|
|
|
|
n->type = V_MPZ;
|
|
|
|
|
|
|
|
return TRUE;
|
|
|
|
#endif
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
assert(0);
|
|
|
|
fail;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
int
|
|
|
|
_PL_unify_atomic(term_t t, PL_atomic_t a)
|
|
|
|
{
|
2011-03-03 11:41:21 +00:00
|
|
|
GET_LD
|
2010-05-04 15:17:08 +01:00
|
|
|
return PL_unify_atom(t, a);
|
2008-12-22 12:02:22 +00:00
|
|
|
}
|
|
|
|
|
2011-03-11 23:21:23 +00:00
|
|
|
int
|
|
|
|
_PL_unify_string(term_t t, word w)
|
|
|
|
{
|
2011-03-26 15:17:17 +00:00
|
|
|
CACHE_REGS
|
2011-03-11 23:21:23 +00:00
|
|
|
return Yap_unify(Yap_GetFromSlot(t PASS_REGS), w);
|
|
|
|
}
|
|
|
|
|
2008-12-22 12:02:22 +00:00
|
|
|
word lookupAtom(const char *s, size_t len)
|
|
|
|
{
|
2011-02-11 01:22:07 +00:00
|
|
|
/* dirty trick to ensure s is null terminated */
|
|
|
|
char *st = (char *)s;
|
|
|
|
st[len] = '\0';
|
2010-06-17 08:20:34 +01:00
|
|
|
if (len >= strlen(s)) {
|
|
|
|
return (word)YAP_LookupAtom(s);
|
|
|
|
} else {
|
|
|
|
char * buf = PL_malloc(len+1);
|
|
|
|
word out;
|
|
|
|
|
|
|
|
if (!buf)
|
|
|
|
return 0;
|
|
|
|
strncpy(buf,s,len);
|
|
|
|
out = (word)YAP_LookupAtom(buf);
|
|
|
|
PL_free(buf);
|
|
|
|
return out;
|
|
|
|
}
|
2008-12-22 12:02:22 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
atom_t lookupUCSAtom(const pl_wchar_t *s, size_t len)
|
|
|
|
{
|
2010-06-17 08:20:34 +01:00
|
|
|
if (len >= wcslen(s)) {
|
|
|
|
return (atom_t)YAP_LookupWideAtom(s);
|
|
|
|
} else {
|
|
|
|
pl_wchar_t * buf = PL_malloc((len+1)*sizeof(pl_wchar_t));
|
|
|
|
word out;
|
|
|
|
|
|
|
|
if (!buf)
|
|
|
|
return 0;
|
|
|
|
wcsncpy(buf,s,len);
|
|
|
|
out = (word)YAP_LookupWideAtom(buf);
|
|
|
|
PL_free(buf);
|
|
|
|
return out;
|
|
|
|
}
|
2008-12-22 12:02:22 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/*******************************
|
|
|
|
* OPTIONS *
|
|
|
|
*******************************/
|
|
|
|
|
|
|
|
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
Variable argument list:
|
|
|
|
|
|
|
|
atom_t name
|
|
|
|
int type OPT_ATOM, OPT_STRING, OPT_BOOL, OPT_INT, OPT_LONG
|
|
|
|
pointer value
|
|
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
|
|
|
|
|
|
|
#define MAXOPTIONS 32
|
|
|
|
|
|
|
|
typedef union
|
|
|
|
{ bool *b; /* boolean value */
|
|
|
|
long *l; /* long value */
|
|
|
|
int *i; /* integer value */
|
|
|
|
char **s; /* string value */
|
|
|
|
word *a; /* atom value */
|
|
|
|
term_t *t; /* term-reference */
|
|
|
|
void *ptr; /* anonymous pointer */
|
|
|
|
} optvalue;
|
|
|
|
|
|
|
|
|
|
|
|
int
|
|
|
|
get_atom_ptr_text(Atom a, PL_chars_t *text)
|
2011-03-02 09:20:05 +00:00
|
|
|
{
|
|
|
|
YAP_Atom ya = (YAP_Atom)a;
|
|
|
|
if (YAP_IsWideAtom(ya)) {
|
|
|
|
pl_wchar_t *name = (pl_wchar_t *)YAP_WideAtomName(ya);
|
|
|
|
text->text.w = name;
|
|
|
|
text->length = wcslen(name);
|
|
|
|
text->encoding = ENC_WCHAR;
|
2008-12-22 12:02:22 +00:00
|
|
|
} else
|
2011-03-02 09:20:05 +00:00
|
|
|
{ char *name = (char *)YAP_AtomName(ya);
|
2008-12-22 12:02:22 +00:00
|
|
|
text->text.t = name;
|
|
|
|
text->length = strlen(name);
|
|
|
|
text->encoding = ENC_ISO_LATIN_1;
|
|
|
|
}
|
|
|
|
text->storage = PL_CHARS_HEAP;
|
|
|
|
text->canonical = TRUE;
|
|
|
|
|
|
|
|
succeed;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
int
|
|
|
|
get_atom_text(atom_t atom, PL_chars_t *text)
|
2011-03-02 09:20:05 +00:00
|
|
|
{ Atom a = (Atom)atomValue(atom);
|
2008-12-22 12:02:22 +00:00
|
|
|
|
|
|
|
return get_atom_ptr_text(a, text);
|
|
|
|
}
|
|
|
|
|
|
|
|
int
|
|
|
|
get_string_text(word w, PL_chars_t *text ARG_LD)
|
2011-03-11 23:21:23 +00:00
|
|
|
{
|
|
|
|
CELL fl = RepAppl(w)[1];
|
|
|
|
if (fl == BLOB_STRING) {
|
|
|
|
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;
|
2008-12-22 12:02:22 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
void
|
|
|
|
PL_get_number(term_t l, number *n) {
|
2011-03-03 11:41:21 +00:00
|
|
|
GET_LD
|
2008-12-22 12:02:22 +00:00
|
|
|
YAP_Term t = valHandle(l);
|
|
|
|
if (YAP_IsIntTerm(t)) {
|
|
|
|
n->type = V_INTEGER;
|
|
|
|
n->value.i = YAP_IntOfTerm(t);
|
|
|
|
#ifdef O_GMP
|
2011-02-27 11:40:27 +00:00
|
|
|
} else if (YAP_IsBigNumTerm(t)) {
|
2008-12-22 12:02:22 +00:00
|
|
|
n->type = V_MPZ;
|
2011-03-02 09:20:05 +00:00
|
|
|
mpz_init(n->value.mpz);
|
|
|
|
YAP_BigNumOfTerm(t, n->value.mpz);
|
2011-02-27 11:40:27 +00:00
|
|
|
} else {
|
|
|
|
n->type = V_MPQ;
|
2011-03-02 09:20:05 +00:00
|
|
|
mpq_init(n->value.mpq);
|
2011-02-27 11:40:27 +00:00
|
|
|
YAP_RationalOfTerm(t, &n->value.mpq);
|
2008-12-22 12:02:22 +00:00
|
|
|
#endif
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
Formatting a float. This is very complicated as we must write floats
|
|
|
|
such that it can be read as a float. This means using the conventions of
|
|
|
|
the C locale and if the float happens to be integer as <int>.0.
|
|
|
|
|
|
|
|
Switching the locale is no option as locale handling is not thread-safe
|
|
|
|
and may have unwanted consequences for embedding. There is a intptr_t
|
|
|
|
discussion on the very same topic on the Python mailinglist. Many hacks
|
|
|
|
are proposed, none is very satisfactory. Richard O'Keefe suggested to
|
|
|
|
use ecvt(), fcvt() and gcvt(). These are not thread-safe. The GNU C
|
|
|
|
library provides *_r() variations that can do the trick. An earlier
|
|
|
|
patch used localeconv() to find the decimal point, but this is both
|
|
|
|
complicated and not thread-safe.
|
|
|
|
|
|
|
|
Finally, with help of Richard we decided to replace the first character
|
|
|
|
that is not a digit nor [eE], as this must be the decimal point.
|
|
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
|
|
|
|
|
|
|
#define isDigit(c) ((c) >= '0' && (c) <= '9')
|
|
|
|
|
2011-02-10 00:01:19 +00:00
|
|
|
intptr_t
|
|
|
|
lengthList(term_t list, int errors)
|
2008-12-22 12:02:22 +00:00
|
|
|
{ GET_LD
|
2011-02-10 00:01:19 +00:00
|
|
|
intptr_t length = 0;
|
|
|
|
Word l = YAP_AddressFromSlot(list);
|
|
|
|
Word tail;
|
2008-12-22 12:02:22 +00:00
|
|
|
|
2011-02-10 00:01:19 +00:00
|
|
|
length = skip_list(l, &tail PASS_LD);
|
2008-12-22 12:02:22 +00:00
|
|
|
|
2011-02-10 00:01:19 +00:00
|
|
|
if ( isNil(*tail) )
|
|
|
|
return length;
|
2008-12-22 12:02:22 +00:00
|
|
|
|
2011-02-10 00:01:19 +00:00
|
|
|
if ( errors )
|
|
|
|
PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, wordToTermRef(l));
|
2008-12-22 12:02:22 +00:00
|
|
|
|
2011-02-10 00:01:19 +00:00
|
|
|
return isVar(*tail) ? -2 : -1;
|
2008-12-22 12:02:22 +00:00
|
|
|
}
|
2009-03-13 19:37:52 +00:00
|
|
|
|
2011-03-26 15:17:17 +00:00
|
|
|
int raiseStackOverflow(int overflow)
|
2009-06-02 00:01:30 +01:00
|
|
|
{
|
2011-03-26 15:17:17 +00:00
|
|
|
return overflow;
|
2009-06-02 00:01:30 +01:00
|
|
|
}
|
|
|
|
|
2011-03-26 15:17:17 +00:00
|
|
|
/*******************************
|
|
|
|
* FEATURES *
|
|
|
|
*******************************/
|
|
|
|
|
|
|
|
int
|
|
|
|
PL_set_prolog_flag(const char *name, int type, ...)
|
|
|
|
{ va_list args;
|
|
|
|
int rval = TRUE;
|
|
|
|
int flags = (type & FF_MASK);
|
|
|
|
|
|
|
|
initPrologFlagTable();
|
|
|
|
|
|
|
|
va_start(args, type);
|
|
|
|
switch(type & ~FF_MASK)
|
|
|
|
{ case PL_BOOL:
|
|
|
|
{ int val = va_arg(args, int);
|
|
|
|
|
|
|
|
setPrologFlag(name, FT_BOOL|flags, val, 0);
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
case PL_ATOM:
|
|
|
|
{ const char *v = va_arg(args, const char *);
|
|
|
|
#ifndef __YAP_PROLOG__
|
|
|
|
if ( !GD->initialised )
|
|
|
|
initAtoms();
|
|
|
|
#endif
|
|
|
|
setPrologFlag(name, FT_ATOM|flags, v);
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
case PL_INTEGER:
|
|
|
|
{ intptr_t v = va_arg(args, intptr_t);
|
|
|
|
setPrologFlag(name, FT_INTEGER|flags, v);
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
default:
|
|
|
|
rval = FALSE;
|
|
|
|
}
|
|
|
|
|
|
|
|
va_end(args);
|
|
|
|
return rval;
|
2009-06-02 00:01:30 +01:00
|
|
|
}
|
2009-03-13 19:37:52 +00:00
|
|
|
|
2011-03-26 15:17:17 +00:00
|
|
|
|
|
|
|
|
2010-02-22 22:01:02 +00:00
|
|
|
int
|
|
|
|
PL_unify_chars(term_t t, int flags, size_t len, const char *s)
|
|
|
|
{ PL_chars_t text;
|
|
|
|
term_t tail;
|
|
|
|
int rc;
|
|
|
|
|
|
|
|
if ( len == (size_t)-1 )
|
|
|
|
len = strlen(s);
|
|
|
|
|
|
|
|
text.text.t = (char *)s;
|
|
|
|
text.encoding = ((flags&REP_UTF8) ? ENC_UTF8 : \
|
|
|
|
(flags&REP_MB) ? ENC_ANSI : ENC_ISO_LATIN_1);
|
|
|
|
text.storage = PL_CHARS_HEAP;
|
|
|
|
text.length = len;
|
|
|
|
text.canonical = FALSE;
|
|
|
|
|
|
|
|
flags &= ~(REP_UTF8|REP_MB|REP_ISO_LATIN_1);
|
|
|
|
|
|
|
|
if ( (flags & PL_DIFF_LIST) )
|
|
|
|
{ tail = t+1;
|
|
|
|
flags &= (~PL_DIFF_LIST);
|
|
|
|
} else
|
|
|
|
{ tail = 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
rc = PL_unify_text(t, tail, &text, flags);
|
|
|
|
PL_free_text(&text);
|
|
|
|
|
|
|
|
return rc;
|
|
|
|
}
|
|
|
|
|
2010-05-04 15:17:08 +01:00
|
|
|
X_API int PL_handle_signals(void)
|
|
|
|
{
|
2011-03-03 11:41:21 +00:00
|
|
|
GET_LD
|
2010-05-04 15:17:08 +01:00
|
|
|
if ( !LD || LD->critical || !LD->signal.pending )
|
|
|
|
return 0;
|
|
|
|
fprintf(stderr,"PL_handle_signals not implemented\n");
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
2011-02-10 00:01:19 +00:00
|
|
|
void
|
|
|
|
outOfCore()
|
|
|
|
{ fprintf(stderr,"Could not allocate memory: %s", OsError());
|
|
|
|
exit(1);
|
|
|
|
}
|
|
|
|
|
|
|
|
int
|
|
|
|
priorityOperator(Module m, atom_t atom)
|
|
|
|
{
|
2011-02-10 21:14:38 +00:00
|
|
|
YAP_Term mod = (YAP_Term)m;
|
|
|
|
if (!m)
|
|
|
|
mod = YAP_CurrentModule();
|
|
|
|
return YAP_MaxOpPriority(YAP_AtomFromSWIAtom(atom), mod);
|
2011-02-10 00:01:19 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
int
|
|
|
|
currentOperator(Module m, atom_t name, int kind, int *type, int *priority)
|
|
|
|
{
|
2011-02-10 21:14:38 +00:00
|
|
|
YAP_Term mod = (YAP_Term)m;
|
|
|
|
YAP_Atom at;
|
|
|
|
int opkind, yap_type;
|
|
|
|
|
|
|
|
if (!m)
|
|
|
|
mod = YAP_CurrentModule();
|
|
|
|
at = YAP_AtomFromSWIAtom(name);
|
|
|
|
switch (kind) {
|
|
|
|
case OP_PREFIX:
|
|
|
|
opkind = 2;
|
|
|
|
break;
|
|
|
|
case OP_INFIX:
|
|
|
|
opkind = 0;
|
|
|
|
break;
|
|
|
|
case OP_POSTFIX:
|
|
|
|
default:
|
|
|
|
opkind = 1;
|
|
|
|
}
|
2011-03-01 10:32:25 +00:00
|
|
|
if (!YAP_OpInfo(YAP_AtomFromSWIAtom(name), mod, opkind, &yap_type, priority)) {
|
2011-02-10 21:14:38 +00:00
|
|
|
return FALSE;
|
2011-03-01 10:32:25 +00:00
|
|
|
}
|
2011-02-10 21:14:38 +00:00
|
|
|
switch(yap_type) {
|
|
|
|
case 1:
|
|
|
|
*type = OP_XFX;
|
|
|
|
break;
|
|
|
|
case 2:
|
|
|
|
*type = OP_XFY;
|
|
|
|
break;
|
|
|
|
case 3:
|
|
|
|
*type = OP_YFX;
|
|
|
|
break;
|
|
|
|
case 4:
|
|
|
|
*type = OP_XFX;
|
|
|
|
break;
|
|
|
|
case 5:
|
|
|
|
*type = OP_XF;
|
|
|
|
break;
|
|
|
|
case 6:
|
|
|
|
*type = OP_YF;
|
|
|
|
break;
|
|
|
|
case 7:
|
|
|
|
*type = OP_FX;
|
|
|
|
break;
|
|
|
|
default:
|
|
|
|
*type = OP_FY;
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
return 1;
|
2011-02-10 00:01:19 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
int
|
|
|
|
numberVars(term_t t, nv_options *opts, int n ARG_LD) {
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
/*******************************
|
|
|
|
* PROMOTION *
|
|
|
|
*******************************/
|
|
|
|
|
2011-02-10 21:14:38 +00:00
|
|
|
static int
|
|
|
|
check_float(double f)
|
|
|
|
{
|
|
|
|
#ifdef HAVE_FPCLASSIFY
|
|
|
|
switch(fpclassify(f))
|
|
|
|
{ case FP_NAN:
|
|
|
|
return PL_error(NULL, 0, NULL, ERR_AR_UNDEF);
|
2011-02-10 00:01:19 +00:00
|
|
|
break;
|
2011-02-10 21:14:38 +00:00
|
|
|
case FP_INFINITE:
|
|
|
|
return PL_error(NULL, 0, NULL, ERR_AR_OVERFLOW);
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
#else
|
|
|
|
#ifdef HAVE_FPCLASS
|
|
|
|
switch(fpclass(f))
|
|
|
|
{ case FP_SNAN:
|
|
|
|
case FP_QNAN:
|
|
|
|
return PL_error(NULL, 0, NULL, ERR_AR_UNDEF);
|
2011-02-10 00:01:19 +00:00
|
|
|
break;
|
2011-02-10 21:14:38 +00:00
|
|
|
case FP_NINF:
|
|
|
|
case FP_PINF:
|
|
|
|
return PL_error(NULL, 0, NULL, ERR_AR_OVERFLOW);
|
|
|
|
break;
|
|
|
|
case FP_NDENORM: /* pos/neg denormalized non-zero */
|
|
|
|
case FP_PDENORM:
|
|
|
|
case FP_NNORM: /* pos/neg normalized non-zero */
|
|
|
|
case FP_PNORM:
|
|
|
|
case FP_NZERO: /* pos/neg zero */
|
|
|
|
case FP_PZERO:
|
2011-02-10 00:01:19 +00:00
|
|
|
break;
|
|
|
|
}
|
2011-02-10 21:14:38 +00:00
|
|
|
#else
|
|
|
|
#ifdef HAVE__FPCLASS
|
|
|
|
switch(_fpclass(f))
|
|
|
|
{ case _FPCLASS_SNAN:
|
|
|
|
case _FPCLASS_QNAN:
|
|
|
|
return PL_error(NULL, 0, NULL, ERR_AR_UNDEF);
|
|
|
|
break;
|
|
|
|
case _FPCLASS_NINF:
|
|
|
|
case _FPCLASS_PINF:
|
|
|
|
return PL_error(NULL, 0, NULL, ERR_AR_OVERFLOW);
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
#else
|
|
|
|
#ifdef HAVE_ISNAN
|
|
|
|
if ( isnan(f) )
|
|
|
|
return PL_error(NULL, 0, NULL, ERR_AR_UNDEF);
|
2011-02-10 00:01:19 +00:00
|
|
|
#endif
|
2011-02-10 21:14:38 +00:00
|
|
|
#ifdef HAVE_ISINF
|
|
|
|
if ( isinf(f) )
|
|
|
|
return PL_error(NULL, 0, NULL, ERR_AR_OVERFLOW);
|
|
|
|
#endif
|
|
|
|
#endif /*HAVE__FPCLASS*/
|
|
|
|
#endif /*HAVE_FPCLASS*/
|
|
|
|
#endif /*HAVE_FPCLASSIFY*/
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2011-02-10 00:01:19 +00:00
|
|
|
|
|
|
|
int
|
|
|
|
promoteToFloatNumber(Number n)
|
|
|
|
{ switch(n->type)
|
|
|
|
{ case V_INTEGER:
|
|
|
|
n->value.f = (double)n->value.i;
|
|
|
|
n->type = V_FLOAT;
|
|
|
|
break;
|
|
|
|
#ifdef O_GMP
|
|
|
|
case V_MPZ:
|
|
|
|
{ double val = mpz_get_d(n->value.mpz);
|
|
|
|
|
|
|
|
if ( !check_float(val) )
|
|
|
|
return FALSE;
|
|
|
|
|
|
|
|
clearNumber(n);
|
|
|
|
n->value.f = val;
|
|
|
|
n->type = V_FLOAT;
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
case V_MPQ:
|
|
|
|
{ double val = mpq_get_d(n->value.mpq);
|
|
|
|
|
|
|
|
if ( !check_float(val) )
|
|
|
|
return FALSE;
|
|
|
|
|
|
|
|
clearNumber(n);
|
|
|
|
n->value.f = val;
|
|
|
|
n->type = V_FLOAT;
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
case V_FLOAT:
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
2011-02-12 00:17:59 +00:00
|
|
|
int
|
|
|
|
PL_get_list_nchars(term_t l, size_t *length, char **s, unsigned int flags)
|
|
|
|
{ Buffer b;
|
|
|
|
CVT_result result;
|
|
|
|
|
|
|
|
if ( (b = codes_or_chars_to_buffer(l, flags, FALSE, &result)) )
|
|
|
|
{ char *r;
|
|
|
|
size_t len = entriesBuffer(b, char);
|
|
|
|
|
|
|
|
if ( length )
|
|
|
|
*length = len;
|
|
|
|
addBuffer(b, EOS, char);
|
|
|
|
r = baseBuffer(b, char);
|
|
|
|
|
|
|
|
if ( flags & BUF_MALLOC )
|
|
|
|
{ *s = PL_malloc(len+1);
|
|
|
|
memcpy(*s, r, len+1);
|
|
|
|
unfindBuffer(flags);
|
|
|
|
} else
|
|
|
|
*s = r;
|
|
|
|
|
|
|
|
succeed;
|
|
|
|
}
|
|
|
|
|
|
|
|
fail;
|
|
|
|
}
|
|
|
|
|
|
|
|
int
|
|
|
|
PL_get_list_chars(term_t l, char **s, unsigned flags)
|
|
|
|
{ return PL_get_list_nchars(l, NULL, s, flags);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2011-03-11 19:49:32 +00:00
|
|
|
int
|
|
|
|
PL_unify_wchars_diff(term_t t, term_t tail, int flags,
|
|
|
|
size_t len, const pl_wchar_t *s)
|
|
|
|
{ PL_chars_t text;
|
|
|
|
int rc;
|
|
|
|
|
|
|
|
if ( len == (size_t)-1 )
|
|
|
|
len = wcslen(s);
|
|
|
|
|
|
|
|
text.text.w = (pl_wchar_t *)s;
|
|
|
|
text.encoding = ENC_WCHAR;
|
|
|
|
text.storage = PL_CHARS_HEAP;
|
|
|
|
text.length = len;
|
|
|
|
text.canonical = FALSE;
|
|
|
|
|
|
|
|
rc = PL_unify_text(t, tail, &text, flags);
|
|
|
|
PL_free_text(&text);
|
|
|
|
|
|
|
|
return rc;
|
|
|
|
}
|
|
|
|
|
2011-02-12 00:17:59 +00:00
|
|
|
int
|
|
|
|
PL_get_wchars(term_t l, size_t *length, pl_wchar_t **s, unsigned flags)
|
|
|
|
{ GET_LD
|
|
|
|
PL_chars_t text;
|
|
|
|
|
|
|
|
if ( !PL_get_text(l, &text, flags) )
|
|
|
|
return FALSE;
|
|
|
|
|
|
|
|
PL_promote_text(&text);
|
|
|
|
PL_save_text(&text, flags);
|
|
|
|
|
|
|
|
if ( length )
|
|
|
|
*length = text.length;
|
|
|
|
*s = text.text.w;
|
|
|
|
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
int
|
|
|
|
PL_get_nchars(term_t l, size_t *length, char **s, unsigned flags)
|
|
|
|
{ GET_LD
|
|
|
|
PL_chars_t text;
|
|
|
|
|
|
|
|
if ( !PL_get_text(l, &text, flags) )
|
|
|
|
return FALSE;
|
|
|
|
|
|
|
|
if ( PL_mb_text(&text, flags) )
|
|
|
|
{ PL_save_text(&text, flags);
|
|
|
|
|
|
|
|
if ( length )
|
|
|
|
*length = text.length;
|
|
|
|
*s = text.text.t;
|
|
|
|
|
|
|
|
return TRUE;
|
|
|
|
} else
|
|
|
|
{ PL_free_text(&text);
|
|
|
|
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
int
|
|
|
|
PL_get_chars(term_t t, char **s, unsigned flags)
|
|
|
|
{ return PL_get_nchars(t, NULL, s, flags);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
2011-02-10 00:01:19 +00:00
|
|
|
|
2011-02-03 11:23:12 +00:00
|
|
|
X_API int
|
|
|
|
PL_ttymode(IOSTREAM *s)
|
|
|
|
{ GET_LD
|
|
|
|
|
|
|
|
if ( s == Suser_input )
|
|
|
|
{ if ( !truePrologFlag(PLFLAG_TTY_CONTROL) ) /* -tty in effect */
|
|
|
|
return PL_NOTTY;
|
|
|
|
if ( ttymode == TTY_RAW ) /* get_single_char/1 and friends */
|
|
|
|
return PL_RAWTTY;
|
|
|
|
return PL_COOKEDTTY; /* cooked (readline) input */
|
|
|
|
} else
|
|
|
|
return PL_NOTTY;
|
|
|
|
}
|
|
|
|
|
2011-03-26 15:17:17 +00:00
|
|
|
char *
|
|
|
|
PL_prompt_string(int fd)
|
|
|
|
{ if ( fd == 0 )
|
|
|
|
{ atom_t a = PrologPrompt(); /* TBD: deal with UTF-8 */
|
|
|
|
|
|
|
|
if ( a )
|
|
|
|
{
|
|
|
|
Atom at = YAP_AtomFromSWIAtom(a);
|
|
|
|
if (!IsWideAtom(at) && !IsBlob(at)) {
|
|
|
|
return RepAtom(at)->StrOfAE;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
return NULL;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2011-02-03 11:23:12 +00:00
|
|
|
X_API void
|
|
|
|
PL_prompt_next(int fd)
|
|
|
|
{ GET_LD
|
|
|
|
|
|
|
|
if ( fd == 0 )
|
|
|
|
LD->prompt.next = TRUE;
|
|
|
|
}
|
|
|
|
|
2010-05-05 16:31:08 +01:00
|
|
|
/* just a stub for now */
|
|
|
|
int
|
|
|
|
warning(const char *fm, ...)
|
|
|
|
{ va_list args;
|
|
|
|
|
|
|
|
va_start(args, fm);
|
|
|
|
fprintf(stderr,"warning: %s\n", fm);
|
|
|
|
va_end(args);
|
|
|
|
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2010-06-17 00:33:57 +01:00
|
|
|
#if defined(HAVE_SELECT) && !defined(__WINDOWS__)
|
|
|
|
|
|
|
|
#ifdef __WINDOWS__
|
|
|
|
#include <winsock2.h>
|
|
|
|
#endif
|
|
|
|
|
|
|
|
static int
|
|
|
|
input_on_fd(int fd)
|
|
|
|
{ fd_set rfds;
|
|
|
|
struct timeval tv;
|
|
|
|
|
|
|
|
FD_ZERO(&rfds);
|
|
|
|
FD_SET(fd, &rfds);
|
|
|
|
tv.tv_sec = 0;
|
|
|
|
tv.tv_usec = 0;
|
|
|
|
|
|
|
|
return select(fd+1, &rfds, NULL, NULL, &tv) != 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
#else
|
|
|
|
#define input_on_fd(fd) 1
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
2011-03-26 15:17:17 +00:00
|
|
|
PL_dispatch_hook_t
|
|
|
|
PL_dispatch_hook(PL_dispatch_hook_t hook)
|
|
|
|
{ PL_dispatch_hook_t old = GD->foreign.dispatch_events;
|
|
|
|
|
|
|
|
GD->foreign.dispatch_events = hook;
|
|
|
|
return old;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2010-06-17 00:33:57 +01:00
|
|
|
X_API int
|
|
|
|
PL_dispatch(int fd, int wait)
|
|
|
|
{ if ( wait == PL_DISPATCH_INSTALLED )
|
|
|
|
return GD->foreign.dispatch_events ? TRUE : FALSE;
|
|
|
|
|
|
|
|
if ( GD->foreign.dispatch_events && PL_thread_self() == 1 )
|
|
|
|
{ if ( wait == PL_DISPATCH_WAIT )
|
|
|
|
{ while( !input_on_fd(fd) )
|
|
|
|
{ if ( PL_handle_signals() < 0 )
|
|
|
|
return FALSE;
|
|
|
|
(*GD->foreign.dispatch_events)(fd);
|
|
|
|
}
|
|
|
|
} else
|
|
|
|
{ (*GD->foreign.dispatch_events)(fd);
|
|
|
|
if ( PL_handle_signals() < 0 )
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2011-03-03 11:41:21 +00:00
|
|
|
/* SWI: int PL_get_atom(term_t t, YAP_Atom *a)
|
|
|
|
YAP: YAP_Atom YAP_AtomOfTerm(Term) */
|
|
|
|
int PL_get_atom__LD(term_t ts, atom_t *a ARG_LD)
|
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
|
|
|
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
|
2011-03-03 11:41:21 +00:00
|
|
|
if ( !IsAtomTerm(t))
|
|
|
|
return 0;
|
|
|
|
*a = YAP_SWIAtomFromAtom(AtomOfTerm(t));
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
|
|
|
|
void PL_put_term__LD(term_t d, term_t s ARG_LD)
|
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
|
|
|
Yap_PutInSlot(d,Yap_GetFromSlot(s PASS_REGS) PASS_REGS);
|
2011-03-03 11:41:21 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
term_t PL_new_term_ref__LD(ARG1_LD)
|
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
|
|
|
term_t to = Yap_NewSlots(1 PASS_REGS);
|
2011-03-03 11:41:21 +00:00
|
|
|
return to;
|
|
|
|
}
|
|
|
|
|
|
|
|
int PL_is_variable__LD(term_t ts ARG_LD)
|
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
|
|
|
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
|
2011-03-03 11:41:21 +00:00
|
|
|
return YAP_IsVarTerm(t);
|
|
|
|
}
|
|
|
|
|
|
|
|
int PL_unify_atom__LD(term_t t, atom_t at ARG_LD)
|
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
2011-03-03 11:41:21 +00:00
|
|
|
YAP_Term cterm = MkAtomTerm(YAP_AtomFromSWIAtom(at));
|
2011-03-07 16:02:55 +00:00
|
|
|
return YAP_Unify(Yap_GetFromSlot(t PASS_REGS),cterm);
|
2011-03-03 11:41:21 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
/* SWI: int PL_unify_integer(term_t ?t, long n)
|
|
|
|
YAP long int unify(YAP_Term* a, Term* b) */
|
2011-03-07 16:34:20 +00:00
|
|
|
int PL_unify_integer__LD(term_t t, intptr_t i ARG_LD)
|
2011-03-03 11:41:21 +00:00
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
2011-03-07 16:34:20 +00:00
|
|
|
Term iterm = MkIntegerTerm(i);
|
2011-03-10 11:05:53 +00:00
|
|
|
return Yap_unify(Yap_GetFromSlot(t PASS_REGS),iterm);
|
2011-03-03 11:41:21 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
extern int Yap_getInputStream(term_t t, IOSTREAM **s);
|
|
|
|
|
|
|
|
int Yap_getInputStream(term_t t, IOSTREAM **s)
|
|
|
|
{
|
|
|
|
GET_LD
|
|
|
|
return getInputStream(t, s);
|
|
|
|
}
|
|
|
|
|
2011-02-03 11:23:12 +00:00
|
|
|
#ifdef _WIN32
|
|
|
|
|
|
|
|
#include <windows.h>
|
|
|
|
|
2011-03-03 11:41:21 +00:00
|
|
|
|
|
|
|
|
2011-02-03 11:23:12 +00:00
|
|
|
#if O_PLMT
|
|
|
|
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
PL_w32thread_raise(DWORD id, int sig)
|
|
|
|
Sets the signalled mask for a specific Win32 thread. This is a
|
|
|
|
partial work-around for the lack of proper asynchronous signal
|
|
|
|
handling in the Win32 platform.
|
|
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
|
|
|
|
|
|
|
static int thread_highest_id = 1;
|
|
|
|
|
|
|
|
X_API int
|
|
|
|
PL_w32thread_raise(DWORD id, int sig)
|
|
|
|
{ int i;
|
|
|
|
|
|
|
|
if ( sig < 0 || sig > MAXSIGNAL )
|
|
|
|
return FALSE; /* illegal signal */
|
|
|
|
|
|
|
|
LOCK();
|
|
|
|
for(i = 1; i <= thread_highest_id; i++)
|
|
|
|
{ PL_thread_info_t *info = GD->thread.threads[i];
|
|
|
|
|
|
|
|
if ( info && info->w32id == id && info->thread_data )
|
|
|
|
{ raiseSignal(info->thread_data, sig);
|
|
|
|
if ( info->w32id )
|
|
|
|
PostThreadMessage(info->w32id, WM_SIGNALLED, 0, 0L);
|
|
|
|
UNLOCK();
|
|
|
|
DEBUG(1, Sdprintf("Signalled %d to thread %d\n", sig, i));
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
UNLOCK();
|
|
|
|
|
|
|
|
return FALSE; /* can't find thread */
|
|
|
|
}
|
|
|
|
|
|
|
|
#else
|
|
|
|
|
|
|
|
int
|
|
|
|
PL_w32thread_raise(DWORD id, int sig)
|
|
|
|
{ return PL_raise(sig);
|
|
|
|
}
|
|
|
|
|
|
|
|
#endif
|
|
|
|
#endif /*__WINDOWS__*/
|
|
|
|
|
|
|
|
|
2011-02-10 21:14:38 +00:00
|
|
|
X_API int
|
2011-02-03 11:23:12 +00:00
|
|
|
PL_raise(int sig)
|
2011-03-03 11:41:21 +00:00
|
|
|
{
|
|
|
|
if (sig == SIG_PLABORT) {
|
|
|
|
YAP_signal(0x40); /* YAP_INT_SIGNAL */
|
|
|
|
return 1;
|
|
|
|
} else {
|
|
|
|
return 0;
|
|
|
|
}
|
2011-02-03 11:23:12 +00:00
|
|
|
}
|
|
|
|
|
2010-08-04 11:37:12 +01:00
|
|
|
extern size_t PL_utf8_strlen(const char *s, size_t len);
|
2010-06-18 10:31:20 +01:00
|
|
|
|
|
|
|
X_API size_t
|
|
|
|
PL_utf8_strlen(const char *s, size_t len)
|
|
|
|
{ return utf8_strlen(s, len);
|
|
|
|
}
|
|
|
|
|
2011-02-16 00:23:58 +00:00
|
|
|
void
|
|
|
|
PL_add_to_protocol(const char *buf, size_t n)
|
|
|
|
{ protocol(buf, n);
|
|
|
|
}
|
|
|
|
|
|
|
|
void
|
|
|
|
PL_license(const char *license, const char *module)
|
2011-02-16 21:11:45 +00:00
|
|
|
{
|
|
|
|
/* unimplemented */
|
2011-02-16 00:23:58 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
bool
|
|
|
|
systemMode(bool accept)
|
2011-03-03 11:41:21 +00:00
|
|
|
{
|
|
|
|
return FALSE;
|
2011-02-16 00:23:58 +00:00
|
|
|
}
|
|
|
|
|
2011-02-14 22:13:45 +00:00
|
|
|
term_t
|
|
|
|
Yap_fetch_module_for_format(term_t args, YAP_Term *modp) {
|
|
|
|
YAP_Term nmod;
|
|
|
|
YAP_Term nt = YAP_StripModule(YAP_GetFromSlot(args), &nmod);
|
|
|
|
*modp = YAP_SetCurrentModule(nmod);
|
|
|
|
if (!nt) {
|
|
|
|
return args;
|
|
|
|
}
|
|
|
|
return YAP_InitSlot(nt);
|
|
|
|
}
|
|
|
|
|
2011-03-26 15:18:56 +00:00
|
|
|
word
|
|
|
|
pl_readline(term_t flag)
|
|
|
|
{
|
|
|
|
|
|
|
|
}
|
|
|
|
|
2011-04-22 15:29:41 +01:00
|
|
|
static Term
|
|
|
|
StreamPosition(IOSTREAM *st)
|
|
|
|
{
|
|
|
|
Term t[4];
|
|
|
|
if (!st)
|
|
|
|
st = Suser_input;
|
|
|
|
t[0] = MkIntegerTerm(st->posbuf.charno);
|
|
|
|
t[1] = MkIntegerTerm(st->posbuf.lineno);
|
|
|
|
t[2] = MkIntegerTerm(st->posbuf.linepos);
|
|
|
|
t[3] = MkIntegerTerm(st->posbuf.byteno);
|
|
|
|
return Yap_MkApplTerm(FunctorStreamPos,4,t);
|
|
|
|
}
|
|
|
|
|
|
|
|
Term
|
|
|
|
Yap_StreamPosition(IOSTREAM *st)
|
|
|
|
{
|
|
|
|
return StreamPosition(st);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2011-03-26 15:18:56 +00:00
|
|
|
#if THREADS
|
|
|
|
|
2010-08-04 11:37:12 +01:00
|
|
|
#define COUNT_MUTEX_INITIALIZER(name) \
|
|
|
|
{ PTHREAD_MUTEX_INITIALIZER, \
|
|
|
|
name, \
|
|
|
|
0L \
|
|
|
|
}
|
|
|
|
|
2011-02-27 23:06:10 +00:00
|
|
|
static int
|
|
|
|
recursive_attr(pthread_mutexattr_t **ap)
|
|
|
|
{ static int done;
|
|
|
|
static pthread_mutexattr_t attr;
|
|
|
|
int rc;
|
|
|
|
|
|
|
|
if ( done )
|
|
|
|
{ *ap = &attr;
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
PL_LOCK(L_THREAD);
|
|
|
|
if ( done )
|
|
|
|
{ PL_UNLOCK(L_THREAD);
|
|
|
|
|
|
|
|
*ap = &attr;
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
if ( (rc=pthread_mutexattr_init(&attr)) )
|
|
|
|
goto error;
|
|
|
|
#ifdef HAVE_PTHREAD_MUTEXATTR_SETTYPE
|
|
|
|
if ( (rc=pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE)) )
|
|
|
|
goto error;
|
|
|
|
#else
|
|
|
|
#ifdef HAVE_PTHREAD_MUTEXATTR_SETKIND_NP
|
|
|
|
if ( (rc=pthread_mutexattr_setkind_np(&attr, PTHREAD_MUTEX_RECURSIVE_NP)) )
|
|
|
|
goto error;
|
|
|
|
#endif
|
|
|
|
#endif
|
|
|
|
|
|
|
|
done = TRUE;
|
|
|
|
PL_UNLOCK(L_THREAD);
|
|
|
|
*ap = &attr;
|
|
|
|
|
|
|
|
return 0;
|
|
|
|
|
|
|
|
error:
|
|
|
|
PL_UNLOCK(L_THREAD);
|
|
|
|
return rc;
|
|
|
|
}
|
|
|
|
|
|
|
|
int
|
|
|
|
recursiveMutexInit(recursiveMutex *m)
|
|
|
|
{
|
|
|
|
int rc;
|
|
|
|
pthread_mutexattr_t *attr;
|
|
|
|
|
|
|
|
if ( (rc=recursive_attr(&attr)) )
|
|
|
|
return rc;
|
|
|
|
|
|
|
|
return pthread_mutex_init(m, attr);
|
|
|
|
|
|
|
|
}
|
|
|
|
|
2010-08-04 11:37:12 +01:00
|
|
|
counting_mutex _PL_mutexes[] =
|
|
|
|
{ COUNT_MUTEX_INITIALIZER("L_MISC"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_ALLOC"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_ATOM"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_FLAG"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_FUNCTOR"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_RECORD"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_THREAD"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_PREDICATE"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_MODULE"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_TABLE"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_BREAK"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_FILE"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_PLFLAG"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_OP"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_INIT"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_TERM"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_GC"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_AGC"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_FOREIGN"),
|
|
|
|
COUNT_MUTEX_INITIALIZER("L_OS")
|
|
|
|
};
|
|
|
|
|
|
|
|
#endif
|