7491e172ea
The eopl language is now racket-based rather than mzscheme-based. This test-suite, which was originally distributed on the book's web-site has been re-written in the new language. Changes include dropping all drscheme-init.scm and top.scm files. Remaining files were renamed to use the .rkt extension and edited to use the #lang syntax (instead of modulue). Require and provide forms were changed to reflect racket's syntax instead of mzscheme's (eg, only-in vs. only). Several occurrences of one-armed ifs were changed to use when and unless. All tests have been run successfully.
59 lines
1.8 KiB
Racket
Executable File
59 lines
1.8 KiB
Racket
Executable File
#lang eopl
|
|
|
|
(require "store.rkt") ; for store ops
|
|
(require "data-structures.rkt") ; for lock, a-lock
|
|
(require "scheduler.rkt") ; for os calls
|
|
(require "queues.rkt")
|
|
|
|
(provide (all-defined-out))
|
|
|
|
;; implements binary semaphores (mutexes).
|
|
|
|
(define instrument-mutexes (make-parameter #f))
|
|
|
|
;; new-mutex () -> Mutex
|
|
;; Page: 188
|
|
(define new-mutex
|
|
(lambda ()
|
|
(a-mutex
|
|
(newref #f)
|
|
(newref '()))))
|
|
|
|
; wait queue, initially empty
|
|
|
|
;; wait-for-mutex : Mutex * Thread -> FinalAnswer
|
|
;; waits for mutex to be open, then closes it.
|
|
;; Page: 190
|
|
(define wait-for-mutex
|
|
(lambda (m th)
|
|
(cases mutex m
|
|
(a-mutex (ref-to-closed? ref-to-wait-queue)
|
|
(cond
|
|
((deref ref-to-closed?)
|
|
(setref! ref-to-wait-queue
|
|
(enqueue (deref ref-to-wait-queue) th))
|
|
(run-next-thread))
|
|
(else
|
|
(setref! ref-to-closed? #t)
|
|
(th)))))))
|
|
|
|
;; signal-mutex : Mutex * Thread -> FinalAnswer
|
|
;; Page 190
|
|
(define signal-mutex
|
|
(lambda (m th)
|
|
(cases mutex m
|
|
(a-mutex (ref-to-closed? ref-to-wait-queue)
|
|
(let ((closed? (deref ref-to-closed?))
|
|
(wait-queue (deref ref-to-wait-queue)))
|
|
(when closed?
|
|
(if (empty? wait-queue)
|
|
(setref! ref-to-closed? #f)
|
|
(dequeue wait-queue
|
|
(lambda (first-waiting-th other-waiting-ths)
|
|
(place-on-ready-queue!
|
|
first-waiting-th)
|
|
(setref!
|
|
ref-to-wait-queue
|
|
other-waiting-ths)))))
|
|
(th))))))
|