static Int
has_bom(int sno, Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
bool rc = GLOBAL_Stream[sno].status & Seekable_Stream_f;
if (!IsVarTerm(t2) && !boolean(t2)) {
return FALSE;
}
if (rc) {
return Yap_unify_constant(t2, TermTrue);
} else {
return Yap_unify_constant(t2, TermFalse);
}
}
static Int has_close_on_abort(
int sno, Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
bool rc = GLOBAL_Stream[sno].status & DoNotCloseOnAbort_Stream_f;
if (!IsVarTerm(t2)) {
return t2 == (rc ? TermTrue : TermFalse);
}
if (rc) {
return Yap_unify_constant(t2, TermTrue);
} else {
return Yap_unify_constant(t2, TermFalse);
}
}
static Int
has_bom(int sno, Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
bool rc = GLOBAL_Stream[sno].status & HAS_BOM_f;
if (!IsVarTerm(t2) && !booleanFlag(t2)) {
// Yap_Error( DOMAIN_ERROR_BOOLEAN, t2, " stream_property/2");
return false;
}
if (rc) {
return Yap_unify_constant(t2, TermTrue);
} else {
return Yap_unify_constant(t2, TermFalse);
}
}
static Int
p_binary_is(void)
{ /* X is Y */
Term t = Deref(ARG2);
Term t1, t2;
if (IsVarTerm(t)) {
Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
t1 = Yap_Eval(Deref(ARG3));
if (!Yap_FoundArithError(t1, ARG3)) {
return FALSE;
}
t2 = Yap_Eval(Deref(ARG4));
if (!Yap_FoundArithError(t2, ARG4)) {
return FALSE;
}
if (IsIntTerm(t)) {
Term tout = Yap_FoundArithError(eval2(IntOfTerm(t), t1, t2), 0L);
if (!tout)
return FALSE;
return Yap_unify_constant(ARG1,tout);
}
if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);
ExpEntry *p;
Term out;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntTerm(1);
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
Yap_Error(TYPE_ERROR_EVALUABLE, t,
"functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,2);
P = FAILCODE;
return(FALSE);
}
if (!(out=Yap_FoundArithError(eval2(p->FOfEE, t1, t2), 0L)))
return FALSE;
return Yap_unify_constant(ARG1,out);
}
return FALSE;
}
static Int p_get_depth_limit( USES_REGS1 )
{
Int d = IntOfTerm(DEPTH);
if (d % 2 == 1)
return(Yap_unify(ARG1, MkFloatTerm(INFINITY)));
return(Yap_unify_constant(ARG1, MkIntTerm(d/2)));
}
/** @pred compare( _C_, _X_, _Y_) is iso
As a result of comparing _X_ and _Y_, _C_ may take one of
the following values:
+
`=` if _X_ and _Y_ are identical;
+
`<` if _X_ precedes _Y_ in the defined order;
+
`>` if _Y_ precedes _X_ in the defined order;
*/
Int p_compare(USES_REGS1) { /* compare(?Op,?T1,?T2) */
Int r = compare(Deref(ARG2), Deref(ARG3));
Atom p;
Term t = Deref(ARG1);
if (r < 0)
p = AtomLT;
else if (r > 0)
p = AtomGT;
else
p = AtomEQ;
if (!IsVarTerm(t)) {
if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
if (a == p)
return true;
if (a != AtomLT && a != AtomGT && a != AtomEq)
Yap_Error(DOMAIN_ERROR_ORDER, ARG1, NULL);
} else {
Yap_Error(TYPE_ERROR_ATOM, ARG1, NULL);
}
return false;
}
return Yap_unify_constant(ARG1, MkAtomTerm(p));
}
/// @memberof is/2
static Int
p_is( USES_REGS1 )
{ /* X is Y */
Term out;
yap_error_number err;
Term t = Deref(ARG2);
if (IsVarTerm(t)) {
Yap_EvalError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
Yap_ClearExs();
do {
out = Yap_InnerEval(Deref(ARG2));
if ((err = Yap_FoundArithError()) == YAP_NO_ERROR)
break;
if (err == RESOURCE_ERROR_STACK) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, CP)) {
Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
return FALSE;
}
} else {
Yap_EvalError(err, ARG2, "X is Exp");
return FALSE;
}
} while (TRUE);
return Yap_unify_constant(ARG1,out);
}
static Int stream_flags(USES_REGS1) { /* '$stream_flags'(+N,-Flags) */
Term trm;
trm = Deref(ARG1);
if (IsVarTerm(trm) || !IsIntTerm(trm))
return (FALSE);
return (Yap_unify_constant(ARG2,
MkIntTerm(GLOBAL_Stream[IntOfTerm(trm)].status)));
}
static Int file_no(int sno, Term t2 USES_REGS) {
int f = Yap_GetStreamFd(sno);
Term rc = MkIntTerm(f);
if (!IsVarTerm(t2) && !IsIntTerm(t2)) {
return false;
}
return Yap_unify_constant(t2, rc);
}
/** @pred get_value(+ _A_,- _V_)
In YAP, atoms can be associated with constants. If one such
association exists for atom _A_, unify the second argument with the
constant. Otherwise, unify _V_ with `[]`.
This predicate is YAP specific.
*/
static Int p_value(USES_REGS1) { /* '$get_value'(+Atom,?Val) */
Term t1 = Deref(ARG1);
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "get_value/2");
return (FALSE);
}
if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1, "get_value/2");
return (FALSE);
}
return (Yap_unify_constant(ARG2, Yap_GetValue(AtomOfTerm(t1))));
}
static Int file_size(USES_REGS1) {
int rc;
Int sno = Yap_CheckStream(
ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f),
"file_size/2");
if (sno < 0)
return (FALSE);
VFS_t *vfs;
char *s = RepAtom(GLOBAL_Stream[sno].name)->StrOfAE;
if (!s) return false;
if ((vfs = vfs_owner(s))) {
vfs_stat st;
vfs->stat(vfs, s, &st);
UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify_constant(ARG2, MkIntegerTerm(st.st_size));
}
if (GLOBAL_Stream[sno].status & Seekable_Stream_f &&
!(GLOBAL_Stream[sno].status &
(InMemory_Stream_f | Socket_Stream_f | Pipe_Stream_f))) {
// there
struct stat file_stat;
if ((rc = fstat(fileno(GLOBAL_Stream[sno].file), &file_stat)) < 0) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
if (rc == ENOENT)
PlIOError(EXISTENCE_ERROR_SOURCE_SINK, ARG1, "%s in file_size",
strerror(errno));
else
PlIOError(PERMISSION_ERROR_INPUT_STREAM, ARG1, "%s in file_size",
strerror(errno));
return false;
}
// and back again
UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify_constant(ARG2, MkIntegerTerm(file_stat.st_size));
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
return false;
}
static Int
p_compare(void)
{ /* compare(?Op,?T1,?T2) */
Int r = compare(Deref(ARG2), Deref(ARG3));
Atom p;
if (r < 0)
p = AtomLT;
else if (r > 0)
p = AtomGT;
else
p = AtomEQ;
return Yap_unify_constant(ARG1, MkAtomTerm(p));
}
static Int
p_binary_op_as_integer(void)
{ /* X is Y */
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
if (IsIntTerm(t)) {
return Yap_unify_constant(ARG2,t);
}
if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);
ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
return Yap_unify(ARG1,ARG2);
}
return Yap_unify_constant(ARG2,MkIntTerm(p->FOfEE));
}
return(FALSE);
}
/** @pred prompt(- _A_,+ _B_)
Changes YAP input prompt from _A_ to _B_, active on *next* standard input
interaction.
*/
static Int prompt(USES_REGS1) { /* prompt(Old,New) */
Term t = Deref(ARG2);
Atom a;
if (!Yap_unify_constant(ARG1, MkAtomTerm(LOCAL_AtPrompt)))
return (FALSE);
if (IsVarTerm(t) || !IsAtomTerm(t))
return (FALSE);
a = AtomOfTerm(t);
if (strlen(RepAtom(a)->StrOfAE) > MAX_PROMPT) {
Yap_Error(SYSTEM_ERROR_INTERNAL, t, "prompt %s is too long",
RepAtom(a)->StrOfAE);
return false;
}
strncpy(LOCAL_Prompt, (char *)RepAtom(LOCAL_AtPrompt)->StrOfAE, MAX_PROMPT);
LOCAL_AtPrompt = a;
return (TRUE);
}
bool
Yap_FetchStreamAlias (int sno, Term t2 USES_REGS)
{
if (IsVarTerm(t2)) {
Atom at = FetchAlias(sno);
if (at == NULL)
return false;
else {
return Yap_unify_constant(t2, MkAtomTerm(at));
}
} else if (IsAtomTerm(t2)) {
Atom at = AtomOfTerm(t2);
return ExistsAliasForStream(sno,at);
} else {
Yap_Error(TYPE_ERROR_ATOM, t2, "stream_property(_,alias( ))");
return false;
}
}
static Int
do_arith23(arith2_op op)
{ /* X is Y */
Term t = Deref(ARG1);
Int out;
Term t1, t2;
if (IsVarTerm(t)) {
Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
t1 = Yap_Eval(t);
if (t1 == 0L)
return FALSE;
t2 = Yap_Eval(Deref(ARG2));
if (t2 == 0L)
return FALSE;
if (!(out=Yap_FoundArithError(eval2(op, t1, t2), 0L)))
return FALSE;
return Yap_unify_constant(ARG3,out);
}
static Int p_values(USES_REGS1) { /* '$values'(Atom,Old,New) */
Term t1 = Deref(ARG1), t3 = Deref(ARG3);
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "set_value/2");
return (FALSE);
}
if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1, "set_value/2");
return (FALSE);
}
if (!Yap_unify_constant(ARG2, Yap_GetValue(AtomOfTerm(t1)))) {
return (FALSE);
}
if (!IsVarTerm(t3)) {
if (IsAtomTerm(t3) || IsNumTerm(t3)) {
Yap_PutValue(AtomOfTerm(t1), t3);
} else
return (FALSE);
}
return (TRUE);
}
static Int read_line_to_string(USES_REGS1) {
int sno = Yap_CheckStream(ARG1, Input_Stream_f, "read_line_to_codes/2");
Int status;
UInt max_inp, buf_sz;
unsigned char *buf;
size_t sz;
StreamDesc *st = GLOBAL_Stream + sno;
int ch;
if (sno < 0)
return false;
status = GLOBAL_Stream[sno].status;
if (status & Eof_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof));
}
max_inp = (ASP - HR) / 2 - 1024;
buf = (unsigned char *)TR;
buf_sz = (unsigned char *)LOCAL_TrailTop - buf;
if (buf_sz > max_inp) {
buf_sz = max_inp;
}
if (st->status & Binary_Stream_f) {
char *b = (char *)TR;
sz = fread(b, 1, buf_sz, GLOBAL_Stream[sno].file);
} else {
unsigned char *pt = buf;
do {
ch = st->stream_wgetc_for_read(sno);
if (ch < 127) {
*pt++ = ch;
if (ch < 0) {
ch = '\n';
pt[-1] = '\n';
}
} else {
pt += get_utf8(pt, 4, &ch);
if (pt + 4 == buf + buf_sz)
break;
}
} while (ch != '\n');
sz = pt - buf;
}
if (sz == -1 || sz == 0) {
if (GLOBAL_Stream[sno].status & Eof_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof));
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
return false;
}
if (GLOBAL_Stream[sno].status & Eof_Stream_f || buf[sz - 1] == 10) {
/* we're done */
if (!(GLOBAL_Stream[sno].status & Eof_Stream_f)) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
/* handle CR before NL */
if ((Int)sz - 2 >= 0 && buf[sz - 2] == 13)
buf[sz - 2] = '\0';
else {
buf[sz - 1] = '\0';
}
} else {
UNLOCK(GLOBAL_Stream[sno].streamlock);
}
}
if (GLOBAL_Stream[sno].encoding == ENC_ISO_UTF8) {
return Yap_unify(ARG2, Yap_UTF8ToString((const char *)TR PASS_REGS));
} else if (GLOBAL_Stream[sno].encoding == ENC_WCHAR) {
return Yap_unify(ARG2, Yap_WCharsToString((const wchar_t *)TR PASS_REGS));
} else {
return Yap_unify(
ARG2, Yap_CharsToString((const char *)TR, ENC_ISO_LATIN1 PASS_REGS));
}
buf += (buf_sz - 1);
max_inp -= (buf_sz - 1);
if (max_inp <= 0) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(RESOURCE_ERROR_STACK, ARG1, NULL);
return FALSE;
}
}
static Int file_name(int sno, Term t2 USES_REGS) {
return Yap_unify_constant(t2, MkAtomTerm(GLOBAL_Stream[sno].name));
}
static Int rl_to_codes(Term TEnd, int do_as_binary, int arity USES_REGS) {
int sno = Yap_CheckStream(ARG1, Input_Stream_f, "read_line_to_codes/2");
StreamDesc *st = GLOBAL_Stream + sno;
Int status;
UInt max_inp, buf_sz, sz;
unsigned char *buf;
bool binary_stream;
int ch;
if (sno < 0)
return false;
status = GLOBAL_Stream[sno].status;
binary_stream = GLOBAL_Stream[sno].status & Binary_Stream_f;
if (status & Eof_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof));
}
max_inp = (ASP - HR) / 2 - 1024;
buf = (unsigned char *)TR;
buf_sz = (unsigned char *)LOCAL_TrailTop - buf;
while (true) {
if (buf_sz > max_inp) {
buf_sz = max_inp;
}
if (do_as_binary && !binary_stream) {
GLOBAL_Stream[sno].status |= Binary_Stream_f;
}
if (st->status & Binary_Stream_f) {
char *b = (char *)TR;
sz = fread(b, 1, buf_sz, GLOBAL_Stream[sno].file);
} else {
unsigned char *pt = buf;
do {
ch = st->stream_wgetc_for_read(sno);
if (ch < 127) {
*pt++ = ch;
if (ch < 0) {
ch = '\n';
pt[-1] = '\n';
}
} else {
pt += get_utf8(pt, 4, &ch);
if (pt + 4 == buf + buf_sz)
break;
}
} while (ch != '\n');
sz = pt - buf;
}
if (do_as_binary && !binary_stream)
GLOBAL_Stream[sno].status &= ~Binary_Stream_f;
if (sz == -1 || sz == 0) {
if (GLOBAL_Stream[sno].status & Eof_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof));
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
}
if (GLOBAL_Stream[sno].status & Eof_Stream_f || buf[sz - 1] == 10) {
/* we're done */
Term end;
if (!(do_as_binary || GLOBAL_Stream[sno].status & Eof_Stream_f)) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
/* handle CR before NL */
if ((Int)sz - 2 >= 0 && buf[sz - 2] == 13)
buf[sz - 2] = '\0';
else
buf[sz - 1] = '\0';
} else {
UNLOCK(GLOBAL_Stream[sno].streamlock);
}
if (arity == 2)
end = TermNil;
else
end = Deref(XREGS[arity]);
return Yap_unify(
ARG2, Yap_UTF8ToDiffListOfCodes((const char *)TR, end PASS_REGS));
}
buf += (buf_sz - 1);
max_inp -= (buf_sz - 1);
if (max_inp <= 0) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(RESOURCE_ERROR_STACK, ARG1, "read_line_to_codes/%d", arity);
return FALSE;
}
}
}
static Int p_get_depth_limit( USES_REGS1 )
{
return(Yap_unify_constant(ARG1, MkIntTerm(IntOfTerm(DEPTH/2))));
}
static Int
rl_to_codes(Term TEnd, int do_as_binary, int arity)
{
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2");
Int status;
UInt max_inp, buf_sz, sz;
char *buf;
int binary_stream;
if (sno < 0)
return FALSE;
status = Stream[sno].status;
binary_stream = Stream[sno].status & Binary_Stream_f;
if (status & Eof_Stream_f) {
UNLOCK(Stream[sno].streamlock);
return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof));
}
max_inp = (ASP-H)/2-1024;
buf = (char *)TR;
buf_sz = (char *)Yap_TrailTop-buf;
while (TRUE) {
if ( buf_sz > max_inp ) {
buf_sz = max_inp;
}
if (do_as_binary && !binary_stream)
Stream[sno].status |= Binary_Stream_f;
sz = Stream[sno].stream_gets(sno, buf_sz, buf);
if (do_as_binary && !binary_stream)
Stream[sno].status &= ~Binary_Stream_f;
if (sz == -1 || sz == 0) {
if (Stream[sno].status & Eof_Stream_f) {
UNLOCK(Stream[sno].streamlock);
return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof));
}
UNLOCK(Stream[sno].streamlock);
return FALSE;
}
if (Stream[sno].status & Eof_Stream_f || buf[sz-1] == 10) {
/* we're done */
Term end;
if (!(do_as_binary || Stream[sno].status & Eof_Stream_f)) {
UNLOCK(Stream[sno].streamlock);
/* handle CR before NL */
if (sz-2 >= 0 && buf[sz-2] == 13)
buf[sz-2] = '\0';
else
buf[sz-1] = '\0';
} else {
UNLOCK(Stream[sno].streamlock);
}
if (arity == 2)
end = TermNil;
else
end = Deref(XREGS[arity]);
return Yap_unify(ARG2, Yap_StringToDiffList((char *)TR, end)) ;
}
buf += (buf_sz-1);
max_inp -= (buf_sz-1);
if (max_inp <= 0) {
UNLOCK(Stream[sno].streamlock);
Yap_Error(OUT_OF_STACK_ERROR, ARG1, "read_line_to_codes/%d", arity);
return FALSE;
}
}
}
