$title('sndfrag - send a fragmented message')
$compact
/********************************************************************
 *
 *     MODULE NAME: sndfrag	
 *
 *     DESCRIPTION: Receive a transaction request, send the reply as a fragmented
 *                  message.
 *                       
 *********************************************************************/

sndfrag: DO;

$include(:rmx:inc/rmxplm.ext)
$include(dcom.ext)
$include(dcom.lit)
$include(:rmx:inc/error.lit)
$include(err.ext)
		
	DECLARE				/* Literals */

		FRAGLEN     LITERALLY   '8',       /* fragmentation buffer length */
		TSTPORT     LITERALLY  	'801H',    /* well-known port */
		EOTFLAGS    LITERALLY	'00000B',  /* send$reply flags for buffer, synch tran and eot */
		NOEXCEPT    LITERALLY   '0',       /* no exception handling by system */
		NOTEOTFLAGS LITERALLY   '0200H';   /* same as above except not eot */ 
	

	DECLARE				/* Global vars */

		status            WORD,
		port_t            TOKEN,    /* Token for local port */
		info              rec_info, /* info block on message received */
		buf_pool          TOKEN,    /* buffer pool attached to port */
		mes_buf(*)        BYTE initial (35,'This is a reply sent in fragments',0dh,0ah),
		mes_idx           WORD,     /* mes_buf index */
		mes_size          WORD,     /* size of mes_buf */
		frag_size         WORD,     /* size of fragment sent */
		sflags            WORD,     /* send message flags */ 
		tran_id           WORD,     /* transaction id */
		con_buf	(20)      BYTE,     /* control message buffer */
		msg_ptr           POINTER;  /* pointer to received message */		
		
		
	CALL set$exception(NOEXCEPT);
	port_t = get$dport(TSTPORT, @buf_pool, NOCHAIN, @status);
	msg_ptr = rq$receive(port_t, WAITFOREVER, @info, @status);
	CALL error$check(100, status);

	IF info.status = E$OK THEN DO;	
		mes_size = size(mes_buf);
		mes_idx = 0;
		sflags = NOTEOTFLAGS;
		frag_size = FRAGLEN;
		
		/* Break message into fragments and send them */
		DO WHILE mes_idx < mes_size;
			IF mes_idx + FRAGLEN > mes_size THEN DO;
				frag_size = mes_size - mes_idx;
				sflags = EOTFLAGS; 
			END;	
			tran_id = rq$send$reply(port_t, info.rem$socket, info.trans$id,
			                        @con_buf, @mes_buf(mes_idx), frag_size,
		                            sflags, @status);
			CALL error$check(110, status);
			mes_idx = mes_idx + FRAGLEN;
		END;	                        
		IF msg_ptr <> NIL THEN DO;
			CALL rq$release$buffer(buf_pool, selector$of(msg_ptr), 0, @status);
			CALL error$check(110, status);
		END;
	END;
	CALL rq$exit$io$job(0,NIL,@status);	
END sndfrag;