Problem:
A simple example of mult-threading in COBOL.
Resolution:
Net Express 4.0 comes supplied with a multi-threading demo in:
\\Net Express\\Base\\DEMO\\MTHREAD
In addition, the following code sample may be of interest. The demo has two threads:
1) The first thread simply increments a counter and displays the result on
the screen.
2) The second thread displays the date and time on the screen.
All this goes on whilst the parent updates its own counter. The demo is simple but it does show how to create a thread and to terminate them. Full details can be found in the multi-threading manual.
Please note, ADIS (Display/Accept) will interrupt threading so that support should be used with caution. Also, you may find you get "funny" results inside the animator as debugging multiple threads seems tricky.
It is always a good idea to run any example from the command line with RUNM or RUNMW.
This is quite a complex area of the product and we would strongly suggest you read the documentation.
* -------------------------------------------------------------- *
special-names.
call-convention 66 is Win32.
* -------------------------------------------------------------- *
working-storage section.
01 ws-thd-name-table occurs 2.
03 ws-thd-name pic x(40).
01 ws-thd-param pic x(4) comp-5.
01 ws-thd-param-size pic x(4) comp-5.
01 ws-thd-flags pic x(4) comp-5.
01 ws-thd-priority pic s9(9) comp-5.
01 ws-thd-stack pic x(4) comp-5.
01 ws-thd-id-table occurs 2.
03 ws-thd-id pointer.
01 ws-thd-return pointer.
01 ws-thd-semaphore pic x(1) external.
01 ws-table-idx pic x(4) comp-5.
01 ws-scr-mutex mutex-pointer external.
* -------------------------------------------------------------- *
thread-local-storage section.
01 ws-counter pic x(4) comp-5.
01 ws-date.
03 ws-date-yyyy pic 9(4).
03 ws-date-mm pic 9(2).
03 ws-date-dd pic 9(2).
01 ws-time.
03 ws-time-hh pic 9(2).
03 ws-time-min pic 9(2).
03 ws-time-ss pic 9(2).
03 ws-time-hs pic 9(2).
01 ws-months pic x(36)
value "JanFebMarAprMayJunJulAugSepOctNovDec".
01 ws-month-table redefines ws-months
occurs 12.
03 ws-month pic x(3).
01 ws-dsp-date.
03 ws-filler1 pic x(6) value "Date: ".
03 ws-dsp-dd pic 9(2).
03 ws-filler2 pic x(1) value "-".
03 ws-dsp-month pic x(3).
03 ws-filler3 pic x(1) value "-".
03 ws-dsp-yyyy pic 9(4).
01 ws-dsp-time.
03 ws-filler4 pic x(6) value "Time: ".
03 ws-dsp-hh pic 9(2).
03 ws-filler5 pic x(1) value ":".
03 ws-dsp-min pic 9(2).
03 ws-filler6 pic x(1) value ":".
03 ws-dsp-ss pic 9(2).
03 ws-filler7 pic x(1) value ".".
03 ws-dsp-hs pic 9(2).
* -------------------------------------------------------------- *
procedure division.
open ws-scr-mutex.
display
spaces at 0101
"MULTI-THREADED EXAMPLE" at 0101
"======================" at 0201
"One parent and two threads." at 0401
"Parent Counter ..." at 0601
"Thread Counter ..." at 0701
end-display.
move 0 to ws-counter.
move "S" to ws-thd-semaphore.
move z"DateTime" to ws-thd-name(1).
move z"Counter" to ws-thd-name(2).
move 0 to ws-thd-param.
move 0 to ws-thd-param-size.
move 1 to ws-thd-flags.
move 0 to ws-thd-priority.
move 0 to ws-thd-stack.
perform varying ws-table-idx from 1 by 1
until ws-table-idx > 2
call "CBL_THREAD_CREATE"
using by reference ws-thd-name(ws-table-idx)
by reference ws-thd-param
by value ws-thd-param-size
by value ws-thd-flags
by value ws-thd-priority
by value ws-thd-stack
by reference ws-thd-id(ws-table-idx)
end-call
end-perform.
if return-code = 0
perform until ws-counter = 20000
add 1 to ws-counter
set ws-scr-mutex to on
display ws-counter at 0620
set ws-scr-mutex to off
* call "CBL_THREAD_YIELD"
end-perform
move "E" to ws-thd-semaphore
call "CBL_THREAD_WAIT"
using by value ws-thd-id(1)
by reference ws-thd-return
end-call
call "CBL_THREAD_WAIT"
using by value ws-thd-id(2)
by reference ws-thd-return
end-call
end-if.
stop run.
* -------------------------------------------------------------- *
entry "DateTime" using ws-thd-param.
perform until ws-thd-semaphore = "E"
accept ws-date from date YYYYMMDD
accept ws-time from time
move ws-date-dd to ws-dsp-dd
move ws-month(ws-date-mm) to ws-dsp-month
move ws-date-yyyy to ws-dsp-yyyy
move ws-time-hh to ws-dsp-hh
move ws-time-min to ws-dsp-min
move ws-time-ss to ws-dsp-ss
move ws-time-hs to ws-dsp-hs
set ws-scr-mutex to on
display ws-dsp-date at 0164
display ws-dsp-time at 0264
set ws-scr-mutex to off
call Win32 "SleepEx"
using by value 500 size 4
by value 1 size 4
end-call
* call "CBL_THREAD_YIELD"
end-perform.
stop run returning address of ws-thd-param.
* -------------------------------------------------------------- *
entry "Counter" using ws-thd-param.
perform until ws-thd-semaphore = "E"
if ws-counter < 1000
add 1 to ws-counter
else
move 0 to ws-counter
end-if
set ws-scr-mutex to on
display ws-counter at 0720
set ws-scr-mutex to off
* call "CBL_THREAD_YIELD"
end-perform.
stop run returning address of ws-thd-param.
* -------------------------------------------------------------- *
