home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 15 / 15.iso / s / s038 / 1.ddi / SUPP.LIF / SNDFRAG.PLM < prev    next >
Encoding:
Text File  |  1992-07-06  |  2.6 KB  |  75 lines

  1. $title('sndfrag - send a fragmented message')
  2. $compact
  3. /********************************************************************
  4.  *
  5.  *     MODULE NAME: sndfrag    
  6.  *
  7.  *     DESCRIPTION: Receive a transaction request, send the reply as a fragmented
  8.  *                  message.
  9.  *                       
  10.  *********************************************************************/
  11.  
  12. sndfrag: DO;
  13.  
  14. $include(:rmx:inc/rmxplm.ext)
  15. $include(dcom.ext)
  16. $include(dcom.lit)
  17. $include(:rmx:inc/error.lit)
  18. $include(err.ext)
  19.         
  20.     DECLARE                /* Literals */
  21.  
  22.         FRAGLEN     LITERALLY   '8',       /* fragmentation buffer length */
  23.         TSTPORT     LITERALLY      '801H',    /* well-known port */
  24.         EOTFLAGS    LITERALLY    '00000B',  /* send$reply flags for buffer, synch tran and eot */
  25.         NOEXCEPT    LITERALLY   '0',       /* no exception handling by system */
  26.         NOTEOTFLAGS LITERALLY   '0200H';   /* same as above except not eot */ 
  27.     
  28.  
  29.     DECLARE                /* Global vars */
  30.  
  31.         status            WORD,
  32.         port_t            TOKEN,    /* Token for local port */
  33.         info              rec_info, /* info block on message received */
  34.         buf_pool          TOKEN,    /* buffer pool attached to port */
  35.         mes_buf(*)        BYTE initial (35,'This is a reply sent in fragments',0dh,0ah),
  36.         mes_idx           WORD,     /* mes_buf index */
  37.         mes_size          WORD,     /* size of mes_buf */
  38.         frag_size         WORD,     /* size of fragment sent */
  39.         sflags            WORD,     /* send message flags */ 
  40.         tran_id           WORD,     /* transaction id */
  41.         con_buf    (20)      BYTE,     /* control message buffer */
  42.         msg_ptr           POINTER;  /* pointer to received message */        
  43.         
  44.         
  45.     CALL set$exception(NOEXCEPT);
  46.     port_t = get$dport(TSTPORT, @buf_pool, NOCHAIN, @status);
  47.     msg_ptr = rq$receive(port_t, WAITFOREVER, @info, @status);
  48.     CALL error$check(100, status);
  49.  
  50.     IF info.status = E$OK THEN DO;    
  51.         mes_size = size(mes_buf);
  52.         mes_idx = 0;
  53.         sflags = NOTEOTFLAGS;
  54.         frag_size = FRAGLEN;
  55.         
  56.         /* Break message into fragments and send them */
  57.         DO WHILE mes_idx < mes_size;
  58.             IF mes_idx + FRAGLEN > mes_size THEN DO;
  59.                 frag_size = mes_size - mes_idx;
  60.                 sflags = EOTFLAGS; 
  61.             END;    
  62.             tran_id = rq$send$reply(port_t, info.rem$socket, info.trans$id,
  63.                                     @con_buf, @mes_buf(mes_idx), frag_size,
  64.                                     sflags, @status);
  65.             CALL error$check(110, status);
  66.             mes_idx = mes_idx + FRAGLEN;
  67.         END;                            
  68.         IF msg_ptr <> NIL THEN DO;
  69.             CALL rq$release$buffer(buf_pool, selector$of(msg_ptr), 0, @status);
  70.             CALL error$check(110, status);
  71.         END;
  72.     END;
  73.     CALL rq$exit$io$job(0,NIL,@status);    
  74. END sndfrag;
  75.