      ************************************************************************
      * Copyright (C) 1984-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.
      ************************************************************************
      $set reentrant case
       *>*************************************************************<*
       *> Reentrant service program started from the server thread.
       *> This service program is fairly simplistic, in that it simply
       *>  writes to the screen in one of Horizontal, Vertical, 
       *>  Right Diagonal or Left Diagonal progressions.
       *> Note:
       *>  - this program is designed to tolerate multiple threads 
       *>    active in it at a time (ie. truly reentrant)
       *>*************************************************************<*
       identification division.
       program-id. service.

       data division.
       working-storage section.
           copy "servwrk.cpy".
	   copy "servdisp.cpy".
       01  dummy                        pic x.

       local-storage section.
       01  .
           05  service-thread-id        usage thread-pointer.
	   05  current-req-type         pic x.

	   05  rand-val                  comp-2.
           05  csr-char                 pic x just right.
	   05  csr-row-col.
	       10  csr-row              pic x comp-x.
	       10  csr-col              pic x comp-x.
	   05  org-row-col.
	       10  org-row              pic x comp-x.
	       10  org-col              pic x comp-x.
	   05  org-row-col-comp-x redefines org-row-col
	   				pic xx comp-x.
	     

       linkage section.
       	   copy "servlnk.cpy".

       procedure division using service-linkage.
       main section.

       *>*************************************************************<*
       *> Simple code to initialize thread, send start message
       *>  do service and then send finalization message
       *>*************************************************************<*
       	   call 'CBL_THREAD_SELF'        using service-thread-id

	   move 78-SERVICE-STARTED          to current-req-type
           perform send-message

           perform do-service

           move 78-SERVICE-FINISHED         to current-req-type
	   perform send-message

	   call 'CBL_THREAD_EXIT'        using 
				      by value org-row-col-comp-x
	   exit program
	   stop run.

       *>*************************************************************<*
       *> do-service.
       *>  Figure out what the starting coordinates are and step along
       *>   writing a digit out to the screen.  Note that we avoid
       *>   the 'reserved' area of the screen that is used by the 
       *>   user interface.
       *>*************************************************************<*
       do-service section.
            move function random to rand-val
       	    if  service-row-incr = 0 
	    	compute csr-row   = rand-val * disp-dim-row
		compute csr-col   = 0
	    else 
	    	compute csr-row   = 0
		compute csr-col   = rand-val * (disp-dim-col - 1)
	    end-if

	    move csr-row-col          to org-row-col
	    move service-id(1:)       to csr-char

	    perform until exit

	    	if  ( csr-row >= disp-res-srow
		   and        <= disp-res-erow )
		and ( csr-col >= disp-res-scol
		   and        <= disp-res-ecol )
		    continue
		else
		    *> We're OK we can plot our point
		    perform display-acquire
		    call 'CBL_SET_CSR_POS'     using csr-row-col
		    call 'CBL_WRITE_SCR_TTY'   using csr-char
						    X'0001'
		    perform display-release

		    *> Suspend thread for a little while
		    call 'CBL_THREAD_SLEEP'  using by value 500
		end-if

		add service-row-incr         to csr-row
		add service-col-incr         to csr-col
		if  csr-row >= disp-dim-row
		or          < 0
		or  csr-col >= ( disp-dim-col - 1 )
		or          < 0 
		    if  csr-char = ' ' 
		        exit perform
		    end-if
		    multiply -1              by service-row-incr
		    multiply -1              by service-col-incr
		    add service-row-incr     to csr-row
		    add service-col-incr     to csr-col
		    move ' '                 to csr-char
		end-if

	    end-perform 

	    exit section.

       *>*************************************************************<*
       *> Send a message as set up in current-req-type to the server 
       *>  thread that 
       *>*************************************************************<*
       send-message section.
       	   set service-req-sem    down by 1

           move current-req-type            to service-req-type
	   move service-id                  to service-req-id
	   set service-req-thread           to service-thread-id

       	   set service-req-ack-sem   up by 1
	   exit section.

        *>****************************************************************<*
        *>                                                                <*
        *> Handle exclusion on the screen....                             <*
        *>                                                                <*
        *>****************************************************************<*
	display-acquire section.
	    
	    set disp-mutex to on
	    exit section.

	display-release section.
	    set disp-mutex to off
	    exit section.
