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

MODULE LIBRAR	(
		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:
!
!	INITIALIZE and SET LIBRARY commands.
!
! ENVIRONMENT:	VAX/VMS, DS-20
!
! AUTHOR: D. Knight , CREATION DATE: 15-May-79
!
!--

!
! TABLE OF CONTENTS
!

FORWARD ROUTINE
	LIBRAR,				! Main routine for the command.
	CRE_FILE,			! Local routine to create file
	INIT;				! Process INITIALIZE.

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

LIBRARY 'XPORT:';			!XPORT I/O macros

REQUIRE 'SCONFG:';			!configuration options

REQUIRE 'BLISSX:';

REQUIRE 'COMUSR:';

REQUIRE 'HOSUSR:';

REQUIRE 'LOGUSR:';

REQUIRE 'SHRUSR:';

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!

GLOBAL
    f_del_log : initial(0);	!during rollback delete cms$lib:
!
! EXTERNAL REFERENCES:
!

external literal
        s_baddir,		!default idr is a CMS lib
	s_dnotempty,		!dir .DIR_SPEC is not empty
	s_errname,		!don't use LOG_NAME in dir specifications
	s_initlib,		!library initialized
	s_libis,		!library is . . .
	s_undeflib,		!library is now undefined
	s_dntfound,		!dir PAR[PAR_TEXT] not found
	s_noopen,		!Can not open output file 
	s_notSlib,		!not a library
	s_useverrec;		!use verify/recover--last transaction not fin.

EXTERNAL ROUTINE
	BADLIB,			! Report a problem with the library.
	BEGTRN,			! Begin a transaction.
	BUG,			! Report a bug.
	COMAND,			! Parse a command.
	CRELOG : NOVALUE,	! Create a logical name
	DELLOG,			! Delete a logical name
	DONLIB,			! Finished with the library.
	ENDTRN,			! End a transaction.
	err,			! report a user error
	ERS,			! Report a user mistake and don't return.
	ersxpo,			! Report error w/xport status and don't return
	exits,			! exit silently
	CMSDIR,			! Get full specification of a directory.
        isdir,			! Test directory exists.
	ISFILE,			! Test if a file exists.
    	ISLIBR,			! Test if a library exists.
	LOCALF,			! Report attempt to use the network.
	LOGTRN,			! write log entry(IOLOG)
	OLDTRN,			! Test if the previous transaction finished.
	SAFLIB,			! Secure the library.
	sysmsg,			! Talk to the user.
	TRNFIL;			! Set characteristics of a transaction file.

GLOBAL ROUTINE LIBRAR (CMD,PAR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Perform the INITIALIZE and SET LIBRARY commands.
!
! FORMAL PARAMETERS:
!
!	CMD - Value of command being processed
!	PAR - address of first parameter block entry
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	One of the codes defined in HOSUSR.REQ .
!
! SIDE EFFECTS:
!
!	The library is checked or initialized, and the logical name
!	fac_name$LIB is defined.  If the check or initialization is 
!	unsuccessful, the definition of fac_name$LIB is deleted.  This 
!	means that any previous	definition of fac_name$LIB will be lost.
!
!--

    BEGIN

    MAP
	PAR : REF PARAMETER_BLOCK;	! Address of the first parameter block.

    LOCAL
	R_DIR_SPEC : REF DESC_BLOCK,	! Full directory specification.
	RESULT,				! Routine's value after SAFLIB called.
        FOR_LIB,			! We are interrested in libraries.
        is_library,			! Is the library a CMS library?
	VALID;				! Directory specification well formed.

    ROUTINE ERR_NO_LIBRARY =
	ERS(s_undeflib,LIT(%string(fac_name,' library is now undefined'))) ;

    !Any error will leave fac_name$LIB undefined.
    DELLOG(LIT(LIB)) ;

    ! Prevent network operations in this release.
    IF
	NOT LOCALF(.PAR[PAR_TEXT_LEN], .PAR[PAR_TEXT_PTR])
    THEN
	ERR_NO_LIBRARY() ;

    ! Give a reasonable message if the directory specification begins with
    ! fac_name$LIB .  (Any indirect use of fac_name$LIB will be reported 
    ! by CMSDIR in a possibly obscure way.)


    BEGIN		! Look for illegal device specification
	LOCAL
	    LOG_NAME : DESC_BLOCK ;	! illegal device specification

	$STR_DESC_INIT(DESCRIPTOR = LOG_NAME,
			STRING = (%CHARCOUNT(LIB) - 1, CH$PTR(UPLIT(LIB)))) ;
	IF
	    CH$EQL(.LOG_NAME[DESC_LEN], .PAR[PAR_TEXT_PTR],
		  LEN_COMMA_PTR(LOG_NAME))
	THEN
	    BEGIN	! fac_name$LIB in directory specification.
	    ERR(S_ERRNAME,CAT('Do not use ', LOG_NAME,' in your directory specification')) ;
	    ERR_NO_LIBRARY() ;
            END ;	! fac_name$LIB in directory specification.

    END ;		! Look for illegal device specification

    ! Make sure the library directory exists, and get its full specification.
    R_DIR_SPEC = CMSDIR(LEN_COMMA_PTR(PAR[PAR_TEXT]), VALID, FOR_LIB);
    IF
	.R_DIR_SPEC EQL K_NULL
    THEN
	BEGIN	! Problem with library directory specification.

	! Supply error message if not already given.
	IF
	    .VALID
	THEN
	    ERR(s_dntfound,CAT('Directory ', PAR[PAR_TEXT], ' not found')) ;
	ERR_NO_LIBRARY() ;
	END ;	! Problem with library directory specification.

    ! If the default directory exists, make sure it is not the library.
    if isdir(len_comma_ptr(''), valid, is_library)
    then
	begin	! default directory is present.
	if .is_library
	then
	    begin	! Bad default directory.
	    err(s_baddir,
		lit(%string('Your default directory cannot be the ',
				fac_name,' library'))) ;
            ERR_NO_LIBRARY() ;
	    end ;	! Bad default directory.
	end ;	! default directory is present.

    IF .cmd EQL k_initialize_com
    THEN
 	f_del_log = true;

    ! Define the logical name for the library.
    ! (We need a handler to delete this name in case of a signal.)
    CRELOG(LIT(LIB), .R_DIR_SPEC) ;

    ! See if the library must be initialized.
    IF
	.CMD EQL K_INITIALIZE_COM
    THEN
	begin
	RESULT = INIT(.R_DIR_SPEC);
	! Report that we have a library, or delete the logical name fac_name$LIB .
	IF
	    .RESULT
	THEN
	    BEGIN		! We have a library.
	    sysmsg(s_initlib,
		CAT(%string(fac_name,' library '), .R_DIR_SPEC, ' initialized'),0);
	    exits(s_initlib)
	    end
	ELSE
	    BEGIN		! We do not have a library.
	    DELLOG(LIT(LIB)) ;
	    ERR_NO_LIBRARY() 
	    END 		! We do not have a library.
	end
    ELSE
	BEGIN	! The library should already exist.

	! Make sure some necessary files are present.
	IF
	    NOT islibr()
	THEN
	    BEGIN	! Not a library.
	    ERR(S_NOTSLIB,CAT(.R_DIR_SPEC,
			%string(' is not a ',fac_name,' library'))) ;
	    dellog(lit(lib));
	    err_no_library()
	    END		! Not a library.
	ELSE
	    BEGIN	! The library is old.
	    IF OLDTRN()
	    THEN
		BEGIN	! The library is bad.
	        sysmsg(s_libis,CAT(%string('Your ',fac_name,' library is '),
		    .R_DIR_SPEC),0);
		ERS(S_USEVERREC,lit(%STRING('The last transaction was not finished;',
		    %string('  Use ',fac_name,' VERIFY/RECOVER')))) ;
		! Do not delete the logical name, so V/R will run.
		END ;	! The library is bad.
	    sysmsg(s_libis,CAT(%string('Your ',fac_name,' library is '), .R_DIR_SPEC),0);
	    exits(s_libis)
	    END	! The library is old.
	
	END	! The library should already exist.

    END;				!End of LIBRAR

ROUTINE CRE_FILE (a_d_file_name, f_write_crc) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Create a library file as needed by the INITIALIZE command.
!
! FORMAL PARAMETERS:
!
!	D_FILE_NAME:	String descriptor filename to be created
!	F_WRITE_CRC:	Flag
!			    TRUE  = write a crc record into file
!			    False = do not write a crc record into file	
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	STEP$_CREATED or a failure completion code
!
! SIDE EFFECTS:
!
!	The file is created and entered into the ROLBCK data base
!
!--

    BEGIN
    BIND
	d_file_name = .a_d_file_name : $str_descriptor();

    OWN
	d_initial_crc :				! initial CRC or CHECKSUM for files
	    $str_descriptor(class = fixed,
			    string = '*/C:00000000');	    ! 32 bit hex

    LOCAL
    	status,					! XPORT status code
	$io_block_decl(WRT) ;			! IOB for creating files.

    !Initialize the IOB.
    $io_block_init(WRT);

    status = $step_open (iob       = wrt_iob,
			 file_spec = d_file_name,
			 options   = append,
			 failure   = 0);

    if .status neq step$_created
    then
	return .status;

    ! Mark the reservation file as part of this transaction and close it.
    TRNFIL(WRT_IOB) ;		

    ! Write out a dummy CRC line if necessary
    if .f_write_crc
    then
	$step_put(IOB = wrt_iob, 
		  STRING = d_initial_crc);

    $step_close(IOB = wrt_iob);

    RETURN step$_created;

    END;  !(of routine CRE_FILE)

ROUTINE INIT (DIR_SPEC) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Process the LIBRARY/INITIALIZE command.  The fac_name$LIB logical name is
!	assumed to be defined and to denote an existing directory.
!
! FORMAL PARAMETERS:
!
!	DIR_SPEC:	Address of a descriptor of the full directory
!			specification, for use in error messages.
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	The code to be returned by the main program for this command.
!
! SIDE EFFECTS:
!
!	The library is initialized.
!
!--

    BEGIN	! INIT

    MAP
	DIR_SPEC : REF DESC_BLOCK;

    LOCAL
	STATUS;				! XPORT status code.


    ! Make sure the directory is empty,
    IF ISFILE(LEN_COMMA_PTR(%STRING(LIB,'*.*')), K_NULL)
    THEN
	BEGIN	! Non-empty directory.
	ERR(S_DNOTEMPTY,CAT('Directory ', .DIR_SPEC, ' is not empty')) ;
	RETURN K_SILENT_SEVERE ;
	END ;	! Non-empty directory.

    ! Secure the library for initialization.
    IF NOT SAFLIB(K_INITIALIZE_LIB)
    THEN
	RETURN K_SILENT_SEVERE ;

    ! Start the initialization transaction.
    BEGTRN() ;


    ! First create the error logging file.
    IF
	(status=cre_file(lit(%string(lib,erlg)), false)) neq step$_created
    THEN
	ERSXPO(s_noopen, .STATUS, LIT('Cannot create the error logging file'));


    !Set up reservation file
    IF
	(status=cre_file(lit(%string(lib,res)), true)) neq step$_created
    THEN
	ERSXPO(s_noopen, .STATUS, LIT('Cannot create the reservation file'));


!    !Now build the new log file
!    IF
!	(status=cre_file(lit(%string(lib,log)), false)) neq step$_created
!    THEN
!	ERSXPO(s_noopen, .STATUS, LIT('Cannot create the history file'));


    !Now build the new definition file
    IF
	(status=cre_file(lit(%string(lib,cdir)), true)) neq step$_created
    THEN
	ERSXPO(s_noopen, .STATUS, LIT('Cannot create the definition file'));


    !Now build the new attribute file
    IF
	(status=cre_file(lit(%string(lib,atf)), true)) neq step$_created
    THEN
	ERSXPO(s_noopen, .STATUS, LIT('Cannot create the class file'));


    ! log this transaction;  this has side effect of creating the history file
    IF
	NOT LOGTRN(K_NORMAL_LOG,0,K_NULL)
    THEN
	BUG(CAT('Unable to write log record;  error occurred in routine ',
		'INIT in module LIBRAR')) ;

    ! End the transaction.
    ENDTRN() ;

    !we're done
    f_del_log = false;

    ! Finished with the library.
    DONLIB() ;

    K_SUCCESS
    END;				!End of INIT

END					!End of Module LIBRAR
ELUDOM