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: |
91b76b986d70ea0fe5ca82b6c870b133 |
User & Date: | vasalvit 2011-11-11 02:54:14.160 |
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
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)) |