c************
c  Description: Primitive used for testing of messaging interface. This
c               primitive will listen for N messages and echo them back.
c
c  Author:  J. Czechowski IV
c  Since:   NeXtMidas 2.1.1
c
c************
        program MSGECHO
        
        implicit none
        include 'primitive.inc'
        include 'qmessages.inc'
        
        STRUCTURE /SPAMINFO/
          integer*4    val1
          integer*4    val2
          character*8  str
        END STRUCTURE
        
        record /MQ_HEADER/ header
        record /MQ_DATA/   data
        record /SPAMINFO/  buf
        integer*4 num_msg
        real*4    wait
        integer*4 mask
        integer*4 status
        integer*4 reader
        integer*4 len
        
        call M$CHECKIN
        
        num_msg = M$LPICK(1)
        wait    = 0
        mask    = 0
        reader  = 0
        
        call M$SYNC
        
        do while ( num_msg .gt. 0 )
          status = M$GET_MSG(header, data, L_mqd, wait, mask)
          
          if (status .eq. 1) then
            num_msg = num_msg - 1
            
            len = M$LENGTH(header.name)
c            call M$INFO('GOT '//header.name(1:len))
            call M$SEND_MSG(header, data, reader, mask)
            
          else
            call M$PAUSE (Mc.pause)
          end if
        enddo
        
        buf.val1 = 42
        buf.val2 = 4
        buf.str  = 'Spam 2'
        call M$SEND_MSGL('=SPAM', 0, 0, 42, 0, 3, 'LLA', buf, 0)
c       GFC compiler update: mqd (next to last arg) is placed in character*8
c         pad Done to 8 characters and the extra spaces will be stripped
        call M$SEND_MSGL('DONE', 0, 0, 7, 0, 1, 'A', 'Done    ', 0)
        
        call M$RETURN
        
        end
