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

MODULE sholib	 (
    		 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:
!	Display users library on the terminal
!
! ENVIRONMENT:
!	VAX/VMS, DS-20
!
! AUTHOR: S. MILLAR, CREATION DATE: 14-JUL-1980
!
! MODIFIED BY:
!
!--
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    sholib ;			! Display and validate users library

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

LIBRARY 'xport:' ;

REQUIRE 'blissx:' ;

REQUIRE 'comusr:' ;

REQUIRE 'sconfg:' ;

REQUIRE 'hosusr:' ;

REQUIRE 'terusr:' ;
!
! MACROS:
!
!
! EQUATED SYMBOLS:
!
!
! OWN STORAGE:
!
!
! EXTERNAL REFERENCES:

EXTERNAL LITERAL

    s_libis,			!library is ...
    s_nolib,			!library not found
    s_notSlib,			!not a library
    s_setlib,			!use SET LIBRARY command
    s_shwsucc,			!success
    s_useverrec;		!last lib trans was not fin. use verif/recover

EXTERNAL
    f_spec_out ;		!special output flag (SHWEXA)


EXTERNAL ROUTINE
    bug,			! Report a problem
    err,
    ers,			! Declare a user mistake
    exqual,			! Examine qualifiers (SHWEXA)
    fuldir,			! Get full directory specification
    islibr,			! Determine if a library exists
    oldtrn,			! Test if last transaction finished.
    setout,			! Close special output file if necessary(TERMIO)
    say,			! send message to user
    trnlog ;			! Translate logical name

GLOBAL ROUTINE sholib (a_qual)  =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine displays the users library on his terminal. It also
!	checks the validity of the library. The library is compared against
!	the logical translation of fac_name$LIB both through the system service
!	$TRNLOG and the service $PARSE. If the library was not initialized
! 	using the SET LIBRARY command the user is notified.
!
! FORMAL PARAMETERS:
!
!	a_qual : address of first qualifier block
!
! IMPLICIT INPUTS:
!
!	none
!
! IMPLICIT OUTPUTS:
!
!	none
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	TRUE if the library is valid, FALSE otherwise.
!
! SIDE EFFECTS:
!
!	none
!
!--

BEGIN			! SHOLIB

OWN

    librar_buf : vector[ch$allocation(256)] ;   ! buffer containing results of
						! logical name translation
LOCAL

    librar_desc :  desc_block ,			! pointer to  logical name buffer

    log_name_desc : desc_block,			! pointer to source logical name

    dir_desc : ref desc_block,			! pointer to buffer of results of FULDIR call

    return_status,				! status of FULDIR call
    status ;					! status of TRNLOG call

! Examine qualifiers
    
    if 
    	not exqual(.a_qual)
    then
    	return k_silent_error ;


!
! Use lib macro to generate fac_name$LIB 
!
    $STR_DESC_INIT(DESCRIPTOR = log_name_desc,
    	           STRING = lit(lib)) ;
!
! Initialize descriptor for results of logical name translation
!
!
    $STR_DESC_INIT(DESCRIPTOR = librar_desc,
    	           STRING = (256, CH$PTR(librar_buf))) ;
!	
! call TRNLOG to get translation of logical name
!	
    status = TRNLOG ( log_name_desc, librar_desc ) ;
!
! Check return status
!
    IF NOT 	.status			!  Problem with logical translation
    THEN
        BEGIN
        err(s_nolib,lit(%string(fac_name,' Library not found'))) ;
    	ers(s_setlib,lit(%string('Use the ',fac_name,' SET LIBRARY command '))) ;
        END;			!  Problem with logical translation

!
! Get full directory specification
!
    dir_desc = fuldir(len_comma_ptr(log_name_desc), return_status, k_null) ;
    IF .dir_desc eql k_null
    THEN				! Problem with library
        BEGIN
        err(s_nolib,lit(%string(fac_name,' library not found'))) ;
        ers(s_setlib,lit(%string('Use the ',fac_name,' SET LIBRARY command '))) ;
        END;			! Problem with library

!
! Test to see if results of fuldir matches that of $TRNLOG
!
    IF NOT CH$EQL( len_comma_ptr(.dir_desc), len_comma_ptr( librar_desc) ) 
    THEN
        ers(s_setlib,lit(%string('Use the ',fac_name,' SET LIBRARY command')));

!
! Test for presence of necessary files
!
    IF NOT islibr ()
    THEN
        BEGIN			! Library not initialized
	err(s_nolib,cat(.dir_desc,%string(' is not a ',fac_name,' library'))) ;
	ers(s_setlib,lit(%string('Use the ',fac_name,' SET LIBRARY command')));
        END				! Library not initialized
    ELSE
        say(cat(%string('Your ',fac_name,' library is '), librar_desc)) ;
				!This must be a "say" and not a "sysmsg"
				!because the output is what was requested
				!by the command...it is the response to
				!the command.  It is NOT a success or failure
				!message from what the command DID.

    if 
    	.f_spec_out
    then
    	if not (setout(k_say_close,k_null,k_null))
    	then
    	    bug(cat('Unable to close output file. error in routine',
    		    'SHOLIB module SHOLIB')) ;

    if oldtrn()
    then
	ers(s_useverrec,lit(%string('The last transaction was not finished;',
			%string('  Use ',fac_name,' VERIFY/RECOVER')))) ;

    RETURN s_shwsucc;
    END;			! SHOLIB

END				! End of module
ELUDOM