Files old-darcsbcl/clean.sh-binary.tar and new-darcsbcl/clean.sh-binary.tar differ
diff -rN -u old-darcsbcl/src/code/target-signal.lisp new-darcsbcl/src/code/target-signal.lisp
--- old-darcsbcl/src/code/target-signal.lisp	2006-05-04 10:30:31.747488750 +0200
+++ new-darcsbcl/src/code/target-signal.lisp	2006-05-04 10:30:32.239519500 +0200
@@ -129,7 +129,17 @@
 (defun sigalrm-handler (signal info context)
   (declare (ignore signal info context))
   (declare (type system-area-pointer context))
-  (sb!impl::run-expired-timers))
+  (sb!impl::run-expired-timers :real))
+
+(defun sigvtalrm-handler (signal info context)
+  (declare (ignore signal info context))
+  (declare (type system-area-pointer context))
+  (sb!impl::run-expired-timers :virtual))
+
+(defun sigprof-handler (signal info context)
+  (declare (ignore signal info context))
+  (declare (type system-area-pointer context))
+  (sb!impl::run-expired-timers :profile))
 
 (defun sigterm-handler (signal code context)
   (declare (ignore signal code context))
@@ -158,6 +168,8 @@
   (enable-interrupt sigsys #'sigsys-handler)
   (ignore-interrupt sigpipe)
   (enable-interrupt sigalrm #'sigalrm-handler)
+  (enable-interrupt sigvtalrm #'sigvtalrm-handler)
+  (enable-interrupt sigprof #'sigprof-handler)
   (sb!unix::reset-signal-mask)
   (values))
 
diff -rN -u old-darcsbcl/src/code/timer.lisp new-darcsbcl/src/code/timer.lisp
--- old-darcsbcl/src/code/timer.lisp	2006-05-04 10:30:31.747488750 +0200
+++ new-darcsbcl/src/code/timer.lisp	2006-05-04 10:30:32.239519500 +0200
@@ -160,7 +160,10 @@
   repeat-interval
   (thread nil :type (or sb!thread:thread (member t nil)))
   interrupt-function
-  cancel-function)
+  cancel-function
+  ;; timer type, see "which" parameter in setitimer
+  which
+  priority-queue)
 
 (def!method print-object ((timer timer) stream)
   (let ((name (%timer-name timer)))
@@ -172,14 +175,14 @@
           ;; identity
           ))))
 
-(defun make-timer (function &key name (thread sb!thread:*current-thread*))
+(defun make-timer (function &key name (thread sb!thread:*current-thread*) (which :real))
   #!+sb-doc
   "Create a timer object that's when scheduled runs FUNCTION. If
 THREAD is a thread then that thread is to be interrupted with
 FUNCTION. If THREAD is T then a new thread is created each timer
 FUNCTION is run. If THREAD is NIL then FUNCTION can be run in any
 thread."
-  (%make-timer :name name :function function :thread thread))
+  (%make-timer :name name :function function :thread thread :which which :priority-queue (%which-to-priority-queue which)))
 
 (defun timer-name (timer)
   #!+sb-doc
@@ -213,10 +216,16 @@
   #!+sb-thread
   (eq sb!thread:*current-thread* (sb!thread:mutex-value *scheduler-lock*)))
 
-(defparameter *schedule* (make-priority-queue :key #'%timer-expire-time))
-
-(defun peek-schedule ()
-  (priority-queue-maximum *schedule*))
+(defparameter *schedule-real* (make-priority-queue :key #'%timer-expire-time))
+(defparameter *schedule-virtual* (make-priority-queue :key #'%timer-expire-time))
+(defparameter *schedule-profile* (make-priority-queue :key #'%timer-expire-time))
+
+(declaim (inline %which-to-priority-queue))
+(defun %which-to-priority-queue (which)
+  (ecase which
+    (:real *schedule-real*)
+    (:virtual *schedule-virtual*)
+    (:profile *schedule-profile*)))
 
 (defun time-left (timer)
   (- (%timer-expire-time timer) (get-internal-real-time)))
@@ -230,21 +239,21 @@
 
 (defun %schedule-timer (timer)
   (let ((changed-p nil)
-        (old-position (priority-queue-remove *schedule* timer)))
+        (old-position (priority-queue-remove (%timer-priority-queue timer) timer)))
     ;; Make sure interruptors are cancelled even if this timer was
     ;; scheduled again since our last attempt.
     (when old-position
       (funcall (%timer-cancel-function timer)))
     (when (eql 0 old-position)
       (setq changed-p t))
-    (when (zerop (priority-queue-insert *schedule* timer))
+    (when (zerop (priority-queue-insert (%timer-priority-queue timer) timer))
       (setq changed-p t))
     (setf (values (%timer-interrupt-function timer)
                   (%timer-cancel-function timer))
           (values-list (make-cancellable-interruptor
                         (%timer-function timer))))
     (when changed-p
-      (set-system-timer)))
+      (set-system-timer (%timer-which timer))))
   (values))
 
 (defun schedule-timer (timer time &key repeat-interval absolute-p)
@@ -280,18 +289,18 @@
   (with-scheduler-lock ()
     (setf (%timer-expire-time timer) nil
           (%timer-repeat-interval timer) nil)
-    (let ((old-position (priority-queue-remove *schedule* timer)))
+    (let ((old-position (priority-queue-remove (%timer-priority-queue timer) timer)))
       (when old-position
         (funcall (%timer-cancel-function timer)))
       (when (eql 0 old-position)
-        (set-system-timer))))
+        (set-system-timer (%timer-which timer)))))
   (values))
 
 (defun list-all-timers ()
   #!+sb-doc
   "Return a list of all timers in the system."
   (with-scheduler-lock ()
-    (concatenate 'list (%pqueue-contents *schedule*))))
+    (concatenate 'list (%pqueue-contents *schedule-real*) (%pqueue-contents *schedule-virtual*) (%pqueue-contents *schedule-profile*))))
 
 ;;; Not public, but related
 
@@ -313,15 +322,17 @@
             (list 0 1)
             (list s u)))))
 
-(defun set-system-timer ()
+(defun set-system-timer (which)
+  (declare (type (member :real :virtual :profile) which))
   (assert (under-scheduler-lock-p))
-  (let ((next-timer (peek-schedule)))
+  (let* ((queue (%which-to-priority-queue which))
+         (next-timer (priority-queue-maximum queue)))
     (if next-timer
         (let ((delta (- (%timer-expire-time next-timer)
                         (get-internal-real-time))))
           (apply #'sb!unix:unix-setitimer
-                 :real 0 0 (real-time->sec-and-usec delta)))
-        (sb!unix:unix-setitimer :real 0 0 0 0))))
+                 which 0 0 (real-time->sec-and-usec delta)))
+        (sb!unix:unix-setitimer which 0 0 0 0))))
 
 (defun run-timer (timer)
   (symbol-macrolet ((function (%timer-function timer))
@@ -340,22 +351,23 @@
                (warn c)))))))
 
 ;; Called from the signal handler.
-(defun run-expired-timers ()
+(defun run-expired-timers (which)
   (unwind-protect
        (with-interrupts
-         (let (timer)
+         (let (timer
+               (queue (%which-to-priority-queue which)))
            (loop
             (with-scheduler-lock ()
-              (setq timer (peek-schedule))
+              (setq timer (priority-queue-maximum queue))
               (unless (and timer
                            (> (get-internal-real-time)
                               (%timer-expire-time timer)))
                 (return-from run-expired-timers nil))
-              (assert (eq timer (priority-queue-extract-maximum *schedule*))))
+              (assert (eq timer (priority-queue-extract-maximum queue))))
             ;; run the timer without the lock
             (run-timer timer))))
     (with-scheduler-lock ()
-      (set-system-timer))))
+      (set-system-timer which))))
 
 (defmacro sb!ext:with-timeout (expires &body body)
   #!+sb-doc

