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 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;
}
static inline Term
TermToGlobalOrAtomAdjust(Term t)
{
if (t && IsAtomTerm(t))
return AtomTermAdjust(t);
return t;
}
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;
}
/** @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 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 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 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 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)));
}
}
}
}
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);
}
/** @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);
}
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);
}
}
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;
}
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;
}
/** @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);
}
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)));
}
}
}
}
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;
}
}
PL_is_blob(term_t t, PL_blob_t **type)
{
CACHE_REGS
Term yt = Yap_GetFromSlot(t PASS_REGS);
Atom a;
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_t;
return TRUE;
}
static void
mark_trail(void)
{
register tr_fr_ptr pt;
pt = TR;
/* moving the trail is simple */
while (pt != (tr_fr_ptr)Yap_TrailBase) {
CELL reg = TrailTerm(pt-1);
if (!IsVarTerm(reg)) {
if (IsAtomTerm(reg)) {
MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
}
}
pt--;
}
}
bool
Yap_FetchStreamAlias (int sno, Term t2 USES_REGS)
{
if (IsVarTerm(t2)) {
Atom at = FetchAlias(sno);
if (at == NULL)
return false;
else {
return Yap_unify_constant(t2, MkAtomTerm(at));
}
} else if (IsAtomTerm(t2)) {
Atom at = AtomOfTerm(t2);
return ExistsAliasForStream(sno,at);
} else {
Yap_Error(TYPE_ERROR_ATOM, t2, "stream_property(_,alias( ))");
return false;
}
}
static Int /* mpe_close(+FileName) */
p_close()
{
Term t_str = Deref(ARG1);
char *str;
/* The arg must be bound to an atom. */
if (IsVarTerm(t_str)) {
Yap_Error(INSTANTIATION_ERROR, t_str, "mpe_close");
return (FALSE);
} else if( !IsAtomTerm(t_str) ) {
Yap_Error(TYPE_ERROR_ATOM, t_str, "mpe_close");
return (FALSE);
} else {
str = RepAtom(AtomOfTerm(t_str))->StrOfAE;
}
return (MPE_Finish_log(str) == 0);
}
YAP_tag_t YAPTerm::tag() {
Term tt = gt();
if (IsVarTerm(tt)) {
CELL *pt = VarOfTerm(tt);
if (IsUnboundVar(pt)) {
CACHE_REGS
if (IsAttVar(pt))
return YAP_TAG_ATT;
return YAP_TAG_UNBOUND;
}
return YAP_TAG_REF;
}
if (IsPairTerm(tt))
return YAP_TAG_PAIR;
if (IsAtomOrIntTerm(tt)) {
if (IsAtomTerm(tt))
return YAP_TAG_ATOM;
return YAP_TAG_INT;
} else {
Functor f = FunctorOfTerm(tt);
if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) {
return YAP_TAG_DBREF;
}
if (f == FunctorLongInt) {
return YAP_TAG_LONG_INT;
}
if (f == FunctorBigInt) {
big_blob_type bt = (big_blob_type)RepAppl(tt)[1];
switch (bt) {
case BIG_INT:
return YAP_TAG_BIG_INT;
case BIG_RATIONAL:
return YAP_TAG_RATIONAL;
default:
return YAP_TAG_OPAQUE;
}
}
}
return YAP_TAG_APPL;
}
}
