      $set reentrant preprocess(htmlpp) endp
      ************************************************************************
      * Copyright (C) 1999 Micro Focus International Ltd.
      * All rights reserved.
      *  
      * This demonstration program is provided for use by users of 
      * Micro Focus products (the "Software") and may be used, 
      * modified and distributed as part of your application provided 
      * that you properly acknowledge the copyright of Micro Focus in this
      * material.
      *     
      * All conditions, warranties and undertakings, express or implied, 
      * statutory or otherwise, on the part of Micro Focus are excluded, 
      * including without limitation those of merchantability or fitness  
      * for purpose. This shall not, however, purport to exclude or 
      * restrict the liability of Micro Focus to any extent not 
      * permitted by law.
      *
      * IN NO EVENT WILL MICRO FOCUS BE LIABLE FOR ANY INDIRECT, 
      * INCIDENTAL, SPECIAL, CONSEQUENTIAL OR OTHER DAMAGES ARISING OUT 
      * OF THE USE OF THE DEMONSTRATION PROGRAM DISTRIBUTED WITH THE 
      * SOFTWARE, WHETHER OR NOT INFORMED OF THE POSSIBILITIES OF 
      * DAMAGES IN ADVANCE.  THESE LIMITATIONS APPLY TO ALL CAUSES OF 
      * ACTION, INCLUDING BREACH OF CONTRACT, BREACH OF WARRANTY, STRICT
      * LIABILITY, AND ANY ACTIONS IN TORTS.
      ************************************************************************
       working-storage section.
       01 threaded-or-not   pic x value "Y".

      * Declare main thread id...
       01 main-thread-id    usage pointer.

      * Declare red, green and blue thread id's..
       01 thread-red-id     usage thread-pointer.
       01 thread-green-id   usage thread-pointer.
       01 thread-blue-id    usage thread-pointer.

      * Thread return-pointers (not used in this demo)
       01 thread-red-return-ptr       usage pointer.
       01 thread-green-return-ptr     usage pointer.
       01 thread-blue-return-ptr      usage pointer.

      * Started?
       01 thread-red-ok         pic x value "Y".
       01 thread-green-ok       pic x value "Y".
       01 thread-blue-ok        pic x value "Y".

      * Remember working-storage can be modified by ALL threads
       01 protected-area.
           03 disp-mutex        usage mutex-pointer.
           03 howmany-cols      pic 9999 value 0.


      * How many cols does the html thread table  have?
       78 MAX-COLS		value 30.

      * How many cols does each thread try to fill?
      *  (must be a multiple of MAX-COLS)
       78 COLS-PER-THREAD	value 120.

      * Internal thread numbers
       78 RED-THREAD	value 1.
       78 GREEN-THREAD	value 2.
       78 BLUE-THREAD	value 3.
       
      * HTML tags for a RED, GREEN or BLUE column
       78 RED-TAG       value
	 '<TD><FONT COLOR="#ff0000"><B>R</B></FONT></TD>'.
       78 GREEN-TAG     value 
	'<TD><FONT COLOR="#00ff00"><B>G</B></FONT></TD>'.
       78 BLUE-TAG      value 
	'<TD><FONT COLOR="#0000ff"><B>B</B></FONT></TD>'.

       thread-local-storage section.
      * Each thread keeps a count of how many columns it uses.
       01 thnum        pic 99.

       linkage section.
       01 num           pic 99.
	procedure division.

      * First check that we are running on a multi threaded RTS.
       call "CBL_THREAD_SELF" using 
           by reference main-thread-id
           on exception
                move "N" to threaded-or-not
       end-call

      * Multi-threading is not supported
       if return-code = 1008
                move "N" to threaded-or-not
       end-if.

      
      *
      * Start of HTML
      *
       exec html
       <html>
       <head>
       <title>Multi-threaded squares demos</title>
       </head>
       <body bgcolor="#ffffff">
       end-exec

      *
       if threaded-or-not not equals "Y"
       then
       exec html
       <center>
       <h1>Sorry but this demo requires the use of the multi-threaded
       runtime</h1>
       <br>
       <em>See thrrgb.txt for more information</em>
       </center>
       </body>
       </html>
       end-exec
          stop run
       end-if

      * Open a mutex to protect output of document
       	  open disp-mutex

      *
      * Include the top of the html from intro.htm
      *
       exec html
        copy "intro.htm".
       end-exec

      *
      * Start of table
      *
       exec html
       <center><table border="2">
       end-exec

      *
      * Do not allow anything to start display'ing until all
      * three threads have been created.
      *
	    set disp-mutex to on

      *
      * Start red thread
      *
	  move RED-THREAD to thnum
	  start 'red' using by content thnum
                       identified by thread-red-id
                       on exception
                            move "N" to thread-red-ok
          end-start

      *
      * Start green thread
      *
	  move GREEN-THREAD to thnum
	  start 'green' using by content thnum
                         identified by thread-green-id on exception
                            move "N" to thread-green-ok
          end-start

      *
      * Start blue thread
      *
	  move BLUE-THREAD to thnum
	  start 'blue' using by content thnum
                        identified by thread-blue-id
                        on exception
                            move "N" to thread-blue-ok

          end-start

      * GO
	    set disp-mutex to off

      *
      * Wait for red, green and blue thread to finish
      *
       if thread-red-ok equal "Y"
	  wait for thread-red-id returning thread-red-return-ptr
       end-if

       if thread-blue-ok equal "Y"
	  wait for thread-blue-id returning thread-blue-return-ptr
       end-if

       if thread-green-ok equal "Y"
	  wait for thread-green-id returning thread-green-return-ptr
       end-if


      *
      * end of table back to the browser
      *
       exec html
       </table></center>
       end-exec


      * Failed to create red thread?
       if thread-red-ok not equal "Y"
       exec html
       <p><h1>Execution Error: failed to created red thread</h1>
       end-exec
       end-if

      * Failed to create green thread?
       if thread-green-ok not equal "Y"
       exec html
       <p><h1>Execution Error: failed to created green thread</h1>
       end-exec
       end-if

      * Failed to create blue thread?
       if thread-blue-ok not equal "Y"
       exec html
       <p><h1>Execution Error: failed to created blue thread</h1>
       end-exec
       end-if


      *
      * Include the bottom of the html from bottom.htm
      *
       exec html
        copy "bottom.htm".
       end-exec

      * Finish with mutex
          close disp-mutex.

      *
      * send end of html page back to the browser
       exec html
       </body>
       </html>
       end-exec

      * THE END
       stop run.






      * 
      * RED thread:
      *
      *
       entry "red" using thnum.
           perform COLS-PER-THREAD times
       	      call "show_block" using thnum

      * as this is a tight loop and we want the threads to complete...
              call "CBL_THREAD_YIELD"
           end-perform
           exit program returning 0.

      *
      * GREEN thread:
      *
      *
       entry "green" using thnum.
           perform COLS-PER-THREAD times
       	      call "show_block" using thnum

      * as this is a tight loop and we want the threads to complete...
              call "CBL_THREAD_YIELD"
           end-perform
           exit program returning 0.

      *
      * BLUE thread:
      *
       entry "blue" using thnum.
           perform COLS-PER-THREAD times
       	      call "show_block" using thnum

      * as this is a tight loop and we want the threads to complete...
              call "CBL_THREAD_YIELD"
           end-perform
           exit program returning 0.


      *
      * show_block, this entry-points sends back a "colour" coded
      * block back to browser.  
      *
       entry "show_block" using num.

      * ONLY allow one thread in this function at one time, as we need
      * to protect "howmany-cols" and we want to return ONE block at a
      * back to the browser.
      *
	    set disp-mutex to on

      * Are we at the start of the row?
            if howmany-cols equal 0
       exec html
       <tr>
       end-exec
            end-if

      * Which thread are we?
            evaluate num
            	when RED-THREAD
       exec html
       :RED-TAG
       end-exec
            	when GREEN-THREAD
       exec html
       :GREEN-TAG
       end-exec
            	when BLUE-THREAD
       exec html
       :BLUE-TAG
       end-exec
            end-evaluate

      * Are we at the end of a row?
            add 1 to howmany-cols
            if howmany-cols equal MAX-COLS
               move 0 to howmany-cols
       exec html
       </tr>
       end-exec
            end-if

      * OK... lets release the mutex and goback
	    set disp-mutex to off

      * as this is a tight loop and we want the threads to complete...
              call "CBL_THREAD_YIELD"
            goback
             
