static Int access_path(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 {
VFS_t *vfs;
char *s = RepAtom(AtomOfTerm(tname))->StrOfAE;
if (!s) return false;
if ((vfs = vfs_owner(s))) {
vfs_stat st;
bool rc = vfs->stat(vfs, s, &st);
UNLOCK(GLOBAL_Stream[sno].streamlock);
return rc;
}
#if HAVE_STAT
struct SYSTEM_STAT ss;
char *file_name;
file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
if (SYSTEM_STAT(file_name, &ss) != 0) {
/* ignore errors while checking a file */
return true;
}
return true;
#else
return false;
#endif
}
}
static Int exists_directory(USES_REGS1) {
Term tname = Deref(ARG1);
char *file_name;
if (IsVarTerm(tname)) {
Yap_Error(INSTANTIATION_ERROR, tname, "exists_directory/1");
return FALSE;
} else if (!IsAtomTerm(tname)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "exists_directory/1");
return FALSE;
} else {
VFS_t *vfs;
char *s = Yap_VF(RepAtom(AtomOfTerm(tname))->StrOfAE);
if (!s) return false;
if ((vfs = vfs_owner(s))) {
bool rc = true;
return vfs->isdir(vfs, s);
UNLOCK(GLOBAL_Stream[sno].streamlock);
return rc;
}
#if HAVE_STAT
struct SYSTEM_STAT ss;
file_name = Yap_VF(RepAtom(AtomOfTerm(tname))->StrOfAE);
if (SYSTEM_STAT(file_name, &ss) != 0) {
/* ignore errors while checking a file */
return false;
}
return (S_ISDIR(ss.st_mode));
#else
return FALSE;
#endif
}
}
static Int p_opdec(USES_REGS1) { /* '$opdec'(p,type,atom) */
/* we know the arguments are integer, atom, atom */
Term p = Deref(ARG1), t = Deref(ARG2), at = Deref(ARG3);
Term tmod = Deref(ARG4);
if (tmod == TermProlog) {
tmod = PROLOG_MODULE;
}
return Yap_OpDec((int)IntOfTerm(p), (char *)RepAtom(AtomOfTerm(t))->StrOfAE,
AtomOfTerm(at), tmod);
}
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);
}
/**
* Specify an alias to the stream. The alias <tt>Name</tt> must be an atom. The
* alias can be used instead of the stream descriptor for every operation
* concerning the stream.
*
* @param + _tname_ Name of Alias
* @param + _tstream_ stream identifier
*
* @return
*/
static Int add_alias_to_stream (USES_REGS1)
{
Term tname = Deref(ARG1);
Term tstream = Deref(ARG2);
Atom at;
Int sno;
if (IsVarTerm(tname)) {
Yap_Error(INSTANTIATION_ERROR, tname, "$add_alias_to_stream");
return (FALSE);
} else if (!IsAtomTerm (tname)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "$add_alias_to_stream");
return (FALSE);
}
if (IsVarTerm(tstream)) {
Yap_Error(INSTANTIATION_ERROR, tstream, "$add_alias_to_stream");
return (FALSE);
} else if (!IsApplTerm (tstream) || FunctorOfTerm (tstream) != FunctorStream ||
!IsIntTerm(ArgOfTerm(1,tstream))) {
Yap_Error(DOMAIN_ERROR_STREAM_OR_ALIAS, tstream, "$add_alias_to_stream");
return (FALSE);
}
at = AtomOfTerm(tname);
sno = (int)IntOfTerm(ArgOfTerm(1,tstream));
if (Yap_AddAlias(at, sno))
return(TRUE);
/* we could not create the alias, time to close the stream */
Yap_CloseStream(sno);
Yap_Error(PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM, tname, "open/3");
return (FALSE);
}
/*
* Here we initialize the arguments indexing
*/
YAP_Int
p_udi_args_init(Term spec, int arity, UdiInfo blk)
{
int i;
Term arg;
Atom idxtype;
UdiControlBlock *cb;
struct udi_p_args p_arg;
for (i = 1; i <= arity; i++) {
arg = ArgOfTerm(i,spec);
if (IsAtomTerm(arg)) {
idxtype = AtomOfTerm(arg);
if (idxtype == AtomMinus) //skip this argument
continue;
p_arg.control = NULL;
cb = NULL;
while ((cb = (UdiControlBlock *) utarray_next(indexing_structures, cb))) {
if (idxtype == (*cb)->decl){
p_arg.arg = i;
p_arg.control = *cb;
p_arg.idxstr = (*cb)->init(spec, i, arity);
utarray_push_back(blk->args, &p_arg);
}
}
if (p_arg.control == NULL){ /* not "-" and not found */
fprintf(stderr, "Invalid Spec (%s)\n", AtomName(idxtype));
return FALSE;
}
}
}
return TRUE;
}
char *Yap_guessFileName(int f, int sno, char *nameb, size_t max) {
#if __linux__
char path[256];
if (snprintf(path, 255, "/proc/self/fd/%d", f) && readlink(path, nameb, max))
return nameb;
#elif __APPLE__
if (fcntl(f, F_GETPATH, nameb) != -1) {
return nameb;
}
#elif __WIN32_
FILE_NAME_INFO *fni = (FILE_NAME_INFO *)malloc(sizeof(FILE_NAME_INFO) +
sizeof(WCHAR) * MAXPATHLEN);
HANDLE handle = (HANDLE)_get_osfhandle(f);
if (GetFileInformationByHandleEx(handle, FileNameInfo, &fni, max)) {
int i;
char *ptr = nameb;
for (i = 0; i < fni->FileNameLength; i++)
*ptr = _PL__utf8_put_char(ptr, fni->FileName[i]);
*ptr = '\0';
return nameb;
}
#endif
if (!StreamName(sno)) {
return NULL;
}
return RepAtom(AtomOfTerm(StreamName(sno)))->StrOfAE;
}
/** @pred compare( _C_, _X_, _Y_) is iso
As a result of comparing _X_ and _Y_, _C_ may take one of
the following values:
+
`=` if _X_ and _Y_ are identical;
+
`<` if _X_ precedes _Y_ in the defined order;
+
`>` if _Y_ precedes _X_ in the defined order;
*/
Int p_compare(USES_REGS1) { /* compare(?Op,?T1,?T2) */
Int r = compare(Deref(ARG2), Deref(ARG3));
Atom p;
Term t = Deref(ARG1);
if (r < 0)
p = AtomLT;
else if (r > 0)
p = AtomGT;
else
p = AtomEQ;
if (!IsVarTerm(t)) {
if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
if (a == p)
return true;
if (a != AtomLT && a != AtomGT && a != AtomEq)
Yap_Error(DOMAIN_ERROR_ORDER, ARG1, NULL);
} else {
Yap_Error(TYPE_ERROR_ATOM, ARG1, NULL);
}
return false;
}
return Yap_unify_constant(ARG1, MkAtomTerm(p));
}
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 inline Term
AtomTermAdjust(Term t)
{
AtomEntry *ae = RepAtom(AtomOfTerm(t));
MarkAtomEntry(ae);
return(t);
}
static Int file_exists(USES_REGS1) {
Term tname = Deref(ARG1);
char *file_name;
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 {
#if HAVE_STAT
struct SYSTEM_STAT ss;
file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
if (SYSTEM_STAT(file_name, &ss) != 0) {
if (errno == ENOENT)
return false;
PlIOError(SYSTEM_ERROR_OPERATING_SYSTEM, tname, "error %s",
strerror(errno));
return false;
}
return true;
#else
return FALSE;
#endif
}
}
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 CELL *
mark_global_cell(CELL *pt)
{
CELL reg = *pt;
if (IsVarTerm(reg)) {
/* skip bitmaps */
switch(reg) {
case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
return pt + 4;
#else
return pt + 3;
#endif
case (CELL)FunctorBigInt:
{
Int sz = 3 +
(sizeof(MP_INT)+
(((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL);
return pt + sz;
}
case (CELL)FunctorLongInt:
return pt + 3;
break;
}
} else if (IsAtomTerm(reg)) {
MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
return pt+1;
}
return pt+1;
}
static void
mark_local(void)
{
CELL *pt;
/* Adjusting the local */
pt = LCL0;
/* moving the trail is simple */
while (pt > ASP) {
CELL reg = *--pt;
if (!IsVarTerm(reg)) {
if (IsAtomTerm(reg)
#ifdef TABLING
/* assume we cannot have atoms on first page,
so this must be an arity
*/
&& reg > Yap_page_size
#endif
) {
MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
}
}
}
}
static Int
p_frequencyty1( USES_REGS1 )
{
// this predicate works only 'SMART_JIT' and 'CONTINUOUS_COMPILATION' modes
if (ExpEnv.config_struc.execution_mode == SMART_JIT || ExpEnv.config_struc.execution_mode == CONTINUOUS_COMPILATION) {
Term t = Deref(ARG1);
// valid value for ARG1 is just 'atom'
if (IsAtomTerm(t)) {
// ARG1 is atom
int i = 0, j = 0;
char *tmp;
// gets string from atom and stores it on 'str'
char *str = (char*)malloc(YAP_AtomNameLength(AtomOfTerm(t))*sizeof(char));
strcpy(str, AtomName(AtomOfTerm(t)));
// Makes upper characters of 'str' (for comparison)
UPPER_ENTRY(str);
// Detectng frequency type according to 'str'
if (strcmp(str, "COUNTER") == 0 || strcmp(str, "COUNT") == 0) {
ExpEnv.config_struc.frequency_type = COUNTER; // setting frequency type to 'counter'
ExpEnv.config_struc.frequency_bound = 1024.0; // if 'counter', frequency bound is '1024.0'
return TRUE;
}
else if (strcmp(str, "TIME") == 0 || strcmp(str, "TIMING") == 0) {
ExpEnv.config_struc.frequency_type = TIME; // setting frequency type to 'time'
ExpEnv.config_struc.frequency_bound = 0.02; // if 'time', frequency bound is '0.02'
return TRUE;
}
else {
// value passed by argument is out of known range
Yap_Error(OUT_OF_KNOWNRANGE_ERROR,t,"");
return FALSE;
}
}
else {
// ARG1 is not an atom
Yap_NilError(INVALID_PARAMETER_TYPE_ERROR,"Frequency type");
return FALSE;
}
}
else {
// current execution mode differs of 'SMART_JIT' and 'CONTINUOUS_COMPILATION'
Yap_NilError(INCOMPATIBLEMODE_WARNING,"");
return FALSE;
}
}
static Int p_check_stream(USES_REGS1) { /* '$check_stream'(Stream,Mode) */
Term mode = Deref(ARG2);
int sno = Yap_CheckStream(
ARG1, AtomOfTerm(mode) == AtomRead ? Input_Stream_f : Output_Stream_f,
"check_stream/2");
if (sno != -1)
UNLOCK(GLOBAL_Stream[sno].streamlock);
return sno != -1;
}
static CELL *
mark_global_cell(CELL *pt)
{
CELL reg = *pt;
if (IsVarTerm(reg)) {
/* skip bitmaps */
switch(reg) {
case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
return pt + 4;
#else
return pt + 3;
#endif
case (CELL)FunctorString:
return pt + 3 + pt[1];
case (CELL)FunctorBigInt:
{
Int sz = 3 +
(sizeof(MP_INT)+
(((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL);
Opaque_CallOnGCMark f;
Opaque_CallOnGCRelocate f2;
Term t = AbsAppl(pt);
if ( (f = Yap_blob_gc_mark_handler(t)) ) {
CELL ar[256];
Int i,n = (f)(Yap_BlobTag(t), Yap_BlobInfo(t), ar, 256);
if (n < 0) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"not enough space for slot internal variables in agc");
}
for (i = 0; i< n; i++) {
CELL *pt = ar+i;
CELL reg = *pt;
if (!IsVarTerm(reg) && IsAtomTerm(reg)) {
*pt = AtomTermAdjust(reg);
}
}
if ( (f2 = Yap_blob_gc_relocate_handler(t)) < 0 ) {
int out = (f2)(Yap_BlobTag(t), Yap_BlobInfo(t), ar, n);
if (out < 0)
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"bad restore of slot internal variables in agc");
}
}
return pt + sz;
}
case (CELL)FunctorLongInt:
return pt + 3;
break;
}
} else if (IsAtomTerm(reg)) {
MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
return pt+1;
}
return pt+1;
}
/** @pred set_value(+ _A_,+ _C_)
Associate atom _A_ with constant _C_.
The `set_value` and `get_value` built-ins give a fast alternative to
the internal data-base. This is a simple form of implementing a global
counter.
~~~~~
read_and_increment_counter(Value) :-
get_value(counter, Value),
Value1 is Value+1,
set_value(counter, Value1).
~~~~~
This predicate is YAP specific.
*/
static Int p_setval(USES_REGS1) { /* '$set_value'(+Atom,+Atomic) */
Term t1 = Deref(ARG1), t2 = Deref(ARG2);
if (!IsVarTerm(t1) && IsAtomTerm(t1) &&
(!IsVarTerm(t2) && (IsAtomTerm(t2) || IsNumTerm(t2)))) {
Yap_PutValue(AtomOfTerm(t1), t2);
return (TRUE);
}
return (FALSE);
}
static void
LookupPredEntry(PredEntry *pe)
{
CACHE_REGS
CELL hash = (((CELL)(pe))/(2*sizeof(CELL))) % LOCAL_ExportPredEntryHashTableSize;
export_pred_entry_hash_entry_t *p;
UInt arity = pe->ArityOfPE;
p = LOCAL_ExportPredEntryHashChain+hash;
while (p->val) {
if (p->val == pe) {
return;
}
p++;
if (p == LOCAL_ExportPredEntryHashChain+LOCAL_ExportPredEntryHashTableSize)
p = LOCAL_ExportPredEntryHashChain;
}
p->arity = arity;
p->val = pe;
if (pe->ModuleOfPred != IDB_MODULE) {
if (arity) {
p->u_af.f = pe->FunctorOfPred;
LookupFunctor(pe->FunctorOfPred);
} else {
p->u_af.a = (Atom)(pe->FunctorOfPred);
LookupAtom((Atom)(pe->FunctorOfPred));
}
} else {
if (pe->PredFlags & AtomDBPredFlag) {
p->u_af.a = (Atom)(pe->FunctorOfPred);
p->arity = (CELL)(-2);
LookupAtom((Atom)(pe->FunctorOfPred));
} else if (!(pe->PredFlags & NumberDBPredFlag)) {
p->u_af.f = pe->FunctorOfPred;
p->arity = (CELL)(-1);
LookupFunctor(pe->FunctorOfPred);
} else {
p->u_af.f = pe->FunctorOfPred;
}
}
if (pe->ModuleOfPred) {
p->module = AtomOfTerm(pe->ModuleOfPred);
} else {
p->module = AtomProlog;
}
LookupAtom(p->module);
LOCAL_ExportPredEntryHashTableNum++;
if (LOCAL_ExportPredEntryHashTableNum >
LOCAL_ExportPredEntryHashTableSize/2
) {
GrowPredTable();
if (!LOCAL_ExportPredEntryHashChain) {
return;
}
}
}
static Int
cmp_extra_args(CELL *si, CELL *sj, struct index_t *it)
{
UInt m = it->udi_free_args;
UInt m0 = 1, x;
for (x=0; x< it->arity; x++) {
if (m0 & m) {
if (si[x] != sj[x]) {
if (IsIntTerm(si[x]))
return IntOfTerm(si[x])-IntOfTerm(sj[x]);
return AtomOfTerm(si[x])-AtomOfTerm(sj[x]);
}
m -= m0;
if (m == 0)
return 0;
}
m0 <<= 1;
}
return 0;
}
/** @pred get_value(+ _A_,- _V_)
In YAP, atoms can be associated with constants. If one such
association exists for atom _A_, unify the second argument with the
constant. Otherwise, unify _V_ with `[]`.
This predicate is YAP specific.
*/
static Int p_value(USES_REGS1) { /* '$get_value'(+Atom,?Val) */
Term t1 = Deref(ARG1);
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "get_value/2");
return (FALSE);
}
if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1, "get_value/2");
return (FALSE);
}
return (Yap_unify_constant(ARG2, Yap_GetValue(AtomOfTerm(t1))));
}
static Int p_values(USES_REGS1) { /* '$values'(Atom,Old,New) */
Term t1 = Deref(ARG1), t3 = Deref(ARG3);
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "set_value/2");
return (FALSE);
}
if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1, "set_value/2");
return (FALSE);
}
if (!Yap_unify_constant(ARG2, Yap_GetValue(AtomOfTerm(t1)))) {
return (FALSE);
}
if (!IsVarTerm(t3)) {
if (IsAtomTerm(t3) || IsNumTerm(t3)) {
Yap_PutValue(AtomOfTerm(t1), t3);
} else
return (FALSE);
}
return (TRUE);
}
static Int prompt1(USES_REGS1) { /* prompt1(Atom) */
Term t = Deref(ARG1);
Atom a;
if (IsVarTerm(t) || !IsAtomTerm(t))
return (FALSE);
LOCAL_AtPrompt = a = AtomOfTerm(t);
if (strlen((char *)RepAtom(a)->StrOfAE) > MAX_PROMPT) {
Yap_Error(SYSTEM_ERROR_INTERNAL, t, "prompt %s is too long",
RepAtom(a)->StrOfAE);
return (FALSE);
}
strncpy(LOCAL_Prompt, (char *)RepAtom(a)->StrOfAE, MAX_PROMPT);
return (TRUE);
}
const char *Yap_GetFileName(Term t USES_REGS) {
char *buf = Malloc(YAP_FILENAME_MAX + 1);
if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorSlash) {
snprintf(buf, YAP_FILENAME_MAX, "%s/%s", Yap_GetFileName(ArgOfTerm(1, t)),
Yap_GetFileName(ArgOfTerm(2, t)));
}
if (IsAtomTerm(t)) {
return RepAtom(AtomOfTerm(t))->StrOfAE;
}
if (IsStringTerm(t)) {
return StringOfTerm(t);
}
return Yap_TextTermToText(t PASS_REGS);
}
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 check_if_valid_new_alias (USES_REGS1)
{
Term tname = Deref(ARG1);
Atom at;
if (IsVarTerm(tname)) {
Yap_Error(INSTANTIATION_ERROR, tname, "$add_alias_to_stream");
return (FALSE);
} else if (!IsAtomTerm (tname)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "$add_alias_to_stream");
return (FALSE);
}
at = AtomOfTerm(tname);
return(Yap_CheckAlias(at) == -1);
}
static Int
p_binary_is(void)
{ /* X is Y */
Term t = Deref(ARG2);
Term t1, t2;
if (IsVarTerm(t)) {
Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
t1 = Yap_Eval(Deref(ARG3));
if (!Yap_FoundArithError(t1, ARG3)) {
return FALSE;
}
t2 = Yap_Eval(Deref(ARG4));
if (!Yap_FoundArithError(t2, ARG4)) {
return FALSE;
}
if (IsIntTerm(t)) {
Term tout = Yap_FoundArithError(eval2(IntOfTerm(t), t1, t2), 0L);
if (!tout)
return FALSE;
return Yap_unify_constant(ARG1,tout);
}
if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);
ExpEntry *p;
Term out;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntTerm(1);
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
Yap_Error(TYPE_ERROR_EVALUABLE, t,
"functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,2);
P = FAILCODE;
return(FALSE);
}
if (!(out=Yap_FoundArithError(eval2(p->FOfEE, t1, t2), 0L)))
return FALSE;
return Yap_unify_constant(ARG1,out);
}
return FALSE;
}
/** @pred prompt(- _A_,+ _B_)
Changes YAP input prompt from _A_ to _B_, active on *next* standard input
interaction.
*/
static Int prompt(USES_REGS1) { /* prompt(Old,New) */
Term t = Deref(ARG2);
Atom a;
if (!Yap_unify_constant(ARG1, MkAtomTerm(LOCAL_AtPrompt)))
return (FALSE);
if (IsVarTerm(t) || !IsAtomTerm(t))
return (FALSE);
a = AtomOfTerm(t);
if (strlen(RepAtom(a)->StrOfAE) > MAX_PROMPT) {
Yap_Error(SYSTEM_ERROR_INTERNAL, t, "prompt %s is too long",
RepAtom(a)->StrOfAE);
return false;
}
strncpy(LOCAL_Prompt, (char *)RepAtom(LOCAL_AtPrompt)->StrOfAE, MAX_PROMPT);
LOCAL_AtPrompt = a;
return (TRUE);
}
bool YAP_is_blob(Term t, blob_type_t **type) {
CACHE_REGS
Term yt = Yap_GetFromSlot(t);
Atom a;
YAP_BlobPropEntry *b;
if (IsVarTerm(yt))
return FALSE;
if (!IsAtomTerm(yt))
return FALSE;
a = AtomOfTerm(yt);
if (!IsBlob(a))
return FALSE;
b = RepBlobProp(a->PropsOfAE);
*type = b->blob_type;
return TRUE;
}
static void
mark_registers(void)
{
CELL *pt;
pt = XREGS;
/* moving the trail is simple */
while (pt != XREGS+MaxTemps) {
CELL reg = *pt++;
if (!IsVarTerm(reg)) {
if (IsAtomTerm(reg)) {
MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
}
}
}
}
