include thread_sleep functionality.
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1653 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
3b033eee50
commit
f5b9000018
@ -1765,7 +1765,7 @@ p_getcwd(void)
|
||||
#if HAVE_STRERROR
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "%s in getcwd/1", strerror(errno));
|
||||
#else
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "in getcwd/1");
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "error %d in getcwd/1", errno);
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
51
C/threads.c
51
C/threads.c
@ -193,6 +193,56 @@ p_create_thread(void)
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_sleep(void)
|
||||
{
|
||||
UInt time = IntegerOfTerm(Deref(ARG1));
|
||||
#if HAVE_NANOSLEEP
|
||||
UInt ntime = IntegerOfTerm(Deref(ARG2));
|
||||
struct timespec req, oreq ;
|
||||
req.tv_sec = time;
|
||||
req.tv_nsec = ntime;
|
||||
if (!nanosleep(&req, &oreq)) {
|
||||
#if HAVE_STRERROR
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "%s in thread_sleep/2", strerror(errno));
|
||||
#else
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "error %d in thread_sleep/2", errno);
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
return Yap_unify(ARG3,MkIntegerTerm(oreq.tv_sec)) &&
|
||||
Yap_unify(ARG4,MkIntegerTerm(oreq.tv_nsec));
|
||||
#elif HAVE_NANOSLEEP
|
||||
UInt ntime = IntegerOfTerm(Deref(ARG2));
|
||||
struct timespec req, oreq ;
|
||||
req.tv_sec = time;
|
||||
req.tv_nsec = ntime;
|
||||
if (!nanosleep(&req, &oreq)) {
|
||||
#if HAVE_STRERROR
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "%s in thread_sleep/2", strerror(errno));
|
||||
#else
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "error %d in thread_sleep/2", errno);
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
return Yap_unify(ARG3,MkIntegerTerm(oreq.tv_sec)) &&
|
||||
Yap_unify(ARG4,MkIntegerTerm(oreq.tv_nsec));
|
||||
#elif HAVE_SLEEP
|
||||
UInt rtime;
|
||||
if ((rtime = sleep(time)) < 0) {
|
||||
#if HAVE_STRERROR
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "%s in thread_sleep/2", strerror(errno));
|
||||
#else
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "error %d in thread_sleep/2", errno);
|
||||
#endif
|
||||
}
|
||||
return Yap_unify(ARG3,MkIntegerTerm(rtime)) &&
|
||||
Yap_unify(ARG4,MkIntTerm(0L));
|
||||
#else
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "no support for thread_sleep in this YAP configuration");
|
||||
#endif
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_self(void)
|
||||
{
|
||||
@ -573,6 +623,7 @@ void Yap_InitThreadPreds(void)
|
||||
Yap_InitCPred("$signal_thread", 1, p_thread_signal, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$nof_threads", 1, p_nof_threads, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$nof_threads_created", 1, p_nof_threads_created, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_sleep", 2, p_thread_sleep, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_runtime", 1, p_thread_runtime, SafePredFlag|HiddenPredFlag);
|
||||
}
|
||||
|
||||
|
||||
@ -16,6 +16,8 @@
|
||||
|
||||
<h2>Yap-5.1.2:</h2>
|
||||
<ul>
|
||||
<li> FIXED: check_callable should check for modules (obs Paulo Moura).</li>
|
||||
<li> NEW: add thread_sleep/1, mostly works like system:sleep/1 (request from Paulo Moura).</li>
|
||||
<li> NEW: add select/3 and intersection/3 to SWI emulation.</li>
|
||||
<li> FIXED: always keep in mind that Yap_WakeUp may change H (would
|
||||
break chr).</li>
|
||||
|
||||
@ -178,6 +178,7 @@
|
||||
#undef HAVE_MKTEMP
|
||||
#undef HAVE_MKTIME
|
||||
#undef HAVE_MMAP
|
||||
#undef HAVE_NANOSLEEP
|
||||
#undef HAVE_NSLINKMODULE
|
||||
#undef HAVE_OPENDIR
|
||||
#undef HAVE_POPEN
|
||||
|
||||
103
configure
vendored
103
configure
vendored
@ -13783,9 +13783,110 @@ done
|
||||
|
||||
|
||||
|
||||
for ac_func in memcpy memmove mkstemp mktemp
|
||||
do
|
||||
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
|
||||
echo "$as_me:$LINENO: checking for $ac_func" >&5
|
||||
echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
|
||||
if eval "test \"\${$as_ac_var+set}\" = set"; then
|
||||
echo $ECHO_N "(cached) $ECHO_C" >&6
|
||||
else
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
/* confdefs.h. */
|
||||
_ACEOF
|
||||
cat confdefs.h >>conftest.$ac_ext
|
||||
cat >>conftest.$ac_ext <<_ACEOF
|
||||
/* end confdefs.h. */
|
||||
/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
|
||||
For example, HP-UX 11i <limits.h> declares gettimeofday. */
|
||||
#define $ac_func innocuous_$ac_func
|
||||
|
||||
/* System header to define __stub macros and hopefully few prototypes,
|
||||
which can conflict with char $ac_func (); below.
|
||||
Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
|
||||
<limits.h> exists even on freestanding compilers. */
|
||||
|
||||
#ifdef __STDC__
|
||||
# include <limits.h>
|
||||
#else
|
||||
# include <assert.h>
|
||||
#endif
|
||||
|
||||
#undef $ac_func
|
||||
|
||||
/* Override any gcc2 internal prototype to avoid an error. */
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
{
|
||||
#endif
|
||||
/* We use char because int might match the return type of a gcc2
|
||||
builtin and then its argument prototype would still apply. */
|
||||
char $ac_func ();
|
||||
/* The GNU C library defines this for functions which it implements
|
||||
to always fail with ENOSYS. Some functions are actually named
|
||||
something starting with __ and the normal name is an alias. */
|
||||
#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
|
||||
choke me
|
||||
#else
|
||||
char (*f) () = $ac_func;
|
||||
#endif
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
int
|
||||
main ()
|
||||
{
|
||||
return f != $ac_func;
|
||||
;
|
||||
return 0;
|
||||
}
|
||||
_ACEOF
|
||||
rm -f conftest.$ac_objext conftest$ac_exeext
|
||||
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
|
||||
(eval $ac_link) 2>conftest.er1
|
||||
ac_status=$?
|
||||
grep -v '^ *+' conftest.er1 >conftest.err
|
||||
rm -f conftest.er1
|
||||
cat conftest.err >&5
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); } &&
|
||||
{ ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; } &&
|
||||
{ ac_try='test -s conftest$ac_exeext'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; }; then
|
||||
eval "$as_ac_var=yes"
|
||||
else
|
||||
echo "$as_me: failed program was:" >&5
|
||||
sed 's/^/| /' conftest.$ac_ext >&5
|
||||
|
||||
eval "$as_ac_var=no"
|
||||
fi
|
||||
rm -f conftest.err conftest.$ac_objext \
|
||||
conftest$ac_exeext conftest.$ac_ext
|
||||
fi
|
||||
echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
|
||||
echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
|
||||
if test `eval echo '${'$as_ac_var'}'` = yes; then
|
||||
cat >>confdefs.h <<_ACEOF
|
||||
#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
|
||||
_ACEOF
|
||||
|
||||
fi
|
||||
done
|
||||
|
||||
|
||||
for ac_func in memcpy memmove mkstemp mktemp mktime opendir
|
||||
|
||||
|
||||
for ac_func in nanosleep mktime opendir
|
||||
do
|
||||
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
|
||||
echo "$as_me:$LINENO: checking for $ac_func" >&5
|
||||
|
||||
@ -1137,7 +1137,8 @@ AC_CHECK_FUNCS(gethostbyname gethostid gethostname)
|
||||
AC_CHECK_FUNCS(gethrtime getpwnam getrusage gettimeofday getwd)
|
||||
AC_CHECK_FUNCS(isatty isnan kill labs link lgamma)
|
||||
AC_CHECK_FUNCS(localtime lstat mallinfo)
|
||||
AC_CHECK_FUNCS(memcpy memmove mkstemp mktemp mktime opendir)
|
||||
AC_CHECK_FUNCS(memcpy memmove mkstemp mktemp)
|
||||
AC_CHECK_FUNCS(nanosleep mktime opendir)
|
||||
AC_CHECK_FUNCS(putenv rand random readlink regexec)
|
||||
AC_CHECK_FUNCS(rename rint rl_set_prompt sbrk select)
|
||||
AC_CHECK_FUNCS(setbuf setlinebuf sigaction siggetmask siginterrupt)
|
||||
|
||||
@ -10071,6 +10071,14 @@ thread-implementation provides
|
||||
@code{pthread_setconcurrency()}. Solaris is a typical example of this
|
||||
family. On other systems this predicate unifies @var{Old} to 0 (zero)
|
||||
and succeeds silently.
|
||||
|
||||
@item thread_sleep(+@var{Time}})
|
||||
@findex thread_sleep/1
|
||||
@snindex thread_sleep/1
|
||||
@cnindex thread_sleep/1
|
||||
Make current thread sleep for @var{Time} seconds. @var{Time} may be an
|
||||
integer or a floating point number. This call should not be used if
|
||||
alarms are also being used.
|
||||
@end table
|
||||
|
||||
|
||||
|
||||
@ -8,8 +8,11 @@
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* $Id: sys.c,v 1.27 2006-05-17 18:38:11 vsc Exp $ *
|
||||
* $Id: sys.c,v 1.28 2006-05-25 16:28:28 vsc Exp $ *
|
||||
* mods: $Log: not supported by cvs2svn $
|
||||
* mods: Revision 1.27 2006/05/17 18:38:11 vsc
|
||||
* mods: make system library use true file name
|
||||
* mods:
|
||||
* mods: Revision 1.26 2006/04/25 03:23:40 vsc
|
||||
* mods: fix ! in debugger (execute_clause)
|
||||
* mods: improve system/1 and execute/1
|
||||
@ -842,7 +845,7 @@ static int
|
||||
p_sleep(void)
|
||||
{
|
||||
YAP_Term ts = YAP_ARG1;
|
||||
long int secs = 0, usecs = 0, out;
|
||||
unsigned long int secs = 0, usecs = 0, out;
|
||||
if (YAP_IsIntTerm(ts)) {
|
||||
secs = YAP_IntOfTerm(ts);
|
||||
} else if (YAP_IsFloatTerm(ts)) {
|
||||
@ -850,25 +853,39 @@ p_sleep(void)
|
||||
if (tfl > 1.0)
|
||||
secs = tfl;
|
||||
else
|
||||
usecs = tfl*1000;
|
||||
usecs = tfl*1000000;
|
||||
}
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
if (secs) usecs = secs*1000;
|
||||
if (secs) usecs = secs*1000 + usecs/1000;
|
||||
Sleep(usecs);
|
||||
/* no errors possible */
|
||||
out = 0;
|
||||
#else
|
||||
#if HAVE_USLEEP
|
||||
#elif HAVE_NANOSLEEP
|
||||
{
|
||||
struct timespec req;
|
||||
if (YAP_IsFloatTerm(ts)) {
|
||||
double tfl = YAP_FloatOfTerm(ts);
|
||||
|
||||
req.tv_nsec = (tfl-floor(tfl))*1000000000;
|
||||
req.tv_sec = rint(tfl);
|
||||
} else {
|
||||
req.tv_nsec = 0;
|
||||
req.tv_sec = secs;
|
||||
}
|
||||
out = nanosleep(&req, NULL);
|
||||
}
|
||||
#elif HAVE_USLEEP
|
||||
if (usecs > 0) {
|
||||
usleep(usecs);
|
||||
out = 0;
|
||||
out = usleep(usecs);
|
||||
} else
|
||||
#endif
|
||||
#if HAVE_SLEEP
|
||||
#elif HAVE_SLEEP
|
||||
{
|
||||
out = sleep(secs);
|
||||
}
|
||||
#else
|
||||
YAP_Error(0,0L,"sleep not available in this configuration");
|
||||
return FALSE:
|
||||
#endif
|
||||
#endif /* defined(__MINGW32__) || _MSC_VER */
|
||||
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(out)));
|
||||
}
|
||||
|
||||
|
||||
13
pl/boot.yap
13
pl/boot.yap
@ -774,14 +774,15 @@ not(G) :- \+ '$execute'(G).
|
||||
).
|
||||
|
||||
'$check_callable'(V,G) :- var(V), !,
|
||||
'$current_module'(Mod),
|
||||
'$do_error'(instantiation_error,Mod:G).
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_callable'(M:G1,G) :- var(M), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_callable'(_:G1,G) :- !,
|
||||
'$check_callable'(G1,G).
|
||||
'$check_callable'(A,G) :- number(A), !,
|
||||
'$current_module'(Mod),
|
||||
'$do_error'(type_error(callable,A),Mod:G).
|
||||
'$do_error'(type_error(callable,A),G).
|
||||
'$check_callable'(R,G) :- db_reference(R), !,
|
||||
'$current_module'(Mod),
|
||||
'$do_error'(type_error(callable,R),Mod:G).
|
||||
'$do_error'(type_error(callable,R),G).
|
||||
'$check_callable'(_,_).
|
||||
|
||||
% Called by the abstract machine, if no clauses exist for a predicate
|
||||
|
||||
@ -476,13 +476,32 @@ thread_local(X) :-
|
||||
'$do_error'(type_error(callable,X),thread_local(Mod:X)).
|
||||
|
||||
|
||||
|
||||
thread_sleep(Time) :-
|
||||
var(Time), !,
|
||||
'$do_error'(instantiation_error,thread_sleep(Time)).
|
||||
thread_sleep(Time) :-
|
||||
integer(Time), Time >= 0, !,
|
||||
'$thread_sleep'(Time,0,_,_).
|
||||
thread_sleep(Time) :-
|
||||
float(Time), Time >= 0, !,
|
||||
STime is integer(float_integer_part(Time)),
|
||||
NTime is integer(float_fractional_part(Time))*1000000000,
|
||||
'$thread_sleep'(STime,NTime,_,_).
|
||||
thread_sleep(Time) :-
|
||||
number(Time),
|
||||
'$do_error'(domain_error(not_less_than_zero,Time),thread_sleep(Time)).
|
||||
thread_sleep(Time) :-
|
||||
'$do_error'(type_error(number,Time),thread_sleep(Time)).
|
||||
|
||||
|
||||
thread_signal(Thread, Goal) :-
|
||||
var(Thread), !,
|
||||
'$do_error'(instantiation_error,thread_signal(Thread, Goal)).
|
||||
thread_signal(Thread, Goal) :-
|
||||
'$check_callable'(Goal,thread_signal(Thread,Goal)).
|
||||
thread_signal(Thread, Goal) :-
|
||||
recorded('$thread_alias',[Id|Thread],_),
|
||||
recorded('$thread_alias',[Id|Thread],_), !,
|
||||
'$thread_signal'(Id, Goal).
|
||||
thread_signal(Thread, Goal) :-
|
||||
integer(Thread), !,
|
||||
|
||||
Reference in New Issue
Block a user