home *** CD-ROM | disk | FTP | other *** search
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; ;;
- ;; EuLisp Module Copyright (C) University of Bath 1991 ;;
- ;; ;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- (defmodule swap
-
- ( standard) ()
-
- ()
-
- (deflocal *thread* nil)
- (deflocal *signal* nil)
-
- (defun wait-until (f) (if (f) t (wait-until f)))
-
- (defun swap ()
- (format t "Swapping...") (flush (standard-output-stream))
- (setq *thread* nil)
- (setq *signal* nil)
- (let ((th (make-thread caller)))
- (thread-start th)
- (wait-until (lambda () *signal*))
- (setq *thread* (current-thread))
- (thread-suspend))
- (format t " swapped.~%") (flush (standard-output-stream))
- nil)
-
- (defun caller ()
- (setq *signal* t)
- (wait-until (lambda () *thread*))
- (system "sleep 1")
- (thread-start *thread*))
-
- (export swap)
-
- )
-
-
-