/// @memberof isnan/1
static Int
p_isinf( USES_REGS1 )
{ /* X is Y */
Term out = 0L;
while (!(out = Eval(Deref(ARG1) 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;
}
}
if (IsVarTerm(out)) {
Yap_EvalError(INSTANTIATION_ERROR, out, "isinf/1");
return FALSE;
}
if (!IsFloatTerm(out)) {
Yap_EvalError(TYPE_ERROR_FLOAT, out, "isinf/1");
return FALSE;
}
return isinf(FloatOfTerm(out));
}
/* copy to a new list of terms */
static Int
build_new_list(CELL *pt, Term t USES_REGS)
{
Int out = 0;
if (IsVarTerm(t))
return(-1);
if (t == TermNil)
return(0);
restart:
while (IsPairTerm(t)) {
out++;
pt[0] = HeadOfTerm(t);
t = TailOfTerm(t);
if (IsVarTerm(t))
return(-1);
if (t == TermNil) {
return(out);
}
pt += 2;
if (pt > ASP - 4096) {
if (!Yap_gcl((ASP-HR)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
pt = HR;
out = 0;
goto restart;
}
}
return(-1);
}
/// @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
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_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 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);
}
/// @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)));
}
}
int pc_import_occ_switches_3(void)
{
CACHE_REGS
TERM p_sw_list,p_sw_list0,p_sw_list1;
TERM p_sw_ins_list0,p_sw_ins_list1,sw,sw_ins;
TERM p_num_sw, p_num_sw_ins;
int i;
int num_sw_ins;
void release_occ_switches();
#ifdef __YAP_PROLOG__
TERM *hstart;
restart:
hstart = heap_top;
#endif
p_sw_list = bpx_get_call_arg(1,3);
p_num_sw = bpx_get_call_arg(2,3);
p_num_sw_ins = bpx_get_call_arg(3,3);
p_sw_list0 = bpx_build_nil();
num_sw_ins = 0;
for (i = 0; i < occ_switch_tab_size; i++) {
SW_INS_PTR ptr;
#ifdef __YAP_PROLOG__
if ( heap_top + 64*1024 >= local_top ) {
H = hstart;
/* running out of stack */
extern int Yap_gcl(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop);
Yap_gcl(4*64*1024, 3, ENV, CP);
goto restart;
}
#endif
sw = bpx_build_structure("sw",2);
bpx_unify(bpx_get_arg(1,sw), bpx_build_integer(i));
p_sw_ins_list0 = bpx_build_nil();
ptr = occ_switches[i];
while (ptr != NULL) {
num_sw_ins++;
if (ptr->inside <= 0.0) ptr->inside = 0.0; /* FIXME: quick hack */
sw_ins = bpx_build_structure("sw_ins",4);
bpx_unify(bpx_get_arg(1,sw_ins),bpx_build_integer(ptr->id));
bpx_unify(bpx_get_arg(2,sw_ins),bpx_build_float(ptr->inside));
bpx_unify(bpx_get_arg(3,sw_ins),bpx_build_float(ptr->smooth));
bpx_unify(bpx_get_arg(4,sw_ins),bpx_build_float(ptr->total_expect));
p_sw_ins_list1 = bpx_build_list();
bpx_unify(bpx_get_car(p_sw_ins_list1),sw_ins);
bpx_unify(bpx_get_cdr(p_sw_ins_list1),p_sw_ins_list0);
p_sw_ins_list0 = p_sw_ins_list1;
ptr = ptr->next;
}
bpx_unify(bpx_get_arg(2,sw),p_sw_ins_list0);
p_sw_list1 = bpx_build_list();
bpx_unify(bpx_get_car(p_sw_list1),sw);
bpx_unify(bpx_get_cdr(p_sw_list1),p_sw_list0);
p_sw_list0 = p_sw_list1;
}
release_occ_switches();
return
bpx_unify(p_sw_list, p_sw_list0) &&
bpx_unify(p_num_sw, bpx_build_integer(occ_switch_tab_size)) &&
bpx_unify(p_num_sw_ins, bpx_build_integer(num_sw_ins));
}
static Int same_file(USES_REGS1) {
char *f1 = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
char *f2 = RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE;
if (strcmp(f1, f2) == 0)
return TRUE;
#if HAVE_LSTAT
{
int out;
struct stat *b1, *b2;
while ((char *)HR + sizeof(struct stat) * 2 > (char *)(ASP - 1024)) {
if (!Yap_gcl(2 * sizeof(struct stat), 2, ENV, Yap_gcP())) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return FALSE;
}
}
b1 = (struct stat *)HR;
b2 = b1 + 1;
if (strcmp(f1, "user_input") == 0) {
if (fstat(fileno(GLOBAL_Stream[0].file), b1) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (strcmp(f1, "user_output") == 0) {
if (fstat(fileno(GLOBAL_Stream[1].file), b1) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (strcmp(f1, "user_error") == 0) {
if (fstat(fileno(GLOBAL_Stream[2].file), b1) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (stat(f1, b1) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
if (strcmp(f2, "user_input") == 0) {
if (fstat(fileno(GLOBAL_Stream[0].file), b2) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (strcmp(f2, "user_output") == 0) {
if (fstat(fileno(GLOBAL_Stream[1].file), b2) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (strcmp(f2, "user_error") == 0) {
if (fstat(fileno(GLOBAL_Stream[2].file), b2) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (stat(f2, b2) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
out = (b1->st_ino == b2->st_ino
#ifdef __LCC__
&& memcmp((const void *)&(b1->st_dev), (const void *)&(b2->st_dev),
sizeof(buf1.st_dev)) == 0
#else
&& b1->st_dev == b2->st_dev
#endif
);
return out;
}
#else
return (FALSE);
#endif
}
