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

MODULE SHWLOG	(
    		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 the routines to process the CMS log and
!	display the information.        
!
! ENVIRONMENT: VAX/VMS, DS-20
!   
!
! AUTHOR: Robert Wheater CREATION DATE: 8-May-80
!
! MODIFIED BY:
!
!--
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
	OUTLOG:NOVALUE,		! print log record
	SHWLOG ;		! main routine for SHOW LOG processing

!
! 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:
!
MACRO
    LEFTB = '(' %,
    RIGHTB = ')' %;
!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE AND PLITS:
!
OWN
    $io_block(RD) ;

!
! EXTERNAL REFERENCES:
!

external literal
	s_cantfind,		! can't find log record requested
	s_nolog,		! no log entries found
	s_nounusual,		! no unusual entries found
	s_shwsucc;		! success

EXTERNAL
    D_ELM_NAM: DESC_BLOCK,	! desc of element name(SHWEXA)
    D_SINCE: DESC_BLOCK,	! desc of since qual string(SHWEXA)

    F_ELM_REF,			! set when element reference occurs(SHWEXA)
    F_NO_PARM,			! set when no parameter on command(SHWEXA)
    F_SINCE_QUA,		! set when since qualifier present(SHWEXA)
    F_SPEC_OUT ,		! set when output to file(SHWEXA)
    F_UNUSUAL_QUA ;		! set when unusual qualifier present(SHWEXA)

EXTERNAL ROUTINE
    ASCDEC,			! convert ASCII to decimal(ASCDEC)
    BADLIB,			! prints bad library message(TERMIO)
    badxpo,
    BUG,			! print bug message(TERMIO)
    DEQUOT,			! remove quotes from string(QUOTES)
    ENDQUO,			! find end of quoted string(STRING)
    EXPARM,			! examine parameter on command line(SHWEXA)
    EXQUAL,			! examine qualifier on command line(SHWEXA)
    GETMEM,			! provide dynamic memory as needed(SHWLG2)
    GET_LXM,			! get next lexeme in string(GETLXM)
    NMONTH,			! get number of month(SHWLG2)
    PRSDAT,			! parse date string(SHWLG2)
    PARSTR,			! parse string into lexemes(SHWLG2)
    REFQUA,			! obtain reference qualifier(SHWLG2)
    SAY,			! display record on terminal(TERMIO)
    SELELM,			! check for element selection(SHWLG2)
    SETOUT ,			! set output to terminal(TERMIO)
    sysmsg;			! send message to user

ROUTINE OUTLOG(LEN,PTR): NOVALUE=

!++
! FUNCTIONAL DESCRIPTION:
!
!	The purpose of this routine is to output a log record after
!	it is selected for printing. This routine will also determine
!	if the record is an unusual record or not and print the appropriate
!	message.      
!
! FORMAL PARAMETERS:
!
!	LEN		Length of this log record.
!
!	PTR		Pointer to this log record.        
!
! IMPLICIT INPUTS:
!
!	None.	
!
! IMPLICIT OUTPUTS:
!
!	None.	
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	TRUE = successful completion
!	FALSE = error in processing    
!
! SIDE EFFECTS:
!
!	
!
!--

    BEGIN
    
    LITERAL
	LG_DATE = 0,			! index to date desc
	LG_TIME = 1,			! index to time desc
	LG_USER = 2,			! index to user id desc
	LG_COMM = 3,			! index to command desc
	LG_SUBC = 4,			! index to subcommand desc
	LG_PARM = 5,			! index to parameter desc
	LG_REMK = 6 ;			! index to remark desc
    
    
    OWN
    	A_LOG_FLDS: REF BLOCKVECTOR[,K_LOG_FLD_FULL] FIELD(LOG_FLD),
    					! address of log record fields
    	A_SUB_FLDS: REF BLOCKVECTOR[,K_LOG_FLD_FULL] FIELD(LOG_FLD),
    					! address of subcommand fields
    	A_PARM_FLDS: REF BLOCKVECTOR[,K_LOG_FLD_FULL] FIELD(LOG_FLD),
    					! address of parameter fields
    	A_SUB_TMP: REF BLOCKVECTOR[,K_LOG_FLD_FULL] FIELD(LOG_FLD),
    					! address sub parameters fields
    
    	A_SUB_PAR_CUR: REF $UNIT_BLOCK[K_SUB_PARM_UNITS] FIELD(SUB_PARM),
    					! block containing address of 
    					! sub components of the parameter
    
    	A_SUB_PAR_1ST: initial(k_null),	! address of first subparameter block
    	A_CUR_SUB_PAR,			! address of current subparameter
	A_NXT_BLK,			! address of next subparameter block
	A_LST_BLK,			! address of last subparameter block

	CHAR,				! contain character for examination

	D_REF_COPY: DESC_BLOCK,		! reference string for copy command
	D_CAT_GEN: REF DESC_BLOCK,	! concatentated gen number desc
	D_REF_INCLUDE: DESC_BLOCK,	! reference string for include command
	D_REF_QUAL: REF DESC_BLOCK,	! reference string for qualifier
	D_REF_SUBC: DESC_BLOCK,		! reference string for /sub
	D_REF_UNUSUAL: DESC_BLOCK,	! reference string for /u
	D_BLK_SUB: DESC_BLOCK,		! descriptor for blank following
					! subcommand display
	D_BLK_PAR: DESC_BLOCK,		! descriptor for blank following
					! parameter display
  
	F_1ST_SUB,			! first sub parameter
	F_GEN_FND,			! set when generation found

	LP_INDX,			! loop index
	LP_SUB_PARM,			! loop control index for building
					! subparm
	L_GEN,				! length of generation number
	L_CAT_SUBC,			! Length of concatentated subcommand
	L_CAT_PARM,			! length of concatentated parameter
	L_PARM_CON,			! length of full concatented parameter
	L_REM,				! length remaining

 	P_BRACE,			! pointer to brace
	P_CAT_PARM,			! pointer to concatented parameter
	P_CAT_SUBC,			! pointer to concatented subcommand
	P_GEN,				! pointer to generation number
	P_PARM_CON,			! pointer to full concatented parameter
	P_TMP,				! work pointer
    
    	V_CNT_FLDS,			! count of number if fields in log rec
    	V_CNT_SUB,			! count of number of fields in 
    					! subcommand
    	V_CNT_PARM ;			! count of number of fields in 
    					! parameter
    
local
     t_char,
     t_len,
     t_ptr ;

    ! initialize 
    F_1ST_SUB = TRUE ;
    F_GEN_FND = FALSE ;
    D_REF_QUAL = K_NULL ;

    ! initialize descriptors
    $STR_DESC_INIT(DESCRIPTOR=D_REF_SUBC,STRING=('/SUB')) ;
    $STR_DESC_INIT(DESCRIPTOR=D_REF_UNUSUAL,STRING=('/U')) ;
    $STR_DESC_INIT(DESCRIPTOR=D_REF_COPY,STRING=('COPY')) ;
    $STR_DESC_INIT(DESCRIPTOR=D_REF_INCLUDE,STRING=(SPELLING(K_INSERT_COM))) ;
%if %bliss (bliss36) %then
    t_ptr = .ptr ;
    t_len = .len ;
    t_char = ch$rchar_a(t_ptr) ;
    while .t_char eql 00 do
          begin
          t_len = .t_len - 1 ;
          t_char = ch$rchar_a(t_ptr) ;
          end ;
    ptr =ch$plus( .t_ptr,-1) ;
    len = .t_len ;
%fi     
 
    ! parse image into fields
    IF
    	NOT PARSTR(.LEN,.PTR,%C' ',A_LOG_FLDS,V_CNT_FLDS)
    THEN
    	BUG(CAT('Error in processing log record into its components. Error ',
    		'occurred in routine OUTLOG of module SHSTAT.')) ;
    
    ! check for the right number of fields in the record 
    ! this is a fixed number for the new format records ,the only 
    ! kind of records handles by this routine.
    if
	.V_CNT_FLDS NEQ (LG_REMK + 1)
    THEN
	BADLIB(CAT('Bad record in history file.',
		   'The record was: ',(.len,.ptr))) ;


    ! remove quotes from subcommand field
    DEQUOT(A_LOG_FLDS[LG_SUBC,LOG_COMP]) ;

    IF
	.A_LOG_FLDS[LG_SUBC,LOG_COMP_LEN] LSS 1
    THEN
	BEGIN	! null subfield
	A_SUB_FLDS = K_NULL ;
	V_CNT_SUB = 0 ;
	END 	! null subfield
    ELSE
	BEGIN	! break up subcommand

	! parse subcommand into its components
	IF 
    	    NOT PARSTR(.A_LOG_FLDS[LG_SUBC,LOG_COMP_LEN],
			.A_LOG_FLDS[LG_SUBC,LOG_COMP_PTR],
    			%C'/',A_SUB_FLDS,V_CNT_SUB) 
	THEN
    	    BUG(CAT('Error in processing subcommand into its components. The ',
    		    ' error occurred in routine OUTLOG of module SHWLOG.')) ;
	
	! include '/' in string by adjusting the descriptors
	INCR A FROM 0 TO (.V_CNT_SUB - 1) BY 1 DO
	    BEGIN	! adjust to include '/'
	    
	    IF
		CH$RCHAR(CH$PLUS(.A_SUB_FLDS[.A,LOG_COMP_PTR],-1)) EQL %C'/'
	    THEN
		BEGIN 	! adjust to include '/'
		A_SUB_FLDS[.A,LOG_COMP_PTR] = CH$PLUS(.A_SUB_FLDS[.A,LOG_COMP_PTR],-1);
		A_SUB_FLDS[.A,LOG_COMP_LEN] = .A_SUB_FLDS[.A,LOG_COMP_LEN] + 1;
		END ;	! adjust to include '/'

	    END ;	! adjust to include '/'
	
	END ;	! break up subcommand

    ! remove quotes from parameter string
    DEQUOT(A_LOG_FLDS[LG_PARM,LOG_COMP]) ;

    !+
    !	Parsing of the parameter is done in two steps. First the parameters
    !	are separated into individual parameters. Then the parameter(referred
    !	to here as subparameter) is separated into parameter and qualifier
    !+

    IF
	.A_LOG_FLDS[LG_PARM,LOG_COMP_LEN] LSS 1
    THEN
	BEGIN	! null parameter
	A_PARM_FLDS = K_NULL ;
	V_CNT_PARM = 0 ;
	END 	! null parameter
    ELSE
	BEGIN	! break up parameter

	! parse parameter string into its components
	IF
    	    NOT PARSTR(.A_LOG_FLDS[LG_PARM,LOG_COMP_LEN],
			.A_LOG_FLDS[LG_PARM,LOG_COMP_PTR],
    			%C' ',A_PARM_FLDS,V_CNT_PARM)
	
	THEN
    	    BUG(CAT('Error in processing parameter into its components. The ',
    		    'error occurred in routine OUTLOG of module SHSTAT.')) ;
	
	! parse parameters into subparameters
	LP_SUB_PARM = 0;
	F_1ST_SUB = TRUE ;
	A_NXT_BLK = K_NULL ;
	A_LST_BLK = K_NULL ;
	
	UNTIL
    	    .LP_SUB_PARM EQL .V_CNT_PARM
	DO
    	    BEGIN	! build subparameter chain
	
    	    ! get block for chain entry
    	    SIMULATE_XPOGETMEM(FULLWORDS=K_SUB_PARM_UNITS,RESULT=A_SUB_PAR_CUR) ;
	
    	    IF
    		.F_1ST_SUB
    	    THEN
    		BEGIN	! save start of chain
    		A_SUB_PAR_1ST = .A_SUB_PAR_CUR ;
    		F_1ST_SUB = FALSE ;
    		END ;	! save start of chain
	
    	    ! parse this parameter
    	    IF
    		NOT PARSTR(.A_PARM_FLDS[.LP_SUB_PARM,LOG_COMP_LEN],
    		   	.A_PARM_FLDS[.LP_SUB_PARM,LOG_COMP_PTR],%C'/',
    	    	   	A_SUB_PAR_CUR[SUB_ADDR],A_SUB_PAR_CUR[SUB_CNT])
    	    THEN
    		BUG(CAT('Unable to process parameter into its components. the ',
    			'error occurred in the routine OUTLOG of module SHWLOG.'));
	
   	    ! adjust descriptors to include '/'
	    A_SUB_TMP = .A_SUB_PAR_CUR[SUB_ADDR] ;
	    INCR A FROM 0 TO (.A_SUB_PAR_CUR[SUB_CNT] - 1) BY 1 DO
		BEGIN	! adjust for '/'

		IF
		    CH$RCHAR(CH$PLUS(.A_SUB_TMP[.A,LOG_COMP_PTR],-1)) EQL %C'/'
		THEN
		    BEGIN ! adjust pointer
		    A_SUB_TMP[.A,LOG_COMP_PTR] = CH$PLUS(.A_SUB_TMP[.A,LOG_COMP_PTR],-1) ;
		    A_SUB_TMP[.A,LOG_COMP_LEN] = .A_SUB_TMP[.A,LOG_COMP_LEN] + 1 ;
		    END ; ! adjust pointer

		END ;	! adjust for '/'

	    ! store backward link
	    A_SUB_PAR_CUR[BW_LNK] = .A_LST_BLK ;

    	    ! update previous address for next pass
    	    A_LST_BLK = .A_SUB_PAR_CUR ;
	
	    ! now update forward link in last block after clearing link
	    ! in current block
	    A_SUB_PAR_CUR[FW_LNK] = K_NULL ;
	    A_NXT_BLK = .A_SUB_PAR_CUR ;
	    A_SUB_PAR_CUR = .A_SUB_PAR_CUR[BW_LNK] ;

	    ! next blk contains address of new blk
	    IF
		.A_SUB_PAR_CUR NEQ K_NULL
	    THEN
		A_SUB_PAR_CUR[FW_LNK] = .A_NXT_BLK ;

    	    ! increment loop control
    	    LP_SUB_PARM = .LP_SUB_PARM + 1;
    	    
    	    END;	! build subparameter chain
    
	END ;	! break up parameter

    !+
    !	The subcommand display field must be built based upon which 
    !	command this is.
    !+
    
    IF
	.A_LOG_FLDS[LG_SUBC,LOG_COMP_LEN] GTR 0
    THEN
	BEGIN	! build subcommand display field

	! get memory for subcommand display field
	SIMULATE_XPOGETMEM(CHARACTERS=.A_LOG_FLDS[LG_SUBC,LOG_COMP_LEN],
			RESULT=P_CAT_SUBC) ;
	P_TMP = .P_CAT_SUBC ;
	L_REM = .A_LOG_FLDS[LG_SUBC,LOG_COMP_LEN] ;
	LP_INDX = 0 ;

	REPEAT
	    BEGIN	! search reference table

	    ! get qualifier
	    IF
		.LP_INDX EQL 0
	    THEN
	        REFQUA(A_LOG_FLDS[LG_COMM,LOG_COMP],D_REF_QUAL) 
	    ELSE
		REFQUA(K_NULL,D_REF_QUAL) ;

	    IF
		.D_REF_QUAL EQL K_NULL
	    THEN
		EXITLOOP ;

	    IF
		CH$EQL(.D_REF_QUAL[DESC_LEN],.D_REF_QUAL[DESC_PTR],
			LEN_COMMA_PTR(D_REF_SUBC),%C' ')
		AND (.LP_INDX EQL 0)
	    THEN
		BEGIN	! subcommand is to be displayed

		IF
		    CH$RCHAR(.A_SUB_FLDS[.LP_INDX,LOG_COMP_PTR]) NEQ %C'/'
		THEN
		    BEGIN	! valid subcommand,not qual

		    CH$MOVE(.A_SUB_FLDS[.LP_INDX,LOG_COMP_LEN],
			    .A_SUB_FLDS[.LP_INDX,LOG_COMP_PTR],
			    .P_TMP) ;

		    ! update temp pointer
		    P_TMP = CH$PLUS(.P_TMP,.A_SUB_FLDS[.LP_INDX,LOG_COMP_LEN]) ;
		    L_REM = .L_REM - .A_SUB_FLDS[.LP_INDX,LOG_COMP_LEN] ;

		    END ;	! valid subcommand,not qual
		
		END ;	! subcommand to be displayed

	    IF
		CH$NEQ(.D_REF_QUAL[DESC_LEN],.D_REF_QUAL[DESC_PTR],
			LEN_COMMA_PTR(D_REF_SUBC),%C' ') 
    	    THEN
		BEGIN	! qualifier search

		INCR L FROM 0 TO (.V_CNT_SUB - 1) BY 1 DO
		    BEGIN	!check for match

		    IF
			CH$EQL(.D_REF_QUAL[DESC_LEN],.D_REF_QUAL[DESC_PTR],
				.D_REF_QUAL[DESC_LEN],
				.A_SUB_FLDS[.L,LOG_COMP_PTR],%C' ')
		    THEN
			BEGIN	! match->xfer

			IF
			    .L_REM GEQ .A_SUB_FLDS[.L,LOG_COMP_LEN]
			THEN
			    BEGIN	! enough space left

			    CH$MOVE(.A_SUB_FLDS[.L,LOG_COMP_LEN],
				    .A_SUB_FLDS[.L,LOG_COMP_PTR],
				    .P_TMP) ;
			    P_TMP = CH$PLUS(.P_TMP,.A_SUB_FLDS[.L,LOG_COMP_LEN]) ;
			    L_REM = .L_REM - .A_SUB_FLDS[.L,LOG_COMP_LEN] ;

			    END 	! enough space left
			ELSE
			    BUG(CAT('Not enough space left for subcommand. Error ',
				    'occurred in routine OUTLOG of module SHWLOG.')) ;

			END ;	! match->xfer
		    
		    END ;	! check for match

		END ;	! qualifier search
	    
	    LP_INDX = .LP_INDX + 1 ;

	    END ;	! search ref table
	    
	    ! set up concatented length - pointer already set up
	    L_CAT_SUBC = .A_LOG_FLDS[LG_SUBC,LOG_COMP_LEN] - .L_REM ;

	    ! put in blank following subcommand
	    IF
		.L_CAT_SUBC GTR 0
	    THEN
	        $STR_DESC_INIT(DESCRIPTOR=D_BLK_SUB,STRING=(' ')) 
	    ELSE
		$STR_DESC_INIT(DESCRIPTOR=D_BLK_SUB,STRING=(0,K_NULL)) ;

	END  	! build subcommand display field
    ELSE
	BEGIN	! no subcommand display field
	L_CAT_SUBC = 0 ;
	P_CAT_SUBC = K_NULL ;

	! make blank following subcommand a zero length descriptor
	$STR_DESC_INIT(DESCRIPTOR=D_BLK_SUB,STRING=(0,K_NULL)) ;

	END ;	! no subcommand display field
	
    !+
    !	must build output parameters for display
    !+


    IF
	.A_LOG_FLDS[LG_PARM,LOG_COMP_LEN] GTR 0
    THEN
	BEGIN	! build parameter display field


	! get memory for concatented parameters
	SIMULATE_XPOGETMEM(CHARACTERS=.A_LOG_FLDS[LG_PARM,LOG_COMP_LEN] + (.V_CNT_PARM * 3),
			RESULT=P_CAT_PARM) ;
	P_TMP = .P_CAT_PARM ;
	L_REM = .A_LOG_FLDS[LG_PARM,LOG_COMP_LEN] + (.V_CNT_PARM * 3) ;

	! set up for subparameter reference
	A_SUB_PAR_CUR = .A_SUB_PAR_1ST ;
	A_SUB_TMP = .A_SUB_PAR_CUR[SUB_ADDR] ;

	INCR I FROM 1 TO .V_CNT_PARM BY 1 DO
	    BEGIN	! loop thru subparameters

	    ! adjust parameter to exclude braced expression
	    P_BRACE = CH$FIND_CH(.A_SUB_TMP[0,LOG_COMP_LEN],
			 	.A_SUB_TMP[0,LOG_COMP_PTR],%C'{') ;

	    IF
		CH$FAIL(.P_BRACE) EQL 0
	    THEN
		A_SUB_TMP[0,LOG_COMP_LEN] = CH$DIFF(.P_BRACE,
					    .A_SUB_TMP[0,LOG_COMP_PTR]) ;

	    ! now transfer parameter
	    CH$MOVE(.A_SUB_TMP[0,LOG_COMP_LEN],
		    .A_SUB_TMP[0,LOG_COMP_PTR],
		    .P_TMP) ;

	    L_REM = .L_REM - .A_SUB_TMP[0,LOG_COMP_LEN] ;
	    P_TMP = CH$PLUS(.P_TMP,.A_SUB_TMP[0,LOG_COMP_LEN]) ;

	    ! must now find generation number
	    INCR K FROM 1 TO (.A_SUB_PAR_CUR[SUB_CNT] - 1) BY 1 DO
		BEGIN	! check for /gen

		CHAR = CH$RCHAR(CH$PLUS(.A_SUB_TMP[.K,LOG_COMP_PTR],1)) ;

		IF
		    (.CHAR GEQ %C'0') AND
		    (.CHAR LEQ %C'9')
		THEN
		    BEGIN 	! set up pointers
		    L_GEN = .A_SUB_TMP[.K,LOG_COMP_LEN] - 1 ;
		    P_GEN = CH$PLUS(.A_SUB_TMP[.K,LOG_COMP_PTR],1) ;
		    F_GEN_FND = TRUE ;
		    EXITLOOP ;
		    END; 	! set up pointers

		END ;	! check for /gen

	    IF
		.F_GEN_FND
	    THEN
		BEGIN	! xfer gen number

		! now put on brackets
		D_CAT_GEN = SCAT(LEFTB,(.L_GEN,.P_GEN),RIGHTB) ;

		! add it onto end of parameter
		CH$MOVE(.D_CAT_GEN[DESC_LEN],.D_CAT_GEN[DESC_PTR],.P_TMP) ;
	 	L_REM = .L_REM - .D_CAT_GEN[DESC_LEN] ;
		P_TMP = CH$PLUS(.P_TMP,.D_CAT_GEN[DESC_LEN]) ;
		F_GEN_FND = FALSE ;

		END ;	! xfer gen number

		! any parameter qualifiers to be printed?
		LP_INDX = 0 ;

		REPEAT
		    BEGIN	! search reference table

		    ! get qualifier
		    IF
			.LP_INDX EQL 0
		    THEN
	    	        REFQUA(A_LOG_FLDS[LG_COMM,LOG_COMP],D_REF_QUAL) 
		    ELSE
			REFQUA(K_NULL,D_REF_QUAL) ;

		    IF
			.D_REF_QUAL EQL K_NULL
		    THEN
			EXITLOOP ;

		    IF
			CH$NEQ(.D_REF_QUAL[DESC_LEN],.D_REF_QUAL[DESC_PTR],
				LEN_COMMA_PTR(D_REF_SUBC),%C' ') 
    		    THEN
			BEGIN	! qualifier search

			INCR L FROM 1 TO (.A_SUB_PAR_CUR[SUB_CNT] - 1) BY 1 DO
			    BEGIN	!check for match

			    IF
				CH$EQL(.D_REF_QUAL[DESC_LEN],.D_REF_QUAL[DESC_PTR],
					.D_REF_QUAL[DESC_LEN],
					.A_SUB_TMP[.L,LOG_COMP_PTR],%C' ')
			    THEN
				BEGIN	! match->xfer

				IF
				    .L_REM GEQ .A_SUB_TMP[.L,LOG_COMP_LEN]
				THEN
				    BEGIN	! enough space left

				    CH$MOVE(.A_SUB_TMP[.L,LOG_COMP_LEN],
					    .A_SUB_TMP[.L,LOG_COMP_PTR],
					    .P_TMP) ;
				    P_TMP = CH$PLUS(.P_TMP,.A_SUB_TMP[.L,LOG_COMP_LEN]) ;
				    L_REM = .L_REM - .A_SUB_TMP[.L,LOG_COMP_LEN] ;

				    END 	! enough space left
				ELSE
				    BUG(CAT('Not enough space left for parameter ',
				    'qualifier (OUTLOG)')) ;

				END ;	! match->xfer
			    
			    END ;	! check for match

			END ;	! qualifier search
		    
		    LP_INDX = .LP_INDX + 1 ;

		    END ;	! search ref table


	    IF
		.A_SUB_PAR_CUR[FW_LNK] NEQ K_NULL
	    THEN
		BEGIN 	! set up pointer to next parameter
		A_SUB_PAR_CUR = .A_SUB_PAR_CUR[FW_LNK] ;
		A_SUB_TMP = .A_SUB_PAR_CUR[SUB_ADDR] ;
		END 	! set up pointer to next parameter
	    ELSE
		EXITLOOP ;

	    ! is a blank necessary?
	    IF
		(.V_CNT_PARM GTR 1) AND (.I NEQ .V_CNT_PARM)
	    THEN
		BEGIN	! write blank
		CH$WCHAR_A(%C' ',P_TMP) ;
		L_REM = .L_REM - 1 ;
		END ;	! write blank

	    END ;	! loop thru subparameters

	! compute length and final pointer
	L_PARM_CON = .A_LOG_FLDS[LG_PARM,LOG_COMP_LEN] +(.V_CNT_PARM * 3) 
			- .L_REM ;
	P_PARM_CON = .P_CAT_PARM ;

	! put in blank after descriptor
	$STR_DESC_INIT(DESCRIPTOR=D_BLK_PAR,STRING=(' ')) ;

	END	! build parameter display field
    ELSE
	BEGIN	! no parameter to display
	L_PARM_CON = 0 ;
	P_PARM_CON = K_NULL ;
	$STR_DESC_INIT(DESCRIPTOR=D_BLK_PAR,STRING=(0,K_NULL)) ;
	END ;	! no parameter to display

    ! leave quotes on remark

    ! output line
    SAY(SCAT(A_LOG_FLDS[LG_DATE,LOG_COMP],' ',A_LOG_FLDS[LG_TIME,LOG_COMP],' ',
	    A_LOG_FLDS[LG_USER,LOG_COMP],' ',A_LOG_FLDS[LG_COMM,LOG_COMP],' ',
	    (.L_CAT_SUBC,.P_CAT_SUBC),D_BLK_SUB,
	    (.L_PARM_CON,.P_PARM_CON),D_BLK_PAR,
	    A_LOG_FLDS[LG_REMK,LOG_COMP])) ;

    ! now put out second line if unusual situation
    INCR I FROM 0 TO (.V_CNT_SUB - 1) BY 1 DO
	BEGIN	! look for /U

	IF
	    CH$EQL(.A_SUB_FLDS[.I,LOG_COMP_LEN],
		   .A_SUB_FLDS[.I,LOG_COMP_PTR],
	   	   LEN_COMMA_PTR(D_REF_UNUSUAL),%C' ')
	THEN
	    SAY(lit('    Unusual Occurrence!')) ;

	END ;	! look for /U

    !+
    !	clear all blocks of memory for next call
    !+

    SIMULATE_XPOGETMEM (OPERATION = CLEAR);

    ! zero start of chain address
    A_SUB_PAR_1ST = k_null ;

    ! normal completion
    TRUE

    END;			! end of routine OUTLOG

GLOBAL ROUTINE SHWLOG(A_QUAL,A_PARM) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will display the log file according to the various
!	selection criteria. The log may be displayed by element,date and
!	unusual events.        
!
! FORMAL PARAMETERS:
!
!	A_QUAL		Address of first qualifier block.
!
!	A_PARM		Address of first parameter block.
!
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	K_SUCCESS = successful completion of routine.
!	K_INFORMATION = alternative success but no output displayed.
!	K_SILENT_ERROR = error in processing.        
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN
    
    
    OWN
        D_DAT_REC: DESC_BLOCK,		! full date from log record
        D_UNU_REF: DESC_BLOCK,		! reference string for /u
    
        M_TMP: VECTOR[CH$ALLOCATION(20)], ! storage for complete date string
    
	F_SINCE_STR:INITIAL(FALSE),	! set when since qual satisfied
	F_UNU_REC: INITIAL(FALSE),	! set when unusual record found

	P_BUF,				! pointer to buffer
	P_SUB,				! pointer to /u
        PAR_DAY,			! day from parameter(numeric)
        PAR_MON,			! month from parameter(numeric)
        PAR_YR,				! year from parameter(numeric)
    
        REC_DAY,			! day from log record(numeric)
        REC_MON,			! month from log record(numeric)
        REC_YR ;				! year from log record(numeric
    
    OWN
	F_ELM_MAT,			! set when element match occurs
	F_OLD_FMT,			! set when old format record recognized
        F_OUTPUT,			! set when first output issued
        F_PRINT,			! set when printing required
    
        L_TMP,				! temp length
        P_TMP ;				! temp pointer

    local
	status;

    LABEL
	READ_BLOCK;

    ! initialize
    F_ELM_MAT = FALSE ;
    F_OUTPUT = FALSE ;
    F_PRINT = FALSE ;
    F_OLD_FMT = FALSE ;

    ! examine command line
    IF
        NOT EXQUAL(.A_QUAL)
    THEN
        RETURN K_SILENT_ERROR ;
    
    EXPARM(.A_PARM) ;
    
    ! save since info
    IF
        .F_SINCE_QUA
    THEN
        BEGIN		! since qual
    
        ! parse date string in parameter
        IF
    	    NOT PRSDAT(D_SINCE,PAR_DAY,PAR_MON,PAR_YR)
    	THEN
    	    RETURN K_SILENT_ERROR ;
    
    	END ;		! since qual
    
    ! initialize descriptor reference string
    $STR_DESC_INIT(DESCRIPTOR=D_UNU_REF,STRING=('/U')) ;
    
    ! open and read log file
    %if vaxvms %then
    !this is strictly a kluge
    !since we optomise by using LOC mode gets we cannot overwrite buffers
    !unfortunately UNQUOTE overwrites buffers and since it is dated code anyway
    rd_rab[rab$v_loc] = false;
    %fi
    if
	(status=$STEP_OPEN(IOB=RD_IOB,FILE_SPEC=(%STRING(LIB,LOG)),
		failure=0)) neq step$_normal
    then
	badxpo(.status,lit('Cannot open history file.'));
    
    UNTIL
        $step_get(IOB=RD_IOB) EQL step$_eof
    DO

READ_BLOCK:
        BEGIN	! log file read loop

        IF
            .rd_iob[IOB$H_STRING] EQL 0
        THEN
            BADLIB(CAT('Illegal history file record:',
                  (.RD_IOB[IOB$H_STRING],.RD_IOB[IOB$A_STRING]))) ;

        IF
    	    .F_SINCE_QUA
    	THEN
    	    BEGIN	! since qualifier present
    
    	    ! set up temp length and pointer
    	    L_TMP = .RD_IOB[IOB$H_STRING] ;
    	    P_TMP = .RD_IOB[IOB$A_STRING] ;
    
     	    ! get date lexeme
	    $STR_DESC_INIT(DESCRIPTOR=D_DAT_REC,STRING=(0,K_NULL)) ;
	    P_BUF = CH$PTR(M_TMP) ;

	    IF
		CH$RCHAR(.P_TMP) EQL %C' '
	    THEN
		BEGIN 	! skip over blank
		P_TMP = CH$PLUS(.P_TMP,1) ;
		L_TMP = .L_TMP - 1 ;
		END ;	! skip over blank

    	    D_DAT_REC[DESC_LEN] = GET_LXM(P_TMP,%C' ',.L_TMP,P_BUF) ;
    	    D_DAT_REC[DESC_PTR] = CH$PTR(M_TMP) ;
    
    	    ! parse date
    	    IF
    		NOT PRSDAT(D_DAT_REC,REC_DAY,REC_MON,REC_YR) 
    	    THEN
    		BADLIB(CAT('Illegal date in history record:',
			(.RD_IOB[IOB$H_STRING],.RD_IOB[IOB$A_STRING]))) ;
    
	    END ;	! since qualifier present

	! now compare dates
	IF
    	    NOT .F_SINCE_STR
	THEN
    	    BEGIN	! check components of date
	
	    IF
		.REC_YR GTR .PAR_YR
	    THEN
		F_SINCE_STR = TRUE ;

	    IF
		.REC_YR EQL .PAR_YR
	    THEN
		BEGIN	! check month

		IF 
		    .REC_MON GTR .PAR_MON
		THEN
		    F_SINCE_STR = TRUE ;

		IF
		    .REC_MON EQL .PAR_MON
		THEN
		    BEGIN	! check day
			
		    IF 
			.REC_DAY GEQ .PAR_DAY
		    THEN
			F_SINCE_STR = TRUE ;

		    END ;	! check day

		END ;	! check month
	
    	    END ;	! check components of date
	
	!check if we can save time here.
	IF  .F_SINCE_QUA   AND   NOT .F_SINCE_STR
	THEN
	    LEAVE READ_BLOCK;

	! setup
	L_TMP = .RD_IOB[IOB$H_STRING] ;
	P_TMP = .RD_IOB[IOB$A_STRING] ;

	IF
	    CH$RCHAR(.P_TMP) EQL %C' '
	THEN
	    BEGIN
	    P_TMP = CH$PLUS(.P_TMP,1) ;
	    L_TMP = .L_TMP - 1 ;
	    END ;

	! skip out to subcommand field
	INCR INDX FROM 1 TO 4 BY 1 DO
	    BEGIN	! find a blank loop

	    P_SUB = CH$FIND_CH(.L_TMP,.P_TMP,%C' ') ;
	
	    IF
		CH$FAIL(.P_SUB) EQL 1
	    THEN
		BADLIB(CAT('Illegal history file record:',
			(.RD_IOB[IOB$H_STRING],.RD_IOB[IOB$A_STRING]))) ;

	    L_TMP = .L_TMP - CH$DIFF(.P_SUB,.P_TMP) - 1 ;
	    P_TMP = CH$PLUS(.P_SUB,1) ;

	    END ;	! find a blank loop

	! check old format in the record
	IF
	    CH$RCHAR(.P_TMP) NEQ %C'"'
	THEN
	    F_OLD_FMT = TRUE ;

	! select the unusual records
	IF
    	    (.F_UNUSUAL_QUA) AND NOT .F_OLD_FMT
	THEN
    	    BEGIN	! look for /u in subcommand
    	    
    	    ! search for substring "/u"
    	    P_SUB = CH$FIND_SUB(.L_TMP,.P_TMP,.D_UNU_REF[DESC_LEN],
				.D_UNU_REF[DESC_PTR]) ;
    	    IF
    		CH$FAIL(.P_SUB) EQL 0
    	    THEN
    		F_UNU_REC = TRUE ;
	
    	    END ;	! look for /u  in subcommand
	
	! advance to parameter lexeme
	P_SUB = CH$FIND_CH(.L_TMP,.P_TMP,%C' ') ;

	IF
	    CH$FAIL(.P_SUB) EQL 1
	THEN
		BADLIB(CAT('Illegal history file record:',
			(.RD_IOB[IOB$H_STRING],.RD_IOB[IOB$A_STRING]))) ;


	L_TMP = .L_TMP - CH$DIFF(.P_SUB,.P_TMP) - 1 ;
	P_TMP = CH$PLUS(.P_SUB,1) ;

	! select by element
	IF
    	    .F_ELM_REF AND NOT .F_OLD_FMT
	THEN
    	    BEGIN	! look for element name in record
	
    	    IF
    		SELELM(.RD_IOB[IOB$H_STRING],
		       .RD_IOB[IOB$A_STRING],D_ELM_NAM)
    	    THEN
    		F_ELM_MAT = TRUE ;

	    ! selelm uses routines which use $simulate_xpogetmem.
	    ! reset each time to keep dynamic memory usage low.
	    SIMULATE_XPOGETMEM(OPERATION = CLEAR);
	
    	    END ;	! look for element name in record
	
	IF
	    NOT .F_OLD_FMT
	THEN
	    BEGIN	! new format record

	    ! decide whether or not to print this record
	    IF
		((NOT .F_UNUSUAL_QUA) AND
		    ((.F_NO_PARM AND NOT .F_SINCE_QUA) OR
			(.F_SINCE_QUA AND .F_SINCE_STR AND NOT .F_ELM_REF) OR
			(.F_ELM_REF AND .F_ELM_MAT AND NOT .F_SINCE_QUA) OR
			((.F_ELM_REF AND .F_ELM_MAT) AND
			(.F_SINCE_QUA AND .F_SINCE_STR))))
		OR
		((.F_UNUSUAL_QUA) AND 
		    ((.F_NO_PARM AND NOT .F_SINCE_QUA AND .F_UNU_REC) OR
			(.F_SINCE_QUA AND .F_SINCE_STR AND .F_UNU_REC AND 
			    NOT .F_ELM_REF) OR
			(.F_ELM_REF AND .F_ELM_MAT AND .F_UNU_REC AND 
			    NOT .F_SINCE_QUA) OR
			((.F_ELM_REF AND .F_ELM_MAT) AND 
			(.F_SINCE_QUA AND .F_SINCE_STR) AND .F_UNU_REC)))    
	    THEN
    		BEGIN	! print this record
	    

	        OUTLOG(.RD_IOB[IOB$H_STRING],.RD_IOB[IOB$A_STRING]);
	    
		IF
		    NOT .F_OUTPUT
		THEN
    		    F_OUTPUT = TRUE ;
	    
    		END ;	! print this record

	    END		! new format record	
	ELSE
	    BEGIN	! old format record

	    IF
		(NOT .F_SINCE_QUA) OR
		(.F_SINCE_QUA AND .F_SINCE_STR)
	    THEN
		BEGIN

		IF
		    CH$RCHAR(.RD_IOB[IOB$A_STRING]) EQL %C' '
		THEN
		    SAY(SCAT((.RD_IOB[IOB$H_STRING] - 1,
			     CH$PLUS(.RD_IOB[IOB$A_STRING],1))))
		ELSE
		    SAY(RD_IOB[IOB$T_STRING]); 

		IF
		    NOT .F_OUTPUT
		THEN
		    F_OUTPUT = TRUE ;

		END ;

	    END ;	! old format record

	F_UNU_REC = FALSE ;
	F_ELM_MAT = FALSE ;
	F_OLD_FMT = FALSE ;

	END ;	! log file read loop
    
    !close history file

    $STEP_CLOSE(IOB=RD_IOB);

    ! free all dynamic memory allocated during this command
    SIMULATE_XPOGETMEM(OPERATION = FREE_MEM);

    ! 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 SHWLOG of module SHWLOG.')) ;

	END ;

    !+
    ! Check exit conditions
    !+

    IF
    	(.F_SINCE_QUA) AND NOT .F_OUTPUT
    THEN
    	BEGIN	! no records selected on /since
    	sysmsg(s_cantfind,CAT('No such history record'),0) ;
    	RETURN s_cantfind;
    	END ;	! no records selected on /since
    
    IF
    	(.F_UNUSUAL_QUA) AND
    	NOT .F_OUTPUT
    THEN
    	BEGIN	! no unusual events
    	sysmsg(s_nounusual,CAT('No unusual entries in history file'),0) ;
    	RETURN s_nounusual;
    	END;	! no unusual events
    
    IF 
    	NOT .F_OUTPUT
    THEN
    	BEGIN	! no history file entries
    	sysmsg(s_nolog,CAT('No history file entries found'),0);
    	RETURN s_nolog;
    	END;	! no history file entries
    
    s_shwsucc
      
    END;			! end of routine SHWLOG

END				! End of module
ELUDOM