Commit 8ae1bd98 authored by Dave Cooper's avatar Dave Cooper

moved ccl low-level code out of initialize.lisp because of non portable reader…

moved ccl low-level code out of initialize.lisp because of non portable reader directive -- actually should go to glisp.
parent 45806326
(in-package :ccl)
(let (*warn-if-redefine-kernel*)
(defun %windows-sleep (millis)
(dotimes (n 3)
(unless (typep millis '(unsigned-byte 32))
(setq millis (/ millis 100))))
(do* ((start (floor (get-internal-real-time)
(floor internal-time-units-per-second 1000))
(floor (get-internal-real-time)
(floor internal-time-units-per-second 1000)))
(millis millis (- stop start))
(stop (+ start millis)))
((or (<= millis 0)
(not (eql (#_SleepEx millis #$true) #$WAIT_IO_COMPLETION)))))))
("fix-windows-ccl-sleep")
\ No newline at end of file
......@@ -212,38 +212,12 @@ Perhaps a zombie process is holding port ~a?~%" port port))
#+ccl
(in-package :ccl)
;;
;; FLAG -- get platform-specific stuff into glisp package.
;;
#+nil
(defun %windows-sleep (millis)
(do* ((start (floor (get-internal-real-time)
(floor internal-time-units-per-second 1000))
(floor (get-internal-real-time)
(floor internal-time-units-per-second 1000)))
(millis millis (- stop start))
(stop (+ start millis)))
((or (<= millis 0)
(not (eql (#_SleepEx millis #$true) #$WAIT_IO_COMPLETION))))))
#+(and ccl windows-target)
(load (compile-file (merge-pathnames "fix-windows-ccl-sleep.lisp" *load-truename*)))
#+(and ccl windows-target)
(let (*warn-if-redefine-kernel*)
(defun %windows-sleep (millis)
(dotimes (n 3)
(unless (typep millis '(unsigned-byte 32))
(setq millis (/ millis 100))))
(do* ((start (floor (get-internal-real-time)
(floor internal-time-units-per-second 1000))
(floor (get-internal-real-time)
(floor internal-time-units-per-second 1000)))
(millis millis (- stop start))
(stop (+ start millis)))
((or (<= millis 0)
(not (eql (#_SleepEx millis #$true) #$WAIT_IO_COMPLETION)))))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment