static Int p_thread_self( USES_REGS1 ) { if (pthread_getspecific(Yap_yaamregs_key) == NULL) return Yap_unify(MkIntegerTerm(-1), ARG1); return Yap_unify(MkIntegerTerm(worker_id), ARG1); }
static Int p_thread_sleep( USES_REGS1 ) { UInt time = IntegerOfTerm(Deref(ARG1)); #if HAVE_NANOSLEEP UInt ntime = IntegerOfTerm(Deref(ARG2)); struct timespec req, oreq ; req.tv_sec = time; req.tv_nsec = ntime; if (nanosleep(&req, &oreq)) { #if HAVE_STRERROR Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "%s in thread_sleep/1", strerror(errno)); #else Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "error %d in thread_sleep/1", errno); #endif return FALSE; } return Yap_unify(ARG3,MkIntegerTerm(oreq.tv_sec)) && Yap_unify(ARG4,MkIntegerTerm(oreq.tv_nsec)); #elif HAVE_SLEEP UInt rtime; if ((rtime = sleep(time)) < 0) { #if HAVE_STRERROR Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "%s in thread_sleep/1", strerror(errno)); #else Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "error %d in thread_sleep/1", errno); #endif } return Yap_unify(ARG3,MkIntegerTerm(rtime)) && Yap_unify(ARG4,MkIntTerm(0L)); #else Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "no support for thread_sleep/1 in this YAP configuration"); #endif }
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); }
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 Int p_inform_agc(void) { Term tn = MkIntegerTerm(tot_agc_time); Term tt = MkIntegerTerm(agc_calls); Term ts = MkIntegerTerm(tot_agc_recovered); return Yap_unify(tn, ARG2) && Yap_unify(tt, ARG1) && Yap_unify(ts, ARG3); }
static Int p_inform_agc(USES_REGS1) { Term tn = MkIntegerTerm(GLOBAL_tot_agc_time); Term tt = MkIntegerTerm(GLOBAL_agc_calls); Term ts = MkIntegerTerm(GLOBAL_tot_agc_recovered); return Yap_unify(tn, ARG2) && Yap_unify(tt, ARG1) && Yap_unify(ts, ARG3); }
static Term float_to_int(Float v) { #if USE_GMP Int i = (Int)v; if (i-v == 0.0) { return MkIntegerTerm(i); } else { return Yap_gmp_float_to_big(v); } #else return MkIntegerTerm(v); #endif }
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); }
Term Yap_MkBigIntTerm(MP_INT *big) { CACHE_REGS Int nlimbs; MP_INT *dst = (MP_INT *)(H+2); CELL *ret = H; Int bytes; if (mpz_fits_slong_p(big)) { long int out = mpz_get_si(big); return MkIntegerTerm((Int)out); } // bytes = big->_mp_alloc * sizeof(mp_limb_t); // nlimbs = ALIGN_YAPTYPE(bytes,CELL)/CellSize; // this works, but it shouldn't need to do this... nlimbs = big->_mp_alloc; bytes = nlimbs*sizeof(CELL); if (nlimbs > (ASP-ret)-1024) { return TermNil; } H[0] = (CELL)FunctorBigInt; H[1] = BIG_INT; dst->_mp_size = big->_mp_size; dst->_mp_alloc = nlimbs*(CellSize/sizeof(mp_limb_t)); memmove((void *)(dst+1), (const void *)(big->_mp_d), bytes); H = (CELL *)(dst+1)+nlimbs; H[0] = EndSpecials; H++; return AbsAppl(ret); }
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 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_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 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); }
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 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 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 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 msb(Int inp) /* calculate the most significant bit for an integer */ { /* the obvious solution: do it by using binary search */ Int out = 0; int off = sizeof(CELL)*4; if (inp < 0) { return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp), "msb/1 received %d", inp); } while (off) { Int limit = ((CELL)1) << (off); if (inp >= limit) { out += off; inp >>= off; } off >>= 1; }
static Int msb(Int inp USES_REGS) /* calculate the most significant bit for an integer */ { /* the obvious solution: do it by using binary search */ Int out = 0; if (inp < 0) { return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp), "msb/1 received %d", inp); } #if HAVE__BUILTIN_FFSLL out = __builtin_ffsll(inp); #elif HAVE_FFSLL out = ffsll(inp); #else if (inp==0) return 0L; #if SIZEOF_INT_P == 8 if (inp & ((CELL)0xffffffffLL << 32)) {inp >>= 32; out += 32;}
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); }
static Int gcd(Int m11,Int m21 USES_REGS) { /* Blankinship algorithm, provided by Miguel Filgueiras */ Int m12=1, m22=0, k; while (m11>0 && m21>0) if (m11<m21) { k = m21/m11; m21 -= k*m11; m22 -= k*m12; } else { k=m11/m21; m11 -= k*m21; m12 -= k*m22; } if (m11<0 || m21<0) { /* overflow? */ /* Oflow = 1; */ Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11), "gcd/2 with %d and %d", m11, m21); return(1); } if (m11) return(m11); return(m21); }
Int gcdmult(Int m11,Int m21,Int *pm11) /* *pm11 gets multiplier of m11 */ { Int m12=1, m22=0, k; while (m11 && m21) if (m11<m21) { k = m21/m11; m21 -= k*m11; m22 -= k*m12; } else { k=m11/m21; m11 -= k*m21; m12 -= k*m22; } if (m11<0 || m21<0) { /* overflow? */ /* Oflow = 1; */ Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11), "gcdmult/2 with %d and %d", m11, m21); return(1); } if (m11) { *pm11 = m12; return(m11); } *pm11 = m22; return(m21); }
static Term Eval(Term t USES_REGS) { if (IsVarTerm(t)) { return Yap_ArithError(INSTANTIATION_ERROR,t,"in arithmetic"); } else if (IsNumTerm(t)) { return t; } else if (IsAtomTerm(t)) { ExpEntry *p; Atom name = AtomOfTerm(t); if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) { /* error */ Term ti[2]; /* error */ ti[0] = t; ti[1] = MkIntTerm(0); t = Yap_MkApplTerm(FunctorSlash, 2, ti); return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "atom %s in arithmetic expression", RepAtom(name)->StrOfAE); } return Yap_eval_atom(p->FOfEE); } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); if (fun == FunctorString) { const char *s = StringOfTerm(t); if (s[1] == '\0') return MkIntegerTerm(s[0]); return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "string in arithmetic expression"); } else if ((Atom)fun == AtomFoundVar) { return Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, "cyclic term in arithmetic expression"); } else { Int n = ArityOfFunctor(fun); Atom name = NameOfFunctor(fun); ExpEntry *p; Term t1, t2; if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) { Term ti[2]; /* error */ ti[0] = t; ti[1] = MkIntegerTerm(n); t = Yap_MkApplTerm(FunctorSlash, 2, ti); return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "functor %s/%d for arithmetic expression", RepAtom(name)->StrOfAE,n); } if (p->FOfEE == op_power && p->ArityOfEE == 2) { t2 = ArgOfTerm(2, t); if (IsPairTerm(t2)) { return get_matrix_element(ArgOfTerm(1, t), t2 PASS_REGS); } } *RepAppl(t) = (CELL)AtomFoundVar; t1 = Eval(ArgOfTerm(1,t) PASS_REGS); if (t1 == 0L) { *RepAppl(t) = (CELL)fun; return FALSE; } if (n == 1) { *RepAppl(t) = (CELL)fun; return Yap_eval_unary(p->FOfEE, t1); } t2 = Eval(ArgOfTerm(2,t) PASS_REGS); *RepAppl(t) = (CELL)fun; if (t2 == 0L) return FALSE; return Yap_eval_binary(p->FOfEE,t1,t2); } } /* else if (IsPairTerm(t)) */ { if (TailOfTerm(t) != TermNil) { return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "string must contain a single character to be evaluated as an arithmetic expression"); } return Eval(HeadOfTerm(t) PASS_REGS); } }
static bool stream_line_number( int sno, Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */ Term tout = StreamPosition(GLOBAL_Stream[sno].linecount); return Yap_unify(t2, MkIntegerTerm(tout)); }
/** * Syntax Error Handler * * @par tokptr: the sequence of tokens * @par sno: the stream numbet * * Implicit arguments: * + */ Term Yap_syntax_error(TokEntry *errtok, int sno) { CACHE_REGS Term info; Term startline, errline, endline; Term tf[4]; Term *tailp = tf + 3; CELL *Hi = HR; TokEntry *tok = LOCAL_tokptr; Int cline = tok->TokPos; startline = MkIntegerTerm(cline); if (errtok != LOCAL_toktide) { errtok = LOCAL_toktide; } LOCAL_Error_TYPE = YAP_NO_ERROR; errline = MkIntegerTerm(errtok->TokPos); if (LOCAL_ErrorMessage) tf[0] = MkStringTerm(LOCAL_ErrorMessage); else tf[0] = MkStringTerm(""); while (tok) { Term ts[2]; if (HR > ASP - 1024) { errline = MkIntegerTerm(0); endline = MkIntegerTerm(0); /* for some reason moving this earlier confuses gcc on solaris */ HR = Hi; break; } if (tok->TokPos != cline) { *tailp = MkPairTerm(TermNewLine, TermNil); tailp = RepPair(*tailp) + 1; cline = tok->TokPos; } if (tok == errtok && tok->Tok != Error_tok) { *tailp = MkPairTerm(MkAtomTerm(AtomError), TermNil); tailp = RepPair(*tailp) + 1; } info = tok->TokInfo; switch (tok->Tok) { case Name_tok: { Term t0[1]; if (info) { t0[0] = MkAtomTerm((Atom)info); } else { t0[0] = TermNil; } ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); } break; case QuasiQuotes_tok: { Term t0[2]; t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>")); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); } break; case WQuasiQuotes_tok: { Term t0[2]; t0[0] = MkAtomTerm(Yap_LookupAtom("<WideQQ>")); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); } break; case Number_tok: ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &(tok->TokInfo)); break; case Var_tok: { Term t[2]; VarEntry *varinfo = (VarEntry *)info; t[0] = MkIntTerm(0); t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t); } break; case String_tok: { Term t0 = Yap_CharsToTDQ((char *)info, CurrentModule, ENC_ISO_LATIN1 PASS_REGS); if (!t0) { return 0; } ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); } break; case WString_tok: { Term t0 = Yap_WCharsToTDQ((wchar_t *)info, CurrentModule PASS_REGS); if (!t0) return 0; ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); } break; case BQString_tok: { Term t0 = Yap_CharsToTBQ((char *)info, CurrentModule, ENC_ISO_LATIN1 PASS_REGS); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); } break; case WBQString_tok: { Term t0 = Yap_WCharsToTBQ((wchar_t *)info, CurrentModule PASS_REGS); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); } break; case Error_tok: { ts[0] = MkAtomTerm(AtomError); } break; case eot_tok: endline = MkIntegerTerm(tok->TokPos); ts[0] = MkAtomTerm(Yap_LookupAtom("EOT")); break; case Ponctuation_tok: { char s[2]; s[1] = '\0'; if ((info) == 'l') { s[0] = '('; } else { s[0] = (char)info; } ts[0] = MkAtomTerm(Yap_LookupAtom(s)); } } tok = tok->TokNext; if (!tok) break; *tailp = MkPairTerm(ts[0], TermNil); tailp = RepPair(*tailp) + 1; } { Term t[3]; t[0] = startline; t[1] = errline; t[2] = endline; tf[1] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween, 3), 3, t); } /* 0: id */ /* 1: strat, error, end line */ /*2 msg */ /* file */ tf[2] = Yap_StreamUserName(sno); clean_vars(LOCAL_VarTable); clean_vars(LOCAL_AnonVarTable); Term terr = Yap_MkApplTerm(FunctorSyntaxError, 4, tf); Term tn[2]; tn[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, &terr); tn[1] = TermNil; terr = Yap_MkApplTerm(FunctorError, 2, tn); #if DEBUG if (Yap_ExecutionMode == YAP_BOOT_MODE) { fprintf(stderr, "SYNTAX ERROR while booting: "); Yap_DebugPlWriteln(terr); } #endif return terr; }
/** * Syntax Error Handler * * @par tokptr: the sequence of tokens * @par sno: the stream numbet * * Implicit arguments: * + */ static Term syntax_error(TokEntry *errtok, int sno, Term cmod) { CACHE_REGS Term startline, errline, endline; Term tf[3]; Term tm; Term *tailp = tf + 2; CELL *Hi = HR; TokEntry *tok = LOCAL_tokptr; Int cline = tok->TokPos; startline = MkIntegerTerm(cline); endline = MkIntegerTerm(cline); if (errtok != LOCAL_toktide) { errtok = LOCAL_toktide; } LOCAL_Error_TYPE = YAP_NO_ERROR; errline = MkIntegerTerm(errtok->TokPos); if (LOCAL_ErrorMessage) tm = MkStringTerm(LOCAL_ErrorMessage); else tm = MkStringTerm("syntax error"); while (tok) { if (HR > ASP - 1024) { errline = MkIntegerTerm(0); endline = MkIntegerTerm(0); /* for some reason moving this earlier confuses gcc on solaris */ HR = Hi; break; } if (tok->TokPos != cline) { *tailp = MkPairTerm(TermNewLine, TermNil); tailp = RepPair(*tailp) + 1; cline = tok->TokPos; } if (tok == errtok && tok->Tok != Error_tok) { *tailp = MkPairTerm(MkAtomTerm(AtomError), TermNil); tailp = RepPair(*tailp) + 1; } Term rep = Yap_tokRep(tok); if (tok->TokNext) { tok = tok->TokNext; } else { endline = MkIntegerTerm(tok->TokPos); tok = NULL; break; } *tailp = MkPairTerm(rep, TermNil); tailp = RepPair(*tailp) + 1; } { Term t[3]; t[0] = startline; t[1] = errline; t[2] = endline; tf[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween, 3), 3, t); } /* 0: strat, error, end line */ /*2 msg */ /* 1: file */ tf[1] = Yap_StreamUserName(sno); clean_vars(LOCAL_VarTable); clean_vars(LOCAL_AnonVarTable); Term terr = Yap_MkApplTerm(FunctorInfo3, 3, tf); Term tn[2]; tn[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, &tm); tn[1] = terr; terr = Yap_MkApplTerm(FunctorError, 2, tn); #if DEBUG if (Yap_ExecutionMode == YAP_BOOT_MODE) { fprintf(stderr, "SYNTAX ERROR while booting: "); Yap_DebugPlWriteln(terr); } #endif return terr; }
YAPTerm::YAPTerm(void *ptr) { CACHE_REGS mk(MkIntegerTerm((Int)ptr)); }
YAPIntegerTerm::YAPIntegerTerm(intptr_t i) { CACHE_REGS Term tn = MkIntegerTerm(i); mk(tn); }
static Int time_file(USES_REGS1) { Term tname = Deref(ARG1); if (IsVarTerm(tname)) { Yap_Error(INSTANTIATION_ERROR, tname, "access"); return FALSE; } else if (!IsAtomTerm(tname)) { Yap_Error(TYPE_ERROR_ATOM, tname, "access"); return FALSE; } else { const char *n = RepAtom(AtomOfTerm(tname))->StrOfAE; VFS_t *vfs; if ((vfs = vfs_owner(n))) { vfs_stat s; vfs->stat(vfs, n, &s); return Yap_unify(ARG2, MkIntegerTerm(s.st_mtimespec.tv_sec)); } #if __WIN32 FILETIME ft; HANDLE hdl; Term rc; if ((hdl = CreateFile(n, 0, 0, NULL, OPEN_EXISTING, 0, 0)) == 0) { Yap_WinError("in time_file"); return false; } if (GetFileTime(hdl, NULL, NULL, &ft) == 0) { Yap_WinError("in time_file"); return false; } // Convert the last-write time to local time. // FileTimeToSystemTime(&ftWrite, &stUTC); // SystemTimeToTzSpecificLocalTime(NULL, &stUTC, &stLocal); CloseHandle(hdl); ULONGLONG qwResult; // Copy the time into a quadword. qwResult = (((ULONGLONG)ft.dwHighDateTime) << 32) + ft.dwLowDateTime; #if SIZEOF_INT_P == 8 rc = MkIntegerTerm(qwResult); #elif USE_GMP char s[64]; MP_INT rop; snprintf(s, 64, "%I64d", (long long int)n); mpz_init_set_str(&rop, s, 10); rc = Yap_MkBigIntTerm((void *)&rop PASS_REGS); #else rc = MkIntegerTerm(ft.dwHighDateTime); #endif return Yap_unify(ARG2, rc); #elif HAVE_STAT struct SYSTEM_STAT ss; if (SYSTEM_STAT(n, &ss) != 0) { /* ignore errors while checking a file */ return FALSE; } return Yap_unify(ARG2, MkIntegerTerm(ss.st_mtime)); #else return FALSE; #endif } }