static Int
a_eq(Term t1, Term t2)
{ /* A =:= B */
int out;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2");
return(FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2");
return(FALSE);
}
if (IsFloatTerm(t1)) {
if (IsFloatTerm(t2))
return (FloatOfTerm(t1) == FloatOfTerm(t2));
else if (IsIntegerTerm(t2)) {
return (FloatOfTerm(t1) == IntegerOfTerm(t2));
}
}
if (IsIntegerTerm(t1)) {
if (IsIntegerTerm(t2)) {
return (IntegerOfTerm(t1) == IntegerOfTerm(t2));
} else if (IsFloatTerm(t2)) {
return (FloatOfTerm(t2) == IntegerOfTerm(t1));
}
}
out = a_cmp(t1,t2);
if (ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; }
return out == 0;
}
static Int a_eq(Term t1, Term t2) {
CACHE_REGS
/* A =:= B */
Int out;
t1 = Deref(t1);
t2 = Deref(t2);
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2");
return (FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2");
return (FALSE);
}
if (IsFloatTerm(t1)) {
if (IsFloatTerm(t2))
return (FloatOfTerm(t1) == FloatOfTerm(t2));
else if (IsIntegerTerm(t2)) {
return (FloatOfTerm(t1) == IntegerOfTerm(t2));
}
}
if (IsIntegerTerm(t1)) {
if (IsIntegerTerm(t2)) {
return (IntegerOfTerm(t1) == IntegerOfTerm(t2));
} else if (IsFloatTerm(t2)) {
return (FloatOfTerm(t2) == IntegerOfTerm(t1));
}
}
out = a_cmp(t1, t2 PASS_REGS);
return out == 0;
}
static Int /* mpe_create_state(+Event,+Event,+Text,+Colour) */
p_create_state()
{
Term t_start = Deref(ARG1), t_end = Deref(ARG2),
t_descr = Deref(ARG3), t_colour = Deref(ARG4);
Int start_id, end_id;
char *descr, *colour;
int retv;
/* The first and second args must be bount to integer event IDs. */
if (IsVarTerm(t_start)) {
Yap_Error(INSTANTIATION_ERROR, t_start, "mpe_create_state");
return (FALSE);
} else if( !IsIntegerTerm(t_start) ) {
Yap_Error(TYPE_ERROR_INTEGER, t_start, "mpe_create_state");
return (FALSE);
} else {
start_id = IntOfTerm(t_start);
}
if (IsVarTerm(t_end)) {
Yap_Error(INSTANTIATION_ERROR, t_end, "mpe_create_state");
return (FALSE);
} else if( !IsIntegerTerm(t_end) ) {
Yap_Error(TYPE_ERROR_INTEGER, t_end, "mpe_create_state");
return (FALSE);
} else {
end_id = IntOfTerm(t_end);
}
/* The third and fourth args must be bound to atoms. */
if (IsVarTerm(t_descr)) {
Yap_Error(INSTANTIATION_ERROR, t_descr, "mpe_create_state");
return (FALSE);
} else if( !IsAtomTerm(t_descr) ) {
Yap_Error(TYPE_ERROR_ATOM, t_descr, "mpe_create_state");
return (FALSE);
} else {
descr = RepAtom(AtomOfTerm(t_descr))->StrOfAE;
}
if (IsVarTerm(t_colour)) {
Yap_Error(INSTANTIATION_ERROR, t_colour, "mpe_create_state");
return (FALSE);
} else if( !IsAtomTerm(t_colour) ) {
Yap_Error(TYPE_ERROR_ATOM, t_colour, "mpe_create_state");
return (FALSE);
} else {
colour = RepAtom(AtomOfTerm(t_colour))->StrOfAE;
}
retv = MPE_Describe_state( (int)start_id, (int)end_id, descr, colour );
return (retv == 0);
}
/// @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 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_log() /* mpe_log(+EventType, +EventNum, +EventStr) */
{
Term t_type = Deref(ARG1), t_num = Deref(ARG2), t_str = Deref(ARG3);
Int event_id, event;
char *descr;
/* The first arg must be bount to integer event type ID. */
if (IsVarTerm(t_type)) {
Yap_Error(INSTANTIATION_ERROR, t_type, "mpe_log");
return (FALSE);
} else if( !IsIntegerTerm(t_type) ) {
Yap_Error(TYPE_ERROR_INTEGER, t_type, "mpe_log");
return (FALSE);
} else {
event_id = IntOfTerm(t_type);
}
/* The second arg must be bount to integer event number. */
if (IsVarTerm(t_num)) {
Yap_Error(INSTANTIATION_ERROR, t_num, "mpe_log");
return (FALSE);
} else if( !IsIntegerTerm(t_num) ) {
Yap_Error(TYPE_ERROR_INTEGER, t_num, "mpe_log");
return (FALSE);
} else {
event = IntOfTerm(t_num);
}
/* The third arg must be bound to an atom. */
if (IsVarTerm(t_str)) {
Yap_Error(INSTANTIATION_ERROR, t_str, "mpe_log");
return (FALSE);
} else if( !IsAtomTerm(t_str) ) {
Yap_Error(TYPE_ERROR_ATOM, t_str, "mpe_log");
return (FALSE);
} else {
descr = RepAtom(AtomOfTerm(t_str))->StrOfAE;
}
return ( MPE_Log_event((int)event_id, (int)event, descr) == 0 );
}
void Yap_PrintPredName(PredEntry *ap) {
CACHE_REGS
Term tmod = ap->ModuleOfPred;
if (!tmod)
tmod = TermProlog;
#if THREADS
Yap_DebugPlWrite(MkIntegerTerm(worker_id));
Yap_DebugPutc(stderr, ' ');
#endif
Yap_DebugPutc(stderr, '>');
Yap_DebugPutc(stderr, '\t');
Yap_DebugPlWrite(tmod);
Yap_DebugPutc(stderr, ':');
if (ap->ModuleOfPred == IDB_MODULE) {
Term t = Deref(ARG1);
if (IsAtomTerm(t)) {
Yap_DebugPlWrite(t);
} else if (IsIntegerTerm(t)) {
Yap_DebugPlWrite(t);
} else {
Functor f = FunctorOfTerm(t);
Atom At = NameOfFunctor(f);
Yap_DebugPlWrite(MkAtomTerm(At));
Yap_DebugPutc(stderr, '/');
Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
}
} else {
if (ap->ArityOfPE == 0) {
Atom At = (Atom)ap->FunctorOfPred;
Yap_DebugPlWrite(MkAtomTerm(At));
} else {
Functor f = ap->FunctorOfPred;
Atom At = NameOfFunctor(f);
Yap_DebugPlWrite(MkAtomTerm(At));
Yap_DebugPutc(stderr, '/');
Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
}
}
char s[1024];
if (ap->PredFlags & StandardPredFlag)
fprintf(stderr, "S");
if (ap->PredFlags & CPredFlag)
fprintf(stderr, "C");
if (ap->PredFlags & UserCPredFlag)
fprintf(stderr, "U");
if (ap->PredFlags & SyncPredFlag)
fprintf(stderr, "Y");
if (ap->PredFlags & LogUpdatePredFlag)
fprintf(stderr, "Y");
if (ap->PredFlags & HiddenPredFlag)
fprintf(stderr, "H");
sprintf(s, " %llx\n", ap->PredFlags);
Yap_DebugPuts(stderr, s);
}
static Term
get_matrix_element(Term t1, Term t2 USES_REGS)
{
if (!IsPairTerm(t2)) {
if (t2 == MkAtomTerm(AtomLength)) {
Int sz = 1;
while (IsApplTerm(t1)) {
Functor f = FunctorOfTerm(t1);
if (NameOfFunctor(f) != AtomNil) {
return MkIntegerTerm(sz);
}
sz *= ArityOfFunctor(f);
t1 = ArgOfTerm(1, t1);
}
return MkIntegerTerm(sz);
}
Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
return FALSE;
}
while (IsPairTerm(t2)) {
Int indx;
Term indxt = Eval(HeadOfTerm(t2) PASS_REGS);
if (!IsIntegerTerm(indxt)) {
Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
return FALSE;
}
indx = IntegerOfTerm(indxt);
if (!IsApplTerm(t1)) {
Yap_ArithError(TYPE_ERROR_EVALUABLE, t1, "X is Y^[A]");
return FALSE;
} else {
Functor f = FunctorOfTerm(t1);
if (ArityOfFunctor(f) < indx) {
Yap_ArithError(TYPE_ERROR_EVALUABLE, t1, "X is Y^[A]");
return FALSE;
}
}
t1 = ArgOfTerm(indx, t1);
t2 = TailOfTerm(t2);
}
if (t2 != TermNil) {
Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
return FALSE;
}
return Eval(t1 PASS_REGS);
}
static Int p_set_depth_limit_for_next_call( USES_REGS1 )
{
Term d = Deref(ARG1);
if (IsVarTerm(d)) {
Yap_Error(INSTANTIATION_ERROR, d, "set-depth_limit");
return(FALSE);
} else if (!IsIntegerTerm(d)) {
Yap_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
return(FALSE);
}
d = MkIntTerm(IntegerOfTerm(d)*2);
DEPTH = d;
return(TRUE);
}
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;
}
}
}
void
Yap_PrintPredName( PredEntry *ap )
{
CACHE_REGS
Term tmod = ap->ModuleOfPred;
if (!tmod) tmod = TermProlog;
#if THREADS
Yap_DebugPlWrite(MkIntegerTerm(worker_id));
Yap_DebugPutc(LOCAL_c_error_stream,' ');
#endif
Yap_DebugPutc(LOCAL_c_error_stream,'>');
Yap_DebugPutc(LOCAL_c_error_stream,'\t');
Yap_DebugPlWrite(tmod);
Yap_DebugPutc(LOCAL_c_error_stream,':');
if (ap->ModuleOfPred == IDB_MODULE) {
Term t = Deref(ARG1);
if (IsAtomTerm(t)) {
Yap_DebugPlWrite(t);
} else if (IsIntegerTerm(t)) {
Yap_DebugPlWrite(t);
} else {
Functor f = FunctorOfTerm(t);
Atom At = NameOfFunctor(f);
Yap_DebugPlWrite(MkAtomTerm(At));
Yap_DebugPutc(LOCAL_c_error_stream,'/');
Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
}
} else {
if (ap->ArityOfPE == 0) {
Atom At = (Atom)ap->FunctorOfPred;
Yap_DebugPlWrite(MkAtomTerm(At));
} else {
Functor f = ap->FunctorOfPred;
Atom At = NameOfFunctor(f);
Yap_DebugPlWrite(MkAtomTerm(At));
Yap_DebugPutc(LOCAL_c_error_stream,'/');
Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
}
}
Yap_DebugPutc(LOCAL_c_error_stream,'\n');
}
static Int p_set_depth_limit( USES_REGS1 )
{
Term d = Deref(ARG1);
if (IsVarTerm(d)) {
Yap_Error(INSTANTIATION_ERROR, d, "set-depth_limit");
return(FALSE);
} else if (!IsIntegerTerm(d)) {
if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) {
d = RESET_DEPTH();
} else {
Yap_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
return(FALSE);
}
}
d = MkIntTerm(IntegerOfTerm(d)*2);
YENV[E_DEPTH] = d;
DEPTH = d;
return(TRUE);
}
YAPPredicate::YAPPredicate(Term &t, Term &tmod, CELL *&ts, const char *pname) {
Term t0 = t;
ap = nullptr;
restart:
if (IsVarTerm(t)) {
throw YAPError(SOURCE(), INSTANTIATION_ERROR, t0, pname);
} else if (IsAtomTerm(t)) {
ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
ts = nullptr;
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
ts = nullptr;
ap = Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsPairTerm(t)) {
t = Yap_MkApplTerm(FunctorCsult, 1, &t);
goto restart;
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE,
Yap_TermToIndicator(t, tmod), pname);
}
if (fun == FunctorModule) {
tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) {
throw YAPError(SOURCE(), INSTANTIATION_ERROR, t0, pname);
}
if (!IsAtomTerm(tmod)) {
throw YAPError(SOURCE(), TYPE_ERROR_ATOM, t0, pname);
}
t = ArgOfTerm(2, t);
goto restart;
}
ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
ts = RepAppl(t) + 1;
} else {
throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE, t0, pname);
}
}
/// @memberof logsum/3
static Int
p_logsum( USES_REGS1 )
{ /* X is Y */
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
int done = FALSE;
Float f1, f2;
while (!done) {
if (IsFloatTerm(t1)) {
f1 = FloatOfTerm(t1);
done = TRUE;
} else if (IsIntegerTerm(t1)) {
f1 = IntegerOfTerm(t1);
done = TRUE;
#if USE_GMP
} else if (IsBigIntTerm(t1)) {
f1 = Yap_gmp_to_float(t1);
done = TRUE;
#endif
} else {
while (!(t1 = Eval(t1 PASS_REGS))) {
if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, CP)) {
Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
return FALSE;
}
} else {
Yap_EvalError(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
return FALSE;
}
}
}
}
done = FALSE;
while (!done) {
if (IsFloatTerm(t2)) {
f2 = FloatOfTerm(t2);
done = TRUE;
} else if (IsIntegerTerm(t2)) {
f2 = IntegerOfTerm(t2);
done = TRUE;
#if USE_GMP
} else if (IsBigIntTerm(t2)) {
f2 = Yap_gmp_to_float(t2);
done = TRUE;
#endif
} else {
while (!(t2 = Eval(t2 PASS_REGS))) {
if (LOCAL_Error_TYPE == 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(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
return FALSE;
}
}
}
}
if (f1 >= f2) {
Float fi = exp(f2-f1);
return Yap_unify(ARG3,MkFloatTerm(f1+log(1+fi)));
} else {
Float fi = exp(f1-f2);
return Yap_unify(ARG3,MkFloatTerm(f2+log(1+fi)));
}
}
static Int p_abolish_frozen_choice_points_until( USES_REGS1 ) {
Term term_offset = Deref(ARG1);
if (IsIntegerTerm(term_offset))
abolish_frozen_cps_until(IntegerOfTerm(term_offset));
return (TRUE);
}
static Int p_wake_choice_point( USES_REGS1 ) {
Term term_offset = Deref(ARG1);
if (IsIntegerTerm(term_offset))
wake_frozen_cp(IntegerOfTerm(term_offset));
return (FALSE);
}
static Int
p_socket_buffering(USES_REGS1)
{
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
Term t4 = Deref(ARG4);
Atom mode;
int fd;
int writing;
#if _WIN32 || defined(__MINGW32__)
int bufsize;
int len;
#else
unsigned int bufsize;
unsigned int len;
#endif
int sno;
if ((sno = Yap_CheckSocketStream(t1, "socket_buffering/4")) < 0) {
return (FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR,t2,"socket_buffering/4");
return(FALSE);
}
if (!IsAtomTerm(t2)) {
Yap_Error(TYPE_ERROR_ATOM,t2,"socket_buffering/4");
return(FALSE);
}
mode = AtomOfTerm(t2);
if (mode == AtomRead)
writing = FALSE;
else if (mode == AtomWrite)
writing = TRUE;
else {
Yap_Error(DOMAIN_ERROR_IO_MODE,t2,"socket_buffering/4");
return(FALSE);
}
fd = Yap_GetStreamFd(sno);
if (writing) {
getsockopt(fd, SOL_SOCKET, SO_SNDBUF, (void *)&bufsize, &len);
} else {
getsockopt(fd, SOL_SOCKET, SO_RCVBUF, (void *)&bufsize, &len);
}
if (!Yap_unify(ARG3,MkIntegerTerm(bufsize)))
return(FALSE);
if (IsVarTerm(t4)) {
bufsize = BUFSIZ;
} else {
Int siz;
if (!IsIntegerTerm(t4)) {
Yap_Error(TYPE_ERROR_INTEGER,t4,"socket_buffering/4");
return(FALSE);
}
siz = IntegerOfTerm(t4);
if (siz < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,t4,"socket_buffering/4");
return(FALSE);
}
bufsize = siz;
}
if (writing) {
setsockopt(fd, SOL_SOCKET, SO_SNDBUF, (void *)&bufsize, sizeof(bufsize));
} else {
setsockopt(fd, SOL_SOCKET, SO_RCVBUF, (void *)&bufsize, sizeof(bufsize));
}
return(TRUE);
}
static inline Int
a_cmp(Term t1, Term t2)
{
ArithError = FALSE;
if (IsVarTerm(t1)) {
ArithError = TRUE;
Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2");
return FALSE;
}
if (IsVarTerm(t2)) {
ArithError = TRUE;
Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2");
return FALSE;
}
if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
return flt_cmp(FloatOfTerm(t1)-FloatOfTerm(t2));
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
return int_cmp(IntegerOfTerm(t1)-IntegerOfTerm(t2));
}
t1 = Yap_Eval(t1);
if (!t1) {
return FALSE;
}
if (IsIntegerTerm(t1)) {
Int i1 = IntegerOfTerm(t1);
t2 = Yap_Eval(t2);
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return int_cmp(i1-i2);
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
Yap_Error_Term = t2;
Yap_ErrorMessage = "trying to evaluate nan";
ArithError = TRUE;
}
#endif
return flt_cmp(i1-f2);
#ifdef USE_GMP
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_int_big(i1,t2);
#endif
} else {
return FALSE;
}
} else if (IsFloatTerm(t1)) {
Float f1 = FloatOfTerm(t1);
#if HAVE_ISNAN
if (isnan(f1)) {
Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
Yap_Error_Term = t1;
Yap_ErrorMessage = "trying to evaluate nan";
ArithError = TRUE;
}
#endif
t2 = Yap_Eval(t2);
#if HAVE_ISNAN
if (isnan(f1))
return -1;
#endif
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return flt_cmp(f1-i2);
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
Yap_Error_Term = t2;
Yap_ErrorMessage = "trying to evaluate nan";
ArithError = TRUE;
}
#endif
return flt_cmp(f1-f2);
#ifdef USE_GMP
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_float_big(f1,t2);
#endif
} else {
return FALSE;
}
#ifdef USE_GMP
} else if (IsBigIntTerm(t1)) {
{
t2 = Yap_Eval(t2);
if (IsIntegerTerm(t2)) {
return Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2));
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
Yap_Error_Term = t2;
Yap_ErrorMessage = "trying to evaluate nan";
ArithError = TRUE;
}
#endif
return Yap_gmp_cmp_big_float(t1, f2);
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_big_big(t1, t2);
} else {
return FALSE;
}
}
#endif
} else {
return FALSE;
}
}
static Int
p_setarg( USES_REGS1 )
{
CELL ti = Deref(ARG1), ts = Deref(ARG2), t3 = Deref(ARG3);
Int i;
if (IsVarTerm(t3) &&
VarOfTerm(t3) > H &&VarOfTerm(t3) < ASP) {
/* local variable */
Term tn = MkVarTerm();
Bind_Local(VarOfTerm(t3), tn);
t3 = tn;
}
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR,ti,"setarg/3");
return FALSE;
} else {
if (IsIntTerm(ti))
i = IntOfTerm(ti);
else {
Term te = Yap_Eval(ti);
if (IsIntegerTerm(te)) {
i = IntegerOfTerm(te);
} else {
Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
return FALSE;
}
}
}
if (IsVarTerm(ts)) {
Yap_Error(INSTANTIATION_ERROR,ts,"setarg/3");
} else if(IsApplTerm(ts)) {
CELL *pt;
if (IsExtensionFunctor(FunctorOfTerm(ts))) {
Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return FALSE;
}
if (i < 1 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) {
if (i<0)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
return FALSE;
if (i==0)
Yap_Error(DOMAIN_ERROR_NOT_ZERO,ts,"setarg/3");
return FALSE;
}
pt = RepAppl(ts)+i;
/* the evil deed is to be done now */
MaBind(pt, t3);
} else if(IsPairTerm(ts)) {
CELL *pt;
if (i < 1 || i > 2) {
if (i<0)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
return FALSE;
}
pt = RepPair(ts)+i-1;
/* the evil deed is to be done now */
MaBind(pt, t3);
} else {
Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return FALSE;
}
return TRUE;
}
static Int a_cmp(Term t1, Term t2 USES_REGS) {
if (IsVarTerm(t1)) {
Yap_ArithError(INSTANTIATION_ERROR, t1,
"while doing arithmetic comparison");
}
if (IsVarTerm(t2)) {
Yap_ArithError(INSTANTIATION_ERROR, t2,
"while doing arithmetic comparison");
}
if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
return flt_cmp(FloatOfTerm(t1) - FloatOfTerm(t2));
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
return int_cmp(IntegerOfTerm(t1) - IntegerOfTerm(t2));
}
t1 = Yap_Eval(t1);
if (!t1) {
return FALSE;
}
if (IsIntegerTerm(t1)) {
Int i1 = IntegerOfTerm(t1);
t2 = Yap_Eval(t2);
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return int_cmp(i1 - i2);
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
"trying to evaluate nan");
}
#endif
return flt_cmp(i1 - f2);
#ifdef USE_GMP
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_int_big(i1, t2);
#endif
} else {
return FALSE;
}
} else if (IsFloatTerm(t1)) {
Float f1 = FloatOfTerm(t1);
#if HAVE_ISNAN
if (isnan(f1)) {
Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t1,
"trying to evaluate nan");
}
#endif
t2 = Yap_Eval(t2);
#if HAVE_ISNAN
if (isnan(f1))
return -1;
#endif
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return flt_cmp(f1 - i2);
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
"trying to evaluate nan");
}
#endif
return flt_cmp(f1 - f2);
#ifdef USE_GMP
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_float_big(f1, t2);
#endif
} else {
return FALSE;
}
#ifdef USE_GMP
} else if (IsBigIntTerm(t1)) {
{
t2 = Yap_Eval(t2);
if (IsIntegerTerm(t2)) {
return Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2));
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
"trying to evaluate nan");
}
#endif
return Yap_gmp_cmp_big_float(t1, f2);
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_big_big(t1, t2);
} else {
return FALSE;
}
}
#endif
} else {
return FALSE;
}
}
/// @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 );
}
static Int
p_socket_connect(USES_REGS1)
{
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
Functor fun;
int sno;
socket_info status;
int fd;
int flag;
Term out;
if ((sno = Yap_CheckSocketStream(t1, "socket_connect/3")) < 0) {
return (FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR,t2,"socket_connect/3");
return(FALSE);
}
if (!IsApplTerm(t2)) {
Yap_Error(DOMAIN_ERROR_STREAM,t2,"socket_connect/3");
return(FALSE);
}
fun = FunctorOfTerm(t2);
fd = Yap_GetStreamFd(sno);
status = Yap_GetSocketStatus(sno);
if (status != new_socket) {
/* ok, this should be an error, as you are trying to bind */
return(FALSE);
}
#if HAVE_SYS_UN_H
if (fun == FunctorAfUnix) {
struct sockaddr_un sock;
Term taddr = ArgOfTerm(1, t2);
char *s;
int len;
if (IsVarTerm(taddr)) {
Yap_Error(INSTANTIATION_ERROR,t2,"socket_connect/3");
return(FALSE);
}
if (!IsAtomTerm(taddr)) {
Yap_Error(TYPE_ERROR_ATOM,taddr,"socket_connect/3");
return(FALSE);
}
s = RepAtom(AtomOfTerm(taddr))->StrOfAE;
sock.sun_family = AF_UNIX;
if ((len = strlen(s)) > 107) /* beat me with a broomstick */ {
Yap_Error(DOMAIN_ERROR_STREAM,taddr,"socket_connect/3");
return(FALSE);
}
sock.sun_family=AF_UNIX;
strcpy(sock.sun_path,s);
if ((flag = connect(fd,
(struct sockaddr *)(&sock),
((size_t) (((struct sockaddr_un *) 0)->sun_path) + len)))
< 0) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_connect/3 (connect: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_connect/3 (connect)");
#endif
return(FALSE);
}
Yap_UpdateSocketStream(sno, client_socket, af_unix);
} else
#endif
if (fun == FunctorAfInet) {
Term thost = ArgOfTerm(1, t2);
Term tport = ArgOfTerm(2, t2);
char *shost;
struct hostent *he;
struct sockaddr_in saddr;
unsigned short int port;
memset((void *)&saddr,(int) 0, sizeof(saddr));
if (IsVarTerm(thost)) {
Yap_Error(INSTANTIATION_ERROR,thost,"socket_connect/3");
return(FALSE);
} else if (!IsAtomTerm(thost)) {
Yap_Error(TYPE_ERROR_ATOM,thost,"socket_connect/3");
return(FALSE);
} else {
shost = RepAtom(AtomOfTerm(thost))->StrOfAE;
if((he=gethostbyname(shost))==NULL) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_connect/3 (gethostbyname: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_connect/3 (gethostbyname)");
#endif
return(FALSE);
}
memcpy((void *)&saddr.sin_addr, (void *)he->h_addr_list[0], he->h_length);
}
if (IsVarTerm(tport)) {
Yap_Error(INSTANTIATION_ERROR,tport,"socket_connect/3");
return(FALSE);
} else if (!IsIntegerTerm(tport)) {
Yap_Error(TYPE_ERROR_INTEGER,tport,"socket_connect/3");
return(FALSE);
} else {
port = (unsigned short int)IntegerOfTerm(tport);
}
saddr.sin_port = htons(port);
saddr.sin_family = AF_INET;
#if ENABLE_SO_LINGER
{
struct linger ling; /* For making sockets linger. */
/* disabled: I see why no reason why we should throw things away by default!! */
ling.l_onoff = 1;
ling.l_linger = 0;
if (setsockopt(fd, SOL_SOCKET, SO_LINGER, (void *) &ling,
sizeof(ling)) < 0) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_connect/3 (setsockopt_linger: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_connect/3 (setsockopt_linger)");
#endif
return FALSE;
}
}
#endif
{
int one = 1; /* code by David MW Powers */
if (setsockopt(fd, SOL_SOCKET, SO_BROADCAST, (void *)&one, sizeof(one))) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_connect/3 (setsockopt_broadcast: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_connect/3 (setsockopt_broadcast)");
#endif
return FALSE;
}
}
flag = connect(fd,(struct sockaddr *)&saddr, sizeof(saddr));
if(flag<0) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_connect/3 (connect: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_connect/3 (connect)");
#endif
return FALSE;
}
Yap_UpdateSocketStream(sno, client_socket, af_inet);
} else
return(FALSE);
out = t1;
return(Yap_unify(out,ARG3));
}
