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

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

!
!			  COPYRIGHT (c) 1982, 1983 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 command processing for the DELETE CLASS and 
!    DELETE ELEMENT commands.
!
! ENVIRONMENT: VAX/VMS, DS-20
!
! AUTHOR: Robert Wheater CREATION DATE: 1-APR-80
!
!--

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
	DELELM,			! Delete element from control directory
	DELFLS,			! Delete file from library
	ERASE,			! Dispatcher for delete command
	ERSCLS,			! DELETE processing for classes
	ERSELM ;		! DELETE processing for elements

!
! INCLUDE FILES:
!

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

LIBRARY 'XPORT:' ;

REQUIRE 'BLISSX:' ;

REQUIRE 'COMUSR:' ;

REQUIRE 'HOSUSR:' ;

REQUIRE 'LOGUSR:' ;

REQUIRE 'SCONFG:' ;

REQUIRE 'SHRUSR:' ;

!
! MACROS:
!
MACRO
    BLD_LOG_NAM(S,L,P) = ! S = logical name string
			 ! L = length of filename
			 ! P = pointer to filename string
			 P_LOG_NAM = CH$PTR(M_LOG_NAM) ;
			 P_LOG_NAM = CH$MOVE(%CHARCOUNT(S),
				     CH$PTR(UPLIT(S)),.P_LOG_NAM);
			 P_LOG_NAM = CH$MOVE(L,P,.P_LOG_NAM) ;
			 L_LOG_NAM = CH$DIFF(.P_LOG_NAM,CH$PTR(M_LOG_NAM)) ;
			 P_LOG_NAM = CH$PTR(M_LOG_NAM); %,

     STG(L,M) = OUTSTG(CH$PTR(UPLIT(L)),%CHARCOUNT(L),M) %;

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!
OWN
    L_LOG_NAM,			    ! length of logical name
    M_LOG_NAM: VECTOR[CH$ALLOCATION(extended_file_spec)],
				    ! storage area for logical name
    P_LOG_NAM ;			    ! pointer to logical name

OWN
	$IO_BLOCK(LLIB),
	$IO_BLOCK(LIB_W) ;

!
! EXTERNAL REFERENCES:
!

external literal

	s_delcls,
	s_elmdel,		!element deleted from library.
	s_elresr,		!element reserved. Can't delete.
	s_haselem,		!contains l or more elem. Can't delete.
	s_invcksum,		!definition file has an inv cksum
	s_invsubc,		!invalid subcommand specified
        s_nodelete,		!file not deleted because it didnt physically exist in lib
	s_nocksum,		!definition file has no checksum
	s_noclassf,		!class not found
	s_noelem,		!element not found in library
	s_noqual,		!no qualifier is present
	s_conffail,		!can not be confirmed
	s_spcclass;		!can't delete as it belongs to follow. classes 

EXTERNAL ROUTINE
	ASCHEX,			! ASCII to hex (ASCDEC)
	BADLIB,			! print bad library message(TERMIO)
	badxpo,
	BEGTRN,			! begin transaction(TRANSA)
	BUG,			! print bug message(TERMIO)
	BUGXPO,			! print xport bug message(TERMIO)
	CANTRN,			! cancel transaction(TERMIO)
	CHKRES,			! check for reservations(CHKRES)
	COMAND,			! Analyze command(COMAND)
	CRCTABLE : NOVALUE,	! Set up polynomial table (CRCOPS)
	CRCCALC,		! Calculate the CRC of a string (CRCOPS)
	DELETE_OR_RENAME,	! delete the file or rename if protected.
	DELVRS,			! delete versions of the file(FILOPS)
	DONLIB,			! release library(TRANSA)
	ENDTRN,			! end of transaction(TRANSA)
	err,
	ERS,			! print error message(TERMIO)
	exits,			! exit silently
	GETCLS, 		! get names of classes(ATTRIB)
	GETELM,			! get element and call routine(GETELM)
	GET_LXM,		! get lexeme(GETLXM)
	HEXASZ,			! Hex to ASCII (DECASC)
	LOGTRN,			! write log entry
	REPRES,			! report reservation(CHKRES)
	SAFLIB,			! request access to library(TRANSA)
	sysmsg,
	TRNFIL,			! register file for recovery(TRANSA)
 	trnlog,			! translate a logical name
	YES ;			! yes or no response to message(TERMIO)

ROUTINE DELELM (L_ELM,P_ELM,A_L_FIL_STR,A_P_FIL_STR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will delete an element from the master control
!	directory.	
!
! FORMAL PARAMETERS:
!
!	L_ELM		Length of element string.
!
!	P_ELM		Pointer to element string.
!
!	A_L_FIL_STR	Address of Length of  filenames string for this element.
!
!	A_P_FIL_STR	Address of Pointer to filenames string for this element.
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	TRUE - element deleted
!	FALSE - element not found
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    BIND
	FIL_STR_LEN = .A_L_FIL_STR,
	FIL_STR_PTR = .A_P_FIL_STR ;

    LOCAL
	D_FIL_SPC: DESC_BLOCK,
	existing_crc,		 ! CRC already in file 
	found_crc,		 ! Found an exisiting CRC
	F_ELM_DEL, 		 ! element deleted
	
	L_FIL_STR,		 ! length of file string
	L_REM,			 ! length remaining
	new_crc,		 ! Newly calculated CRC
	old_crc,		 ! Re-calculated CRC
	
	P_FIL_STR,		 ! pointer to file string
	status;

    ! Initialize delete flag
    F_ELM_DEL = FALSE ;

    !Open reservation control files
    if
	(status=$STEP_OPEN(IOB=llib_iob,FILE_SPEC=(%STRING(LIB,CDIR)),
		OPTIONS=INPUT,failure=0)) neq step$_normal
    then
	badxpo(.status,lit('Cannot open definition file. '));
    if
	(status=$STEP_OPEN(IOB=LIB_W_IOB,FILE_SPEC=(%STRING(LIB,CDIR)),
		OPTIONS=OUTPUT,failure=0)) neq step$_created
    then
	badxpo(.status,lit('Cannot open new definition file'));

    ! register for crash recovery
    TRNFIL(LIB_W_IOB);

    ! Set up polynomial table and zero accumulators   
    crctable();
    existing_crc = 0;
    found_crc = false;
    new_crc = 0;
    old_crc = 0;

    !Search for the correct name
    UNTIL
	$step_get(IOB=llib_iob) EQL step$_eof
    DO
	BEGIN		! copy loop

	LOCAL
	    ELM_NAM : VECTOR[CH$ALLOCATION(EL_NAM_SIZE)],
	    ELM_PTR,
	    ELM_SIZ,
	    TMP_PTR;
	
	! Check to see if this is the CRC control line
	if ch$eql(4,ch$ptr(uplit('*/C:')),4,.llib_iob[iob$a_string])
	then
	    begin
	    local
		len,
		ptr ;
	    len = .llib_iob[iob$h_string] - 4;
	    ptr = ch$plus( .llib_iob[iob$a_string],4) ;
	    existing_crc = aschex ( ptr,len) ;
	    found_crc = true;
	    exitloop ;
	    end;

	! Calculate the CRC of this line
	old_crc = .old_crc +
		 crccalc(.llib_iob[iob$h_string], .llib_iob[iob$a_string]) ;

	!Get the element name from the control line
	TMP_PTR=.llib_iob[IOB$A_STRING];
	ELM_PTR=CH$PTR(ELM_NAM);
	ELM_SIZ=GET_LXM(TMP_PTR,%C' ',.llib_iob[IOB$H_STRING],ELM_PTR);

	IF
	    CH$EQL(.L_ELM,.P_ELM,.ELM_SIZ,CH$PTR(ELM_NAM))
	    AND NOT .F_ELM_DEL
	THEN
	    BEGIN	! save list of filenames
	    F_ELM_DEL = TRUE ;
	    L_REM = .llib_iob[IOB$H_STRING]-.ELM_SIZ-1 ;
	    ! get memory for filenames string
	    $XPO_GET_MEM(CHARACTERS=.L_REM,RESULT=P_FIL_STR) ;

	    ! now get string
	    FIL_STR_PTR = .P_FIL_STR ;
	    ch$move(.l_rem,.tmp_ptr,.p_fil_str) ;
	    FIL_STR_LEN = .l_rem ;
	    END 	! save list of filenames
	ELSE
	   !Write out the line
	   begin
	   new_crc = .new_crc + 
		 crccalc(.llib_iob[iob$h_string], .llib_iob[iob$a_string]) ;
	   $step_put(IOB=LIB_W_IOB,STRING=llib_iob[IOB$T_STRING]);
	   end;

	END;

    ! Check CRC's to make sure the file is ok
    IF NOT .FOUND_CRC
    THEN
	SYSMSG(s_nocksum,CAT('Definition file has no checksum'),0)
    ELSE
    IF .EXISTING_CRC NEQ .OLD_CRC
    THEN
	SYSMSG(s_invcksum,CAT('Definition file has an invalid checksum'),0);

    IF
	NOT .F_ELM_DEL
    THEN
	BEGIN		! element not deleted
	! leave original file intact
	$step_close(IOB=llib_iob) ;
	! get rid of new file
	!   LET ROLL BACK DO THE CLOSE AND DELETE.
	! $step_close(IOB=LIB_W_IOB,OPTIONS=REMEMBER,FAILURE=0) ;
	! $STEP_DELETE(IOB=LIB_W_IOB) ;
	RETURN FALSE ;
	END 		! element not deleted
    ELSE
	BEGIN		! element deleted
	local
	    len,
	    num_buf :vector[ch$allocation(max_num_size+5)],
	    ptr;
 
	! leave new file intact
	! but first write out new CRC
	ptr = ch$move(4,ch$ptr(uplit('*/C:')),ch$ptr(num_buf)) ;
	len = hexasz( .new_crc, .ptr, 8 );
	ptr = ch$plus(.ptr, .len) ;
	ch$wchar(%c' ', .ptr );
	len = .len + 5;
	$step_put ( iob = lib_w_iob, string = (.len, ch$ptr(num_buf)),
		   failure = 0 ) ;
	$step_CLOSE(IOB=LIB_W_IOB) ;

	! get rid of old file
	$step_close(IOB=llib_iob) ;
	$STR_DESC_INIT(DESCRIPTOR=D_FIL_SPC,STRING=(%STRING(LIB,CDIR))) ;
	DELVRS(FILVRS,.D_FIL_SPC[DESC_LEN],.D_FIL_SPC[DESC_PTR]) ;
	RETURN TRUE ;
	END ;		! element deleted

    END;				!End of DELELM

ROUTINE DELFLS(L_FIL_STR,P_FIL_STR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will delete a file from the library by deleting
!	all of its files.
!
! FORMAL PARAMETERS:
!
!	L_FIL_STR	Length of filenames string.
!
!	P_FIL_STR	Pointer to filenames string.
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	TRUE = deletion performed properly
!	No return after error message for bad lib if unable to delete file.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN
    
    LOCAL
	d_file_name : $str_desc(),
	F_ODD_QUO,		! set when odd number quote encountered
	L_FIL_NAM,		! length of individual filename string
	L_TMP,			! length remaining in string

	P_FIL_NAM,		! pointer to individual file name string
	P_STR_FIL,		! pointer to start of file name
	P_TMP ;			! temporary work pointer



    ! initialize flag
    f_odd_quo = false ;

    ! initialize pointers
    L_TMP = .L_FIL_STR ;
    P_TMP = .P_FIL_STR ;    
    P_STR_FIL = .P_FIL_STR ;

    UNTIL
	.L_TMP EQL 0
    DO
	BEGIN 	! scan filenames string

	LOCAL
	    CHAR ;

	CHAR = CH$RCHAR_A(P_TMP) ;
	L_TMP = .L_TMP - 1 ;
	
	IF
	    .CHAR EQL %C'"'
	THEN
	    BEGIN	! set flag

	    IF
		.F_ODD_QUO
	    THEN
		F_ODD_QUO = FALSE
	    ELSE 
		F_ODD_QUO = TRUE ;

	    END ;	! set flag

	IF
	    NOT .F_ODD_QUO
	THEN
	    BEGIN	! not in quoted string

	    IF
		.CHAR EQL %C'/'
	    THEN
		BEGIN	! end of filename

		L_FIL_NAM = CH$DIFF(CH$PLUS(.P_TMP,-1),.P_STR_FIL) ;
		P_FIL_NAM = .P_STR_FIL ;

        	! build library name
        	BLD_LOG_NAM(LIB,.L_FIL_NAM,.P_FIL_NAM) ;


 		$str_desc_init(descriptor = d_file_name,
 			       string=(.l_log_nam,.p_log_nam));
		IF
	    	    NOT delete_or_rename(d_file_name)
		THEN
		    err(s_nodelete,CAT((.L_LOG_NAM,.P_LOG_NAM), 
				' has already been deleted -  not by CMS!')) ;

		UNTIL
		    .L_TMP EQL 0
		DO
		    BEGIN	! search for comma

		    CHAR = CH$RCHAR_A(P_TMP) ;
		    L_TMP = .L_TMP - 1 ;

		    IF
			.CHAR EQL %C','
		    THEN
			EXITLOOP ;

		    END ;	!search for comma

		P_STR_FIL = .P_TMP ;

		! prevent further comma processing
		CHAR = 0 ;

		END ;	! end of filename

	    IF
		.CHAR EQL %C','
	    THEN
		BEGIN 	! filename with no properties

		L_FIL_NAM = CH$DIFF(CH$PLUS(.P_TMP,-1),.P_STR_FIL) ;
		P_FIL_NAM = .P_STR_FIL ;

        	! build library name
        	BLD_LOG_NAM(LIB,.L_FIL_NAM,.P_FIL_NAM) ;
	
 		$str_desc_init(descriptor = d_file_name,
 			       string=(.l_log_nam,.p_log_nam));
		IF
	    	    NOT delete_or_rename(d_file_name)
		THEN
    		    err(s_nodelete,CAT((.L_LOG_NAM,.P_LOG_NAM), 
				' has already been deleted -  not by CMS!')) ;

		P_STR_FIL = .P_TMP ;

		END ;	! filename with no properties

	    END ;	! not in quoted string

	END ;	! scan filenames string
    IF
	(.P_STR_FIL NEQA .P_TMP) AND NOT .F_ODD_QUO
    THEN
	BEGIN	! only one filename

	L_FIL_NAM = CH$DIFF(.P_TMP,.P_STR_FIL) ;
	P_FIL_NAM = .P_STR_FIL ;

        ! build library name
        BLD_LOG_NAM(LIB,.L_FIL_NAM,.P_FIL_NAM) ;
    
 	$str_desc_init(descriptor = d_file_name,
 			string=(.l_log_nam,.p_log_nam));
	IF
	    NOT delete_or_rename(d_file_name)
	THEN
	    err(s_nodelete,CAT((.L_LOG_NAM,.P_LOG_NAM), 
				' has already been deleted -  not by CMS!')) ;

	END ;	! only one filename




    TRUE

    END;			! end of routine DELFLS

GLOBAL ROUTINE ERASE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine act as the dispatch for the DELETE Commands.
!
! FORMAL PARAMETERS:
!
!	None.
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	K_SUCCESS = requested actions performed successfully.
!	K_SILENT_ERROR = requested action failed.
!
! SIDE EFFECTS:
!
!	
!
!--

    BEGIN
    
    OWN
	RETVAL ;		! return value

    LOCAL
    	CMD,			! command code
	SUB_CMD,		! subcommand code    
	QUAL,			! address of first qualifier block
	PARM,			! address of first parameter block
	USR_REM ;		! address of descriptor for user remark
    
    ! inspect the command
    IF
    	NOT COMAND(CMD,SUB_CMD,QUAL,PARM,USR_REM)
    THEN
    	RETURN K_SILENT_ERROR ;
    
    RETVAL = (SELECTONE .SUB_CMD OF
    		
    		SET
    
    		[K_CLASS_SUB]:
    
    		    ERSCLS(.SUB_CMD,.PARM,.USR_REM) ;
    
    		[K_ELEMENT_SUB]:
    
    		    ERSELM(.SUB_CMD,.PARM,.QUAL,.USR_REM) ;
    
    		[OTHERWISE]:
    
    		    BEGIN	! invalid option
		    ERS(s_invsubc,CAT('Invalid option')) ;
    		    RETURN K_SILENT_ERROR ;
    		    END ;	! invalid option
		
		TES) ;

    .RETVAL
    
    END;	! end of routine ERASE

    
ROUTINE ERSCLS(S_CMD,A_PARM,A_REMARK) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will do the processing for the DELETE CLASSES Command.
!	If the class exists and contains no generations, it will be removed 
!	from the class file. Subsequently the above action will be logged. 
!
! FORMAL PARAMETERS:
!
!	S_CMD		Subcommand code
!
!	A_PARM		Address of parameter block containing class name
!
!	A_REMARK	Address of descriptor containing remark string
!
! IMPLICIT INPUTS:
!
!	none.
!
! IMPLICIT OUTPUTS:
!
!	none.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	K_SUCCESS		Successful completion
!	K_SILENT_ERROR		Error in processing this command
!
! SIDE EFFECTS:
!
!	
!
!--

    BEGIN
    
    LOCAL
	CRC_LEN,
	CRC_PTR,
	D_CLS_NAM: DESC_BLOCK,		! class name in file
	D_CLS_PAR: REF PARAMETER_BLOCK,	! class name in parameter
	D_FIL_SPC: DESC_BLOCK,		! class file spec for deleting
	D_MAT_REC: DESC_BLOCK,		! matching class record in the file
	D_REMARK: REF DESC_BLOCK,	! remark string
	EXISTING_CRC,			! CRC already in file
	FOUND_CRC,			! Found an existing CRC
	F_CLS_DEL,			! set when class was deleted
	F_RD_CLS, 			! set when previous read of class was
					! a match
	M_CLS_NAM: VECTOR[CH$ALLOCATION(31)],
					! storage for class name
	NUM_BUF: VECTOR[CH$ALLOCATION(MAX_NUM_SIZE+5)],
	OLD_CRC,			! CRC in input file
	NEW_CRC,			! CRC to be put in output file


	REC_LEN,			! length of record in file
	REC_PTR,			! pointer to record in file
	status;

    ! initialize flags
    F_RD_CLS = FALSE ;
    F_CLS_DEL = FALSE ;

    ! set up descriptors
    D_CLS_PAR = .A_PARM ;
    D_REMARK = .A_REMARK ;

    ! request access to the library
    IF
	NOT SAFLIB(K_UPDATE_LIB)
    THEN
	RETURN K_SILENT_SEVERE ;

    ! open class file as input
    IF
	(status=$STEP_OPEN(IOB=llib_iob,FILE_SPEC=%STRING(LIB,ATF),
	 OPTIONS=INPUT,FAILURE=0)) NEQ STEP$_NORMAL
    THEN
	BADXPO(.status,LIT('Unable to open input class file')) ;

    ! begin transaction
    BEGTRN() ;

    !Initialize CRC accumulators
    existing_crc = 0;
    found_crc = false;
    old_crc = 0;
    new_crc = 0;
    ! Set up polynomial table
    crctable();

    ! open output file
    IF
	(status=$STEP_OPEN(IOB=LIB_W_IOB,FILE_SPEC=%STRING(LIB,ATF),
	 OPTIONS=OUTPUT,FAILURE=0)) NEQ STEP$_CREATED
    THEN
	BADXPO(.status,LIT('Unable to open output class file')) ;

    ! register output for crash recovery
    TRNFIL(LIB_W_IOB) ;

    ! read input and transfer to output
    UNTIL
	$step_get(IOB=llib_iob) EQL STEP$_EOF
    DO
	BEGIN		! main read loop
	
	!See if we have the control string
	IF CH$EQL(4,CH$PTR(UPLIT('*/C:')),4,.llib_iob[IOB$A_STRING])
	THEN
	    BEGIN
	    LOCAL
		LEN,
		PTR ;
	    LEN = .llib_iob[IOB$H_STRING] - 4;
	    PTR = CH$PLUS( .llib_iob[IOB$A_STRING],4) ;
	    EXISTING_CRC = ASCHEX ( PTR,LEN) ;
	    FOUND_CRC = TRUE;
	    EXITLOOP ;
	    END;

	! Calculate the CRC of this line
	OLD_CRC = .OLD_CRC +
		 CRCCALC(.llib_iob[IOB$H_STRING], .llib_iob[IOB$A_STRING]) ;


	
	IF
	    .F_RD_CLS
	THEN
	    BEGIN	! elements in this class
	    IF
		(CH$RCHAR(.llib_iob[IOB$A_STRING]) EQL %C' ')
	    THEN
		BEGIN 		! element records follow class

		ERS(s_haselem,CAT('Cannot delete ',D_CLS_NAM,
			' as it contains one or more elements. ' )) ;

		! close input
		$step_close(IOB=llib_iob) ;

		! close and delete output
		$step_close(IOB=LIB_W_IOB,OPTIONS=REMEMBER,FAILURE=0) ;
		$STEP_DELETE(IOB=LIB_W_IOB,FAILURE=0) ;
		CANTRN() ;
		DONLIB() ;
		RETURN K_SILENT_ERROR ;

		END 		! element records follow class
	    ELSE
		BEGIN		! valid deletion
		F_RD_CLS = FALSE ;
		F_CLS_DEL = TRUE ;
		END ;		! valid deletion

	    END ;	! elements in this class

	! check for class record
	IF
	     CH$RCHAR(.llib_iob[IOB$A_STRING]) NEQ %C' '
	     AND NOT .F_CLS_DEL
	THEN
	    BEGIN	! class record

	    ! extract class name
	    REC_LEN = .llib_iob[IOB$H_STRING] ;
	    REC_PTR = .llib_iob[IOB$A_STRING] ;
	    D_CLS_NAM[DESC_PTR] = CH$PTR(M_CLS_NAM) ;
	    D_CLS_NAM[DESC_LEN] = GET_LXM(REC_PTR,%C' ',.REC_LEN,
					  D_CLS_NAM[DESC_PTR]) ;
	    D_CLS_NAM[DESC_PTR] = CH$PTR(M_CLS_NAM) ;

	    IF
		CH$EQL(LEN_COMMA_PTR(D_CLS_NAM),
			.D_CLS_PAR[PAR_TEXT_LEN],
			.D_CLS_PAR[PAR_TEXT_PTR],%C' ')
	    THEN
		F_RD_CLS = TRUE ;

	    END ;	! class record

	IF 
	    NOT .F_RD_CLS
	THEN
	    BEGIN
	    ! Calculate the CRC of this line
	    NEW_CRC = .NEW_CRC +
		 CRCCALC(.llib_iob[IOB$H_STRING], .llib_iob[IOB$A_STRING]) ;
	    $step_PUT(IOB=LIB_W_IOB,STRING=(.llib_iob[IOB$H_STRING],
					.llib_iob[IOB$A_STRING])) ;
	    END;

	END ;		! main read loop

    ! last record was target class
    IF
	.F_RD_CLS AND NOT .F_CLS_DEL
    THEN
	F_CLS_DEL = TRUE ;

 
    ! First write out new CRC
    CRC_PTR = CH$MOVE(4,CH$PTR(UPLIT('*/C:')),CH$PTR(NUM_BUF)) ;
    CRC_LEN = HEXASZ( .NEW_CRC, .CRC_PTR, 8 );
    CRC_PTR = CH$PLUS(.CRC_PTR, .CRC_LEN) ;
    CH$WCHAR(%C' ', .CRC_PTR );
    CRC_LEN = .CRC_LEN + 5;
    $step_PUT ( IOB = LIB_W_IOB, STRING = (.CRC_LEN, CH$PTR(NUM_BUF)),
		   FAILURE = 0 ) ;
    ! close files
    $step_close(IOB=LIB_W_IOB,OPTIONS=REMEMBER,FAILURE=0) ;
    $step_close(IOB=llib_iob,OPTIONS=REMEMBER,FAILURE=0) ;
  
    ! Check CRC'S
    IF NOT .FOUND_CRC
    THEN
	SYSMSG(s_nocksum,CAT('Definition file has no checksum'),0)
    ELSE
    IF .EXISTING_CRC NEQ .OLD_CRC
    THEN
	SYSMSG(s_invcksum,CAT('Definition file has an invalid',
			'checksum'),0);

    IF
	.F_CLS_DEL
    THEN
	sysmsg(s_delcls,CAT('Class ',D_CLS_PAR[PAR_TEXT],' deleted'),0) ;

    ! delete appropriate file
    IF
	NOT .F_CLS_DEL
    THEN
	BEGIN 		! class not found
	ERS(s_noclassf,CAT('The class ',D_CLS_PAR[PAR_TEXT],' does not ',
				'exist. ')) ;
	$STEP_DELETE(IOB=LIB_W_IOB) ;
	CANTRN() ;
	DONLIB() ;
	RETURN K_SILENT_ERROR ;
	END 		! class not found
    ELSE
	BEGIN 	! delete old file
	$STR_DESC_INIT(DESCRIPTOR=D_FIL_SPC,STRING=(%STRING(LIB,ATF))) ;
	DELVRS(FILVRS,.D_FIL_SPC[DESC_LEN],.D_FIL_SPC[DESC_PTR]) ;
	! write log entry
	IF
	    NOT LOGTRN(K_NORMAL_LOG,0,K_NULL)
	THEN
	    BUG(CAT('Unable to write log record. Error occurred in routine ',
		    'ERSCLS of module ERASE')) ;
        ENDTRN() ;
	END ;	! delete old file

    DONLIB() ;

    exits(s_delcls)

    END;			! end of routine ERSCLS

ROUTINE ERSELM(S_CMD,A_PARM,A_QUAL,A_REMARK)=

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will perform the functions of the DELETE ELEMENTS
!	Command. If no reservations and no classes for the element exist
!	the entry for the element is remove from the master control
!	directory and the element deleted from the library. Subsequently
!	the action logged.
!
! FORMAL PARAMETERS:
!
!	S_CMD		subcommand code
!
!	A_PARM		address of parameter block
!	
!	A_QUAL  	address of qualifier block
!
!	A_REMARK	address of descriptor for remark text
!
! IMPLICIT INPUTS:
!
!	
!
! IMPLICIT OUTPUTS:
!
!	
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	K_SUCCESS = the element was successfully destroyed
!	K_SILENT_ERROR = some error occurred during processing
!
! SIDE EFFECTS:
!
!	
!
!--

    BEGIN
    
    OWN	
	A_RES_LIS,				! address of reservation list
	L_FIL_LIS,				! length of filename list
	P_FIL_LIS ;				! pointer to filename list

    LOCAL
	D_CLS_FND: DESC_BLOCK,			! desc for classes found
	D_WILD_CD: DESC_BLOCK,			! desc for wild gen number
	GETELM_STAT,				! status returned by GETELM
    	QUAL: REF QUALIFIER_BLOCK,
    	PARM: REF PARAMETER_BLOCK,
    	REM : REF DESC_BLOCK,
	XPO_STAT ;				! xport status
    
    QUAL = .A_QUAL ;    
    PARM = .A_PARM ;
    REM = .A_REMARK ;

    ! request access to library
    IF
    	NOT SAFLIB(K_UPDATE_LIB)
    THEN
    	RETURN K_SILENT_SEVERE ;

    IF 
    	.QUAL EQL K_NULL
    THEN
    	BEGIN	! no qualifier  present
    	ERS(s_noqual, CAT('The ',SPELLING(K_ALL_QUAL),
    		' qualifier is required in this release')) ;
    	END ;   ! no qualifier present

    IF 
    	.QUAL[QUA_CODE] NEQ K_ALL_QUAL
    THEN
    	BEGIN	! /ALL not present
    	ERS(s_noqual, CAT('The ',SPELLING(K_ALL_QUAL),
    		' qualifier is required in this release')) ;
    	END ;   ! /ALL not present

    
    ! check for reservations on this element
    IF
    	CHKRES(.PARM[PAR_TEXT_PTR],.PARM[PAR_TEXT_LEN],A_RES_LIS) 
    THEN
    	BEGIN		! element reserved
    
    	! report reservation
    	REPRES(.A_RES_LIS,0) ;
    
    	ERS(s_elresr,CAT('Cannot delete ',PARM[PAR_TEXT],' as it is ',
		'reserved'));

    	END ;		! element reserved
    
    ! initialize wild card generation number
    $STR_DESC_INIT(DESCRIPTOR=D_WILD_CD,STRING=('*')) ;
    
    ! initialize class found string for GETCLS routine
    $STR_DESC_INIT(DESCRIPTOR=D_CLS_FND,STRING=(0,K_NULL)) ;
    
    IF
    	GETCLS(LEN_COMMA_PTR(D_WILD_CD),
    	       .PARM[PAR_TEXT_LEN],.PARM[PAR_TEXT_PTR],
   	       D_CLS_FND)
    THEN
    	BEGIN		! element in a class
    
    	! report class this element belongs to
    	ERR(s_spcclass,CAT('Cannot delete ',PARM[PAR_TEXT],' as it belongs ',
			'to the following class(es):')) ;
    	ERS(s_spcclass,CAT('   ',D_CLS_FND)) ;
    
    	! suspend further processing

    	END ;		! element in a class
    
    ! obtain confirmation from user
    IF
	NOT YES(CAT('Confirm ',PARM[PAR_TEXT]))

    THEN
	BEGIN
	ERS(s_conffail,CAT('Cannot confirm ',PARM[PAR_TEXT],));
	END ;

    ! set crash recovery for beginning of transaction
    BEGTRN() ;
    

    IF
    	NOT DELELM(.PARM[PAR_TEXT_LEN],.PARM[PAR_TEXT_PTR],
		   L_FIL_LIS,P_FIL_LIS)
    THEN
    	BEGIN		! element not in library
 	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 '),PARM[PAR_TEXT],
		(' does not exist in the CMS library '),d_log_trn));
    	END ;		! element not in library
    
    
    ! write log record
    IF
	NOT LOGTRN(K_NORMAL_LOG,0,K_NULL)
    THEN
	BUG(CAT('Unable to write log record.  Error occurred in routine ',
		'ERSELM of module ERASE')) ;    
    
    ENDTRN() ;

    IF
	DELFLS(.L_FIL_LIS,.P_FIL_LIS)
    THEN
       ! report command completion
       sysmsg(s_elmdel,CAT('Element ',PARM[PAR_TEXT],' deleted from library '),0);

    DONLIB() ;
    
    exits(s_elmdel)
    
    END;			! end of routine ERSELM

END				! End of module
ELUDOM