本プログラムは、スレッド記憶領域操作の初期化を行い、スレッド局所データにアクセスする操作を使用するスレッドを起動させる。各スレッドおよび実行単位の終了時に、各ts-testエントリ内で一貫性の確認が行われる。本プログラムはスレッド局所記憶節、外部データ項目、出力手続、本機能の圧縮を行う基本同期を活用する。
$set reentrant sourceformat(free)
copy "cblproto.cpy".
************************************************************
* tstore-main. *
* Main routine to initialize tables and kick off threads. *
* *
************************************************************
program-id. 'tstore'.
environment division.
special-names. command-line is cmdln.
working-storage section.
78 THREAD-COUNT VALUE 5.
01 tstore-handle cblt-pointer is external.
01 c-0 cblt-x1-compx.
01 foo-item pic 9(9) value 0.
01 thredid pic xxxx comp-5.
01 thread-handle cblt-pointer.
01 thread-entry cblt-ppointer.
01 exitparms cblt-exit-params.
thread-local-storage section.
01 filler.
05 tl-count pic x value 'x'.
05 tl-ptr cblt-pointer.
linkage section.
01 tstore-item.
05 filler pic x.
88 TSTORE-INIT VALUE 'Y'.
05 tstore-count pic 999.
procedure division.
*>
*> Initialize thread table and set up for clean exit
*>
call "CBL_TSTORE_CREATE" using tstore-handle
by value length tstore-item
by value h'04'
*>
*> Set up for clean exit
*>
move low-values to exitparms
set cblt-ep-install-addr to entry 'exitproc'
move 0 to c-0
call 'CBL_EXIT_PROC' using c-0 exitparms
call 'ts-get' using tl-ptr
set address of tstore-item to tl-ptr
move THREAD-COUNT to tstore-count
set thread-entry to entry "ts-entry"
move 1 to thredid
perform THREAD-COUNT times
call "CBL_THREAD_CREATE_P" using by value thread-entry
by reference thredid
by value length of thredid
by value 0
by value 0
by value 0
by reference thread-handle
if return-code not = 0
call 'CBL_THREAD_PROG_LOCK'
display "FAIL: Cannot create thread"
call 'CBL_THREAD_PROG_UNLOCK'
stop run
end-if
add 1 to thredid
end-perform
stop run.
entry "exitproc".
call "CBL_TSTORE_GET" using by value tstore-handle
by reference tl-ptr
set address of tstore-item to tl-ptr
if tl-ptr = NULL
or not TSTORE-INIT
or tstore-count not = THREAD-COUNT
display "FAIL: TSTORE not initialized properly!"
else
display "PASS: Main thread has count " tstore-count
end-if
call "CBL_TSTORE_CLOSE" using by value tstore-handle
exit program.
end program 'tstore'.
************************************************************
* *
* ts-entry. *
* Root entry point for threads created by application. *
* *
************************************************************
program-id. 'ts-entry'.
working-storage section.
78 REP-COUNT VALUE 5.
01 tl-ptr cblt-pointer.
linkage section.
01 lnk-thredid pic xxxx comp-5.
01 tstore-item.
05 filler pic x.
88 TSTORE-INIT VALUE 'Y'.
05 tstore-count pic 999.
procedure division using lnk-thredid.
thread-section.
perform REP-COUNT times
call 'ts-test' using lnk-thredid
end-perform
call 'ts-get' using tl-ptr
set address of tstore-item to tl-ptr
call "CBL_THREAD_PROG_LOCK"
if tstore-count not = REP-COUNT
display "FAIL: Thread storage rep-count BAD"
else
display "PASS: Thread storage rep-count good"
end-if
call "CBL_THREAD_PROG_UNLOCK"
exit program.
end program 'ts-entry'.
************************************************************
* *
* ts-test. *
* Routine to get a thread storage area and increment its *
* count *
* *
************************************************************
program-id. 'ts-test'.
working-storage section.
01 global-count pic 99999 value 0.
thread-local-storage section.
01 tl-ptr cblt-pointer.
01 tl-count pic 999 value 0.
linkage section.
01 lnk-thredid pic xxxx comp-5.
01 tstore-item.
05 filler pic x.
88 TSTORE-INIT VALUE 'Y'.
05 tstore-count pic 999.
procedure division using lnk-thredid.
thread-section.
call 'ts-get' using tl-ptr
set address of tstore-item to tl-ptr
add 1 to tstore-count
add 1 to tl-count
if tstore-count not = tl-count
display "ERROR: inconsistent thread local data"
stop run
end-if
call "CBL_THREAD_PROG_LOCK"
add 1 to global-count
display "MESSAGE: thread-test has been called " tstore-count
" by thread " lnk-thredid
display "MESSAGE: thread-test has been called " global-count " globally "
call "CBL_THREAD_PROG_UNLOCK"
exit program.
end program 'ts-test'.
************************************************************
* ts-get. *
* Common routine to get and initialize the thread storage *
* area allocated by CBL_TSTORE_GET. *
* *
************************************************************
program-id. 'ts-get'.
data division.
working-storage section.
01 tstore-handle cblt-pointer external.
thread-local-storage section.
01 tl-ptr cblt-pointer.
linkage section.
01 tstore-item.
05 filler pic x.
88 TSTORE-INIT VALUE 'Y'.
05 tstore-count pic 999.
01 lnk-ptr usage pointer.
procedure division using lnk-ptr.
call "CBL_TSTORE_GET" using by value tstore-handle
by reference tl-ptr
if tl-ptr = NULL
display "FAIL: Error in getting thread " &
"storage data"
stop run
end-if
set address of tstore-item to tl-ptr
if not TSTORE-INIT
move 0 to tstore-count
end-if
set tstore-init to true
set lnk-ptr to tl-ptr
exit program.
end program 'ts-get'.