Unnamed Fossil Project

Check-in [91b76b986d]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:+ new module THREADS for working with threads + THREAD-INIT and THREAD-DONE for initializing/terminating library + MAIN-SEND and MAIN-LOOP for sending/receiving messages + EXECUTE-ON-MAIN for executing method on MAIN thread + EXECUTE-IN-BACKGROUND for executing method in a new BACKGROUND thread
Timelines: family | ancestors | tui
Files: files | file ages | folders
SHA1:91b76b986d70ea0fe5ca82b6c870b1333afe260f
User & Date: vasalvit 2011-11-11 02:54:14
Context
2011-11-11
02:54
+ new module THREADS for working with threads + THREAD-INIT and THREAD-DONE for initializing/terminating library + MAIN-SEND and MAIN-LOOP for sending/receiving messages + EXECUTE-ON-MAIN for executing method on MAIN thread + EXECUTE-IN-BACKGROUND for executing method in a new BACKGROUND thread Leaf check-in: 91b76b986d user: vasalvit tags: tui
2011-11-08
18:27
$ bug fixing + SCREEN-READY function (for verifiing initialization) + ASSERTs within SCREEN and CONTEXT functions * GOTOXY renamed to CURSOR-MOVE check-in: 61487324aa user: vasalvit tags: tui
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added sources/libraries/tui/tests/threads-tests.scm.







































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
;
;       THREADS-TESTS
;               Test methods for THREADS module.
;       HISTORY
;               10.11.2011              vasalvit
;                       First version
;
(load "threads.scm")

(let ()
        (threads-init)
        (letrec (
                [print (lambda (text)
                        (display text) (newline))]
                [third (lambda ()
                        (thread-need-main)
                        (print "Third from MAIN")
                        (main-send #f))]
                [second (lambda ()
                        (thread-need-background)
                        (print "Second from BACKGROUND")
                        (execute-on-main third))]
                [first (lambda ()
                        (thread-need-main)
                        (print "First from MAIN")
                        (execute-in-background second))]
                [loop (lambda ()
                        (print "Started")
                        (assert (eq? #f (main-loop)))
                        (print "Completed"))])
                (execute-on-main first)
                (loop)
        )
        (threads-term)
)

Added sources/libraries/tui/threads.scm.























































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
;
;       THREADS
;               Methods for working with threads.
;       HISTORY
;               10.11.2011              vasalvit
;                       First version.
;
(require-extension mailbox)
(require-extension srfi-18)
(require-extension defstruct)

;       THREAD-IS-MAIN
;               Return TRUE if current thread is MAIN thread.
;       THREAD-NEED-MAIN
;               Verify that current thread is MAIN thread.
(define _main-thread_ #f)
(define (thread-is-main)
        (eq? _main-thread_ (current-thread)))
(define (thread-need-main)
        (assert (thread-is-main) "Required MAIN thread"))
(define (thread-need-background)
        (assert (not (thread-is-main)) "Required BACKGROUND thread"))

;       THREADS-READY
;               TRUE if library initialized.
(define _main-mailbox_ #f)
(define (threads-ready)
        (not (eq? _main-mailbox_ #f)))
(define (threads-verify)
        (assert (threads-ready) "Threads library not initialized"))

;       THREADS-INIT
;       THREADS-TERM
;               Initialization and termination threads.
(define (threads-init)
        (assert (not (threads-ready)) "Threads library already initialized")
        (set! _main-thread_ (current-thread))
        (set! _main-mailbox_ (make-mailbox "MAIN")))
(define (threads-term)
        (threads-verify)
        (set! _main-thread_ #f)
        (set! _main-mailbox_ #f))

;       MAIN-LOOP
;               Returns next event from MAIN thread.
(define (main-loop)
        (threads-verify)
        (thread-need-main)
        (let ((object (mailbox-receive! _main-mailbox_)))
                (cond
                        [(procedure? object) (begin
                                (object)
                                (main-loop))]
                        [else object])))

;       MAIN-SEND
;               Send specified object to MAIN thread.
(define (main-send object)
        (threads-verify)
        (mailbox-send! _main-mailbox_ object))

;       EXECUTE-IN-BACKGROUND
;               Create new thread, execute one function, destroy thread.
(define (execute-in-background proc)
        (threads-verify)
        (assert (procedure? proc))
        (thread-start! (make-thread proc)))

;       EXECUTE-ON-MAIN
;               Send function to main thread for executing.
(define (execute-on-main proc)
        (threads-verify)
        (assert (procedure? proc))
        (mailbox-send! _main-mailbox_ proc))