/**
* 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 file_no(int sno, Term t2 USES_REGS) {
int f = Yap_GetStreamFd(sno);
Term rc = MkIntTerm(f);
if (!IsVarTerm(t2) && !IsIntTerm(t2)) {
return false;
}
return Yap_unify_constant(t2, rc);
}
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 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 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
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_binary_op_as_integer(void)
{ /* X is Y */
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
if (IsIntTerm(t)) {
return Yap_unify_constant(ARG2,t);
}
if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);
ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
return Yap_unify(ARG1,ARG2);
}
return Yap_unify_constant(ARG2,MkIntTerm(p->FOfEE));
}
return(FALSE);
}
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;
}
}
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;
}
}
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 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_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
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(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));
}
