      ************************************************************************
      * 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.
      ************************************************************************
       identification division.
       program-id. main.
       environment division.
           special-names.  console is crt.

       data division.
       working-storage section.
	   copy "servwrk.cpy".
	   copy "servlnk.cpy".

       01  .
	   05  uint-thread                  usage thread-pointer.

	   05  thread-return-ptr            usage pointer.
	   05  thread-return-code  redefines thread-return-ptr
	   				    picture x(4) comp-x.

	   05  current-req-id               picture 99 value 0.
	   05  current-req-type             picture x.
	   05  current-req-thread           usage thread-pointer.

	   05  thread-count                 picture x(4) comp-x value 0.
	   05  thread-count-id              picture x(4) comp-x value 0.

	   05  filler                       picture x.
	       88  execution-state-running value 'r'.
	       88  execution-state-exit    value ' '.


       procedure division.
       	    perform init-servwrk

	    *>
	    *> Start up user interface
	    *>
	    start 'servui'    identified by uint-thread

	    *>
	    *> Keep going until we have no threads outstanding
	    *>
	    set execution-state-running   to true
	    perform until thread-count = 0 
	    	      and execution-state-exit

	    	*>
	    	*> Let one of our services or the user interface
		*>  send a message to us
		*>
      		set service-req-sem       up by 1

		*>
		*> In a real client server application the server (us)
		*>  would poll this semaphore _and_ a request input 
		*>  queue that is used by our clients. 
		*>
		set service-req-ack-sem down by 1

		*>
		*> OK we have a completion notice by the service or 
		*>  a request by a client (in this case the user interface)
		*>
		move service-req-type         to current-req-type
		move service-req-id(1:)       to current-req-id(1:)
		set current-req-thread        to service-req-thread

		evaluate current-req-type
		when 78-SERVICE-EXIT
		    set execution-state-exit  to true

		when 78-SERVICE-VERT
		when 78-SERVICE-HORIZ 
		when 78-SERVICE-RDIAG
		when 78-SERVICE-LDIAG
		    *>
		    *> We have a service request from the user interface
		    *>  set up parameters controlling the request
		    *>
		    move 0                    to service-row-incr
		    				 service-col-incr

		    if  current-req-type not = 78-service-horiz
		        move 1                to service-row-incr
		    end-if
		    if  current-req-type not = 78-service-vert
		    	if  current-req-type = 78-service-ldiag
			    move -1           to service-col-incr
			else 
			    move 1            to service-col-incr
			end-if
		    end-if

		    *>
		    *> Create service thread
		    *>
		    move thread-count-id      to service-id
         	    start 'service' using by content service-linkage
				      identified by current-req-thread
		    if  return-code not = 0 
			move service-id           to service-done-id
			move 78-DONE-ABORT        to service-done-type
			perform send-message
		    else
		    	add 1                     to thread-count-id
						     thread-count
		    end-if
		        
		when 78-SERVICE-STARTED
		    *>
		    *> Message from service - it has started so inform
		    *>  user interface
		    *>
		    move current-req-id       to service-done-id
		    move 78-DONE-STARTED      to service-done-type
		    perform send-message

		when 78-SERVICE-FINISHED
		    *>
		    *> Message from service - it has completed, so 
		    *>  join with thread and inform user interface
		    *>
      		    wait for current-req-thread
		    		returning thread-return-ptr

		    subtract 1              from thread-count
		    move current-req-id       to service-done-id
		    move 78-DONE-FINISHED     to service-done-type
		    move thread-return-code   to service-done-rc
		    perform send-message
		end-evaluate
	    end-perform 
	    move 78-DONE-EXIT                 to service-done-type
	    perform send-message

	    wait for uint-thread  returning thread-return-ptr

	    perform fini-servwrk
	    stop run.

       *>**************************************************************<*
       *> Send a message (as set up by caller) to the child.
       *>**************************************************************<*
       send-message section.
       	    set service-done-sem         up by 1
	    set service-done-ack-sem   down by 1
	    exit section.

       *>**************************************************************<*
       *> Initialize and finalize control semaphores and the like 
       *>  while we are still in single threaded mode.
       *>**************************************************************<*
       init-servwrk section.
            call 'CBL_THREAD_SELF'          using uint-thread
	    on exception
	    	display 'No threading support in RTS'
		stop run
	    end-call
	    if  return-code = 1008
	    	display 'Runtime system is single threaded'
		stop run
	    end-if
	    open service-req-sem      *> Semaphore flags service request
	    open service-req-ack-sem  *> Semaphore flags service request ack

	    open service-done-sem     *> Semaphore tells UI service done
	    open service-done-ack-sem *> Semaphore waiting for UI acknowlege

	    exit section.

       fini-servwrk section.
	    close service-req-sem
	    close service-req-ack-sem
	    close service-done-sem
	    close service-done-ack-sem

	    exit section.
