home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 15 / 15.iso / s / s038 / 1.ddi / SUPP.LIF / DCRCVMSG.PLM < prev    next >
Encoding:
Text File  |  1992-07-06  |  4.6 KB  |  139 lines
  1. $title('dcrcvmsg - receive a 2K data chain message')
  2. $compact
  3. /********************************************************************
  4.  *
  5.  *     MODULE NAME: dcrcvmsg    
  6.  *
  7.  *     DESCRIPTION: When a message is received, determine whether it is in data
  8.  *                  chain or buffer form.  If data chain, compress the chain into
  9.  *                  a single segment.  Expect a 2K message with a printable
  10.  *                  part at the first and second 1K + 2 boundaries.  Write the 
  11.  *                  printable part to the console.
  12.  *
  13.  *********************************************************************/
  14.  
  15. dcrcvmsg: DO;
  16.  
  17. $include(:rmx:inc/rmxplm.ext)
  18. $include(dcom.ext)
  19. $include(dcom.lit)
  20. $include(:rmx:inc/error.lit)
  21. $include(err.ext)
  22.                
  23. DECLARE             /* Literals */
  24.  
  25.     TSTPORT     LITERALLY   '801H',      /* well-known port */
  26.     NOEXCEPT    LITERALLY    '0';        /* no exception handling by system */
  27.  
  28. DECLARE     /* Global vars */
  29.  
  30.         status      WORD,
  31.         port_t      TOKEN,              /* Token for local port */
  32.         local_host  WORD,               /* local host id */
  33.         info        rec_info,           /* info block on message received */
  34.         bpool       TOKEN,              /* buffer pool */
  35.         dcmsg_ptr   POINTER,            /* pointer to data chain message */
  36.         msg_ptr     POINTER,            /* pointer to received message */
  37.         msg BASED dcmsg_ptr (1) BYTE;   
  38.  
  39. $subtitle('get$dc$data')
  40. /********************************************************************
  41.  *
  42.  *     PROC NAME: get$dc$data    
  43.  *
  44.  *     DESCRIPTION: This procedure takes a data chain and copies the data described
  45.  *                  by it into a single segment.  This procedure only works if the
  46.  *                  data is less than 64K in size.  Data chains can describe data
  47.  *                  greater than 64K.
  48.  *
  49.  *     CALL: mbuf_ptr = get$dc$data(dc_ptr, status_ptr)
  50.  *
  51.  *     INPUTS:  dc_ptr - points to a data chain
  52.  *              status_ptr - points to a status word
  53.  *              
  54.  *     RETURNS: mbuf_ptr - points to a segment containing the data
  55.  *                         described by a data chain
  56.  *********************************************************************/
  57.  
  58. get$dc$data: PROCEDURE(dc_ptr, status_ptr) POINTER PUBLIC;
  59.  
  60.     DECLARE            /* Params */
  61.  
  62.         dc_ptr      POINTER, /* points to data chain */
  63.         status_ptr  POINTER; /* points to status word */
  64.  
  65.     DECLARE             /* Locals */
  66.  
  67.         buf_ptr                 POINTER,
  68.         dc BASED dc_ptr (1)     blk_struc,
  69.         status BASED status_ptr WORD,
  70.         num_bytes               WORD,    /* number of bytes in data chain */
  71.         cpybuf_tok              TOKEN,   /* buffer to hold data chain data */
  72.         cpybuf_ptr                POINTER, /* points to cpybuf */
  73.         cpybuf BASED cpybuf_ptr c_buf,
  74.         i                       WORD,    /* local index */
  75.         cpyidx                  WORD;    /* index into cpybuf */         
  76.  
  77.     num_bytes = 0;
  78.     i = 0;
  79.  
  80.     /* get the size of the data described by the data chain */
  81.     
  82.     DO WHILE dc(i).b_size <> 0;
  83.  
  84.         num_bytes = num_bytes + dc(i).b_size;
  85.         i = i + 1;
  86.     END;
  87.     /* add 2 to num_bytes for the size field in c_buf */
  88.     num_bytes = num_bytes + 2;
  89.     cpybuf_tok = rq$create$segment(num_bytes, status_ptr); 
  90.     CALL error$check(100, status);
  91.     cpybuf_ptr = build$ptr(cpybuf_tok, 0);
  92.     cpybuf.size = num_bytes - 2;
  93.  
  94.     i = 0;
  95.     cpyidx = 0;
  96.     DO WHILE dc(i).b_size <> 0;
  97.         buf_ptr = BUILD$PTR(dc(i).buf_sel, DOUBLE(dc(i).buf_offset));
  98.         CALL movb(buf_ptr, @cpybuf.buf(cpyidx), dc(i).b_size); 
  99.         cpyidx = cpyidx + dc(i).b_size;
  100.         i = i + 1;
  101.     END;
  102.  
  103.     RETURN cpybuf_ptr;
  104. END get$dc$data;                    
  105.         
  106.  
  107.             /* Start main */
  108.  
  109.     CALL set$exception(NOEXCEPT);
  110.     port_t = get$dport(TSTPORT, @bpool, CHAIN, @status);
  111.     msg_ptr = rq$receive(port_t, WAITFOREVER, @info, @status);
  112.     CALL error$check(110, status);
  113.     IF (info.flags AND DATACHAIN) = DATACHAIN THEN DO;
  114.         dcmsg_ptr = get$dc$data(msg_ptr, @status);
  115.         CALL error$check(120, status);
  116.         /*
  117.          * print message that was contained at start of the buffer described
  118.          * by the first element in the data chain 
  119.          *
  120.          */
  121.         CALL rqc$send$eo$response(NIL,0,@msg(2),@status);
  122.         CALL error$check(130, status);
  123.         /*
  124.          * print message that was contained at start of the buffer described
  125.          * by the second element in the data chain 
  126.          *
  127.          */
  128.         CALL rqc$send$eo$response(NIL,0,@msg(1028),@status);
  129.         CALL error$check(140, status);
  130.     END;        
  131.     ELSE DO;
  132.         CALL rqc$send$eo$response(NIL,0,msg_ptr,@status); 
  133.         CALL error$check(150, status);
  134.     END;
  135.     CALL rq$release$buffer(bpool, SELECTOR$OF(msg_ptr), (info.flags AND 3),
  136.                            @status);
  137.     CALL rq$exit$io$job(0,NIL,@status);
  138.  END dcrcvmsg;
  139.