/// @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 }