Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE SHWRES	(
		IDENT = '1',
		%IF
		    %BLISS(BLISS32)
		%THEN
		    LANGUAGE(BLISS32),
		    ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
				    NONEXTERNAL=LONG_RELATIVE)
		%ELSE
		    LANGUAGE(BLISS36)
		%FI
		) =
BEGIN

!
!			  COPYRIGHT (C) 1982 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY:	CMS library processor
!
! ABSTRACT:
!   This module contains routines that check on the status of the library.
!   These routine primarily involve display of information from the LOG and
!   RESERVATION files.
!
! ENVIRONMENT:	VAX/VMS, DS-20
!
! AUTHOR: Robert Wheater, CREATION DATE: 3-Mar-80
!
! MODIFIED BY:
!
!--
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
	OUTRES: NOVALUE,	! prints reservation line
	SHWRES;			! prints listing of reservation file

!
! INCLUDE FILES:
!
%if %bliss(bliss32) %then
    library 'sys$library:starlet';
%else
    require 'jsys:';
%fi

LIBRARY 'XPORT:';

REQUIRE 'SCONFG:';

REQUIRE 'BLISSX:';

REQUIRE 'COMUSR:';

REQUIRE 'HOSUSR:';

REQUIRE 'SHRUSR:';

REQUIRE 'SHWUSR:';

REQUIRE 'TERUSR:';

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!
GLOBAL
    BUF_TAB_LST,			! last valid entry entered in the
					! buffer table
    b_tab_end,			! index of highest entry available
					! in the buffer table
    F_OUTPUT,				! set when first output issued

    L_OLD_ELM,				! length of previous element name

    M_OLD_ELM: VECTOR[CH$ALLOCATION(EL_NAM_SIZE)],
					! old element name area

    P_OLD_ELM,				! pointer to previous element name

    R_BUF_TAB: REF BLOCKVECTOR[,K_REC_FLD_FULL] FIELD(D_REC_FLD), 
					! blockvector containing descriptor
					! pointers to each record in the buffer
    R_CHN_BUF: REF BLOCK[K_CHN_BLK_FULL] FIELD(CHN_BLK) ;
					! chain entry for buffer allocation

OWN
    $io_block(RD);			! file to be read

!
! EXTERNAL REFERENCES:
!

external literal
	s_noelem,			!elem does not exist in library
	s_nores,			!no reservations
	s_shwsucc;			!success

EXTERNAL
    D_ELM_NAM: DESC_BLOCK,		! desc of element name(SHWEXA)
    F_ELM_REF,				! element reference flag(SHWEXA)
    F_NO_PARM, 				! no parameter specified(SHWEXA)
    F_SPEC_OUT ;			! special output to file(SHWEXA)

EXTERNAL ROUTINE			! declared on module:
    badxpo,
    BUG,				! TERMIO
    ERS,				! TERMIO
    EXABUF,				! SHWEXA
    EXQUAL,				! SHWEXA
    EXPARM,				! SHWEXA
    GET_LXM,				! GETLXM
    SAY,				! TERMIO
    SETOUT ,				! TERMIO
    sysmsg,
    trnlog;			    	! translate a logical name

GLOBAL ROUTINE OUTRES(L_IMAGE,P_IMAGE):NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will output a reservation line from the reservation
!	file or from a string in the same format.   The appearance of an
!	asterisk(*) in column 1 of the image signifies a replacement image.
!	Any other character in column 1 means a reservation image
!
! FORMAL PARAMETERS:
!
!	L_IMAGE		Length of string
!
!	P_IMAGE		Pointer to string
!
! IMPLICIT INPUTS:
!
!	
!
! IMPLICIT OUTPUTS:
!
!	
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	Novalue routine.
!
! SIDE EFFECTS:
!
!	
!
!--

    BEGIN
    
    LOCAL
	F_REPLACE,			! replacement flag
	
	L_GEN_NUM,			! length of generation number
	L_NAME,				! length of user name
	L_REM_TXT,			! length of remaining text in line
	L_SKIP,				! length of skip area
	
	M_GEN_NUM: VECTOR[CH$ALLOCATION(100)],	! memory allocated for gen number
	M_NAME: VECTOR[CH$ALLOCATION(40)],	! memory allocated for user name
	M_SKIP: VECTOR[CH$ALLOCATION(80)],	! memory allocated for skip area
	
	P_GEN_NUM,			! pointer to generation number
	P_NAME,				! pointer to user name
	P_REM_TXT,			! pointer to remaining text in line
	P_SKIP ;			! pointer to skip area
	
	
    ! initialize
    F_REPLACE = FALSE ;
    
    ! set replace flag if appropriate
    IF
	(CH$RCHAR(.P_IMAGE) EQL %C'*')
    THEN
	F_REPLACE = TRUE ;
	
	
    ! set up remaining text pointers
    L_REM_TXT = .L_IMAGE ;
    P_REM_TXT = .P_IMAGE ;
    
    ! skip over column 1
    CH$RCHAR_A(P_REM_TXT);
    L_REM_TXT = .L_REM_TXT - 1;
    
    ! skip over element name
    P_SKIP = CH$PTR(M_SKIP) ;
    L_SKIP = GET_LXM(P_REM_TXT,%C' ',.L_REM_TXT,P_SKIP) ;
    L_REM_TXT = .L_REM_TXT - .L_SKIP - 1 ;

    ! reserved gen is next lexeme
    IF
	NOT .F_REPLACE
    THEN
	BEGIN	    ! get gen reserved
	P_GEN_NUM = CH$PTR(M_GEN_NUM) ;
	L_GEN_NUM = GET_LXM(P_REM_TXT,%C' ',.L_REM_TXT,P_GEN_NUM) ;
	L_REM_TXT = .L_REM_TXT - .L_GEN_NUM - 1;
	P_GEN_NUM = CH$PTR(M_GEN_NUM) ;
	END	    ! get gen reserved
    ELSE
	BEGIN	    ! replace-skip gen reserved
	P_SKIP = CH$PTR(M_SKIP) ;
	L_SKIP = GET_LXM(P_REM_TXT,%C' ',.L_REM_TXT,P_SKIP) ;
	L_REM_TXT = .L_REM_TXT - .L_SKIP - 1 ;
	END ;	    ! replace-skip gen reserved
	
    ! get user name
    P_NAME = CH$PTR(M_NAME) ;
    L_NAME = GET_LXM(P_REM_TXT,%C' ',.L_REM_TXT,P_NAME) ;
    L_REM_TXT = .L_REM_TXT - .L_NAME - 1 ;
    P_NAME = CH$PTR(M_NAME) ;
    
    ! if a replace-next lexeme is replaced gen
    IF
	.F_REPLACE
    THEN
	BEGIN	    ! get replace gen no.
	P_GEN_NUM = CH$PTR(M_GEN_NUM) ;
	L_GEN_NUM = GET_LXM(P_REM_TXT,%C' ',.L_REM_TXT,P_GEN_NUM) ;
	L_REM_TXT = .L_REM_TXT - .L_GEN_NUM - 1 ;
	P_GEN_NUM = CH$PTR(M_GEN_NUM) ;
	END ;	    ! get replace gen no.
	
    ! output whole line
    SAY(CAT('    ',(.L_NAME,.P_NAME),' Generation ',(.L_GEN_NUM,.P_GEN_NUM),
	    ' ',(.L_REM_TXT,.P_REM_TXT))) ;
	    
    END ;	! end of routine outres

GLOBAL ROUTINE SHWRES(A_QUAL,A_PARM) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine displays the reservations currently in effect.
!
! FORMAL PARAMETERS:
!
!	A_QUAL		Address of first qualifier block
!
!	A_PARM 		Address of first parameter block
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	K_SUCCESS = successful completion
!	K_INFORMATION = alternate success
!	K_SILENT_ERROR = error occurred
!
! SIDE EFFECTS:
!
!	NONE.
!
!--


    BEGIN
    LITERAL
	L_MAX_LIN = 132,		! estimate of probable max length
					! of reservation line in the file
	N_MAX_REC = 20 ;		! estimate of probable max number
					! of record for one element in
					! reservation file at one time

	!+
	!    WARNING: the values above must be of sufficient size
	! 	to satify the request with one allocation of additional
	!	space.
	!+

    OWN
	REC_CNT: INITIAL(0) ;		! count number of records read

    LOCAL
	A_NEW_CHN,			! address of new chain entry
	A_NEW_TAB,			! address of new buffer table
	A_PRE_CHN,			! address of previous chain entry
	
	CUR_CHN_CNT,			! count of current # of blocks on chain

	F_1ST_ELM,			! set after first element loaded in buffer
	F_ELM_FND,			! set if element exists in control directory

	I_NXT_REC,			! index to next record in buffer table
	
	L_ELM,				! length of element name in iob record
	L_COPY,				! length of data to copy
	L_REM_BUF,			! length remaining in the buffer
	L_REM_TMP,			! length remaining for user name scan
	L_TMP,				! length of user name

	LOOP_CNT,			! iteration counter for loop

	P_BLK_TMP,			! pointer to blank following user name
	P_ELM,				! pointer to element name in iob record
	P_INI_BUF,			! pointer of initial buffer block
	P_NXT_AVA,			! pointer to next available location in
					! the buffer
	P_TMP,				! pointer to user name
	POINTR,				! work pointer used for initialization
	status;	

    ! examine command line
    IF
        NOT EXQUAL(.A_QUAL) 
    THEN
	RETURN K_SILENT_ERROR ;

    EXPARM(.A_PARM) ;

    ! check if element exist in library if element ref
    F_ELM_FND = FALSE ;

    IF
	.F_ELM_REF
    THEN
	BEGIN		! check for element existance

	! open and read control directory
	if
	    (status=$STEP_OPEN(IOB=RD_IOB,FILE_SPEC=%STRING(LIB,CDIR),
			OPTIONS=INPUT,failure=0)) neq step$_normal
	then
	    badxpo(.status,lit('Cannot open definition file'));

	UNTIL
	    $step_get(IOB=RD_IOB) EQL step$_eof
	DO
	    BEGIN	! read file loop
	
	    LOCAL
		L_ELM,
		M_ELM: VECTOR[CH$ALLOCATION(EL_NAM_SIZE)],
		P_ELM,
		P_IOB ;

	    ! Check for control line
	    if ch$eql(4,ch$ptr(uplit('*/C:')),4,.rd_iob[iob$a_string])
	    then
		exitloop;

	    P_IOB = .RD_IOB[IOB$A_STRING] ;
	    P_ELM = CH$PTR(M_ELM) ;
	    L_ELM = GET_LXM(P_IOB,%C' ',.RD_IOB[IOB$H_STRING],P_ELM) ;
	    P_ELM = CH$PTR(M_ELM) ;

	    IF
		CH$EQL(.D_ELM_NAM[DESC_LEN],.D_ELM_NAM[DESC_PTR],
			.L_ELM,.P_ELM,%C' ')
	    THEN
		F_ELM_FND = TRUE ;

	    END ;	! read file loop

	! close iob for use on reservation file
	$step_close(IOB=RD_IOB) ;

  	IF
	    NOT .F_ELM_FND
	THEN
 	    BEGIN
 	    local
 		d_log_nam : $str_desc(),
 		d_log_trn : $str_desc(),
 		log_trn_buf : vector[ch$allocation(log_nam_value_size)];

 	    $str_desc_init(descriptor = d_log_nam,
 			   string=(len_comma_ptr(lib)));
 	    $str_desc_init(descriptor = d_log_trn,
 			   string=(log_nam_value_size,ch$ptr(log_trn_buf)));
 	    trnlog(d_log_nam,d_log_trn);
	    ERS(s_noelem,CAT(('Element '),d_elm_nam,
		(' does not exist in the CMS library '),d_log_trn));
 	    END;
	END ;		! check for element existance

    ! initialize old element save area
    P_OLD_ELM = CH$PTR(M_OLD_ELM) ;
    L_OLD_ELM = EL_NAM_SIZE ;

    F_1ST_ELM = FALSE ;
    F_OUTPUT = FALSE ;

    ! first allocation
    ! get buffer table
    $XPO_GET_MEM(FULLWORDS=N_MAX_REC * K_REC_FLD_FULL,
		 RESULT=R_BUF_TAB) ;
    b_tab_end = N_MAX_REC-1 ;
    I_NXT_REC = 0;

    ! get initial memory block
    $XPO_GET_MEM(CHARACTERS=N_MAX_REC * L_MAX_LIN,
		 RESULT=P_INI_BUF) ;
    ! set pointer and remaining length
    P_NXT_AVA = .P_INI_BUF ;
    L_REM_BUF = N_MAX_REC * L_MAX_LIN ;

    !initial count of number of chained blocks
    CUR_CHN_CNT = 0 ;

    ! open reservation file
    if
	(status=$STEP_OPEN(IOB=RD_IOB,FILE_SPEC=(%STRING(LIB,RES)),
	      OPTIONS=INPUT,failure=0)) neq step$_normal
    then
	badxpo(.status,lit('Cannot open reservation file.'));

    ! read reservation file
    UNTIL
	$step_get(IOB=RD_IOB) EQL step$_eof
    DO
	BEGIN		! read loop

        ! Check for control line
	if ch$eql(4,ch$ptr(uplit('*/C:')),4,.rd_iob[iob$a_string])
	then
	    exitloop;

	! increment record count
	REC_CNT = .REC_CNT + 1 ;

	! find out if element name changed
	P_ELM = CH$PLUS(.RD_IOB[IOB$A_STRING],1) ;
	L_ELM = CH$FIND_CH(.RD_IOB[IOB$H_STRING]-1,
			   .P_ELM,%C' ') ;
	L_ELM = CH$DIFF(.L_ELM,.P_ELM) ;

	IF
	    .F_1ST_ELM AND
	    CH$NEQ(.L_OLD_ELM,.P_OLD_ELM,
		   .L_ELM,.P_ELM,%C' ')
	THEN
	    BEGIN	! new element-start output processing

	    ! verify that element is to be printed
	    IF
		.F_NO_PARM OR		
		(.F_ELM_REF AND 
		CH$EQL(.L_OLD_ELM,.P_OLD_ELM,
			LEN_COMMA_PTR(D_ELM_NAM),%C' '))
	    THEN
		EXABUF() ;


	    IF
		.F_ELM_REF AND CH$EQL(.L_OLD_ELM,.P_OLD_ELM,
					LEN_COMMA_PTR(D_ELM_NAM),%C' ')
    	    THEN
		EXITLOOP ;		! *exit main read loop*

	    ! update old element area to new element name
	    CH$MOVE(.L_ELM,.P_ELM,.P_OLD_ELM) ;
	    L_OLD_ELM = .L_ELM ;

	    ! reset all pointers
	    I_NXT_REC = 0 ;
	    BUF_TAB_LST = 0 ;
	    P_NXT_AVA = .P_INI_BUF ;
	    L_REM_BUF = N_MAX_REC * L_MAX_LIN ;

	    ! must now free all chained memory
	    UNTIL
		.CUR_CHN_CNT EQL 0
	    DO
		BEGIN	! free memory blocks and chain blocks
		$XPO_FREE_MEM(STRING=(N_MAX_REC * L_MAX_LIN,
					.R_CHN_BUF[P_BLK] )) ;
		A_PRE_CHN = .R_CHN_BUF[BWD_LNK] ;
		$XPO_FREE_MEM(BINARY_DATA=(K_CHN_BLK_FULL,.R_CHN_BUF,FULLWORDS)) ;

		! point to previous chain entry and decrement count
		R_CHN_BUF = .A_PRE_CHN ;
		CUR_CHN_CNT = .CUR_CHN_CNT - 1 ;
		END ; 	! free memory block and chain blocks

	    ! reduce buffer table to original size if expanded
	    IF
		.b_tab_end GEQ N_MAX_REC
	    THEN
		BEGIN	! reduce table

		$XPO_FREE_MEM(BINARY_DATA=((.b_tab_end+1) * K_REC_FLD_FULL,
					    .R_BUF_TAB,FULLWORDS)) ;
		$XPO_GET_MEM(FULLWORDS=N_MAX_REC * K_REC_FLD_FULL,
				RESULT=R_BUF_TAB ) ;
		b_tab_end = N_MAX_REC - 1 ; 

		END ;	! reduce table
		    
	    END ; 	! new element - start output processing

	!+
	!	MEMORY ALLOCATION REQUIRED
	!
	!    Memory is allocated for two structures in this program.
	!    
	!    1. Buffer table - this table contains pointers to strings
	!        	in the buffer. The expansion of this table is
	!		done by expanding the previous size by N_MAX_REC
	!		and copying current table into the new one and
	!		freeing the old one.
	!
	!    2. Buffer - when ever new buffer space is needed for the record
	!		strings a buffer block is allocated. Also at this time
	!		a chain of buffer records is build containing the
	!		address of all buffer blocks allocated beyond the 
	!		initial block.
	!+
 
	! buffer table big enough
	IF
	    .I_NXT_REC GTR .b_tab_end
	THEN
	    BEGIN	! must expand buffer table

	    ! get new memory first
   	    $XPO_GET_MEM(FULLWORDS=(.b_tab_end+1+N_MAX_REC) * K_REC_FLD_FULL,
			 RESULT=A_NEW_TAB);
	    !tranfer buffer table pointers to new block
	    L_COPY = (.b_tab_end+1) * K_REC_FLD_FULL ;
	    CH$MOVE(.L_COPY,CH$PTR(.R_BUF_TAB),CH$PTR(.A_NEW_TAB)) ;

	    ! free old table and update pointer and indexes
	    $XPO_FREE_MEM(BINARY_DATA=((.b_tab_end+1) * K_REC_FLD_FULL,
				       .R_BUF_TAB,FULLWORDS)) ;
	    R_BUF_TAB = .A_NEW_TAB ;
	    b_tab_end = .b_tab_end + N_MAX_REC ;
	    END ; 	! must expand buffer table
	    
	IF
	    .L_REM_BUF LSS .RD_IOB[IOB$H_STRING]
	THEN
	    BEGIN	! must allocate new buffer block

	    ! first get memory for chain entry
	    $XPO_GET_MEM(FULLWORDS=K_CHN_BLK_FULL,
			 RESULT=A_NEW_CHN) ;
	    IF
		.CUR_CHN_CNT EQL 0
	    THEN
		BEGIN		! first chained block
		R_CHN_BUF = .A_NEW_CHN;
		CUR_CHN_CNT = .CUR_CHN_CNT + 1;
		R_CHN_BUF[CHN_CNT] = .CUR_CHN_CNT ;
		R_CHN_BUF[BUF_LEN] = N_MAX_REC * L_MAX_LIN ;
		R_CHN_BUF[FWD_LNK] = 0;
		R_CHN_BUF[BWD_LNK] = 0;

		! get memory block
		$XPO_GET_MEM(CHARACTERS=L_MAX_LIN * N_MAX_REC,
			        RESULT=R_CHN_BUF[P_BLK]);
		! reset pointer and remaining length
		P_NXT_AVA = CH$PTR(.R_CHN_BUF[P_BLK]) ;
		L_REM_BUF = L_MAX_LIN * N_MAX_REC ;
		END 		! first chained block
	    ELSE
		BEGIN		! more than one block to be chained
		
		IF
		    .R_CHN_BUF[CHN_CNT] NEQ .CUR_CHN_CNT
		THEN
		    BUG(CAT('Buffer chain pointer pointing to wrong entry. ',
			    'Error occurred in routine SHWRES of module ',
			    'STSHOW.')) ;
		! setup forward link + save previous chain entry
		R_CHN_BUF[FWD_LNK] = .A_NEW_CHN ;
		A_PRE_CHN = .R_CHN_BUF ;

		! point to new chain entry
		R_CHN_BUF = .R_CHN_BUF[FWD_LNK] ;
		CUR_CHN_CNT = .CUR_CHN_CNT + 1;
		
		! initialize this entry
		R_CHN_BUF[CHN_CNT] = .CUR_CHN_CNT ;
		R_CHN_BUF[BUF_LEN] = N_MAX_REC * L_MAX_LIN ;
		R_CHN_BUF[FWD_LNK] = 0 ;
		R_CHN_BUF[BWD_LNK] = .A_PRE_CHN ;
		$XPO_GET_MEM(CHARACTERS=N_MAX_REC * L_MAX_LIN,
			        RESULT=R_CHN_BUF[P_BLK]) ;
		! setup pointer and remaining length
		P_NXT_AVA = CH$PTR(.R_CHN_BUF[P_BLK]) ;
		L_REM_BUF = N_MAX_REC * L_MAX_LIN ;

		END ;		! more than one block chained

	    END;	! must allocate new buffer block

	! move line from iob to buffer
	IF
	    .RD_IOB[IOB$H_STRING] LEQ .L_REM_BUF
	THEN
	    BEGIN	! space available in buffer
	     
	    IF
		NOT .F_1ST_ELM
	    THEN
		BEGIN		! first record only
		F_1ST_ELM = TRUE;

		! put in old element area
		P_ELM = CH$PLUS(.RD_IOB[IOB$A_STRING],1) ;
		L_ELM = CH$FIND_CH(.RD_IOB[IOB$H_STRING]-1,
					.P_ELM,%C' ');
		L_ELM = CH$DIFF(.L_ELM,.P_ELM);
		CH$MOVE(.L_ELM,.P_ELM,.P_OLD_ELM);
		L_OLD_ELM = .L_ELM;
		END ;		! first record only

	    CH$MOVE(.RD_IOB[IOB$H_STRING],.RD_IOB[IOB$A_STRING],
			.P_NXT_AVA) ;
	    $STR_DESC_INIT(DESCRIPTOR=R_BUF_TAB[.I_NXT_REC,D_COM_LIN],
			       STRING=(.RD_IOB[IOB$H_STRING],
				       .P_NXT_AVA)) ;
	    P_TMP = .R_BUF_TAB[.I_NXT_REC,D_COM_LIN_PTR];
	    L_REM_TMP = .R_BUF_TAB[.I_NXT_REC,D_COM_LIN_LEN]-1 ;

	    LOOP_CNT = 3 ;
	    UNTIL
		.LOOP_CNT EQL 0
	    DO
		BEGIN	! find user name len,ptr
		P_TMP = CH$PLUS(.P_TMP,1) ;
		P_BLK_TMP = CH$FIND_CH(.L_REM_TMP,.P_TMP,%C' ') ;
		L_TMP = CH$DIFF(.P_BLK_TMP,.P_TMP) ;
		L_REM_TMP = .L_REM_TMP-.L_TMP-1 ;
		P_TMP = .P_BLK_TMP;
		IF
		    .LOOP_CNT EQL 2
		THEN
		    BEGIN	! reserve generation
		    POINTR = CH$PLUS(.P_TMP,-.L_TMP) ;
		    $STR_DESC_INIT(DESCRIPTOR=R_BUF_TAB[.I_NXT_REC,D_RES_GEN],
				       STRING=(.L_TMP,.POINTR)) ;
		    END ;	! reserve generation
		    
		LOOP_CNT = .LOOP_CNT-1 ;
		END ;	! fin user name len,ptr

	    ! reset pointer to beginning of string
	    P_TMP = CH$PLUS(.P_TMP,-.L_TMP) ;

	    ! set descriptor for user name
	    $STR_DESC_INIT(DESCRIPTOR=R_BUF_TAB[.I_NXT_REC,D_USR_NAM],
			       STRING=(.L_TMP,.P_TMP)) ;
	    ! adjust remaining ptr and len
	    P_NXT_AVA = CH$PLUS(.P_NXT_AVA,.RD_IOB[IOB$H_STRING]) ;
	    L_REM_BUF = .L_REM_BUF-.RD_IOB[IOB$H_STRING];

	    BUF_TAB_LST = .I_NXT_REC;
	    I_NXT_REC = .I_NXT_REC + 1;

	    END ;	! space available in buffer

	END;	! read loop


    ! process last element read in the loop
    IF
	.REC_CNT GTR 0
    THEN 
	BEGIN	! must have read at least one record

        IF
	    .F_NO_PARM OR
	    (.F_ELM_REF AND
	    CH$EQL(.L_OLD_ELM,.P_OLD_ELM,
		     LEN_COMMA_PTR(D_ELM_NAM),%C' ') AND
		     NOT .F_OUTPUT)
        THEN
 	    EXABUF();
	
	END ;	! must have read at least one record


    ! reset output to terminal
    IF
	.F_SPEC_OUT
    THEN
	BEGIN

	IF
	    NOT (SETOUT(K_SAY_CLOSE,K_NULL,K_NULL))
	THEN
	    BUG(CAT('Unable to close output file. Error occurred in routine',
		    ' SHWRES of module SHWRES.'));
	END ;

    ! close reservation file
    $step_close(IOB=RD_IOB) ;

    ! no output issued, then inform user
    IF
	NOT .F_OUTPUT
    THEN
	BEGIN
	sysmsg(s_nores,CAT('No reservations found'),0) ;
	RETURN s_nores;
	END ;

    s_shwsucc

    END;				!End of SHWRES 

END				! End of module
ELUDOM