	PROGRAM SIMPLE_CLIENT

C***************************************************************
C SIMPLE_CLIENT - A simple example of a PAMS client process.    
C                                                               
C This program provides an example of a very simplistic client  
C process.  It's main function is to allow the user to enter    
C messages that will be sent to the SIMPLE_SERVER process.      
C                                                               
C The first prompt asks the user if he/she wishes to start the  
C server process.  If the user answers "Y"es, the SIMPLE_SERVER 
C process is started.  If the answer is "N"o, the server is not 
C run, however SIMPLE_CLIENT will allow the user to enter       
C messages which it will loop to itself.                        
C                                                               
C SIMPLE_CLIENT has the following logic flow:                   
C                                                               
C                +---------------------------+                  
C                |  Declare Process to PAMS  |                  
C                |  using PAMS_ATTACH_Q      |                  
C                +---------------------------+                  
C                              |                                
C                +---------------------------+                  
C                | Prompt user to start the  |                  
C                | server process.  If Y     |                  
C                | start SIMPLE_SERVER. If N |                  
C                | set-up to loop to ourself |                  
C                +---------------------------+                  
C                              |                                
C                +---------------------------+                  
C                | Initialize Variables, etc.|                  
C                +---------------------------+                  
C            +---------------->|                                
C            |   +---------------------------+     +----------+ 
C            |   |   Wait for user to enter  |     | <ctrl-z> | 
C            |   |   a message.              |---->|   exit   | 
C            |   +---------------------------+     +----------+ 
C            |                 |                                
C            |   +---------------------------+                  
C            |   |   Send user message to    |                  
C            |   | server (or ourself) using |                  
C            |   |       PAMS_PUT_MSG        |                  
C            |   +---------------------------+                  
C            |                 |                                
C            |   +---------------------------+                  
C            |   |   Wait for a reply from   |                  
C            |   | the server (or our msg.)  |                  
C            |   |       PAMS_GET_MSGW       |                  
C            |   +---------------------------+                  
C            |                 |                                
C            +---------<-------+                                
C                                                               
C To build SIMPLE_CLIENT and SIMPLE_SERVER use the SIMPLE_BUILD 
C command procedure.  If you wish to compile and link this      
C program manually you may use the following commands:          
C                                                               
C     $ FOR  SIMPLE_CLIENT+DMQ$LIB:DMQ.TLB/LIB                 
C     $ LINK SIMPLE_CLIENT,DMQ$LIB:DMQ/OPT                    
C                                                               
C To execute use:  $ RUN SIMPLE_CLIENT                          
C                                                               
C***************************************************************

		IMPLICIT NONE

C ** Include standard system definition files. 

	INCLUDE '($SSDEF)/NOLIST'		! VMS System Service Return Codes
	INCLUDE '($CLIDEF)/NOLIST'
	INCLUDE '($LNMDEF)/NOLIST'

C ** Include PAMS specific definition files. 

	INCLUDE 'dmq$user:dmq(PAMS_FOR_ENTRY_POINT)'	  ! PAMS function type declar's
	INCLUDE 'dmq$user:dmq(PAMS_FOR_PROCESS)'	  ! Known Process number def's
	INCLUDE 'dmq$user:dmq(PAMS_FOR_GROUP)'		  ! Known Group number def's
	INCLUDE 'dmq$user:dmq(PAMS_FOR_TYPE_CLASS)'	  ! Generic Type/Class def's
	INCLUDE 'dmq$user:dmq(PAMS_FOR_RETURN_STATUS_DEF)'! PAMS Function return status
	INCLUDE 'dmq$user:dmq(PAMS_FOR_SYMBOL_DEF)'	  ! Generic PSEL/DSEL def's

	INTEGER*2 BUF_SIZE
	PARAMETER (BUF_SIZE=80)			! Buffer size for local buffers 

C ** Define data type for PAMS target/source addresses. 

        STRUCTURE /PAMS_ADDRESS/
          UNION
            MAP
              INTEGER*4 ALL
            END MAP
            MAP
              INTEGER*2 PROCESS
              INTEGER*2 GROUP
            END MAP
          END UNION
        END STRUCTURE

C ** Declare local variables, pointers, and arrays 
        STRUCTURE /TRNLNM_LIST/
              INTEGER*2 BUFFER_LENGTH
              INTEGER*2 ITEM_CODE
              INTEGER*4 TRANSNAME
              INTEGER*4 RETURN_LENGTH_ADDRESS
        END STRUCTURE

        RECORD /TRNLNM_LIST/ ITEM_LIST1
        RECORD /TRNLNM_LIST/ ITEM_LIST2
        RECORD /TRNLNM_LIST/ ITEM_LIST3
        RECORD /TRNLNM_LIST/ ITEM_LIST4
        CHARACTER*4     BUS
        CHARACTER*5     GROUP
        CHARACTER*10    BUS_GROUP
        CHARACTER*20    DISK
        CHARACTER*127   EXEDIR
        CHARACTER*132   STRING
        INTEGER*4       RET_LENGTH1,RET_LENGTH2,RET_LENGTH3
	BYTE		SERVER			! Answer from server prompt
        INTEGER*4       LIB$WAIT
        REAL*8          WTTIME
	INTEGER*4	STATUS,LIB$SPAWN	! Completion status code   
        INTEGER*4       FLAGS,PID
	INTEGER*4	PROC_NUM_REQ		! Requested process #      
	INTEGER*4	I,SYS$TRNLNM		! Misc. loop index
        RECORD /PAMS_ADDRESS/ PROC_NUM_ACT	! Actual process #         
	RECORD /PSB/	PSB			! PAMS status block        

C **  Define outbound ("put") message variables and arrays 
	RECORD /PAMS_ADDRESS/ SOURCE		! Source queue address     
	BYTE		PUT_BUFFER(BUF_SIZE)	! Message buffer           
	INTEGER*2	PUT_CLASS		! Message class code       
	BYTE		PUT_DELIVERY		! Delivery mode            
	INTEGER*2	PUT_PRIORITY		! Message priority         
	INTEGER*4	PUT_RESP_QUE		! Response queue           
	INTEGER*2	PUT_SIZE		! Message size             
	INTEGER*4	PUT_TIMEOUT		! Time-out for blocked msg 
	INTEGER*2	PUT_TYPE		! Message type code        
	BYTE		PUT_UMA			! Undeliverable msg action 

C ** Define inbound ("get") message variables and arrays 
	RECORD /PAMS_ADDRESS/ TARGET		! Target queue address     
	BYTE		GET_BUFFER(BUF_SIZE)	! Message buffer           
	INTEGER*2	GET_CLASS		! Message class code       
	INTEGER*2	GET_PRIORITY		! Message priority         
	INTEGER*4	GET_SELECT		! Message selection mask   
	INTEGER*2	GET_SIZE		! Message size             
	INTEGER*4	GET_TIMEOUT		! Time-out for blocked msg 
	INTEGER*2	GET_TYPE		! Message type code        
        INTEGER*4       ATTACH_MODE             ! Attach mode for pams_attach_q
	INTEGER*4       Q_TYPE                  ! Q TYPE

C ****************************************************************
C *                  Initialization Section                      *
C *                         - - - - -                            *
C *  Declare our process to PAMS and initialize variables, etc.  *
C ****************************************************************

	WRITE (6, 10)
10	FORMAT ('0SIMPLE_CLIENT - Simple Client Process Example'/)

C ** Call pams_attach_q to attach to ourself to the PAMS  
C ** message bus, and assign our process (queue) number.     

        ATTACH_MODE = PSYM_ATTACH_TEMPORARY
        Q_TYPE = PSYM_ATTACH_PQ
        STATUS = PAMS_ATTACH_Q (ATTACH_MODE,PROC_NUM_ACT.ALL,Q_TYPE,
     1                          0,0,0,0,0,0,0)
	IF (STATUS .NE. SS$_NORMAL) THEN
	   TYPE *, ' Error returned by PAMS_ATTACH_Q code=', STATUS
	   CALL EXIT (STATUS)
	END IF

	WRITE  (6, 25) PROC_NUM_ACT.GROUP, PROC_NUM_ACT.PROCESS
25	FORMAT ('0   QUEUE ADDRESS IS ',I5.5,'.',I3.3)

C ** Ask the user if he/she wishes to have SIMPLE_CLIENT send 
C ** messages to itself, or if they wish to start the server. 

30	WRITE  (6, 35) 
35	FORMAT ('    Do your wish to start the server process [Y/N]? ',$)
	READ   (5, 37) SERVER
37	FORMAT (A1)

C    Convert answer to lower case (if upper case) and check for validity. 
	IF (SERVER .GE. 'a') SERVER = SERVER - 32
	IF ((SERVER .NE. 'N') .AND. (SERVER .NE. 'Y')) GO TO 30

C ** If the user answered "Y"es, set target queue to the spare PAMS queue
C ** used by the server, then use LIB$SPAWN to run the command procedure
C ** to start the server.  Else set the target queue to our own queue.

	IF (SERVER .EQ. 'Y') THEN
	   TARGET.ALL = PAMS_SPARE1   !<< MUST match queue used by the SERVER!
           ITEM_LIST1.TRANSNAME = %LOC (DISK)
           ITEM_LIST1.RETURN_LENGTH_ADDRESS = %LOC (RET_LENGTH1)
           ITEM_LIST1.ITEM_CODE = LNM$_STRING
           ITEM_LIST1.BUFFER_LENGTH = 20
           STATUS = SYS$TRNLNM (,'DMQ$LNM_TBL','DMQ$DISK',,ITEM_LIST1)
           IF (STATUS .NE. SS$_NORMAL) THEN
              TYPE *,'  SYS$TRNLNM FOR DISK FAILED CODE =',STATUS
              CALL EXIT (STATUS)
           END IF
           ITEM_LIST2.TRANSNAME = %LOC (EXEDIR)
           ITEM_LIST2.RETURN_LENGTH_ADDRESS = %LOC (RET_LENGTH2)
           ITEM_LIST2.ITEM_CODE = LNM$_STRING
           ITEM_LIST2.BUFFER_LENGTH = 127
           STATUS = SYS$TRNLNM (,'DMQ$LNM_TBL','DMQ$EXE',,ITEM_LIST2)
           IF (STATUS .NE. SS$_NORMAL) THEN
              TYPE *,'  SYS$TRNLNM FOR DMQ$EXE FAILED CODE =',STATUS
              CALL EXIT (STATUS)
           END IF
           ITEM_LIST3.TRANSNAME = %LOC (BUS_GROUP)
           ITEM_LIST3.RETURN_LENGTH_ADDRESS = %LOC (RET_LENGTH3)
           ITEM_LIST3.ITEM_CODE = LNM$_STRING
           ITEM_LIST3.BUFFER_LENGTH = 10
           STATUS = SYS$TRNLNM (,'DMQ$LNM_TBL','DMQ$BUS_GROUP',,
     1                            ITEM_LIST3)
           IF (STATUS .NE. SS$_NORMAL) THEN
              TYPE *,'SYS$TRNLNM FOR BUS AND GROUP FAILED CODE ='
     1                ,STATUS
              CALL EXIT (STATUS)
           END IF
           BUS = BUS_GROUP(1:4)
           GROUP = BUS_GROUP(6:10)
           FLAGS = CLI$M_NOWAIT
           WRITE (STRING,999) 
     1     '@DMQ$EXAMPLES:SIMPLE_RUN_SERVER.COM',DISK,
     1      EXEDIR,BUS,GROUP
999        FORMAT (A36,' ',A<RET_LENGTH1>,
     1             ' ',A<RET_LENGTH2>,' ',A4,' ',A5)
	   STATUS = LIB$SPAWN (STRING,,,FLAGS,,PID)
	   IF (STATUS .NE. SS$_NORMAL) THEN
	      TYPE *, ' Error returned by LIB$SPAWN code=', STATUS
	      CALL EXIT (STATUS)
	   END IF
	   TYPE *,'   Server process started.'
	ELSE
	   TARGET.ALL = PROC_NUM_ACT.ALL
	   TYPE *,'   Server not started.  Messages will be sent to ourself.'
	END IF

C **  Initialize the  variables that we will be using for messaging. 

	GET_PRIORITY	= 0			! Receive all messages      
	GET_TIMEOUT	= 600			! 60 second time-out on rcv 
	GET_SELECT	= 0			! No special selection mask 

	PUT_CLASS	= 1			! Send class 1 message      
	PUT_PRIORITY	= 0			! Send at standard priority 
	PUT_RESP_QUE	= 0			! Response queue - default  
	PUT_TYPE	= -123			! Msg type is user defined  
	PUT_TIMEOUT	= 0			! Accept standard time-out  
	PUT_DELIVERY	= PDEL_MODE_NN_MEM	! No notify, memory queuing
	PUT_UMA		= PDEL_UMA_DISC   	! Discard if undeliverable  
                        

C ******************************************************************
C *                    Main Processing Loop                        *
C *                         - - - - -                              *
C *  Prompt for a message send it to the server task wait for      *
C *  a response from the server quit when user presses <CTRL-Z>.   *
C ******************************************************************
        WTTIME = 4
        STATUS = LIB$WAIT (WTTIME)    !WAIT 4 SECONDS ONCE.
	DO WHILE (.TRUE.)

C   ** Prompt for and read the message.  If <CTRL-Z> pressed (EOF) we are done. 

100	   WRITE (6, 105)
105	   FORMAT ('0   Enter message or press <CTRL-Z> to exit...',/,
     &		   '    >',$)
	   READ  (5, 103, END=9000) PUT_SIZE, (PUT_BUFFER(I), I=1,PUT_SIZE)
103	   FORMAT (Q,80A1)

C   ** Send the message to the target process queue.  If an error is returned,
C   ** report it and exit.  Otherwise, display class and type info.

	   STATUS = PAMS_PUT_MSG (PUT_BUFFER, PUT_PRIORITY, TARGET.ALL,
     &				  PUT_CLASS, PUT_TYPE, PUT_DELIVERY, PUT_SIZE,
     &				  PUT_TIMEOUT, PSB, PUT_UMA, PUT_RESP_QUE) 
 
	   IF (STATUS .NE. SS$_NORMAL) THEN
	      TYPE *,'Error returned by PAMS_PUT_MSG code=', STATUS
	      CALL EXIT (STATUS)
	   END IF

	   WRITE (6, 135) TARGET.GROUP, TARGET.PROCESS, PUT_CLASS, PUT_TYPE
135	   FORMAT ('0   CLIENT: Sent Msg to ',I3,'.',I3.3,
     &		   ' class=',I5,' type=',I5)

C   ** Now wait for the server process to send the reply message.  
C   ** If time-out error returned, report it and continue.  If any other
C   ** error, report it and exit.  Else, display what was received.

	   STATUS = PAMS_GET_MSGW (GET_BUFFER, GET_PRIORITY, SOURCE.ALL,
     &				   GET_CLASS, GET_TYPE, BUF_SIZE, GET_SIZE, 
     &				   GET_TIMEOUT, GET_SELECT, PSB) 

	   IF (STATUS .EQ. PAMS__TIMEOUT) THEN
	      TYPE *,'PAMS_GET_MSGW Timeout'

	   ELSE IF (STATUS .NE. SS$_NORMAL) THEN
              TYPE *,'Error returned by PAMS_GET_MSGW code=', STATUS
	      CALL EXIT (STATUS)

	   ELSE
	      WRITE  (6, 145) SOURCE.GROUP, SOURCE.PROCESS, GET_CLASS, GET_TYPE
145	      FORMAT ('0   CLIENT: Received from ',I3,'.',I3.3,
     &		      '  class=',I5,' type=',I5)
	      WRITE  (6, 147) (GET_BUFFER(I),I=1, GET_SIZE)
147	      FORMAT ('            Message=',80(A1:))
	   END IF

C ** Go back and wait for user to enter another message to send.

	END DO


C *************************************************
C *                 EXIT Routine                  *
C *                   - - - -                     *
C *  User entered <CTRL-Z>.  Clean-up, and exit.  *
C *************************************************

C    If the server process was started, then use SYS$FORCEX to stop
C    the server process with the DLC STOP process command.

9000     CALL SYS$FORCEX (PID,,)

C    Tell PAMS we're through with it.

	CALL PAMS_EXIT ()

C    Tell user we're done then exit.

	TYPE *, 'SIMPLE_CLIENT - Done'
	CALL EXIT (SS$_NORMAL)

	END


C		*  End of SIMPLE_CLIENT.FOR  *
