static BITS32*
NEXT_MAX(BITS32 *pt0, BITS32 *pte, Term tmin, Term tmax, struct index_t *it)
{
Term* si = EXO_OFFSET_TO_ADDRESS(it, pt0[0]);
int do_min, do_max;
Int min = 0, max = 0;
if (IsVarTerm(tmin)) {
do_min = FALSE;
} else {
do_min = TRUE;
min = IntOfTerm(tmin);
}
if (IsVarTerm(tmax)) {
do_max = FALSE;
} else {
do_max = TRUE;
max = IntOfTerm(tmax);
}
while ((do_min && IntOfTerm(si[it->udi_arg]) < min) ||
(do_max && IntOfTerm(si[it->udi_arg]) > max)) {
pt0--;
if (pt0 == pte)
return NULL;
si = EXO_OFFSET_TO_ADDRESS(it, *pt0);
}
return pt0;
}
static int
compar(const void *ip0, const void *jp0) {
CACHE_REGS
BITS32 *ip = (BITS32 *)ip0, *jp = (BITS32 *)jp0;
Term i = EXO_OFFSET_TO_ADDRESS(LOCAL_exo_it, *ip)[LOCAL_exo_arg];
Term j = EXO_OFFSET_TO_ADDRESS(LOCAL_exo_it, *jp)[LOCAL_exo_arg];
//fprintf(stderr, "%ld-%ld\n", IntOfTerm(i), IntOfTerm(j));
return IntOfTerm(i)-IntOfTerm(j);
}
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);
}
static int
compar2(const void *ip0, const void *jp0) {
CACHE_REGS
BITS32 *ip = (BITS32 *)ip0, *jp = (BITS32 *)jp0;
struct index_t *it = LOCAL_exo_it;
Term* si = EXO_OFFSET_TO_ADDRESS(it, *ip);
Term* sj = EXO_OFFSET_TO_ADDRESS(it, *jp);
int cmp = cmp_extra_args(si, sj, it);
if (cmp)
return cmp;
return IntOfTerm(si[LOCAL_exo_arg])-IntOfTerm(sj[LOCAL_exo_arg]);
}
static Int p_get_depth_limit( USES_REGS1 )
{
Int d = IntOfTerm(DEPTH);
if (d % 2 == 1)
return(Yap_unify(ARG1, MkFloatTerm(INFINITY)));
return(Yap_unify_constant(ARG1, MkIntTerm(d/2)));
}
/**
* 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);
}
static Int stream_flags(USES_REGS1) { /* '$stream_flags'(+N,-Flags) */
Term trm;
trm = Deref(ARG1);
if (IsVarTerm(trm) || !IsIntTerm(trm))
return (FALSE);
return (Yap_unify_constant(ARG2,
MkIntTerm(GLOBAL_Stream[IntOfTerm(trm)].status)));
}
static Int
p_debug( USES_REGS1 )
{ /* $debug(+Flag) */
int i = IntOfTerm(Deref(ARG1));
if (i >= 'a' && i <= 'z')
GLOBAL_Option[i - 96] = !GLOBAL_Option[i - 96];
return (1);
}
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
p_log() /* mpe_log(+EventType, +EventNum, +EventStr) */
{
Term t_type = Deref(ARG1), t_num = Deref(ARG2), t_str = Deref(ARG3);
Int event_id, event;
char *descr;
/* The first arg must be bount to integer event type ID. */
if (IsVarTerm(t_type)) {
Yap_Error(INSTANTIATION_ERROR, t_type, "mpe_log");
return (FALSE);
} else if( !IsIntegerTerm(t_type) ) {
Yap_Error(TYPE_ERROR_INTEGER, t_type, "mpe_log");
return (FALSE);
} else {
event_id = IntOfTerm(t_type);
}
/* The second arg must be bount to integer event number. */
if (IsVarTerm(t_num)) {
Yap_Error(INSTANTIATION_ERROR, t_num, "mpe_log");
return (FALSE);
} else if( !IsIntegerTerm(t_num) ) {
Yap_Error(TYPE_ERROR_INTEGER, t_num, "mpe_log");
return (FALSE);
} else {
event = IntOfTerm(t_num);
}
/* The third arg must be bound to an atom. */
if (IsVarTerm(t_str)) {
Yap_Error(INSTANTIATION_ERROR, t_str, "mpe_log");
return (FALSE);
} else if( !IsAtomTerm(t_str) ) {
Yap_Error(TYPE_ERROR_ATOM, t_str, "mpe_log");
return (FALSE);
} else {
descr = RepAtom(AtomOfTerm(t_str))->StrOfAE;
}
return ( MPE_Log_event((int)event_id, (int)event, descr) == 0 );
}
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;
}
static Int
p_compilation_threads( USES_REGS1 )
{
// this predicate works only 'CONTINUOUS_COMPILATION' mode
if (ExpEnv.config_struc.execution_mode == SMART_JIT || ExpEnv.config_struc.execution_mode == CONTINUOUS_COMPILATION) {
Term t = Deref(ARG1);
Int v;
// valid value for ARG1 is 'integer' (because it defines number of threads)
if (IsIntTerm(t)) {
// ARG1 is integer
v = IntOfTerm(t);
if (v < 1) {
// ERROR: number of threads is negative!!
Yap_Error(OUT_OF_KNOWNRANGE_ERROR,t,"");
return FALSE;
}
if (v >= ExpEnv.config_struc.ncores) {
// WARNING: number of threads is not ideal -- real parallelism won't occur!!
fprintf(stderr,
" It was detected %ld cores on this computer, therefore it is ideally to set just %ld compilation thread. Reconsider its value...\n",
ExpEnv.config_struc.ncores, ExpEnv.config_struc.ncores-1);
}
// setting compilation threads
ExpEnv.config_struc.compilation_threads = v;
/* initializing structures which will handle compilation threads */
{
if (ExpEnv.config_struc.threaded_compiler_threads) free(ExpEnv.config_struc.threaded_compiler_threads);
if (ExpEnv.config_struc.posthreads) free(ExpEnv.config_struc.posthreads);
ExpEnv.config_struc.threaded_compiler_threads = (pthread_t*)malloc(v*sizeof(pthread_t));
ExpEnv.config_struc.posthreads = (CELL*)malloc(v*sizeof(CELL));
int i;
for (i = 0; i < v; i++) ExpEnv.config_struc.posthreads[i] = 0;
}
/***/
#if YAP_DBG_PREDS
if (ExpEnv.debug_struc.act_predicate_msgs.success_msgs) fprintf(stderr," Type of main clause was changed to HOT AND FEWER!!\n");
#endif
return TRUE;
}
else {
// ARG1 is not an integer
Yap_NilError(INVALID_PARAMETER_TYPE_ERROR,"compilation_threads/1 (1st arg)");
return FALSE;
}
}
else {
// current execution mode differs of 'CONTINUOUS_COMPILATION'
Yap_NilError(INCOMPATIBLEMODE_WARNING,"");
return FALSE;
}
}
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;
}
static Int
open_mem_read_stream (USES_REGS1) /* $open_mem_read_stream(+List,-Stream) */
{
Term t, ti;
int sno;
Int sl = 0, nchars = 0;
char *nbuf;
ti = Deref(ARG1);
while (ti != TermNil) {
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR, ti, "open_mem_read_stream");
return (FALSE);
} else if (!IsPairTerm(ti)) {
Yap_Error(TYPE_ERROR_LIST, ti, "open_mem_read_stream");
return (FALSE);
} else {
sl++;
ti = TailOfTerm(ti);
}
}
while ((nbuf = (char *)Yap_AllocAtomSpace((sl+1)*sizeof(char))) == NULL) {
if (!Yap_growheap(FALSE, (sl+1)*sizeof(char), NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
return(FALSE);
}
}
ti = Deref(ARG1);
while (ti != TermNil) {
Term ts = HeadOfTerm(ti);
if (IsVarTerm(ts)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "open_mem_read_stream");
return (FALSE);
} else if (!IsIntTerm(ts)) {
Yap_Error(TYPE_ERROR_INTEGER, ARG1, "open_mem_read_stream");
return (FALSE);
}
nbuf[nchars++] = IntOfTerm(ts);
ti = TailOfTerm(ti);
}
nbuf[nchars] = '\0';
sno = Yap_open_buf_read_stream(nbuf, nchars, &LOCAL_encoding, MEM_BUF_CODE);
t = Yap_MkStream (sno);
return (Yap_unify (ARG2, t));
}
static Int
p_frequency_bound( 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 values for ARG1 are 'integer' and 'float'
if (IsIntTerm(t) || IsFloatTerm(t)) {
// ARG1 is integer or float
// getting ARG1 value
Float v;
if (IsIntTerm(t)) v = (Float)IntOfTerm(t);
if (IsFloatTerm(t)) v = FloatOfTerm(t);
// setting 'frequency bound' if 'frequency type' is 'COUNTER'
if (ExpEnv.config_struc.frequency_type == COUNTER) {
if (v < 20.0) {
fprintf(stderr,"%.2f is a very low value for the active frequency type. Reconsider its value...\n", v);
return FALSE;
}
ExpEnv.config_struc.frequency_bound = roundf(v);
return TRUE;
}
// setting 'frequency bound' if 'frequency type' is 'TIME'
else {
if (v <= 0.0 || v > 0.49) {
fprintf(stderr,"%.2f is an invalid or a very high value for the active frequency type. Reconsider its value...\n", v);
return FALSE;
}
ExpEnv.config_struc.frequency_bound = v;
return TRUE;
}
}
else {
// ARG1 is not an 'integer' or 'float'
Yap_NilError(INVALID_PARAMETER_TYPE_ERROR,"frequency_bound/1 (1st arg)");
return FALSE;
}
}
else {
// current execution mode differs of 'SMART_JIT' and 'CONTINUOUS_COMPILATION'
Yap_NilError(INCOMPATIBLEMODE_WARNING,"");
return FALSE;
}
}
static inline Float
get_float(Term t) {
if (IsFloatTerm(t)) {
return FloatOfTerm(t);
}
if (IsIntTerm(t)) {
return IntOfTerm(t);
}
if (IsLongIntTerm(t)) {
return LongIntOfTerm(t);
}
#ifdef USE_GMP
if (IsBigIntTerm(t)) {
return Yap_gmp_to_float(t);
}
#endif
return 0.0;
}
static Int
p_socket_listen(USES_REGS1)
{
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
int sno;
socket_info status;
int fd;
Int j;
if ((sno = Yap_CheckSocketStream(t1, "socket_listen/2")) < 0) {
return (FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR,t2,"socket_listen/2");
return(FALSE);
}
if (!IsIntTerm(t2)) {
Yap_Error(TYPE_ERROR_INTEGER,t2,"socket_listen/2");
return(FALSE);
}
j = IntOfTerm(t2);
if (j < 0) {
Yap_Error(DOMAIN_ERROR_STREAM,t1,"socket_listen/2");
return(FALSE);
}
fd = Yap_GetStreamFd(sno);
status = Yap_GetSocketStatus(sno);
if (status != server_socket) {
/* ok, this should be an error, as you are trying to bind */
return(FALSE);
}
if (listen(fd,j) < 0) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_listen/2 (listen: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_listen/2 (listen)");
#endif
}
return(TRUE);
}
static Int p_get_depth_limit( USES_REGS1 )
{
return(Yap_unify_constant(ARG1, MkIntTerm(IntOfTerm(DEPTH/2))));
}
static Int
p_setarg( USES_REGS1 )
{
CELL ti = Deref(ARG1), ts = Deref(ARG2), t3 = Deref(ARG3);
Int i;
if (IsVarTerm(t3) &&
VarOfTerm(t3) > H &&VarOfTerm(t3) < ASP) {
/* local variable */
Term tn = MkVarTerm();
Bind_Local(VarOfTerm(t3), tn);
t3 = tn;
}
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR,ti,"setarg/3");
return FALSE;
} else {
if (IsIntTerm(ti))
i = IntOfTerm(ti);
else {
Term te = Yap_Eval(ti);
if (IsIntegerTerm(te)) {
i = IntegerOfTerm(te);
} else {
Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
return FALSE;
}
}
}
if (IsVarTerm(ts)) {
Yap_Error(INSTANTIATION_ERROR,ts,"setarg/3");
} else if(IsApplTerm(ts)) {
CELL *pt;
if (IsExtensionFunctor(FunctorOfTerm(ts))) {
Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return FALSE;
}
if (i < 1 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) {
if (i<0)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
return FALSE;
if (i==0)
Yap_Error(DOMAIN_ERROR_NOT_ZERO,ts,"setarg/3");
return FALSE;
}
pt = RepAppl(ts)+i;
/* the evil deed is to be done now */
MaBind(pt, t3);
} else if(IsPairTerm(ts)) {
CELL *pt;
if (i < 1 || i > 2) {
if (i<0)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
return FALSE;
}
pt = RepPair(ts)+i-1;
/* the evil deed is to be done now */
MaBind(pt, t3);
} else {
Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return FALSE;
}
return TRUE;
}
static int
compare(const BITS32 *ip, Int j USES_REGS) {
Term i = EXO_OFFSET_TO_ADDRESS(LOCAL_exo_it, *ip)[LOCAL_exo_arg];
//fprintf(stderr, "%ld-%ld\n", IntOfTerm(i), j);
return IntOfTerm(i)-j;
}
static Int p_table( USES_REGS1 ) {
Term mod, t, list;
PredEntry *pe;
Atom at;
int arity;
tab_ent_ptr tab_ent;
#ifdef MODE_DIRECTED_TABLING
int* mode_directed = NULL;
#endif /* MODE_DIRECTED_TABLING */
mod = Deref(ARG1);
t = Deref(ARG2);
list = Deref(ARG3);
if (IsAtomTerm(t)) {
at = AtomOfTerm(t);
pe = RepPredProp(PredPropByAtom(at, mod));
arity = 0;
} else if (IsApplTerm(t)) {
at = NameOfFunctor(FunctorOfTerm(t));
pe = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod));
arity = ArityOfFunctor(FunctorOfTerm(t));
} else
return (FALSE);
if (list != TermNil) { /* non-empty list */
#ifndef MODE_DIRECTED_TABLING
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "invalid tabling declaration for %s/%d (mode directed tabling not enabled)", AtomName(at), arity);
return(FALSE);
#else
/*************************************************************************************
The mode operator declaration is reordered as follows:
1. arguments with mode 'index' (any number)
2. arguments with mode 'min' and 'max' (any number, following the original order)
3. arguments with mode 'all' (any number)
4. arguments with mode 'sum' or 'last' (only one of the two is allowed)
5. arguments with mode 'first' (any number)
*************************************************************************************/
int pos_index = 0;
int pos_min_max = 0;
int pos_all = 0;
int pos_sum_last = 0;
int pos_first = 0;
int i;
int *aux_mode_directed;
aux_mode_directed = malloc(arity * sizeof(int));
for (i = 0; i < arity; i++) {
int mode = IntOfTerm(HeadOfTerm(list));
if (mode == MODE_DIRECTED_INDEX)
pos_index++;
else if (mode == MODE_DIRECTED_MIN || mode == MODE_DIRECTED_MAX)
pos_min_max++;
else if (mode == MODE_DIRECTED_ALL)
pos_all++;
else if (mode == MODE_DIRECTED_SUM || mode == MODE_DIRECTED_LAST) {
if (pos_sum_last) {
free(aux_mode_directed);
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "invalid tabling declaration for %s/%d (more than one argument with modes 'sum' and/or 'last')", AtomName(at), arity);
return(FALSE);
} else
pos_sum_last = 1;
}
aux_mode_directed[i] = mode;
list = TailOfTerm(list);
}
pos_first = pos_index + pos_min_max + pos_all + pos_sum_last;
pos_sum_last = pos_index + pos_min_max + pos_all;
pos_all = pos_index + pos_min_max;
pos_min_max = pos_index;
pos_index = 0;
ALLOC_BLOCK(mode_directed, arity * sizeof(int), int);
for (i = 0; i < arity; i++) {
int aux_pos = 0;
if (aux_mode_directed[i] == MODE_DIRECTED_INDEX)
aux_pos = pos_index++;
else if (aux_mode_directed[i] == MODE_DIRECTED_MIN || aux_mode_directed[i] == MODE_DIRECTED_MAX)
aux_pos = pos_min_max++;
else if (aux_mode_directed[i] == MODE_DIRECTED_ALL)
aux_pos = pos_all++;
else if (aux_mode_directed[i] == MODE_DIRECTED_SUM || aux_mode_directed[i] == MODE_DIRECTED_LAST)
aux_pos = pos_sum_last++;
else if(aux_mode_directed[i] == MODE_DIRECTED_FIRST)
aux_pos = pos_first++;
mode_directed[aux_pos] = MODE_DIRECTED_SET(i, aux_mode_directed[i]);
}
free(aux_mode_directed);
#endif /* MODE_DIRECTED_TABLING */
}
static Int
p_main_clause_ty( 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 values for ARG1 are 'integer' and 'atom'
if (IsIntTerm(t)) {
// ARG1 is integer
Int v;
v = IntOfTerm(t);
if (v < 0 || v > 3) {
// value passed by argument is out of known range
Yap_Error(OUT_OF_KNOWNRANGE_ERROR,t,"");
return FALSE;
}
#if YAP_DBG_PREDS
if (ExpEnv.debug_struc.act_predicate_msgs.success_msgs) {
switch(v) {
case 0:
fprintf(stderr," Type of main clause was changed to JUST HOT!!\n");
break;
case 1:
fprintf(stderr," Type of main clause was changed to HOT AND CALLEE!!\n");
break;
case 2:
fprintf(stderr," Type of main clause was changed to HOT AND GREATER!!\n");
break;
case 3:
fprintf(stderr," Type of main clause was changed to HOT AND FEWER!!\n");
break;
}
}
#endif
// setting 'mainclause_ty' -- I should de add '1' because the first enum of 'enumMainClauseType' is 'UNUSED', used just for control
ExpEnv.config_struc.mainclause_ty = (enumMainClauseType)(v+1);
return TRUE;
}
else if (IsAtomTerm(t)) {
// ARG1 is atom
enumMainClauseType v;
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);
// Detecting mainclause type chosen by user according to 'str'
if (strcmp(str, "JUSTHOT") == 0) {
v = JUST_HOT;
#if YAP_DBG_PREDS
if (ExpEnv.debug_struc.act_predicate_msgs.success_msgs) fprintf(stderr," Type of main clause was changed to JUST HOT!!\n");
#endif
}
else if (strcmp(str, "HOTANDCALLEE") == 0) {
v = HOT_AND_CALLEE;
#if YAP_DBG_PREDS
if (ExpEnv.debug_struc.act_predicate_msgs.success_msgs) fprintf(stderr," Type of main clause was changed to HOT AND CALLEE!!\n");
#endif
}
else if (strcmp(str, "HOTANDGREATER") == 0) {
v = HOT_AND_GREATER;
#if YAP_DBG_PREDS
if (ExpEnv.debug_struc.act_predicate_msgs.success_msgs) fprintf(stderr," Type of main clause was changed to HOT AND GREATER!!\n");
#endif
}
else if (strcmp(str, "HOTANDFEWER") == 0) {
v = HOT_AND_FEWER;
#if YAP_DBG_PREDS
if (ExpEnv.debug_struc.act_predicate_msgs.success_msgs) fprintf(stderr," Type of main clause was changed to HOT AND FEWER!!\n");
#endif
}
else {
// value passed by argument is out of known range
Yap_Error(OUT_OF_KNOWNRANGE_ERROR,t,"");
return FALSE;
}
ExpEnv.config_struc.mainclause_ty = v;
return TRUE;
}
else {
// ARG1 is not an integer or atom
Yap_NilError(INVALID_PARAMETER_TYPE_ERROR,"main_clause_ty/1 (1st arg)");
return FALSE;
}
}
else {
// current execution mode differs of 'SMART_JIT' and 'CONTINUOUS_COMPILATION'
Yap_NilError(INCOMPATIBLEMODE_WARNING,"");
return FALSE;
}
}
static Int
p_socket(USES_REGS1)
{
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
Term t3 = Deref(ARG3);
char *sdomain, *stype;
Int domain = AF_UNSPEC, type, protocol;
int fd;
Term out;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR,t1,"socket/4");
return(FALSE);
}
if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM,t1,"socket/4");
return(FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR,t2,"socket/4");
return(FALSE);
}
if (!IsAtomTerm(t2)) {
Yap_Error(TYPE_ERROR_ATOM,t2,"socket/4");
return(FALSE);
}
if (IsVarTerm(t3)) {
Yap_Error(INSTANTIATION_ERROR,t3,"socket/4");
return(FALSE);
}
if (!IsIntTerm(t3)) {
Yap_Error(TYPE_ERROR_ATOM,t3,"socket/4");
return(FALSE);
}
sdomain = RepAtom(AtomOfTerm(t1))->StrOfAE;
if (sdomain[0] != 'A' || sdomain[1] != 'F' || sdomain[2] != '_')
return(FALSE); /* Error */
sdomain += 3;
switch (sdomain[0]) {
case 'A':
if (strcmp(sdomain, "AAL5") == 0)
domain = AF_AAL5;
else if (strcmp(sdomain, "APPLETALK") == 0)
domain = AF_APPLETALK;
else if (strcmp(sdomain, "AX25") == 0)
domain = AF_AX25;
break;
case 'B':
if (strcmp(sdomain, "BRIDGE") == 0)
domain = AF_APPLETALK;
break;
case 'D':
if (strcmp(sdomain, "DECnet") == 0)
domain = AF_DECnet;
break;
case 'F':
if (strcmp(sdomain, "FILE") == 0)
domain = AF_FILE;
break;
case 'I':
if (strcmp(sdomain, "INET") == 0)
domain = AF_INET;
else if (strcmp(sdomain, "INET6") == 0)
domain = AF_INET6;
else if (strcmp(sdomain, "IPX") == 0)
domain = AF_IPX;
break;
case 'L':
if (strcmp(sdomain, "LOCAL") == 0)
domain = AF_LOCAL;
break;
case 'N':
if (strcmp(sdomain, "NETBEUI") == 0)
domain = AF_NETBEUI;
else if (strcmp(sdomain, "NETLINK") == 0)
domain = AF_NETLINK;
else if (strcmp(sdomain, "NETROM") == 0)
domain = AF_NETROM;
break;
case 'O':
if (strcmp(sdomain, "OSINET") == 0)
domain = AF_OSINET;
break;
case 'P':
if (strcmp(sdomain, "PACKET") == 0)
domain = AF_PACKET;
break;
case 'R':
if (strcmp(sdomain, "ROSE") == 0)
domain = AF_ROSE;
else if (strcmp(sdomain, "ROUTE") == 0)
domain = AF_ROUTE;
break;
case 'S':
if (strcmp(sdomain, "SECURITY") == 0)
domain = AF_SECURITY;
else if (strcmp(sdomain, "SNA") == 0)
domain = AF_SNA;
break;
case 'U':
if (strcmp(sdomain, "UNIX") == 0)
domain = AF_UNIX;
break;
case 'X':
if (strcmp(sdomain, "X25") == 0)
domain = AF_X25;
break;
}
stype = RepAtom(AtomOfTerm(t2))->StrOfAE;
if (stype[0] != 'S' || stype[1] != 'O' || stype[2] != 'C' || stype[3] != 'K' || stype[4] != '_')
return(FALSE); /* Error */
stype += 5;
if (strcmp(stype,"STREAM") == 0)
type = SOCK_STREAM;
else if (strcmp(stype,"DGRAM") == 0)
type = SOCK_DGRAM;
else if (strcmp(stype,"RAW") == 0)
type = SOCK_RAW;
else if (strcmp(stype,"RDM") == 0)
type = SOCK_RDM;
else if (strcmp(stype,"SEQPACKET") == 0)
type = SOCK_SEQPACKET;
else if (strcmp(stype,"PACKET") == 0)
type = SOCK_PACKET;
else
return(FALSE);
protocol = IntOfTerm(t3);
if (protocol < 0)
return(FALSE);
fd = socket(domain, type, protocol);
if (invalid_socket_fd(fd)) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket/4 (socket: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket/4 (socket)");
#endif
return(FALSE);
}
if (domain == AF_UNIX || domain == AF_LOCAL )
out = Yap_InitSocketStream(fd, new_socket, af_unix);
else if (domain == AF_INET )
out = Yap_InitSocketStream(fd, new_socket, af_inet);
else {
/* ok, we currently don't support these sockets */
#if _MSC_VER || defined(__MINGW32__)
_close(fd);
#else
close(fd);
#endif
return(FALSE);
}
if (out == TermNil) return(FALSE);
return(Yap_unify(out,ARG4));
}
inline static Int compare(Term t1, Term t2) /* compare terms t1 and t2 */
{
if (t1 == t2)
return 0;
if (IsVarTerm(t1)) {
if (IsVarTerm(t2))
return Signed(t1) - Signed(t2);
return -1;
} else if (IsVarTerm(t2)) {
/* get rid of variables */
return 1;
}
if (IsAtomOrIntTerm(t1)) {
if (IsAtomTerm(t1)) {
if (IsAtomTerm(t2))
return cmp_atoms(AtomOfTerm(t1), AtomOfTerm(t2));
if (IsPrimitiveTerm(t2))
return 1;
if (IsStringTerm(t2))
return 1;
return -1;
} else {
if (IsIntTerm(t2)) {
return IntOfTerm(t1) - IntOfTerm(t2);
}
if (IsApplTerm(t2)) {
Functor fun2 = FunctorOfTerm(t2);
switch ((CELL)fun2) {
case double_e:
return 1;
case long_int_e:
return IntOfTerm(t1) - LongIntOfTerm(t2);
#ifdef USE_GMP
case big_int_e:
return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2);
#endif
case db_ref_e:
return 1;
case string_e:
return -1;
}
}
return -1;
}
} else if (IsPairTerm(t1)) {
if (IsApplTerm(t2)) {
Functor f = FunctorOfTerm(t2);
if (IsExtensionFunctor(f))
return 1;
else {
if (f != FunctorDot)
return strcmp(".", RepAtom(NameOfFunctor(f))->StrOfAE);
else {
return compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepAppl(t2));
}
}
}
if (IsPairTerm(t2)) {
return (
compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepPair(t2) - 1));
} else
return 1;
} else {
/* compound term */
Functor fun1 = FunctorOfTerm(t1);
if (IsExtensionFunctor(fun1)) {
/* float, long, big, dbref */
switch ((CELL)fun1) {
case double_e: {
if (IsFloatTerm(t2))
return (rfloat(FloatOfTerm(t1) - FloatOfTerm(t2)));
if (IsRefTerm(t2))
return 1;
return -1;
}
case long_int_e: {
if (IsIntTerm(t2))
return LongIntOfTerm(t1) - IntOfTerm(t2);
if (IsFloatTerm(t2)) {
return 1;
}
if (IsLongIntTerm(t2))
return LongIntOfTerm(t1) - LongIntOfTerm(t2);
#ifdef USE_GMP
if (IsBigIntTerm(t2)) {
return Yap_gmp_tcmp_int_big(LongIntOfTerm(t1), t2);
}
#endif
if (IsRefTerm(t2))
return 1;
return -1;
}
#ifdef USE_GMP
case big_int_e: {
if (IsIntTerm(t2))
return Yap_gmp_tcmp_big_int(t1, IntOfTerm(t2));
if (IsFloatTerm(t2)) {
return 1;
}
if (IsLongIntTerm(t2))
return Yap_gmp_tcmp_big_int(t1, LongIntOfTerm(t2));
if (IsBigIntTerm(t2)) {
return Yap_gmp_tcmp_big_big(t1, t2);
}
if (IsRefTerm(t2))
return 1;
return -1;
}
#endif
case string_e: {
if (IsApplTerm(t2)) {
Functor fun2 = FunctorOfTerm(t2);
switch ((CELL)fun2) {
case double_e:
return 1;
case long_int_e:
return 1;
#ifdef USE_GMP
case big_int_e:
return 1;
#endif
case db_ref_e:
return 1;
case string_e:
return strcmp((char *)StringOfTerm(t1), (char *)StringOfTerm(t2));
}
return -1;
}
return -1;
}
case db_ref_e:
if (IsRefTerm(t2))
return Unsigned(RefOfTerm(t2)) - Unsigned(RefOfTerm(t1));
return -1;
}
}
if (!IsApplTerm(t2)) {
if (IsPairTerm(t2)) {
Int out;
Functor f = FunctorOfTerm(t1);
if (!(out = ArityOfFunctor(f)) - 2)
out = strcmp((char *)RepAtom(NameOfFunctor(f))->StrOfAE, ".");
return out;
}
return 1;
} else {
Functor fun2 = FunctorOfTerm(t2);
Int r;
if (IsExtensionFunctor(fun2)) {
return 1;
}
r = ArityOfFunctor(fun1) - ArityOfFunctor(fun2);
if (r)
return r;
r = cmp_atoms(NameOfFunctor(fun1), NameOfFunctor(fun2));
if (r)
return r;
else
return (compare_complex(RepAppl(t1), RepAppl(t1) + ArityOfFunctor(fun1),
RepAppl(t2)));
}
}
}
static Int
p_execution_mode( USES_REGS1 )
{
enumExecModes mode;
// valid values for ARG1 are 'integer' and 'atom'
Term t = Deref(ARG1);
if (IsIntTerm(t)) {
// ARG1 is integer
Int v = IntOfTerm(t);
if (v < 0 || v > 3) {
// value passed by argument is out of known range (valid values are: 0 -- interpreted; 1 -- smart jit; 2 -- continuous compilation; 3 -- just compiled)
Yap_Error(OUT_OF_KNOWNRANGE_ERROR,t,"");
return FALSE;
}
// storing mode
mode = (enumExecModes)v;
}
else 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);
// Detecting mode according to 'str'
if (strcmp(str, "INTERPRETED") == 0) mode = JUST_INTERPRETED;
else if (strcmp(str, "SMARTJIT") == 0) mode = SMART_JIT;
else if (strcmp(str, "CONTINUOUSCOMPILATION") == 0) mode = CONTINUOUS_COMPILATION;
else if (strcmp(str, "JUSTCOMPILED") == 0) mode = JUST_COMPILED;
else {
// value passed by argument is out of known range
Yap_Error(OUT_OF_KNOWNRANGE_ERROR,t,"");
return FALSE;
}
}
else {
// ARG1 is not an integer or atom
Yap_NilError(INVALID_PARAMETER_TYPE_ERROR,"Execution mode");
return FALSE;
}
// setting execution mode
ExpEnv.config_struc.execution_mode = mode;
/* setting execution mode parameters */
switch (mode) {
case JUST_INTERPRETED:
{
if (Yap_ExecutionMode == INTERPRETED) {
// execution mode only can be 'JUST_INTERPRETED' if 'Yap_ExecutionMode == INTERPRETED' (passing -J0 on command line)
// 'JUST_INTERPRETED' does not use these parameters
ExpEnv.config_struc.frequency_type = NO_FREQ;
ExpEnv.config_struc.frequency_bound = 0.0;
ExpEnv.config_struc.profiling_startp = 0.0;
ExpEnv.config_struc.mainclause_ty = UNUSED;
ExpEnv.config_struc.compilation_threads = 0;
#if YAP_DBG_PREDS
if (ExpEnv.debug_struc.act_predicate_msgs.success_msgs)
fprintf(stderr," YAP Execution mode changed to INTERPRETED!!\n");
#endif
}
else {
// 'Yap_ExecutionMode' is not compatible
Yap_NilError(INCOMPATIBLE_CODEMODE_WARNING,"INTERPRETED");
return FALSE;
}
}
break;
case SMART_JIT:
{
if (Yap_ExecutionMode == MIXED_MODE) {
// execution mode only can be 'SMART_JIT' if 'Yap_ExecutionMode == MIXED_MODE' (passing -J1 on command line)
ExpEnv.config_struc.frequency_type = COUNTER;
ExpEnv.config_struc.frequency_bound = 1024.0;
ExpEnv.config_struc.profiling_startp = 0.72;
ExpEnv.config_struc.mainclause_ty = HOT_AND_CALLEE;
ExpEnv.config_struc.compilation_threads = 0;
#if YAP_DBG_PREDS
if (ExpEnv.debug_struc.act_predicate_msgs.success_msgs)
fprintf(stderr," YAP Execution mode changed to SMART JIT!!\n");
#endif
}
else {
// 'Yap_ExecutionMode' is not compatible
Yap_NilError(INCOMPATIBLE_CODEMODE_WARNING,"SMART JIT");
return FALSE;
}
}
break;
case CONTINUOUS_COMPILATION:
{
if (Yap_ExecutionMode == MIXED_MODE) {
// execution mode only can be 'CONTINUOUS_COMPILATION' if 'Yap_ExecutionMode == MIXED_MODE' (passing -J1 on command line)
ExpEnv.config_struc.frequency_type = COUNTER;
ExpEnv.config_struc.frequency_bound = 1024.0;
ExpEnv.config_struc.profiling_startp = 0.72;
ExpEnv.config_struc.mainclause_ty = HOT_AND_CALLEE;
ExpEnv.config_struc.compilation_threads = ExpEnv.config_struc.ncores-1;
#if YAP_DBG_PREDS
if (ExpEnv.debug_struc.act_predicate_msgs.success_msgs)
fprintf(stderr," YAP Execution mode changed to CONTINUOUS COMPILATION!!\n");
#endif
}
else {
// 'Yap_ExecutionMode' is not compatible
Yap_NilError(INCOMPATIBLE_CODEMODE_WARNING,"CONTINUOUS COMPILATION");
return FALSE;
}
}
break;
case JUST_COMPILED:
{
if (Yap_ExecutionMode == COMPILED) {
// execution mode only can be 'JUST_COMPILED' if 'Yap_ExecutionMode == COMPILED' (passing -J2 on command line)
// 'JUST_COMPILED' does not use these parameters
ExpEnv.config_struc.frequency_type = NO_FREQ;
ExpEnv.config_struc.frequency_bound = 0.0;
ExpEnv.config_struc.profiling_startp = 0.0;
ExpEnv.config_struc.mainclause_ty = UNUSED;
ExpEnv.config_struc.compilation_threads = 0;
#if YAP_DBG_PREDS
if (ExpEnv.debug_struc.act_predicate_msgs.success_msgs)
fprintf(stderr," YAP Execution mode changed to JUST COMPILED!!\n");
#endif
}
else {
// 'Yap_ExecutionMode' is not compatible
Yap_NilError(INCOMPATIBLE_CODEMODE_WARNING,"JUST COMPILED");
return FALSE;
}
}
break;
}
/***/
return TRUE;
}
static Int
p_socket_bind(USES_REGS1)
{
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
int sno;
Functor fun;
socket_info status;
int fd;
if ((sno = Yap_CheckSocketStream(t1, "socket_bind/2")) < 0) {
return (FALSE);
}
status = Yap_GetSocketStatus(sno);
fd = Yap_GetStreamFd(sno);
if (status != new_socket) {
/* ok, this should be an error, as you are trying to bind */
return(FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR,t2,"socket_bind/2");
return(FALSE);
}
if (!IsApplTerm(t2)) {
Yap_Error(DOMAIN_ERROR_STREAM,t2,"socket_bind/2");
return(FALSE);
}
fun = FunctorOfTerm(t2);
#if HAVE_SYS_UN_H
if (fun == FunctorAfUnix || fun == FunctorAfLocal) {
struct sockaddr_un sock;
Term taddr = ArgOfTerm(1, t2);
char *s;
int len;
if (IsVarTerm(taddr)) {
Yap_Error(INSTANTIATION_ERROR,t2,"socket_bind/2");
return(FALSE);
}
if (!IsAtomTerm(taddr)) {
Yap_Error(TYPE_ERROR_ATOM,taddr,"socket_bind/2");
return(FALSE);
}
s = RepAtom(AtomOfTerm(taddr))->StrOfAE;
sock.sun_family = AF_UNIX;
if ((len = strlen(s)) > 107) /* hit me with a broomstick */ {
Yap_Error(DOMAIN_ERROR_STREAM,taddr,"socket_bind/2");
return(FALSE);
}
sock.sun_family=AF_UNIX;
strcpy(sock.sun_path,s);
if (bind(fd,
(struct sockaddr *)(&sock),
((size_t) (((struct sockaddr_un *) 0)->sun_path) + len))
< 0) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (bind: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (bind)");
#endif
return(FALSE);
}
Yap_UpdateSocketStream(sno, server_socket, af_unix);
return(TRUE);
} else
#endif
if (fun == FunctorAfInet) {
Term thost = ArgOfTerm(1, t2);
Term tport = ArgOfTerm(2, t2);
char *shost;
struct hostent *he;
struct sockaddr_in saddr;
Int port;
memset((void *)&saddr,(int) 0, sizeof(saddr));
if (IsVarTerm(thost)) {
saddr.sin_addr.s_addr = INADDR_ANY;
} else if (!IsAtomTerm(thost)) {
Yap_Error(TYPE_ERROR_ATOM,thost,"socket_bind/2");
return(FALSE);
} else {
shost = RepAtom(AtomOfTerm(thost))->StrOfAE;
if((he=gethostbyname(shost))==NULL) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (gethostbyname: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (gethostbyname)");
#endif
return(FALSE);
}
memcpy((void *)&saddr.sin_addr, (void *)he->h_addr_list[0], he->h_length);
}
if (IsVarTerm(tport)) {
port = 0;
} else {
port = IntOfTerm(tport);
}
saddr.sin_port = htons(port);
saddr.sin_family = AF_INET;
if(bind(fd,(struct sockaddr *)&saddr, sizeof(saddr))==-1) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (bind: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (bind)");
#endif
return(FALSE);
}
if (IsVarTerm(tport)) {
/* get the port number */
#if _WIN32 || defined(__MINGW32__)
int namelen;
#else
unsigned int namelen;
#endif
Term t;
if (getsockname(fd, (struct sockaddr *)&saddr, &namelen) < 0) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (getsockname: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (getsockname)");
#endif
return(FALSE);
}
t = MkIntTerm(ntohs(saddr.sin_port));
Yap_unify(ArgOfTermCell(2, t2),t);
}
Yap_UpdateSocketStream(sno, server_socket, af_inet);
return(TRUE);
} else
return(FALSE);
}
static Int compare_complex(register CELL *pt0, register CELL *pt0_end,
register CELL *pt1) {
CACHE_REGS
register CELL **to_visit = (CELL **)HR;
register Int out = 0;
loop:
while (pt0 < pt0_end) {
register CELL d0, d1;
++pt0;
++pt1;
d0 = Derefa(pt0);
d1 = Derefa(pt1);
if (IsVarTerm(d0)) {
if (IsVarTerm(d1)) {
out = Signed(d0) - Signed(d1);
if (out)
goto done;
} else {
out = -1;
goto done;
}
} else if (IsVarTerm(d1)) {
out = 1;
goto done;
} else {
if (d0 == d1)
continue;
else if (IsAtomTerm(d0)) {
if (IsAtomTerm(d1))
out = cmp_atoms(AtomOfTerm(d0), AtomOfTerm(d1));
else if (IsPrimitiveTerm(d1))
out = 1;
else
out = -1;
/* I know out must be != 0 */
goto done;
} else if (IsIntTerm(d0)) {
if (IsIntTerm(d1))
out = IntOfTerm(d0) - IntOfTerm(d1);
else if (IsFloatTerm(d1)) {
out = 1;
} else if (IsLongIntTerm(d1)) {
out = IntOfTerm(d0) - LongIntOfTerm(d1);
#ifdef USE_GMP
} else if (IsBigIntTerm(d1)) {
out = Yap_gmp_tcmp_int_big(IntOfTerm(d0), d1);
#endif
} else if (IsRefTerm(d1))
out = 1;
else
out = -1;
if (out != 0)
goto done;
} else if (IsFloatTerm(d0)) {
if (IsFloatTerm(d1)) {
out = rfloat(FloatOfTerm(d0) - FloatOfTerm(d1));
} else if (IsRefTerm(d1)) {
out = 1;
} else {
out = -1;
}
if (out != 0)
goto done;
} else if (IsStringTerm(d0)) {
if (IsStringTerm(d1)) {
out = strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1));
} else if (IsIntTerm(d1))
out = 1;
else if (IsFloatTerm(d1)) {
out = 1;
} else if (IsLongIntTerm(d1)) {
out = 1;
#ifdef USE_GMP
} else if (IsBigIntTerm(d1)) {
out = 1;
#endif
} else if (IsRefTerm(d1)) {
out = 1;
} else {
out = -1;
}
if (out != 0)
goto done;
} else if (IsLongIntTerm(d0)) {
if (IsIntTerm(d1))
out = LongIntOfTerm(d0) - IntOfTerm(d1);
else if (IsFloatTerm(d1)) {
out = 1;
} else if (IsLongIntTerm(d1)) {
out = LongIntOfTerm(d0) - LongIntOfTerm(d1);
#ifdef USE_GMP
} else if (IsBigIntTerm(d1)) {
out = Yap_gmp_tcmp_int_big(LongIntOfTerm(d0), d1);
#endif
} else if (IsRefTerm(d1)) {
out = 1;
} else {
out = -1;
}
if (out != 0)
goto done;
}
#ifdef USE_GMP
else if (IsBigIntTerm(d0)) {
if (IsIntTerm(d1)) {
out = Yap_gmp_tcmp_big_int(d0, IntOfTerm(d1));
} else if (IsFloatTerm(d1)) {
out = 1;
} else if (IsLongIntTerm(d1)) {
out = Yap_gmp_tcmp_big_int(d0, LongIntOfTerm(d1));
} else if (IsBigIntTerm(d1)) {
out = Yap_gmp_tcmp_big_big(d0, d1);
} else if (IsRefTerm(d1))
out = 1;
else
out = -1;
if (out != 0)
goto done;
}
#endif
else if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
if (IsApplTerm(d1)) {
Functor f = FunctorOfTerm(d1);
if (IsExtensionFunctor(f))
out = 1;
else if (!(out = 2 - ArityOfFunctor(f)))
out = strcmp(".", (char *)RepAtom(NameOfFunctor(f))->StrOfAE);
} else
out = 1;
goto done;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit[3] = (CELL *)*pt0;
to_visit += 4;
*pt0 = d1;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit += 3;
}
#endif
pt0 = RepPair(d0) - 1;
pt0_end = RepPair(d0) + 1;
pt1 = RepPair(d1) - 1;
continue;
} else if (IsRefTerm(d0)) {
if (IsRefTerm(d1))
out = Unsigned(RefOfTerm(d1)) - Unsigned(RefOfTerm(d0));
else
out = -1;
goto done;
} else if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2, *ap3;
if (!IsApplTerm(d1)) {
out = 1;
goto done;
} else {
/* store the terms to visit */
Functor f2;
ap2 = RepAppl(d0);
ap3 = RepAppl(d1);
f = (Functor)(*ap2);
if (IsExtensionFunctor(f)) {
out = 1;
goto done;
}
f2 = (Functor)(*ap3);
if (IsExtensionFunctor(f2)) {
out = -1;
goto done;
}
/* compare functors */
if (f != (Functor)*ap3) {
if (!(out = ArityOfFunctor(f) - ArityOfFunctor(f2)))
out = cmp_atoms(NameOfFunctor(f), NameOfFunctor(f2));
goto done;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit[3] = (CELL *)*pt0;
to_visit += 4;
*pt0 = d1;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit += 3;
}
#endif
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
pt1 = ap3;
continue;
}
}
}
}
/* Do we still have compound terms to visit */
if (to_visit > (CELL **)HR) {
#ifdef RATIONAL_TREES
to_visit -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
*pt0 = (CELL)to_visit[3];
#else
to_visit -= 3;
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
#endif
goto loop;
}
done:
/* failure */
#ifdef RATIONAL_TREES
while (to_visit > (CELL **)HR) {
to_visit -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
*pt0 = (CELL)to_visit[3];
}
#endif
return (out);
}
static Int
p_frequencyty2( 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)) {
Term u = Deref(ARG2);
// valid values for ARG2 are 'integer' and 'float'
if (IsIntTerm(u) || IsFloatTerm(u)) {
// ARG1 is atom and ARG2 is integer or float
int i = 0, j = 0;
char *tmp;
// getting string from atom and stores it on 'str'
char *str = (char*)malloc(YAP_AtomNameLength(AtomOfTerm(t))*sizeof(char));
strcpy(str, AtomName(AtomOfTerm(t)));
// Making upper characters of 'str' (for comparison)
UPPER_ENTRY(str);
// getting ARG2 value
Float v;
if (IsIntTerm(u)) v = (Float)IntOfTerm(u);
if (IsFloatTerm(u)) v = FloatOfTerm(u);
// setting 'frequency type' and 'frequency bound' if 'COUNTER'
if (strcmp(str, "COUNTER") == 0 || strcmp(str, "COUNT") == 0) {
if (v < 20.0) {
// Very low frequency bound to apply on 'COUNTER'
fprintf(stderr,"%.2f is a very low value for the active frequency type. Reconsider its value...\n", v);
return FALSE;
}
ExpEnv.config_struc.frequency_type = COUNTER;
ExpEnv.config_struc.frequency_bound = roundf(v);
return TRUE;
}
// setting 'frequency type' and 'frequency bound' if 'TIME'
else if (strcmp(str, "TIME") == 0 || strcmp(str, "TIMING") == 0) {
if (v <= 0.0 || v > 0.49) {
// Very low frequency bound to apply on 'COUNTER'
fprintf(stderr,"%.2f is an invalid or a very high value for the active frequency type. Reconsider its value...\n", v);
return FALSE;
}
ExpEnv.config_struc.frequency_type = TIME;
ExpEnv.config_struc.frequency_bound = v;
return TRUE;
}
else {
// value passed by argument (ARG1) is out of known range
Yap_Error(OUT_OF_KNOWNRANGE_ERROR,t,"");
return FALSE;
}
}
else {
// ARG2 is not an 'integer' or 'float'
Yap_NilError(INVALID_PARAMETER_TYPE_ERROR,"frequencyty/2 (2nd arg)");
return FALSE;
}
}
else {
// ARG1 is not an atom
Yap_NilError(INVALID_PARAMETER_TYPE_ERROR,"frequencyty/2 (1st arg)");
return FALSE;
}
}
else {
// current execution mode differs of 'SMART_JIT' and 'CONTINUOUS_COMPILATION'
Yap_NilError(INCOMPATIBLEMODE_WARNING,"");
return FALSE;
}
}
