$title('crbpool - create a buffer pool')
$include(subsys.inc)

crbpool: DO;

$include(:rmx:inc/rmxplm.ext)
$include(:rmx:inc/common.lit)
$include(:rmx:inc/error.lit)

error$check:PROCEDURE(number, test$status) EXTERNAL;
DECLARE
		number  WORD,
		test$status WORD;
END error$check;

$if r_32
$else
	DECLARE	WORD_16			LITERALLY	'WORD',
			WORD_32			LITERALLY	'DWORD',
			SIZE$OF$WORD	LITERALLY	'WORD_16';
$endif

	/* no exception handling by system */
	DECLARE	NOEXCEPT		LITERALLY   '0';

$subtitle('create$buf$pool')
/********************************************************************
 *
 *     PROC NAME: create$buf$pool	
 *
 *     DESCRIPTION: Create a buffer pool with the attributes passed by the caller.
 *                  Create an initial number of buffers and release them to the 
 *                  buffer pool.  Return a token for the buffer pool to the caller.  
 *
 *     CALL: buf$pool$tok = create$buf$pool(max_bufs, init_num_bufs, size
 *													 attrs, status_ptr);	
 *     INPUTS:	  max_bufs - maximum number of buffers for buffer pool
 *                init_num_bufs - initial number of buffers for buffer
 *                pool.
 *                attrs - buffer pool creation attributes
 *                size - size of buffers in buffer pool
 *                status_ptr - points to a status word
 *
 *     RETURNS:  buf$pool$tok - token for newly created buffer pool
 *
 *     CALLS: rq$create$buffer$pool, rq$create$segment, rq$release$buffer
 *			
 *
 *********************************************************************/

create$buf$pool: PROCEDURE(max_bufs, init_num_bufs, attrs, size, status_ptr) TOKEN PUBLIC;

	DECLARE			/* Parameters */

		max_bufs        WORD,       /* maximum number of buffers in buffer pool */
		init_num_bufs   WORD,       /* initial number of buffers in pool */
		attrs           WORD,       /* buffer pool creation attributes */
		size            SIZE$OF$WORD,  /* size of buffers in buffer pool */  
		status_ptr      POINTER;    /* exception pointer */
		 			
	DECLARE			/* Local Parameters */

		status      BASED status_ptr WORD ,
		buf_pool                     TOKEN,  /* buffer pool complete with buffers */
		buf_tok                      TOKEN,  /* buffer token */
		i                            WORD;   /* local index */

	DECLARE			/* Literals */

		BFLAGS      LITERALLY   '010B';     /* single buffer, don't release */

	buf_pool = rq$create$buffer$pool(max_bufs, attrs, status_ptr);
	CALL error$check(10, status);
	DO i = 1 to init_num_bufs;
		buf_tok = rq$create$segment(size, status_ptr);
		CALL error$check(20, status);
		IF status <> E$OK THEN
			RETURN selector$of(NIL);	
		CALL rq$release$buffer(buf_pool, buf_tok, BFLAGS, status_ptr);
		CALL error$check(30, status);
		IF status <> E$OK THEN
			RETURN selector$of(NIL);
	END;
	RETURN buf_pool;

END create$buf$pool;
END crbpool;