/// @memberof between/3
static Int cont_between(USES_REGS1) {
Term t1 = EXTRA_CBACK_ARG(3, 1);
Term t2 = EXTRA_CBACK_ARG(3, 2);
Yap_unify(ARG3, t1);
if (IsIntegerTerm(t1)) {
Int i1;
Term tn;
if (t1 == t2)
cut_succeed();
i1 = IntegerOfTerm(t1);
tn = add_int(i1, 1 PASS_REGS);
EXTRA_CBACK_ARG(3, 1) = tn;
HB = B->cp_h = HR;
return TRUE;
} else {
Term t[2];
Term tn;
Int cmp;
cmp = Yap_acmp(t1, t2 PASS_REGS);
if (cmp == 0)
cut_succeed();
t[0] = t1;
t[1] = MkIntTerm(1);
tn = Eval(Yap_MkApplTerm(FunctorPlus, 2, t) PASS_REGS);
EXTRA_CBACK_ARG(3, 1) = tn;
HB = B->cp_h = HR;
return TRUE;
}
}
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)));
}
static Int qq_open(USES_REGS1) {
PRED_LD
Term t = Deref(ARG1);
if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) =
FunctorDQuasiQuotation) {
void *ptr;
char *start;
size_t l int s;
Term t0, t1, t2;
if (IsPointerTerm((t0 = ArgOfTerm(1, t))) &&
IsPointerTerm((t1 = ArgOfTerm(2, t))) &&
IsIntegerTerm((t2 = ArgOfTerm(3, t)))) {
ptr = PointerOfTerm(t0);
start = PointerOfTerm(t1);
len = IntegerOfTerm(t2);
if ((s = Yap_open_buf_read_stream(start, len, ENC_UTF8, MEM_BUF_USER)) <
0)
return false;
return Yap_unify(ARG2, Yap_MkStream(s));
} else {
Yap_Error(TYPE_ERROR_READ_CONTEXT, t);
}
return FALSE;
}
}
static Int p_freeze_choice_point( USES_REGS1 ) {
if (IsVarTerm(Deref(ARG1))) {
Int offset = freeze_current_cp();
return Yap_unify(ARG1, MkIntegerTerm(offset));
}
return (FALSE);
}
static bool
stream_mode(int sno,
Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
stream_flags_t flags = GLOBAL_Stream[sno].status &
(Input_Stream_f | Output_Stream_f | Append_Stream_f);
if (!IsVarTerm(t2) && !(isatom(t2))) {
return FALSE;
}
if (flags & Input_Stream_f)
return Yap_unify(t2, TermRead);
if (flags & Output_Stream_f)
return Yap_unify(t2, TermWrite);
if (flags & Append_Stream_f)
return Yap_unify(t2, TermAppend);
return false;
}
static Int file_base_name(USES_REGS1) { /* file_base_name(Stream,N) */
Term t = Deref(ARG1);
Atom at;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2");
return FALSE;
}
at = AtomOfTerm(t);
const char *c = RepAtom(at)->StrOfAE;
const char *s;
#if HAVE_BASENAME && 0 // DISABLED: Linux basename is not compatible with
// file_base_name in SWI and GNU
char c1[YAP_FILENAME_MAX + 1];
strncpy(c1, c, YAP_FILENAME_MAX);
s = basename(c1);
#else
Int i = strlen(c);
while (i && !Yap_dir_separator((int)c[--i]))
;
if (Yap_dir_separator((int)c[i])) {
i++;
}
s = c + i;
#endif
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
}
static Int file_directory_name(USES_REGS1) { /* file_directory_name(Stream,N) */
Term t = Deref(ARG1);
Atom at;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "file_directory_name/2");
return false;
}
at = AtomOfTerm(t);
const char *c = RepAtom(at)->StrOfAE;
#if HAVE_BASENAME && 0 // DISABLED: Linux basename is not compatible with
// file_base_name in SWI and GNU
const char *s;
char c1[YAP_FILENAME_MAX + 1];
strncpy(c1, c, YAP_FILENAME_MAX);
s = dirname(c1);
#else
char s[YAP_FILENAME_MAX + 1];
Int i = strlen(c);
strncpy(s, c, YAP_FILENAME_MAX);
while (--i) {
if (Yap_dir_separator((int)c[i]))
break;
}
if (i == 0) {
s[0] = '.';
i = 1;
}
s[i] = '\0';
#endif
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
}
static Int /* mpe_create_event(?Event) */
p_create_event()
{
Int event_id;
event_id = MPE_Log_get_event_number();
return Yap_unify(ARG1, MkIntegerTerm(event_id));
}
static bool
eof_action(int sno,
Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
stream_flags_t flags =
GLOBAL_Stream[sno].status &
(Eof_Error_Stream_f | Reset_Eof_Stream_f | Push_Eof_Stream_f);
if (!IsVarTerm(t2) && !(isatom(t2))) {
return FALSE;
}
if (flags & Eof_Error_Stream_f) {
return Yap_unify(t2, TermError);
}
if (flags & Reset_Eof_Stream_f) {
return Yap_unify(t2, TermReset);
}
return Yap_unify(t2, TermEOfCode);
}
static Int
p_thread_zombie_self( USES_REGS1 )
{
/* make sure the lock is available */
if (pthread_getspecific(Yap_yaamregs_key) == NULL)
return Yap_unify(MkIntegerTerm(-1), ARG1);
pthread_mutex_lock(&(LOCAL_ThreadHandle.tlock));
DEBUG_TLOCK_ACCESS(4, worker_id);
if (LOCAL_ActiveSignals &= YAP_ITI_SIGNAL) {
DEBUG_TLOCK_ACCESS(5, worker_id);
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
return FALSE;
}
// fprintf(stderr," -- %d\n", worker_id);
LOCAL_ThreadHandle.in_use = FALSE;
LOCAL_ThreadHandle.zombie = TRUE;
return Yap_unify(MkIntegerTerm(worker_id), ARG1);
}
static Term add_priority(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomPriority, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt));
if (IsPairTerm(tail) || tail == TermNil) {
return MkPairTerm(topt, tail);
} else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil));
}
}
static Term add_names(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt));
if (IsPairTerm(tail) || tail == TermNil) {
return MkPairTerm(topt, tail);
} else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil));
}
}
static Int
p_thread_status_unlock( USES_REGS1 )
{
/* make sure the lock is available */
if (pthread_getspecific(Yap_yaamregs_key) == NULL)
return FALSE;
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock_status));
return Yap_unify(MkIntegerTerm(worker_id), ARG1);
}
static Int
p_thread_new_tid( USES_REGS1 )
{
int new_worker = allocate_new_tid();
if (new_worker == -1) {
Yap_Error(RESOURCE_ERROR_MAX_THREADS, MkIntegerTerm(MAX_THREADS), "");
return FALSE;
}
return Yap_unify(MkIntegerTerm(new_worker), ARG1);
}
static Int read_stream_to_codes(USES_REGS1) {
int sno = Yap_CheckStream(ARG1, Input_Stream_f,
"reaMkAtomTerm (AtomEofd_line_to_codes/2");
CELL *HBASE = HR;
CELL *h0 = &ARG4;
if (sno < 0)
return FALSE;
while (!(GLOBAL_Stream[sno].status & Eof_Stream_f)) {
/* skip errors */
Int ch = GLOBAL_Stream[sno].stream_getc(sno);
Term t;
if (ch == EOFCHAR)
break;
t = MkIntegerTerm(ch);
h0[0] = AbsPair(HR);
*HR = t;
HR += 2;
h0 = HR - 1;
yhandle_t news, news1, st = Yap_StartSlots();
if (HR >= ASP - 1024) {
RESET_VARIABLE(h0);
news = Yap_InitSlot(AbsPair(HBASE));
news1 = Yap_InitSlot((CELL)(h0));
if (!Yap_gcl((ASP - HBASE) * sizeof(CELL), 3, ENV, Yap_gcP())) {
Yap_Error(RESOURCE_ERROR_STACK, ARG1, "read_stream_to_codes/3");
return false;
}
/* build a legal term again */
h0 = (CELL *)(Yap_GetFromSlot(news1));
HBASE = RepPair(Yap_GetFromSlot(news));
}
Yap_CloseSlots(st);
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
if (HR == HBASE)
return Yap_unify(ARG2, ARG3);
RESET_VARIABLE(HR - 1);
Yap_unify(HR[-1], ARG3);
return Yap_unify(AbsPair(HBASE), ARG2);
}
static Int
p_stream_to_codes(void)
{
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2");
CELL *HBASE = H;
CELL *h0 = &ARG4;
if (sno < 0)
return FALSE;
while (!(Stream[sno].status & Eof_Stream_f)) {
/* skip errors */
Int ch = Stream[sno].stream_getc(sno);
Term t;
if (ch == EOFCHAR)
break;
t = MkIntegerTerm(ch);
h0[0] = AbsPair(H);
*H = t;
H+=2;
h0 = H-1;
if (H >= ASP-1024) {
RESET_VARIABLE(h0);
ARG4 = AbsPair(HBASE);
ARG5 = (CELL)h0;
if (!Yap_gcl((ASP-HBASE)*sizeof(CELL), 5, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, ARG1, "read_stream_to_codes/3");
return FALSE;
}
/* build a legal term again */
h0 = (CELL *)ARG5;
HBASE = RepPair(ARG4);
}
}
UNLOCK(Stream[sno].streamlock);
if (H == HBASE)
return Yap_unify(ARG2,ARG3);
RESET_VARIABLE(H-1);
Yap_unify(H[-1],ARG3);
return Yap_unify(AbsPair(HBASE),ARG2);
}
static Int
p_msort( USES_REGS1 )
{
/* use the heap to build a new list */
CELL *pt = HR;
Term out;
/* list size */
Int size;
size = build_new_list(pt, Deref(ARG1) PASS_REGS);
if (size < 0)
return(FALSE);
if (size < 2)
return(Yap_unify(ARG1, ARG2));
pt = HR; /* because of possible garbage collection */
/* reserve the necessary space */
HR += size*2;
simple_mergesort(pt, size, M_EVEN);
adjust_vector(pt, size);
out = AbsPair(pt);
return(Yap_unify(out, ARG2));
}
static Int
open_mem_write_stream (USES_REGS1) /* $open_mem_write_stream(-Stream) */
{
Term t;
int sno;
sno = Yap_OpenBufWriteStream( PASS_REGS1 );
if (sno == -1)
return (PlIOError (SYSTEM_ERROR_INTERNAL,TermNil, "new stream not available for open_mem_read_stream/1"));
t = Yap_MkStream (sno);
return (Yap_unify (ARG1, t));
}
static bool
has_encoding(int sno,
Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
if (!IsVarTerm(t2) && !(isatom(t2))) {
return FALSE;
}
if (0 && IsAtomTerm(t2)) {
encoding_t e = enc_id(RepAtom(AtomOfTerm(t2))->StrOfAE);
GLOBAL_Stream[sno].encoding = e;
return true;
} else {
const char *s = enc_name(LOCAL_encoding);
return Yap_unify(t2, MkAtomTerm(Yap_LookupAtom(s)));
}
}
static Int
p_sort( USES_REGS1 )
{
/* use the heap to build a new list */
CELL *pt = HR;
Term out;
/* list size */
Int size;
size = build_new_list(pt, Deref(ARG1) PASS_REGS);
if (size < 0)
return(FALSE);
if (size < 2)
return(Yap_unify(ARG1, ARG2));
pt = HR; /* because of possible garbage collection */
/* make sure no one writes on our temp data structure */
HR += size*2;
/* reserve the necessary space */
size = compact_mergesort(pt, size, M_EVEN);
/* reajust space */
HR = pt+size*2;
adjust_vector(pt, size);
out = AbsPair(pt);
return(Yap_unify(out, ARG2));
}
PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
{
CACHE_REGS
AtomEntry *ae;
if (!blob)
return FALSE;
ae = lookupBlob(blob, len, type);
if (!ae) {
return FALSE;
}
if (type->acquire) {
type->acquire(AtomToSWIAtom(AbsAtom(ae)));
}
return Yap_unify(Yap_GetFromSlot(t PASS_REGS), MkAtomTerm(AbsAtom(ae)));
}
Term
Yap_Globalise(Term t)
{
CACHE_REGS
CELL *vt;
Term tn;
if (!IsVarTerm(t))
return t;
vt = VarOfTerm(t);
if (vt <= HR && vt > H0)
return t;
tn = MkVarTerm();
Yap_unify(t, tn);
return tn;
}
static Int
open_mem_read_stream (USES_REGS1) /* $open_mem_read_stream(+List,-Stream) */
{
Term t, ti;
int sno;
Int sl = 0, nchars = 0;
char *nbuf;
ti = Deref(ARG1);
while (ti != TermNil) {
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR, ti, "open_mem_read_stream");
return (FALSE);
} else if (!IsPairTerm(ti)) {
Yap_Error(TYPE_ERROR_LIST, ti, "open_mem_read_stream");
return (FALSE);
} else {
sl++;
ti = TailOfTerm(ti);
}
}
while ((nbuf = (char *)Yap_AllocAtomSpace((sl+1)*sizeof(char))) == NULL) {
if (!Yap_growheap(FALSE, (sl+1)*sizeof(char), NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
return(FALSE);
}
}
ti = Deref(ARG1);
while (ti != TermNil) {
Term ts = HeadOfTerm(ti);
if (IsVarTerm(ts)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "open_mem_read_stream");
return (FALSE);
} else if (!IsIntTerm(ts)) {
Yap_Error(TYPE_ERROR_INTEGER, ARG1, "open_mem_read_stream");
return (FALSE);
}
nbuf[nchars++] = IntOfTerm(ts);
ti = TailOfTerm(ti);
}
nbuf[nchars] = '\0';
sno = Yap_open_buf_read_stream(nbuf, nchars, &LOCAL_encoding, MEM_BUF_CODE);
t = Yap_MkStream (sno);
return (Yap_unify (ARG2, t));
}
static Int
p_unifiable( USES_REGS1 )
{
tr_fr_ptr trp, trp0 = TR;
Term tf = TermNil;
if (!unifiable(ARG1,ARG2)) {
return FALSE;
}
trp = TR;
while (trp != trp0) {
Term t[2];
--trp;
t[0] = TrailTerm(trp);
t[1] = *(CELL *)t[0];
tf = MkPairTerm(Yap_MkApplTerm(FunctorEq,2,t),tf);
RESET_VARIABLE(t[0]);
}
return Yap_unify(ARG3, tf);
}
static Int lines_in_file(USES_REGS1) {
Int sno = Yap_CheckStream(ARG1, (Input_Stream_f), "lines_in_file/2");
if (sno < 0)
return false;
FILE *f = GLOBAL_Stream[sno].file;
size_t count = 0;
int ch;
#if __ANDROID__
#define getw getc
#endif
if (!f)
return false;
while ((ch = getw(f)) >= 0) {
if (ch == '\n') {
count++;
}
}
return Yap_unify(ARG2, MkIntegerTerm(count));
}
static Int
peek_mem_write_stream ( USES_REGS1 )
{ /* '$peek_mem_write_stream'(+GLOBAL_Stream,?S0,?S) */
Int sno = Yap_CheckStream (ARG1, (Output_Stream_f | InMemory_Stream_f), "close/2");
Int i;
Term tf = ARG2;
CELL *HI;
const char *ptr;
if (sno < 0)
return (FALSE);
restart:
HI = HR;
#if MAY_WRITE
if (fflush(GLOBAL_Stream[sno].file) == 0) {
ptr = GLOBAL_Stream[sno].nbuf;
i = GLOBAL_Stream[sno].nsize;
}
#else
ptr = GLOBAL_Stream[sno].u.mem_string.buf;
i = GLOBAL_Stream[sno].u.mem_string.pos;
#endif
while (i > 0) {
--i;
tf = MkPairTerm(MkIntTerm(ptr[i]),tf);
if (HR + 1024 >= ASP) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
HR = HI;
if (!Yap_gcl((ASP-HI)*sizeof(CELL), 3, ENV, Yap_gcP()) ) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return(FALSE);
}
i = GLOBAL_Stream[sno].u.mem_string.pos;
tf = ARG2;
LOCK(GLOBAL_Stream[sno].streamlock);
goto restart;
}
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (Yap_unify(ARG3,tf));
}
static Int
p_agc_threshold(void)
{
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
return Yap_unify(ARG1, MkIntegerTerm(AGcThreshold));
} else if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER,t,"prolog_flag/2 agc_margin");
return FALSE;
} else {
Int i = IntegerOfTerm(t);
if (i<0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,t,"prolog_flag/2 agc_margin");
return FALSE;
} else {
AGcThreshold = i;
return TRUE;
}
}
}
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);
}
static Int read_stream_to_terms(USES_REGS1) {
int sno = Yap_CheckStream(ARG1, Input_Stream_f, "read_line_to_codes/2");
Term t, hd;
yhandle_t tails, news;
if (sno < 0)
return FALSE;
t = AbsPair(HR);
RESET_VARIABLE(HR);
Yap_InitSlot((CELL)(HR));
tails = Yap_InitSlot((CELL)(HR));
news = Yap_InitSlot((CELL)(HR));
HR++;
while (!(GLOBAL_Stream[sno].status & Eof_Stream_f)) {
RESET_VARIABLE(HR);
RESET_VARIABLE(HR + 1);
hd = (CELL)HR;
Yap_PutInSlot(news, (CELL)(HR + 1));
HR += 2;
while ((hd = Yap_read_term(sno, TermNil, 2)) == 0L)
;
// just ignore failure
CELL *pt = VarOfTerm(Yap_GetFromSlot(tails));
if (Deref(hd) == TermEOfCode) {
*pt = Deref(ARG3);
break;
} else {
CELL *newpt = (CELL *)Yap_GetFromSlot(news);
*pt = AbsPair(newpt - 1);
Yap_PutInSlot(tails, (CELL)newpt);
}
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify(t, ARG2);
}
/// @memberof between/3
static Int
init_between( USES_REGS1 )
{
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
if (IsVarTerm(t1)) {
Yap_EvalError(INSTANTIATION_ERROR, t1, "between/3");
return FALSE;
}
if (IsVarTerm(t2)) {
Yap_EvalError(INSTANTIATION_ERROR, t1, "between/3");
return FALSE;
}
if (!IsIntegerTerm(t1) &&
!IsBigIntTerm(t1)) {
Yap_EvalError(TYPE_ERROR_INTEGER, t1, "between/3");
return FALSE;
}
if (!IsIntegerTerm(t2) &&
!IsBigIntTerm(t2) &&
t2 != MkAtomTerm(AtomInf) &&
t2 != MkAtomTerm(AtomInfinity)) {
Yap_EvalError(TYPE_ERROR_INTEGER, t2, "between/3");
return FALSE;
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
Term t3;
t3 = Deref(ARG3);
if (!IsVarTerm(t3)) {
if (!IsIntegerTerm(t3)) {
if (!IsBigIntTerm(t3)) {
Yap_EvalError(TYPE_ERROR_INTEGER, t3, "between/3");
return FALSE;
}
cut_fail();
} else {
Int i3 = IntegerOfTerm(t3);
if (i3 >= i1 && i3 <= i2)
cut_succeed();
cut_fail();
}
}
if (i1 > i2) cut_fail();
if (i1 == i2) {
Yap_unify(ARG3, t1);
cut_succeed();
}
} else if (IsIntegerTerm(t1) && IsAtomTerm(t2)) {
Int i1 = IntegerOfTerm(t1);
Term t3;
t3 = Deref(ARG3);
if (!IsVarTerm(t3)) {
if (!IsIntegerTerm(t3)) {
if (!IsBigIntTerm(t3)) {
Yap_EvalError(TYPE_ERROR_INTEGER, t3, "between/3");
return FALSE;
}
cut_fail();
} else {
Int i3 = IntegerOfTerm(t3);
if (i3 >= i1)
cut_succeed();
cut_fail();
}
}
} else {
Term t3 = Deref(ARG3);
Int cmp;
if (!IsVarTerm(t3)) {
if (!IsIntegerTerm(t3) && !IsBigIntTerm(t3)) {
Yap_EvalError(TYPE_ERROR_INTEGER, t3, "between/3");
return FALSE;
}
if (Yap_acmp(t3, t1 PASS_REGS) >= 0 && Yap_acmp(t2,t3 PASS_REGS) >= 0 && P != FAILCODE)
cut_succeed();
cut_fail();
}
cmp = Yap_acmp(t1, t2 PASS_REGS);
if (cmp > 0) cut_fail();
if (cmp == 0) {
Yap_unify(ARG3, t1);
cut_succeed();
}
}
EXTRA_CBACK_ARG(3,1) = t1;
EXTRA_CBACK_ARG(3,2) = t2;
return cont_between( PASS_REGS1 );
}
