sleep.sl 1.4 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849
  1. %
  2. % Sleep.SL - Sleep Primitive
  3. %
  4. % Author: Alan Snyder
  5. % Hewlett-Packard/CRC
  6. % Date: 15 July 1982
  7. %
  8. %
  9. %
  10. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  11. % 6-Aug-82, WFG: Modified to include an "inefficient" VAX version.
  12. (CompileTime (load if-system))
  13. (BothTimes
  14. (progn
  15. (load common)
  16. (if_system Dec20
  17. (load jsys))))
  18. (if_system Dec20
  19. (de sleep-until-timeout-or-input (n-60ths) % Dec-20 version
  20. % Return when either of two conditions are met: (1) Input is available.
  21. % (2) The specified elapsed time (in units of 1/60th second) has elapsed.
  22. % Don't waste CPU cycles!
  23. (for (from i 1 n-60ths 2)
  24. (until (> (CharsInInputBuffer) 0))
  25. (do (Jsys0 33 0 0 0 (const jsDISMS)))
  26. ))
  27. )
  28. (if_system Unix
  29. (de sleep-until-timeout-or-input (n-60ths) % Unix version
  30. % Should use the SELECT system call?
  31. % Return when either of two conditions are met: (1) Input is available.
  32. % (2) The specified elapsed time (in units of 1/60th second) has elapsed.
  33. (let ((timer (time)) % Get "current time" in milliseconds.
  34. % Approximate number of 1000ths to count (17 roughly equal
  35. % 16.6666...)
  36. (n-1000ths (* 17 n-60ths)))
  37. (for
  38. % Pause until time runs out,
  39. (while (< (- (time) timer) n-1000ths))
  40. % or a character is typed.
  41. (until (> (CharsInInputBuffer) 0))))))