wait.sl 877 B

1234567891011121314151617181920212223242526272829
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. %
  3. % Wait.SL - Wait Primitive (TOPS-20 Version)
  4. %
  5. % Author: Alan Snyder
  6. % Hewlett-Packard/CRC
  7. % Date: 23 September 1982
  8. %
  9. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  10. (CompileTime (load fast-int))
  11. (BothTimes (load jsys))
  12. (de wait-timeout (f n-60ths)
  13. % Return when either of two conditions are met: (1) The function F (of no
  14. % arguments) returns non-NIL; (2) The specified elapsed time (in units of
  15. % 1/60th second) has elapsed. Don't waste CPU cycles! Return the last
  16. % value returned by F (which is always invoked at least once).
  17. (let (result)
  18. (while (and (not (setf result (apply f nil)))
  19. (> n-60ths 0))
  20. (Jsys0 250 0 0 0 (const jsDISMS))
  21. (setf n-60ths (- n-60ths 15))
  22. )
  23. result
  24. ))