From c5fcf7179a83ef65c86c6a4a390029149e518649 Mon Sep 17 00:00:00 2001 From: Franciszek Malinka Date: Tue, 5 Oct 2021 21:49:54 +0200 Subject: Duzy commit ze smieciami --- 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 deletions(-) delete mode 100644 Semestr 2/racket/l15/kacp.bak delete mode 100644 Semestr 2/racket/l15/kacp.rkt delete mode 100644 Semestr 2/racket/l15/solution.bak delete 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 deleted file mode 100644 index ff2a2bc..0000000 --- a/Semestr 2/racket/l15/kacp.bak +++ /dev/null @@ -1,55 +0,0 @@ -#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 deleted file mode 100644 index bd484f1..0000000 --- a/Semestr 2/racket/l15/kacp.rkt +++ /dev/null @@ -1,59 +0,0 @@ -#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 deleted file mode 100644 index 03ab86a..0000000 --- a/Semestr 2/racket/l15/solution.bak +++ /dev/null @@ -1,7 +0,0 @@ -#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 deleted file mode 100644 index 915502e..0000000 --- a/Semestr 2/racket/l15/solution.rkt +++ /dev/null @@ -1,85 +0,0 @@ -#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