use setitmer instead of alarm.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1886 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/sysbits.c

@@ -2230,7 +2230,7 @@ DoTimerThread(LPVOID targ)
   HANDLE htimer;
   LARGE_INTEGER liDueTime;
 
-  htimer = CreateWaitableTimer(NULL,FALSE,NULL);
+  htimer = CreateWaitableTimer(NULL, FALSE, NULL);
   liDueTime.QuadPart =  -10000000;
   liDueTime.QuadPart *=  time;
   /* Copy the relative time into a LARGE_INTEGER. */
@@ -2254,6 +2254,7 @@ static Int
 p_alarm(void)
 {
   Term t = Deref(ARG1);
+  Term t2 = Deref(ARG2);
   if (IsVarTerm(t)) {
     Yap_Error(INSTANTIATION_ERROR, t, "alarm/2");
     return(FALSE);
@@ -2262,6 +2263,14 @@ p_alarm(void)
     Yap_Error(TYPE_ERROR_INTEGER, t, "alarm/2");
     return(FALSE);
   }
+  if (IsVarTerm(t2)) {
+    Yap_Error(INSTANTIATION_ERROR, t2, "alarm/2");
+    return(FALSE);
+  }
+  if (!IsIntegerTerm(t2)) {
+    Yap_Error(TYPE_ERROR_INTEGER, t2, "alarm/2");
+    return(FALSE);
+  }
 #if _MSC_VER || defined(__MINGW32__)
   {
     Term tout;
@@ -2285,7 +2294,26 @@ p_alarm(void)
       }
     }
     tout = MkIntegerTerm(0);
-    return(Yap_unify(ARG2,tout));
+    return Yap_unify(ARG3,tout) && Yap_unify(ARG4,MkIntTerm(0));
+  }
+#elif HAVE_SETITIMER
+  {
+    struct itimerval new, old;
+
+    new.it_interval.tv_sec = 0;
+    new.it_interval.tv_usec = 0;
+    new.it_value.tv_sec = IntegerOfTerm(ARG1);
+    new.it_value.tv_usec = IntegerOfTerm(ARG2);
+    if (setitimer(ITIMER_REAL, &new, &old) < 0) {
+#if HAVE_STRERROR
+      Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "setitimer: %s", strerror(errno));
+#else
+      Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "setitimer %d", errno);
+#endif
+      return FALSE;
+    }
+    return Yap_unify(ARG3,MkIntegerTerm(old.it_value.tv_sec)) &&
+      Yap_unify(ARG4,MkIntegerTerm(old.it_value.tv_usec));
   }
 #elif HAVE_ALARM
   {
@@ -2294,7 +2322,7 @@ p_alarm(void)
 
     left = alarm(IntegerOfTerm(t));
     tout = MkIntegerTerm(left);
-    return Yap_unify(ARG2,tout);
+    return Yap_unify(ARG3,tout) && Yap_unify(ARG4,MkIntTerm(0)) ;
   }
 #else
   /* not actually trying to set the alarm */
@@ -2302,7 +2330,7 @@ p_alarm(void)
     return TRUE;
   Yap_Error(SYSTEM_ERROR, TermNil,
 	"alarm not available in this configuration");
-  return(FALSE);
+  return FALSE;
 #endif
 }
 
@@ -2572,7 +2600,7 @@ Yap_InitSysPreds(void)
   Yap_InitCPred ("$yap_home", 1, p_yap_home, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred ("getcwd", 1, p_getcwd, SafePredFlag|SyncPredFlag);
   Yap_InitCPred ("$dir_separator", 1, p_dir_sp, SafePredFlag|HiddenPredFlag);
-  Yap_InitCPred ("$alarm", 2, p_alarm, SafePredFlag|SyncPredFlag|HiddenPredFlag);
+  Yap_InitCPred ("$alarm", 4, p_alarm, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred ("$getenv", 2, p_getenv, SafePredFlag|HiddenPredFlag);
   Yap_InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred ("$file_age", 2, p_file_age, SafePredFlag|SyncPredFlag|HiddenPredFlag);

changes-5.1.html

@@ -16,6 +16,8 @@
 
 <h2>Yap-5.1.2:</h2>
 <ul>
+<li> FIXED: alarm used alarm(2) but it should use setitimer(2) so that
+timeout can work with millisecs (obs from Bernd Gutmann).</li>
 <li> FIXED: add . to -g goal (obs from Paulo Moura).</li>
 <li> FIXED: min_list (obs from Angelika, Bernd & Niels).</li>
 <li> FIXED: issues with C-Interface (obs from Trevor Walker).</li>

config.h.in

@@ -195,6 +195,7 @@
 #undef  HAVE_SBRK
 #undef  HAVE_SELECT
 #undef  HAVE_SETBUF
+#undef  HAVE_SETITIMER
 #undef  HAVE_SETLINEBUF
 #undef  HAVE_SHMAT
 #undef  HAVE_SIGACTION

configure.in

@@ -1194,7 +1194,8 @@ 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)
+AC_CHECK_FUNCS(setbuf setitimer setlinebuf sigaction)
+AC_CHECK_FUNCS(siggetmask siginterrupt)
 AC_CHECK_FUNCS(signal sigprocmask socket stat)
 AC_CHECK_FUNCS(strchr strerror strncat strncpy strtod)
 AC_CHECK_FUNCS(time times tmpnam usleep vsnprintf)

docs/yap.tex

@@ -5733,11 +5733,11 @@ Execute a new shell.
 @findex alarm/3
 @snindex alarm/3
 @cnindex alarm/3
-Arranges for YAP to be interrupted in @var{Seconds}
-seconds. When interrupted, YAP will execute @var{Callable} and
-then return to the previous execution. If @var{Seconds} is @code{0}, no
-new alarm is scheduled. In any event, any previously set alarm is
-canceled.
+Arranges for YAP to be interrupted in @var{Seconds} seconds, or in
+@var{Seconds.MicroSeconds}. When interrupted, YAP will execute
+@var{Callable} and then return to the previous execution. If
+@var{Seconds} is @code{0}, no new alarm is scheduled. In any event,
+any previously set alarm is canceled.
 
 The variable @var{OldAlarm} unifies with the number of seconds remaining
 until any previously scheduled alarm was due to be delivered, or with

library/timeout.yap

@@ -26,8 +26,9 @@
 %
 time_out(Goal, Time, Result) :-
 	T is Time//1000,
+	UT is (Time mod 1000)*1000,
 	% enable alarm
-	alarm(T,throw(time_out),_),
+	alarm(T.UT,throw(time_out),_),
 	% launch goal and wait for signal
 	( catch(Goal, time_out, Result = time_out)
         % make sure to disable alarm

pl/boot.yap

@@ -102,7 +102,7 @@ true :- true.
 
  % reset alarms when entering top-level.
  '$enter_top_level' :-
-	 '$alarm'(0, _),
+	 '$alarm'(0, 0, _, _),
 	 fail.
  '$enter_top_level' :-
 	 '$clean_up_dead_clauses',

pl/signals.yap

@@ -150,8 +150,12 @@ on_signal(Signal,OldAction,Action) :-
 
 
 alarm(Interval, Goal, Left) :-
+	integer(Interval), !,
 	on_signal(sig_alarm, _, Goal),
-	'$alarm'(Interval, Left).
+	'$alarm'(Interval, 0, Left, _).
+alarm(Interval.USecs, Goal, Left.LUSecs) :-
+	on_signal(sig_alarm, _, Goal),
+	'$alarm'(Interval, USecs, Left, LUSecs).
 
 raise_exception(Ball) :- throw(Ball).