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

MODULE SHWSER	(
		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
! TRANSFERRRED.
!
! 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 service routines use in show command processing.
!   These routines are used primarily for printing.
!
! ENVIRONMENT:	VAX/VMS, DS-20
!
! AUTHOR: Robert Wheater, CREATION DATE: 3-Mar-80
!
! MODIFIED BY:
!
!--
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
	FILLSP:NOVALUE,		! fills a field with blanks
	FMTOUT,			! prints formatted output
	GENLIN:NOVALUE,		! prints a generation line
	OUTSHW:NOVALUE,		! builds output buffer and prints
	UNFMTO;			! prints unformated output

!
! 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
        STG(L,M,F) = OUTSHW(CH$PTR(UPLIT(L)),%CHARCOUNT(L),M,F) %;
!
! EQUATED SYMBOLS:
!

LITERAL
	DEF_BUF_INC=100;		!Default buffer increment

!
! OWN STORAGE:
!

OWN
	LINE_BUF : initial(0),			!Pointer to line buffer
	LINE_BUF_SIZE : INITIAL(0),		!Size of current line buffer
	LINEPTR : initial(0);			!pointer to line

!
! EXTERNAL REFERENCES:
!

EXTERNAL
    FIRST ;				! flag for first time on header
					! printing(SHOW)
EXTERNAL LITERAL
    s_formstrng;			!error in format string

EXTERNAL ROUTINE
    BADLIB,				! print bad lib msg and terminate(TERMIO)
    BUG,				! terminate and print message(TERMIO)
    ERS,				! print error message(TERMIO)
    GET_LXM,				! get next lexeme(GETLXM)
    TWIDTH,				! compute terminal width(IOSERV)
    SAYLP ,				! writes mult-line on terminal(TERMIO)
    SAYSLO ;				! write single line output(TERMIO)

GLOBAL ROUTINE FILLSP (CNT) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
!	NONE.
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    !Make sure at least one space is always generated
    STG(' ',FALSE,FALSE);

    !Now generate the remainder
    INCR I FROM 1 TO .CNT-1 DO STG(' ',FALSE,FALSE)

    END;				!End of FILLSP

GLOBAL ROUTINE FMTOUT(REC_LEN,REC_PTR,A_FMTSTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will take the element name from the master
!	control directory record and substitute it into the format
!	string. The resulting image is stored in the output buffer.
!
! FORMAL PARAMETERS:
!
!	REC_LEN		    Length of record in master control directory
!			    file.
!	REC_PTR		    Pointer to record in master control directory
!			    file.
!	A_FMTSTR	    Address of descriptor for format string.
!
! IMPLICIT INPUTS:
!
!	
!
! IMPLICIT OUTPUTS:
!
!	
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	TRUE = record outputted correctly
!	FALSE = record not outputted correctly
!
! SIDE EFFECTS:
!
!	
!
!--

    BEGIN
    
    BIND
	FMT_STR = .A_FMTSTR: DESC_BLOCK ;
	
    LOCAL
	CHAR,				! character save area
	FMT_REM_CNT,			! format remaing count
	LB_PTR,				! pointer to # location
	NAME: VECTOR[CH$ALLOCATION(FILE_SPEC_SIZE)],
	NAME_LEN,			! length of element name
	NAME_PTR,			! pointer to element name
	XFER_LEN,			! length of string to transfer
	XFER_PTR ;			! pointer of string to transfer
	
    ! initialize name pointer
    NAME_PTR = CH$PTR(NAME) ;
    ! save element name
    NAME_LEN = GET_LXM(REC_PTR,%C' ',.REC_LEN,NAME_PTR) ;
    ! reset name pointer to point to start of name
    NAME_PTR = CH$PTR(NAME) ;

    ! initialize format string length and pointer
    FMT_REM_CNT = .FMT_STR[DESC_LEN] ;
    XFER_PTR = .FMT_STR[DESC_PTR] ;
    ! Scan format string and do substitution
    
    UNTIL
	(FMT_REM_CNT EQL 0)
    DO
	BEGIN	    ! scan fmt str
	! look for a #
	LB_PTR = CH$FIND_CH(.FMT_REM_CNT,.XFER_PTR,%C'#') ;
	IF
	    (CH$FAIL(.LB_PTR) EQL 1)
	THEN
	    BEGIN	! no # in string
	    ! transfer complete string
	    OUTSHW(.XFER_PTR,.FMT_REM_CNT,FALSE,FALSE) ;
	    EXITLOOP ;
	    END ;	! end no # in string
	! get length up to #
	XFER_LEN = CH$DIFF(.LB_PTR,.XFER_PTR) ;
	OUTSHW(.XFER_PTR,.XFER_LEN,FALSE,FALSE) ;
	! adjust remaining count
	FMT_REM_CNT = .FMT_REM_CNT-.XFER_LEN-2 ;

	! look at char after #
	CHAR = CH$RCHAR_A(LB_PTR) ;	! # char
	CHAR = CH$RCHAR_A(LB_PTR) ;	! save char after #

	SELECTONE .CHAR OF
	    SET
	    
	    [%C'E',%C'e']:
		OUTSHW(.NAME_PTR,.NAME_LEN,FALSE,FALSE) ;
	    
	    [%C'#']:
		STG('#',FALSE,FALSE) ;
		
	    [OTHERWISE]:
		BEGIN	    ! illegal sequence
		ERS(s_formstrng,CAT('Illegal format string:',
				(2,CH$PLUS(.LB_PTR,-2)))) ;
		RETURN FALSE ;
		END ;	    ! end illegal sequence
	    TES;
	    
	! update ptr for next iteration
	XFER_PTR = .LB_PTR ;
	
	END ;	    ! end scan fmt str
	
    OUTSHW(0,0,TRUE,FALSE) ;

    TRUE
    	
    END;

GLOBAL ROUTINE GENLIN(ELM_LEN,ELM_PTR,IMAGE_LEN,IMAGE_PTR):NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine takes the element name and the generation
!	information image as input and generates the output image.
!
! FORMAL PARAMETERS:
!
!	ELM_LEN		Length of element name.
!
!	ELM_PTR		Pointer to element name.
!
!	IMAGE_LEN	Length of generation information image.
!
!	IMAGE_PTR	Pointer to generation information image.
!
! IMPLICIT INPUTS:
!
!	
!
! IMPLICIT OUTPUTS:
!
!	
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	none.
!
! SIDE EFFECTS:
!
!	
!
!--

    BEGIN
    
    LOCAL
	GEN_REF_LEN,
	REM_IMAGE_LEN,
	REM_IMAGE_PTR ;
	
	
    ! put element name in buffer
    OUTSHW(.ELM_PTR,.ELM_LEN,FALSE,TRUE) ;
    STG('(',FALSE,FALSE) ;
    
    ! extract generation ref and put in output buffer
    REM_IMAGE_LEN = .IMAGE_LEN ;
    REM_IMAGE_PTR = .IMAGE_PTR ;
    
    GEN_REF_LEN = CH$FIND_CH(.REM_IMAGE_LEN,.REM_IMAGE_PTR,%C' ') ;
    IF
	(CH$FAIL(.GEN_REF_LEN) EQL 1)
    THEN
	BUG(CAT('There is no blank delimiter in file ',
		(.ELM_LEN,.ELM_PTR),' after the generation ',
		'reference;  error occurred in routine GENLIN ',
		'of module STSHOW')) ;
    GEN_REF_LEN = CH$DIFF(.GEN_REF_LEN,.REM_IMAGE_PTR) ;
    
    ! advance over + sign
    REM_IMAGE_PTR = CH$PLUS(.REM_IMAGE_PTR,1) ;
    GEN_REF_LEN = .GEN_REF_LEN-1 ;
    OUTSHW(.REM_IMAGE_PTR,.GEN_REF_LEN,FALSE,TRUE) ;
    STG(') ',FALSE,FALSE) ;
    
    ! adjust ptr and len to point beyond blank that follows gen ref
    REM_IMAGE_PTR = CH$PLUS(.REM_IMAGE_PTR,.GEN_REF_LEN+1) ;
    REM_IMAGE_LEN = .REM_IMAGE_LEN-.GEN_REF_LEN-2 ;
    
    ! output rest of image
    OUTSHW(.REM_IMAGE_PTR,.REM_IMAGE_LEN,TRUE,TRUE) ;
    END ;	! end of routine genlin

GLOBAL ROUTINE OUTSHW (PTR,LGT,TERM,FORMAT) :NOVALUE =	!

!++
! FUNCTIONAL DESCRIPTION:
!
!	Put a string into the output buffer and output it if desired.
!
! FORMAL PARAMETERS:
!
!	PTR - Pointer to string
!	LGT - length of string
!	TERM - if true, output the complete line
!	FORMAT - if true, use multiline formatted output.
!		 if false, output single line.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    !Move text into buffer if there is any
    IF
	.PTR NEQ 0 AND
	.LGT GTR 0
    THEN
	BEGIN

	local
	    max_size_needed;

	if
	    .lineptr eql 0
	then
	    max_size_needed=.lgt
	else
	    max_size_needed=ch$diff(.lineptr,.line_buf)+.lgt;

	!See if room exists
	IF
	    .max_size_needed GTR .LINE_BUF_SIZE
	THEN
	    !Get a new buffer which is large enough to continue
	    BEGIN

	    LOCAL
		size_to_allocate,
		T_BUF,
		T_PTR;

	    !Allocate new storage for output buffer
	    IF
		.max_size_needed GTR 5000
	    THEN
		BUG(LIT('Text buffer overflow in OUTSHW'));

	    size_to_allocate=.max_size_needed+def_buf_inc;

	    $XPO_GET_MEM(CHARACTERS=.size_to_allocate,RESULT=T_BUF);
	    T_PTR=.T_BUF;

	    !Transfer the existing text to the new larger buffer
	    IF
		.LINE_BUF_SIZE NEQ 0
	    THEN
		BEGIN
		T_PTR=CH$MOVE(CH$DIFF(.LINEPTR,.LINE_BUF),.LINE_BUF,.T_PTR);

		!Return old buffer to free storage
		$XPO_FREE_MEM(STRING=(.LINE_BUF_SIZE,.LINE_BUF))
		END;

	    !Set pointers to user buffer and set new buffer size
	    LINEPTR=.T_PTR;
	    LINE_BUF=.T_BUF;
	    LINE_BUF_SIZE=.size_to_allocate
	    END;

	LINEPTR=CH$MOVE(.LGT,.PTR,.LINEPTR)

	END;

    !See if line is to be terminated and output
    IF
	.TERM
    THEN
	BEGIN

	LOCAL
	    CNT;

	!See how many characters there are
	CNT=CH$DIFF(.LINEPTR,.line_buf);

	if
	   .FORMAT
	THEN
	    !Output the entire line (formatted,multiline output)
	    SAYLP(.CNT,.line_buf)
	ELSE
	    ! output single line (unformatted)
	    SAYSLO(.CNT,.line_buf) ;

	!Now reset the buffer pointer
	LINEPTR=.line_buf

	END;

    END;			!End of OUTSHW

GLOBAL ROUTINE UNFMTO(REC_LEN,REC_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine takes a record from the master control directory
!	file and generates an output record in the format required
!	by the SHOW ELEMENTS command which does not have a format
!	qualifier.
!
! FORMAL PARAMETERS:
!
!	REC_LEN		    Length of record in master control directory
!			    file.
!	REC_PTR		    Pointer to record in master control directory
!			    file.
!	FIRST_PASS	    TRUE = First pass through routine.
!
! IMPLICIT INPUTS:
!
!	
!
! IMPLICIT OUTPUTS:
!
!	
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	TRUE = Record outputted correctly.
!	FALSE = Record not outputted correctly.
!
! SIDE EFFECTS:
!
!	
!
!--
    BEGIN
    
    OWN
	TER_WID ;		    ! terminal width
    LOCAL
        CHAR_SAVE,		    ! save character 
	DELIM_PTR,		    ! pointer to delimiter
	FIL_NAM_LEN,		    ! length count of file name
	L_TMP,			    ! temp length and pointer
	P_TMP,			    ! 
	QUO_FLG,		    ! flag str of quoted string
	QUO_PTR,		    ! pointer used in quote char scan
	REC_REM_LEN,		    ! record remain length
	REC_CUR_PTR ;		    ! pointer to record
	

    ! compute width of terminal
    TWIDTH(TER_WID) ;

    !Put out heading on first time through
    IF
        .FIRST
    THEN
        BEGIN
        ! print heading if no format qualifier
        STG('Element             .... Files contained in element ....',TRUE,FALSE);
        FIRST=FALSE
        END;

    ! initialize values
    REC_REM_LEN = .REC_LEN ;
    REC_CUR_PTR = .REC_PTR ;
    ! put filename to output buffer
    DELIM_PTR=CH$FIND_CH(.REC_REM_LEN,.REC_CUR_PTR,%C' ') ;
    IF
	CH$FAIL(.DELIM_PTR)
    THEN
	BADLIB(CAT('Missing blank delimiter following the element name in the',
		' master control file ')) ;
    FIL_NAM_LEN = CH$DIFF(.DELIM_PTR,.REC_CUR_PTR) ;
    OUTSHW(.REC_CUR_PTR,.FIL_NAM_LEN,FALSE,TRUE) ;
    ! update pointer for file names
    REC_CUR_PTR = CH$PLUS(.REC_CUR_PTR,.FIL_NAM_LEN+1) ;
    REC_REM_LEN = .REC_REM_LEN-.FIL_NAM_LEN-1 ;
    ! blank fill out to column 20
    FILLSP(20-.FIL_NAM_LEN) ;

    IF
	.REC_REM_LEN LSS (.TER_WID - 20)
    THEN
	OUTSHW(.REC_CUR_PTR,.REC_REM_LEN,TRUE,TRUE) 
    ELSE
	BEGIN	! longer than one line
	L_TMP = .TER_WID - 20 ;
	P_TMP = .REC_CUR_PTR ;
	OUTSHW(.P_TMP,.L_TMP,TRUE,TRUE) ;

	! update remaining length and pointer
	REC_REM_LEN = .REC_REM_LEN - .L_TMP ;
	REC_CUR_PTR = CH$PLUS(.REC_CUR_PTR,.L_TMP) ;

	UNTIL
	    .REC_REM_LEN LEQ 0
	DO
	    BEGIN	! put out second part of image

	    FILLSP(20) ;
	    P_TMP = .REC_CUR_PTR ;
	    IF
	        .REC_REM_LEN LSS .L_TMP
	    THEN
		BEGIN
		OUTSHW(.P_TMP,.REC_REM_LEN,TRUE,TRUE) ;
		EXITLOOP ;
		END
	    ELSE
	        OUTSHW(.P_TMP,.L_TMP,TRUE,TRUE) ;

	    ! update pointer and length
	    REC_REM_LEN = .REC_REM_LEN - .L_TMP ;
	    REC_CUR_PTR = CH$PLUS(.REC_CUR_PTR,.L_TMP) ;

	    END ;	! put out second part of image

	END ;	! longer than one line

    TRUE	
    END;	! end of routine UNFMTO

END				! End of module
ELUDOM