From 9477dbe667f250ecd23f8fc0d56b942191526421 Mon Sep 17 00:00:00 2001 From: Franciszek Malinka Date: Thu, 25 Feb 2021 14:42:55 +0100 Subject: Stare semestry, niepoukladane --- Semestr 2/racket/l15/kacp.bak | 55 +++++++++++++++++++++++++ Semestr 2/racket/l15/kacp.rkt | 59 +++++++++++++++++++++++++++ Semestr 2/racket/l15/solution.bak | 7 ++++ Semestr 2/racket/l15/solution.rkt | 85 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 206 insertions(+) create mode 100644 Semestr 2/racket/l15/kacp.bak create mode 100644 Semestr 2/racket/l15/kacp.rkt create mode 100644 Semestr 2/racket/l15/solution.bak create mode 100644 Semestr 2/racket/l15/solution.rkt (limited to 'Semestr 2/racket/l15') diff --git a/Semestr 2/racket/l15/kacp.bak b/Semestr 2/racket/l15/kacp.bak new file mode 100644 index 0000000..ff2a2bc --- /dev/null +++ b/Semestr 2/racket/l15/kacp.bak @@ -0,0 +1,55 @@ +#lang racket + +(define (run-concurrent . thunks) + (define threads (map thread thunks)) + (for-each thread-wait threads)) + +(define (random-sleep) + (sleep (/ (random) 100))) + +(define (with-random-sleep proc) + (lambda args + (random-sleep) + (apply proc args))) + +(define (make-serializer) + (define sem (make-semaphore 1)) + (lambda (proc) + (lambda args + (semaphore-wait sem) + (define ret (apply proc args)) + (semaphore-post sem) + ret))) + +(define (table) + (random-sleep) + (define forks (list (make-semaphore 1) + (make-semaphore 1) + (make-semaphore 1) + (make-semaphore 1) + (make-semaphore 1))) + (define (pick-fork i) + (random-sleep) + (semaphore-wait (list-ref forks i))) + (define (put-fork i) + (random-sleep) + (semaphore-post (list-ref forks i))) + (define (dispatch m) + (cond [(eq? m 'pick-fork) pick-fork] + [(eq? m 'put-fork) put-fork] + [else (error "Unknown request -- TABLE" + m)])) + dispatch) + +(define dtable (table)) + +(define (philosopher dining-table number) + (define my-turn (make-serializer)) + (define (eat) + (display number) + (newline) + ((dining-table 'pick-fork) number) + ((dining-table 'put-fork) number) + ((dining-table 'pick-fork) (modulo (+ number 1) 5)) + ((dining-table 'put-fork) (modulo (+ number 1) 5))) + (my-turn eat)) \ No newline at end of file diff --git a/Semestr 2/racket/l15/kacp.rkt b/Semestr 2/racket/l15/kacp.rkt new file mode 100644 index 0000000..bd484f1 --- /dev/null +++ b/Semestr 2/racket/l15/kacp.rkt @@ -0,0 +1,59 @@ +#lang racket + +(define (run-concurrent . thunks) + (define threads (map thread thunks)) + (for-each thread-wait threads)) + +(define (random-sleep) + (sleep (/ (random) 100))) + +(define (with-random-sleep proc) + (lambda args + (random-sleep) + (apply proc args))) + +(define (make-serializer) + (define sem (make-semaphore 1)) + (lambda (proc) + (lambda args + (semaphore-wait sem) + (define ret (apply proc args)) + (semaphore-post sem) + ret))) + +(define (table) + (random-sleep) + (define forks (list (make-semaphore 1) + (make-semaphore 1) + (make-semaphore 1) + (make-semaphore 1) + (make-semaphore 1))) + (define (pick-fork i) + (random-sleep) + (semaphore-wait (list-ref forks i))) + (define (put-fork i) + (random-sleep) + (semaphore-post (list-ref forks i))) + (define (dispatch m) + (cond [(eq? m 'pick-fork) pick-fork] + [(eq? m 'put-fork) put-fork] + [else (error "Unknown request -- TABLE" + m)])) + dispatch) + +(define dtable (table)) + +(define (philosopher dining-table number) + (define my-turn (make-serializer)) + (define (eat) + (display "Zaczynam ") + (display number) + (newline) + ((dining-table 'pick-fork) number) + ((dining-table 'put-fork) number) + ((dining-table 'pick-fork) (modulo (+ number 1) 5)) + ((dining-table 'put-fork) (modulo (+ number 1) 5)) + (display "Koncze ") + (display number) + (newline)) + (my-turn eat)) \ No newline at end of file diff --git a/Semestr 2/racket/l15/solution.bak b/Semestr 2/racket/l15/solution.bak new file mode 100644 index 0000000..03ab86a --- /dev/null +++ b/Semestr 2/racket/l15/solution.bak @@ -0,0 +1,7 @@ +#lang racket + + + +(define (run-concurrent . thunks) + (define threads (map thread thunks)) + (for-each thread-wait threads)) \ No newline at end of file diff --git a/Semestr 2/racket/l15/solution.rkt b/Semestr 2/racket/l15/solution.rkt new file mode 100644 index 0000000..915502e --- /dev/null +++ b/Semestr 2/racket/l15/solution.rkt @@ -0,0 +1,85 @@ +#lang racket + +(provide philosopher) + +;; Do debugu + +(define (run-concurrent . thunks) + (define threads (map thread thunks)) + (for-each thread-wait threads)) + +(define (random-sleep) + (sleep (/ (random) 100))) + +(define (with-random-sleep proc) + (lambda args + (random-sleep) + (apply proc args))) + +(define (make-serializer) + (define sem (make-semaphore 1)) + (lambda (proc) + (lambda args + (semaphore-wait sem) + (define ret (apply proc args)) + (semaphore-post sem) + ret))) + +(define (make-table) + (define forks (map (lambda (x) (make-semaphore 1)) '(0 1 2 3 4))) + (define (get-fork i) + (list-ref forks i)) + (define (pick-fork i) + (random-sleep) + (semaphore-wait (get-fork i))) + (define (put-fork i) + (random-sleep) + (semaphore-post (get-fork i))) + (define (dispatch m) + (cond [(eq? m 'pick-fork) pick-fork] + [(eq? m 'put-fork) put-fork] + [else (error "Unknown request -- MAKE-TABLE" m)])) + dispatch) + +;(define dining-table (make-table)) + +;(define (repeat proc n) +; (if (> n 0) +; (begin +; (proc) +; (repeat proc (- n 1))) +; #f)) +; +;(define (hungry nr x) +; (lambda () (repeat (lambda () (philosopher dining-table nr)) x))) + +;; Rozwiązanie: + +(define forks-sem (map (lambda (x) (make-semaphore 1)) '(0 0 0 0 0))) + +(define (get-fork i) + (list-ref forks-sem i)) + +(define (is-free? i) + (semaphore-try-wait? (get-fork i))) + +(define (put-fork dining-table i) + ((dining-table 'put-fork) i) + (semaphore-post (get-fork i))) + +(define (philosopher dining-table i) + (define left-fork i) + (define right-fork (modulo (+ i 1) 5)) + (define (loop) + (if (is-free? left-fork) + (if (is-free? right-fork) + (begin + ((dining-table 'pick-fork) left-fork) + ((dining-table 'pick-fork) right-fork) + (put-fork dining-table left-fork) + (put-fork dining-table right-fork)) + (loop)) + (begin + (semaphore-post (get-fork left-fork)) + (loop)))) + (loop)) \ No newline at end of file -- cgit v1.2.3