

		PROGRAM SIMPLE_SERVER

C***************************************************************
C                                                               
C SIMPLE_SERVER - A simple example of a PAMS server process.    
C                                                               
C This program provides an example of a very simplistic server  
C process that essentially performs the following functions:    
C                                                               
C                +---------------------------+                  
C                |  Declare Process to PAMS  |                  
C                |  using PAMS_ATTACH_Q      |                  
C                +---------------------------+                  
C                              |                                
C                              V                                
C                +---------------------------+                  
C                | Initialize Variables, etc.|                  
C                +---------------------------+                  
C            +---------------->|                                
C            |                 V                                
C            |   +---------------------------+                  
C            |   |   Wait for a message to   |                  
C            |   |     be received using     |                  
C            |   |       PAMS_GET_MSGW       |                  
C            |   +---------------------------+                  
C            |                 |                                
C            |                 V                                
C            |   +---------------------------+                  
C            |   |   Send "canned" response  |                  
C            |   |  message to client using  |                  
C            |   |       PAMS_PUT_MSG        |                  
C            |   +---------------------------+                  
C            |                 |                                
C            +---------<-------+                                
C                                                               
C To build SIMPLE_SERVER and SIMPLE_CLIENT 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     $ FORTRAN SIMPLE_SERVER+DMQ$LIB:DMQ.TLB/LIB                  
C     $ LINK    SIMPLE_SERVER,DMQ$LIB:DMQ/OPT                    
C                                                               
C The RUN_SIMPLE_SERVER.COM command procedure is used by        
C SIMPLE_CLIENT to start SIMPLE_SERVER as a detached process.   
C                                                               
C***************************************************************

		IMPLICIT NONE

C ** Include standard system definition files. 

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

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 
        CHARACTER       Q_NAME*11/'spare1'/
        INTEGER*4       Q_NAME_LEN
	BYTE		SERVER			! Answer from server prompt
	INTEGER*4	STATUS			! Completion status code   
	INTEGER*4	PROC_NUM_REQ		! Requested process #      
	INTEGER*4	I			! 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,Q_TYPE

C ****************************************************************
C *                  Initialization Section                      *
C *                         - - - - -                            *
C *  Declare our process to PAMS and initialize variables, etc.  *
C ****************************************************************

	WRITE (6, 10)
10	FORMAT ('0SIMPLE_SERVER - Simple Server 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_BY_NAME
        Q_TYPE = PSYM_ATTACH_PQ
        Q_NAME_LEN = 11

        STATUS = PAMS_ATTACH_Q (ATTACH_MODE,PROC_NUM_ACT.ALL,Q_TYPE,
     1                          %REF(Q_NAME),Q_NAME_LEN,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 **  Initialize the  variables that we will be using for messaging. 

	GET_PRIORITY	= 0			! Receive all messages      
	GET_TIMEOUT	= 0			! No 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 ******************************************************************

	DO WHILE (.TRUE.)

C   ** Wait for a message to be sent by a client process.     
C   ** If time-out received, report it and continue.  if any  
C   ** other error, report it and exit.  Else display message.

	   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 *,'   SERVER: PAMS_GET_MSGW Timeout.  Continuing...'

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

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

C   ** Return "canned" response message to the client process.
C   ** Message returned contains client process id and the first
C   ** 50 characters of the message received.

	   PUT_SIZE = 26+GET_SIZE
	   ENCODE (80, 135, PUT_BUFFER) SOURCE.GROUP, SOURCE.PROCESS,
     &					      (GET_BUFFER(I),I=1,GET_SIZE)
135	   FORMAT ('Message from ',I3,'.',I3.3,' is "',50(A1:),'"')

C   ** Set target process id to that of the process that sent the
C   ** message, then send the response message to it. 

	   TARGET.ALL = SOURCE.ALL

	   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, 145) TARGET.GROUP, TARGET.PROCESS, PUT_CLASS, PUT_TYPE
145	   FORMAT ('0   SERVER: Sent Msg to ',I3,'.',I3.3,
     &		   ' class=',I5,' type=',I5)
	   WRITE  (6, 147) PUT_BUFFER
147	   FORMAT ('            Message=',80A1)

	END DO

	END

C			*  End of SIMPLE_SERVER.FOR  *
