;;; Define some useful functions
(load-shared-object "librt.so.1")

(define-alien-type nil
    (struct timespec
            (tv-sec long)   ; seconds
            (tv-nsec long))) ; nanoseconds

(declaim (inline %clock-gettime))
(define-alien-routine ("clock_gettime" %clock-gettime)
    int
  (clk_id (signed 32))
  (tp (* (struct timespec))))

(declaim (inline %clock-nanosleep))
(define-alien-routine ("clock_nanosleep" %clock-nanosleep)
    int
  (clk_id (signed 32))
  (flags int)
  (request (* (struct timespec)))
  (remain (* (struct timespec))))

(defconstant CLOCK_REALTIME 0)
(defconstant CLOCK_MONOTONIC 1)
(defconstant CLOCK_PROCESS_CPUTIME_ID 2)
(defconstant CLOCK_THREAD_CPUTIME_ID 3)

(defconstant TIMER_ABSTIME 1)

(defun clock-gettime (clkid)
  (with-alien ((output (struct timespec)))
    (unless (= 0 (%clock-gettime clkid (addr output)))
      (error "Error from clock-gettime"))
    (cons (slot output 'tv-sec) (slot output 'tv-nsec))))

(defun clock-nanosleep (clkid flags request)
  (with-alien ((request-ts (struct timespec))
               (output (struct timespec)))
    (setf (slot request-ts 'tv-sec) (car request)
          (slot request-ts 'tv-nsec) (cdr request))
    (unless (= 0 (%clock-nanosleep clkid flags (addr request-ts) (addr output)))
      (error "Error from clock-nanosleep"))
    (cons (slot output 'tv-sec) (slot output 'tv-nsec))))


;; Make a bunch of *varN* globals and testN functions, so that we can
;; repeatedly test the binding thread-safety.
(defun do-nothing ())

(macrolet ((make-stuff ()
             (cons 'progn
                   (loop for n from 0 to 500
                         for var-name = (intern (format nil "*VAR~D*" n))
                         for fun-name = (intern (format nil "TEST~D" n))
                         collecting
                         `(defvar ,var-name)
                         collecting
                         `(defun ,fun-name ()
                            (let ((,var-name nil))
                              (assert (boundp ',var-name))
                              (do-nothing)))
                         ))))
  (make-stuff))

(defun test-one (n)
  (let* ((num-threads 2)
         (thread-v (make-array num-threads))
         (fun (symbol-function (intern (format nil "TEST~D" n))))
         (go-time (clock-gettime CLOCK_REALTIME)))

    ;; Tell the threads to start running in .1 seconds from now.
    (incf (cdr go-time) 100000000)
    (when (>= (cdr go-time) 1000000000)
      (incf (car go-time))
      (decf (cdr go-time) 1000000000))

    ;; Start some threads, calling a test function for one of the variables.
    (loop for thread-number fixnum from 0 below num-threads
          do
       (setf (svref thread-v thread-number)
             (sb-thread:make-thread
              (lambda ()
                ;; Will until the right time to run..
                (clock-nanosleep CLOCK_REALTIME TIMER_ABSTIME go-time)
                ;; Call the testN function.
                (funcall fun)))))

    ;; Wait for threads to finish.
    (loop for thread across thread-v
          do
       (let ((result (sb-thread:join-thread thread :default :ERROR)))
         (when (eq result :ERROR)
           (error "thread join error"))))))

(defun run-test ()
  ;(format t "TLS index: ~D~%" SB-VM::*FREE-TLS-INDEX*)
  (loop for n from 0 to 500
        do (test-one n)))