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))
|