Google
 

Trailing-Edge - PDP-10 Archives - DEC_CMS-20_V1.0_SRC - cms/sources/recovr.bli
There are no other files named recovr.bli in the archive.
module recovr (	! Nullify an incomplete transaction.
		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 routines for recovering the library after
!	a crash.
!
! Environment:  VAX/VM, TOPS-20, TOPS-10
!
! Author:  Earl Van Horn	Creation Date:  July, 1980
!
!--
!
! Table of Contents:
!
forward routine
    recovr,			! Nullify an incomplete transaction.
    bad_and_good_times,		! Get the official times of the transaction to
				! be nullified and the last good transaction.
    delete_or_rename,		! Get rid of a file by deleting or renaming.
    recover_log,		! Nullify the log entry for the transaction.
    recover_non_log,		! Nullify changes to a file that is not a log.
%if %bliss(bliss32) %then
    rement,			! Remove directory entry, do not delete file.
    rmsopen,
%fi
    rescind_bad_transaction ;	! Get rid of BAD file so library can be used.

!
! Include Files:
!
%if %bliss(bliss32) %then
library 'SYS$LIBRARY:STARLET' ;
%fi
 
%if %bliss(bliss36) %then
    %if %switches(tops20) %then
        require 'JSYS:';
    %fi
%fi

library 'XPORT:' ;
require 'BLISSX:' ;
require 'SCONFG:' ;
require 'TIMUSR:' ;

!
! Macros:
!

!
! Equated Symbols:
!

literal
    k_first_inform = 5,		! How soon do we start telling him?
    k_inform_every_nth = 30,	! Say hello to the user on every 30th attempt.
    k_max_attempts = 240,	! Maximum number of times to try getting the
				! library before giving up.
    k_retry_seconds = 1 ;	! Number of seconds for an on-line process to
				! wait before trying to get the library again.

!
! Own Storage:
!
own

    ! Variables needed for RECOVR to communicate with RECOVER_NON_LOG.
    bad_time : time_block,	! Official time of transaction to be nullified.
    do_the_recovery,		! Do the recovery as opposed to check only.
    good_time : time_block,	! Official time of last good transaction.
    recoverable ,		! Library is still recoverable.  FALSE means
				! this recovery attempt has failed.
    f_recover : initial(0);	! a recover is in progress

!
! External References:
!

external literal
    s_bfnotfnd,			!couldn't find bad file
    s_candlboth,		!both resultant & prev can be deleted
    s_cannotdo,			!not able to recover
    s_fafterlst,		!good file after last good transaction
    s_failrcovr,		!attempted recovery has failed
    s_fnotclosd,		!FIN file not closed by us
    s_graftrlst,		!file has good rec after last one
    s_grnotfnd,			!couldn't find last good record
    s_hnoclose,			!history file could not be closed
    s_hnoopen,			!can't open history file
    s_honoopen,			!can't open history output file dur recovery
    s_htcloserr,		!history file couldn't be closed after trunc
    s_htnotconn,		!cannot connect history file for truncation
    s_htopenerr,		!can't open history file for truncation
    s_inuse,
    s_libempty,			!file does not exist in the library
    s_nobackup,			!no backup for previous
    s_nodelete,			!file not deleted because it didnt exist in lib
    s_nohdel,			!cannot delete bad history file record
    s_noentry,			!no FIN directory entry
    s_nofile,			!file not found
    s_noparse,			!can not parse
    s_notHvers,			!not the highest version
    s_notLvers,			!not the next lower version
    s_ordererr,			!bad trans is not after last good one
    s_proceed,
    s_rafterbad,		!file had a rec after bad one
    s_recovered,		!successful recovery
    s_removfail,		!can't remove the entry
%if VaxVms %then
    s_renxxx,			!file delete protected; renamed to 00cms.xxx
%fi
    s_renamfail,		!renaming failed
    s_rnbeforep,		!resultant not earlier than previous
    s_waiting;

external routine
    asctim,		! Convert a system time to ASCII.
    bug : novalue,	! Report a bug and abort.
    delvrs,		! delete a specified number of file versions
    err,		! Report a problem and continue.
    erriob,		! Report a library problem involving an IOB.
    errsts,		! Report an error involving a system status code.
    hibernate,
    isfile,		! Test whether a file exists.
    nateql,		! Compare file names and types for equality.
    revmrk,		! Get revision date and time of a file.
    sysmsg,		! Display a message to the user.
%if %bliss(bliss32) %then
    samfil,		! Test if two files are the same physical file.
%fi
    timcop : novalue,	! Copy a time block value to another time block.
    timeql,		! Compare two time blocks for equality.
    timleq,		! Compare two time blocks for less than or equal.
    vernum,		! Get the version number of a file spec.
    wilds ;		! Search a directory.
global routine recovr =

!++
! Functional Description:
!
!	This routine nullifies an incomplete library transaction.
!	It assumes that the disk has not been clobbered, i.e., that the
!	only problem is that we stopped in the middle of a transaction.
!
! Formal Parameters:
!
!	None
!
! Implicit Inputs:
!
!	None
!
! Implicit Outputs:
!
!	The time blocks BAD_TIME and GOOD_TIME declared own in this module.
!	DO_THE_RECOVERY declared own in this module.
!	RECOVERABLE declared own in this module.
!
! Routine Value:
! Completion Codes:
!
!	TRUE means the library has been recovered and has been released for
!	further use.  FALSE means the recovery was unsuccessful and the user
!	has been informed.
!
! Side Effects:
!
!	The library is recovered.
!
!--

    begin	! RECOVR
    local
	log_ok,			! Means recovery of the log was successful.
	n_files,		! Number of files scanned.
	started,		! Means the transaction got started, so
				! the full recovery process must be done.
	valid ;			! Means WILDS found no problem seaching the
				! directory.

    routine
	err_failure = err(s_failrcovr,lit('Attempted recovery has failed')) ;
    routine
	err_give_up = err(s_cannotdo,lit('Automatic recovery is not possible')) ;
    routine
	say_ok = sysmsg(s_recovered,
		 lit('Previous transaction successfully canceled'),0) ;

    !Signal a recover is in progress
    f_recover = true;
    ! Get the official times of the transaction to be nullified and the
    ! last good transaction.
    if not bad_and_good_times(started, bad_time, good_time)
    then
	begin	! Cannot get transaction times.
	err_give_up() ;
	return false ;
	end ;
    if not .started
    then
	begin	! The transaction never really got started.

	! Get rid of the partially written BAD file.
	if not rescind_bad_transaction()
	then
	    begin	! Could not rescind the unstarted transaction.
	    err_give_up() ;
	    return false ;
	    end ;	! Could not rescind the unstarted transaction.

	say_ok() ;
	return true ;

	end ;	! The transaction never really got started.

    ! Set the other variables for communicating with RECOVER_NON_LOG.
    recoverable = true ;	! Initialize.
    do_the_recovery = false ;	! Just check for problems on the first pass.

    ! Make a pass through the library to see if recovery might be successful.
    n_files = wilds(len_comma_ptr(%string(lib, sys_wild_file_spec)),
			recover_non_log, valid) ;

    if not .valid
    then
	begin	! Invalid on first pass.
	err_give_up() ;
	return false ;
	end ;	! Invalid on first pass.
    if .n_files eql 0
    then
	begin	! Empty directory on first pass.
	err(s_libempty,lit('No files exist in the library')) ;
	err_give_up() ;
	return false ;
	end ;	! Empty directory on first pass.

    ! Make final call for the first pass if the library is still recoverable.
    if .recoverable
    then
	recover_non_log(k_null, -1) ;

    ! Give up if the first pass check failed.
    if not .recoverable
    then
	begin	! Problem found on the first pass.
	err_give_up() ;
	return false ;
	end ;	! Problem found on the first pass.

    ! Up to now, no change has been made to the library.
    ! Now begin the actual recovery by deleting the log entry for the
    ! nullified transaction.
    if not recover_log(bad_time, good_time)
    then
	begin	! Could not recover the log.
	err_failure() ;
	return false ;
	end ;	! Could not recover the log.

    ! Make a second pass through the other files, for actual recovery.
    do_the_recovery = true ;
    n_files = wilds(len_comma_ptr(%string(lib, sys_wild_file_spec)),
			recover_non_log, k_null) ;

    if .n_files eql 0
    then
	bug(lit('RECOVR found no files on the second pass.')) ;

    ! Make final call for the second pass if the library is still recoverable.
    if .recoverable
    then
	recover_non_log(k_null, -1) ;

    ! Give up if the second pass failed.
    if not .recoverable
    then
	begin	! Problem found on the second pass.
	err_failure() ;
	return false ;
	end ;	! Problem found on the second pass.

    ! Finally, get rid of the BAD file, so the library can be used.
    if not rescind_bad_transaction()
    then
	begin	! Could not get rid of the BAD file.
	err_failure() ;
	return false ;
	end ;	! Could not get rid of the BAD file.

    say_ok() ;

    true
    end ;	! RECOVR
routine bad_and_good_times(a_started, a_this_bad_time, a_this_good_time) =

!++
! Functional Description:
!
!	This routine obtains the official transaction times for the
!	transaction to be nullified and the last good transaction.  If the
!	time of the nullifiable transaction cannot be obtained, this means
!	the transaction never really got started.  In this case FALSE is
!	stored using the first parameter, and the recovery may be completed
!	by calling RESCIND_BAD_TRANSACTION immediately.
!
!	If the time of the last good transaction is not less than the
!	time of the nullifiable time, this is one of the conditions under
!	which the routine returns FALSE (see below).
!
! Formal Parameters:
!
!    A_STARTED:		Address of a fullword into which TRUE will be stored
!			to indicate that the transaction got started and a
!			full recovery is necessary.  If FALSE is stored, the
!			transaction never really got started, and
!			RESCIND_BAD_TRANSACTION may be called immediately.
!			If the routine returns FALSE, the value stored
!			is undefined.
!
!    A_THIS_BAD_TIME:	Address of a time block to recieve the official
!			transaction time of the nullifiable transaction.
!			If the routine stores FALSE in .A_STARTED or
!			returns FALSE, the time is undefined.
!
!    A_THIS_GOOD_TIME:	Address of a time block to recieve the official
!			transaction time of the last good transaction.
!			If the routine stores FALSE in .A_STARTED or
!			returns FALSE, the time is undefined.
!
! Implicit Inputs:
!
!	The file fac_name$LIB:00fac_name.BAD is examined for the nullifiable time.
!	The file fac_name$LIB:00fac_name.FIN is examined for the time of the last
!	good transaction, and to determine if it is the same file as
!	fac_name$LIB:00fac_name.BAD( in the case of VAX/VMS) .
!
! Implicit Outputs:
!
!	None
!
! Routine Value:
! Completion Codes:
!
!	TRUE means recovery is possible.  FALSE means automatic recovery
!	is not possible and the user has been informed why.
!
! Side Effects:
!
!	If fac_name$LIB:00fac_name.BAD and fac_name$LIB:00fac_name.FIN are the same file,
!	the entry for 00fac_name.FIN is removed from the fac_name$LIB directory.
!	This is possible if the crash occurred while BAD was being renamed
!	in the case of VAX/VMS.
!
!--

    begin	! BAD_AND_GOOD_TIMES
    bind
	started = .a_started,
	this_bad_time = .a_this_bad_time : time_block,
	this_good_time = .a_this_good_time : time_block ;
    local
	by_step ;		! The FIN file was closed by us.

    ! The official time of the transaction to be nullified is the revision
    ! time of the BAD file, provided it was closed by us.
    if not revmrk(len_comma_ptr(%string(lib, bad)), this_bad_time, started)
    then
	started = false ;

    if .started
    then
	begin		! BAD was closed by us.

	! Make sure an entry exists for FIN before testing to see if
	! it names the same physical file as BAD.
	if not isfile(len_comma_ptr(%string(lib, fin)), k_null)
	then
	    begin	! No FIN entry.
	    err(s_noentry,lit(%string('No directory entry for ',
				'fin file'))) ;
	    return false ;
	    end ;	! No FIN entry.

%if VaxVms %then
	if samfil(len_comma_ptr(%string(lib, bad)),
		  len_comma_ptr(%string(lib, fin)))
	then
	    begin	! BAD and FIN are one and the same file.

	    !+
	    ! The directory entries for the BAD file and the FIN file denote
	    ! the same physical file on the disk.  This can happen if the
	    ! crash occurred while the BAD file was being renamed to FIN
	    ! at the end of the transaction.
	    !
	    ! Even though the transaction is actually complete, in this
	    ! release we will act as if it is not.  We will remove the FIN
	    ! entry from the directory without deleting the file.  This will
	    ! leave the BAD entry denoting the file, and we will proceed to
	    ! nullify the transaction in the normal way.
	    !-

	    if not rement(lit(%string(lib, fin)))
	    then
		return false ;

	    end ;	! BAD and FIN are one and the same file.
%fi

	! The official time of the last good transaction is the revision
	! time of the FIN file, which must have been closed by us.
	if not revmrk(len_comma_ptr(%string(lib,fin)), this_good_time, by_step)
	then
	    begin	! No FIN file.
	    err(s_nofile,lit('Fin file does not exist')) ;
	    return false ;
	    end ;	! No FIN file.

	! Assure that the FIN file's transaction time is meaningful.
	if not .by_step
	then
	    begin	! FIN not closed by us.
	    err(s_fnotclosd,
		lit(%string('Fin file was not closed by ',fac_name)) );
	    return false ;
	    end ;	! FIN not closed by us.

	! The last good transaction must occur before the one being nullified.
	if timleq(this_bad_time, this_good_time)
	then
	    begin	! Good transaction not before bad.
	    err(s_ordererr,
		lit('Time of bad transaction precedes time of last good one'));
	    return false ;
	    end ;	! Good transaction not before bad.

	end ;		! BAD was closed by us.

    true
    end ;	! BAD_AND_GOOD_TIMES
global routine delete_or_rename(a_file_spec) =

!++
! Functional Description:
!
!	This routine gets rid of a file from the library by deleting
!	or renaming it to the next higher version of 00fac_name.XXX .
!	The latter might be required if the crash occurred before we had
!	a chance to set the protection to allow the group to delete the file.
!
!	This routine assumes that the directory entry for the file exists.
!	This is the case if the file specification was found by WILDS.
!	If the file itself does not exists, the directory entry will be
!	removed.
!
! Formal Parameters:
!
!	A_FILE_SPEC:	Address of a descriptor of the file specification of
!			the file to be disposed of.
!
! Implicit Inputs:
!
!	None
!
! Implicit Outputs:
!
!	The next higher version of fac_name$LIB:00fac_name.XXX might be created.
!
! Routine Value:
! Completion Codes:
!
!	TRUE means disposal was successful.  FALSE means unsuccessful and the
!	user has been informed.
!
! Side Effects:
!
!	The specified file is deleted or renamed.
!
!--

    begin	! DELETE_OR_RENAME
    bind
	file_spec = .a_file_spec : $xpo_descriptor() ;
    local
	$io_block_decl(i),
	status ;	! XPORT status code.

    $io_block_init(i) ;
    if not (status = $step_delete(iob = i_iob, file_spec = file_spec,failure = 0))
    then

    %if VaxVms %then

	begin		! Deletion failed.
	if .status eql step$_no_file
	then
	    begin	! Remove the directory entry.

            if not .f_recover
	    then
		return false ;

	    if not rement(file_spec)
	    then
		return false ;

	    end		! Remove the directory entry.
	else
	    begin	! Rename the file to get it out of the way.

	    if not $step_rename(iob = i_iob, failure = 0,
			new_spec = lit(%string(lib, xxx)))
	    then
		begin	! Renaming failed.
		erriob(s_renamfail,i_iob,
		       cat('DELETE_OR_RENAME could not clear ',file_spec)) ;
		return false ;
		end 	! Renaming failed.
	    else
                err(s_renxxx,cat('File ',file_spec,' delete protected; renamed to 00CMS.XXX'));
	    end ;	! Rename the file to get it out of the way.
	end ;		! Deletion failed.

    %fi
    %if tops20 %then
	begin		! Deletion failed.
	if .status eql gjfx19 ^ 3 ! file does not exist
	then
	    return false 
	else
	    begin	!file protected; since we cannot rename inform the user

	    erriob(s_nodelete,i_iob,
		       cat('Cannot delete file ',file_spec)) ;
	    end ;
	end ;		! Deletion failed.
    %fi

    true
    end ;	! DELETE_OR_RENAME
routine recover_log(a_this_bad_time, a_this_good_time) =

!++
! Functional Description:
!
!	This routine nullifies the entry in the log for the transaction whose
!	official transaction time is given by the first parameter.  Afterward,
!	the latest transaction in the log must be the one whose time is given
!	by the second parameter.
!
!	In this implementation, the nullified transaction must be represented
!	by the last transaction in the log, or not at all.
!
! Formal Parameters:
!
!    A_THIS_BAD_TIME:	Address of a time block for the official transaction
!			time of the log entry to be nullified.
!
!    A_THIS_GOOD_TIME:	Address of a time block for the official time of the
!			last good transaction.
!
! Implicit Inputs:
!
!	None
!
! Implicit Outputs:
!
!	None
!
! Routine Value:
! Completion Codes:
!
!	TRUE means the offending log entry, if any, was deleted.
!	FALSE means recovery failed, and the user has been informed.
!
! Side Effects:
!
!	The offending entry is deleted from fac_name$LIB:00fac_name.HIS .
!
!--

    begin	! RECOVER_LOG
    bind
	this_bad_time = .a_this_bad_time : time_block,
	this_good_time = .a_this_good_time : time_block ;
    literal
	k_ascii_time_alloc = 24 ;	! Number of characters needed in
					! buffer for call to LOGTIM.
    local
	bad_ascii_time : desc_block,	! ASCII version of THIS_BAD_TIME.

%if %bliss(bliss32) %then
	bad_ascii_time_buf : vector[k_ascii_time_alloc, byte],
	good_ascii_time_buf : vector[k_ascii_time_alloc, byte],

	save_rfa : vector[rab$s_rfa, byte],	! For saving the RFA of the
						! bad record.
%fi

%if %bliss(bliss36) %then
        bad_ascii_time_buf: vector[ch$allocation(k_ascii_time_alloc)],
        good_ascii_time_buf: vector[ch$allocation(k_ascii_time_alloc)],

	$io_block_decl(out),		! Output truncated log
%fi

	bad_found,			! The bad entry has been found.
	good_ascii_time : desc_block,	! ASCII version of THIS_GOOD_TIME.

	good_found,			! The last good entry has been found.
	$io_block_decl(i),		! To examine the log file.



	status ;			! XPORT or system status code.
    bind
	log_spec = lit(%string(lib, log)) : desc_block ; ! File spec. for log.

    label
	normal_processing;		! Label for block enclosing most processing
					!  This block is left if an error 
					!  occurs while files are open.


    ! Convert the argument times for comparision with the log.
    $str_desc_init(descriptor = bad_ascii_time,
			string = (0, ch$ptr(bad_ascii_time_buf))) ;
    $str_desc_init(descriptor = good_ascii_time,
			string = (0, ch$ptr(good_ascii_time_buf))) ;
    bad_ascii_time[desc_len] =
		asctim(this_bad_time, .bad_ascii_time[desc_ptr]) ;
    good_ascii_time[desc_len] =
		asctim(this_good_time, .good_ascii_time[desc_ptr]) ;

    ! No entries have yet been found.
    bad_found = false ;
    good_found = false ;

    ! Prepare to examine the log.
    $io_block_init(i);
    if not $step_open(iob = i_iob, file_spec = log_spec, failure = 0)
    then
	begin	! Open for examination failed.
	erriob(s_hnoopen,i_iob, lit('Cannot open history file')) ;
	return false ;
	end ;	! Open for examination failed.

%if Tops20 %then
    ! open output log file
    $io_block_init (out);

    if not $step_open(iob=out_iob,options=output,file_spec=log_spec,failure=0) then
	begin	! failed on attempt to open output history file
	erriob(s_honoopen,out_iob,lit('Cannot open output history file'));
	return false ;
	end ;	! failed on attempt to open output history file
%fi

    NORMAL_PROCESSING:
	BEGIN

	!+
	!  Leave this block if an error occurs while files are open.
	!  The files are closed and false is returned.
	!-

	! See if the last record should be deleted.
	while (status = $step_get(iob = i_iob, failure = 0))
	do
	    begin	! Get next record.

	    if .good_found
	    then
		begin	! Record after the last good one.

		if .bad_found
		then
		    begin	! Records after the bad one.
		    err(s_rafterbad,lit('The history file has a record after the bad one')) ;
		    leave normal_processing;			!return false ;
		    end ;	! Records after the bad one.

		! This should be the bad record.
		bad_found = $str_eql(string1 = bad_ascii_time,
					string2 = (.bad_ascii_time[desc_len],
						   .i_iob[iob$a_string])) ;
		if .bad_found
		then
		    begin	! Remember the RFA of the bad record.

		    %if VaxVms %then
		    bind
			rab = .i_iob[iob$a_rms_rab] : $rab_decl ;

		    ch$move(rab$s_rfa, ch$ptr(rab[rab$w_rfa]),
					ch$ptr(save_rfa)) ;
		    %fi

		    %if Tops20 %then

		    !
		    !  Once the bad record is found, no more records are
		    !  written to the new file.
		    !

		    0	!(keep bliss happy)

		    %fi

		    end		! Remember the RFA of the bad record.
		else
		    begin	! Good record after the last good one.
		    err(s_graftrlst,lit('History file has good record after the last good one')) ;
		    leave normal_processing;			!return false ;
		    end ;	! Good record after the last good one.

		end	! Record after the last good one.
	    else
		begin	! process records thru last good one

		! Note if this is the last good record.
		good_found = $str_eql(string1 = good_ascii_time,
					string2 = (.good_ascii_time[desc_len],
						   .i_iob[iob$a_string])) ;

		%if Tops20 %then
		! transfer record from input to output  (up to and including good record)
		$step_put(iob=out_iob,string=i_iob[iob$t_string]) ;
		%fi

		end ;	! process records thru last good one

	    end;	! end of WHILE-DO loop

	!+
	!  Exit loop when GET operation fails (hard failure or EOF)
	!-

	! Punt on any failure but end of file.
	if .status neq step$_eof
	then
	    begin	! Read failed.
	    erriob(s_hnoopen,i_iob, cat('Cannot open history file' )) ;
	    leave normal_processing;				!return false ;
	    end ;	! Read failed.

	if not .good_found
	then
	    begin	! The last good record could not be found.
	    err(s_grnotfnd,lit('No history file record for the last good transaction')) ;
	    leave normal_processing;				!return false ;
	    end ;	! The last good record could not be found.


	%if Tops20 %then

	if $step_close(iob=out_iob,option=remember,failure=0) neq step$_normal then
	    bug(lit('Unable to close output history file.')) ; 

	! close the input file and delete it
	if $step_close(iob=i_iob,option=remember,failure=0) neq step$_normal then
	    bug(lit('Unable to input history file.')) ;

	delvrs(filvrs,.log_spec[desc_len],.log_spec[desc_ptr]) ;

	%fi


	%if VaxVms %then
	if not $step_close(iob = i_iob, failure = 0)
	then
	    begin		! Could not close after examination.
	    err(s_hnoclose,lit('Cannot close history file' )) ;
	    return false ;
	    end ;		! Could not close after examination.

	if .bad_found
	then
	    begin	! Truncate at the bad record.
	    local
		fab : $fab_decl,
		rab : $rab_decl ;

	    ! Initialize for access by record's file address.
	    $fab_init(fab = fab, fac = trn, 
		    fns = .log_spec[desc_len], fna = .log_spec[desc_ptr]) ;
	    $rab_init(rab = rab, fab = fab, rac = rfa) ;

	    ! Open the log file for truncation.
	    if not (status = rmsopen(fab))
	    then
		begin	! Could not open for truncation.
		errsts(s_htopenerr,.status, lit('History file could not be opened for truncation')) ;
		return false ;
		end ;	! Could not open for truncation.
		
	    ! Connect the RAB to the FAB.
	    if not (status = $connect(rab = rab))
	    then
		begin	! Could not connect.
		errsts(s_htnotconn,.status, lit('History file could not be connected for truncation'));
		return false ;
		end ;	! Could not connect.

	    ! Tell RMS to find the bad record.
	    ch$move(rab$s_rfa, ch$ptr(save_rfa), ch$ptr(rab[rab$w_rfa])) ;
	    if not (status = $find(rab = rab))
	    then
		begin	! Could not find the bad record.
		errsts(s_bfnotfnd,.status, cat('Bad History file record could',
			    ' not be found again')) ;
		return false ;
		end ;

	    ! Delete the bad record.
	    if not (status = $truncate(rab = rab))
	    then
		begin	! Could not truncate the log.
		errsts(s_nohdel,.status, lit('Bad history file record could not be deleted')) ;
		return false ;
		end ;

	    if not (status = $close(fab = fab))
	    then
		begin	! Could not close after truncation.
		errsts(s_htcloserr,.status, lit('History file not closed after truncation')) ;
		return false ;
		end ;	! Could not close after truncation.

	    end ;	! Truncate at the bad record.
	%fi

	return true;

	end;	!(of block normal_processing)

    !
    ! An error occured during the reading (and possibly re-writing) of the
    ! history file.  Close the file that is open for read and close and 
    ! delete the file that is open for write.
    !

    if not $step_close (iob = i_iob,
			failure = 0)
    then
	err(s_hnoclose,lit('Cannot close history file (open for reading)'));


    %if Tops20 %then

    if not $step_close (iob     = out_iob,
			options = remember,
			failure = 0)
    then
	bug(lit('Cannot close history file (open for writting)'));

    if not $step_delete (iob     = out_iob,
			failure = 0)
    then
	bug(lit('Cannot delete partially re-written history file'));

    %fi

    return false;
    end ;	! RECOVER_LOG
routine recover_non_log(a_id, n_calls) =

!++
! Functional Description:
!
!	This routine recovers a non-log file to the version that existed before
!	the tranaction being nullified.
!
!	It should be called by WILDS for each file of the library directory,
!	and then called once more with .N_CALLS equal to -1.
!	If .DO_THE_RECOVERY is FALSE, no changes will be made to the library,
!	but checks will be performed to see if the library is recoverable.
!
!	This routine assumes that all files with the same file name and type
!	are presented consecutively, in order of decreasing version number.
!	The WILDS routine satisfies this requirement.
!
!	NB:  TOPS-10 has no file versions/generations.
!	This routine and WILDS act accordingly.
!
!	Because this routine has OWN storage declared within it, it can process
!	only one sequence of calls at a time.
!
! Formal Parameters:
!
!	A_ID:		Address of file idenification, in the case of VAX
!			
!			Address of a FAB block with a NAM block attached,
!			describing one file of the directory being scanned.
!			
!			In the case of the -20 this is the address of the
!			JFN describing one file in the directory being scanned
!
!			In the case of the -10 this is the address of a
!			file-spec string descriptor.
!			
!			If .NCALLS is -1, this parameter is ignored.
!
!	N_CALLS:	Number of times this routine has been called in a
!			sequence of calls, one for each file of the directory.
!			The call for the first file is 1, and -1 indicates
!			a final call after calls for all the files.
!
! Implicit Inputs:
!
!	The time blocks BAD_TIME and GOOD_TIME declared own in this module.
!	DO_THE_RECOVERY declared own in this module.
!	RECOVERABLE declared own in this module.
!
! Implicit Outputs:
!
!	RECOVERABLE declared own in this module.
!
! Routine Value:
! Completion Codes:
!
!	TRUE means call again if there is another file in the directory, or
!	with .NCALLS equal to -1 if there are no more.  FALSE means do not
!	call again for this sequence of calls, i.e., the next call must be
!	with .N_CALLS equal to 1 or -1.  FALSE is always returned if
!	.N_CALLS is -1.
!
! Side Effects:
!
!	Files are deleted from fac_name$LIB to help effect recovery.
!
!--

    begin	! RECOVER_NON_LOG

    !+
    ! This routine deletes files created by the transaction being nullified.
    ! It ignores files normally appended or not modified.  For example, it
    ! ignores the LOG and LOK files.  To be deleted, a file must have the
    ! following characteristics:
    !
    !	It must have the highest version number for its file name and type.
    !	It must not have been closed by us, or else its transaction time must
    !		be equal to that of the transaction being nullified.
    !
    ! As a precaution, a file with a version number greater than 1 is not
    ! deleted unless there is a backup file for it in the library.  The backup
    ! must have the following characteristics:
    !
    !	It must have the same file name and type as the file to be deleted.
    !	Its version number must be 1 less than that of the file to be deleted.
    !	It must have been closed by us.
    !	Its transaction time must be less than the last good transaction time.
    !
    ! To meet these requirements, the routine remembers the file it saw on
    ! the previous call (by descriptor PREVIOUS), and whether the file should
    ! be deleted (by variable NEED_TO_DELETE).
    !
    ! As an additional test for library integrity, the routine checks that all
    ! good (not deletable) files of the same name and type have consecutive
    ! version numbers and consecutive transaction times.
    !-

%if VaxVms %then

    bind
	fab = .a_id : $fab_decl,
	nam = if .n_calls eql -1 then 0 else .fab[fab$l_nam] : $nam_decl ;

%fi

%if Tops20 %then

    own
	f_id: ref block[1] ;		! file id (jfn)

    own
        f_len,                          ! length of filename
	file_id,			! temporay work area
	file_str: block[ch$allocation(extended_file_spec)],
					! area to store ascii file string
	p_upd,				! pointer to end of string
	req_mask;			! request mask

%fi

    own
	n_files,			! Number of files in this sequence.
	need_to_delete,			! The previous file should be deleted
					! if it has a good backup.
	previous : $str_descriptor(class = dynamic, string = (0, 0)),
					! The specification of the previous
					! file in this sequence of calls,
					! provided it was not deleted.
					! A zero length string means there
					! is no such file.
	previous_time : time_block,	! The transaction time of the previous
					! file.  This is meaningful only if the
					! length of PREVIOUS is greater than
					! zero and .NEED_TO_DELETE is FALSE.
					! (and .SEQUENCE_IN_PROCESS is TRUE.)
	sequence_in_process : initial(false) ;
					! Means a sequence of calls has
					! started but not finished.

    local
	by_step,			! A file was closed by us.
	resultant : desc_block,		! Name of the file for this call.
	this_time : time_block ;	! Transaction time for current file.

    routine err_no_recovery(a_value,a_message) =
	begin	! ERR_NO_RECOVERY
	recoverable = false ;
	err(.a_value,.a_message)
	end ;	! ERR_NO_RECOVERY

    ! First dispose of the last-call case.
    if .n_calls eql -1
    then
	begin		! Last call of a sequence.

	! Make sure the library is still recoverable.  There is a similar test
	! below, but that message includes the file specification obtained
	! from FAB.
	if not .recoverable
	then
	    bug(lit('RECOVER_NON_LOG was given an unrecoverable library.')) ;

	! Make sure any previous file is not supposed to be deleted.
	if .sequence_in_process and .need_to_delete
	then
	    err_no_recovery(s_nobackup,cat('No backup for ', previous)) ;

	! Allow the next sequence of calls.
	sequence_in_process = false ;

	! End this sequence.
	return false ;

	end ;		! Last call of a sequence.

%if VaxVms %then

    ! .A_FAB is now meaningful, so identify the file for this call.
    $str_desc_init(descriptor = resultant,
			string = (.nam[nam$b_rsl], .nam[nam$l_rsa])) ;

%fi

%if Tops20 %then

    file_id = 0 ;
    f_id = .a_id ;
    file_id = .f_id[rh] ;

    req_mask = %o'111110000001';	! output: device,directory,filename
					! file type, version number, puncuatuate

    ! convert JFN to ascii string
    jfns(ch$ptr(file_str),.file_id,.req_mask,0;p_upd) ;

    f_len = ch$diff(.p_upd,ch$ptr(file_str)) ;
 
    ! set up the descriptor
    $str_desc_init(descriptor=resultant,
		       string=(.f_len,ch$ptr(file_str))) ;

%fi

    ! Make sure the library has not been found seriously defective so far.
    if not .recoverable
    then
	bug(cat('RECOVER_NON_LOG has unrecoverable library for ', resultant)) ;

    ! Start a sequence of calls on the first call.
    if .n_calls eql 1
    then
	begin		! First call of a sequence.

	! Make sure the previous sequence finished.
	if .sequence_in_process
	then
	    bug(cat(resultant, ' may not start a RECOVER_NON_LOG sequence.')) ;

	! Initialize the own storage for this sequence.
	sequence_in_process = true ;
	n_files = 0 ;
	$str_copy(string = (0, 0), target = previous) ;
	need_to_delete = false ;

	end		! First call of a sequence.
    else
	if not .sequence_in_process
	then
	    bug(cat(resultant, ' is first call to RECOVER_NON_LOG.')) ;

    ! Make sure no calls of the sequence are missed.
    n_files = .n_files + 1 ;
    if .n_files neq .n_calls
    then
	bug(cat('N_CALLS to RECOVER_NON_LOG is bad for ', resultant)) ;

    ! Ignore files that do not need to be recovered, or that are not to
    ! be recovered by this routine.
    if     nateql(resultant, lit(%string(lib, lok)))
	or nateql(resultant, lit(%string(lib, fin)))
	or nateql(resultant, lit(%string(lib, bad)))
	or nateql(resultant, lit(%string(lib, erlg)))
	or nateql(resultant, lit(%string(lib, log)))
	or nateql(resultant, lit(%string(lib, xxx)))
	or nateql(resultant, lit(%string(lib, intlck)))
    then
	return true ;

    ! Get the revision date and time, and whether closed by us.
    if not revmrk(len_comma_ptr(resultant), this_time, by_step)
    then
	by_step = false ;	! Directory entry exists, but file does not.
				! DELETE_OR_RENAME will remove the entry.

    ! See if this file is a candidate for deletion.
    if not .by_step or timeql(this_time, bad_time)
    then
	begin		! Candidate for deletion.

	! Do not delete the backup for a previous file.  (In this release
	! a transaction can only produce one new copy of a file.)
	if .need_to_delete
	then
	    begin	! Deletable backup.
	    if nateql(resultant, previous)
	    then err_no_recovery(s_candlboth,cat(previous, ' and ', resultant,
			' are both deletable'))
 	    else err_no_recovery(s_nobackup,cat('No backup for ', previous)) ;
	    return false ;
	    end ;	! Deletable backup.

	! Delete only the highest version of a file.
	if nateql(resultant, previous)
	then
	    begin	! Not highest version.
	    err_no_recovery(s_nothvers,
			    cat(resultant, ' is not the highest version')) ;
	    return false ;
	    end ;	! Not highest version.

	! Delete this file if it is version 1.
	if vernum(resultant) eql 1
	then
	    begin	! Delete version 1.
	    if .do_the_recovery
	    then
		if not delete_or_rename(resultant)
		then
		    begin	! Cannot delete version 1.
		    recoverable = false ;
		    return false ;
		    end ;	! Cannot delete version 1.

	    $str_copy(string = (0, 0), target = previous) ;
	    need_to_delete = false ;
	    end		! Delete version 1.
	else
	    begin	! Save a higher version for deletion.
	    $str_copy(string = resultant, target = previous) ;
	    need_to_delete = true ;
	    end ;	! Save a higher version for deletion.

	end		! Candidate for deletion.
    else
	begin		! Good file.

	! Make sure no good files have times after the last good transaction.
	if not timleq(this_time, good_time)
	then
	    begin	! Good file after last good transaction.
	    err_no_recovery(s_fafterlst,cat(resultant,
			' is a good file after the last good transaction')) ;
	    return false ;
	    end ;	! Good file after last good transaction.


	if .need_to_delete
	then
	    begin	! This file is a potential backup.
	
	    if not nateql(resultant, previous)
	    then
		begin	! Bad backup.
		err_no_recovery(s_nobackup,cat('No backup for ', previous));
		return false ;
		end ;	! Bad backup.

	    if .do_the_recovery
	    then
		if not delete_or_rename(previous)
		then
		    begin	! Cannot delete higher version.
		    recoverable = false ;
		    return false ;
		    end ;	! Cannot delete higher version.

		
	    end		! This file is a potential backup.
	else
	    if nateql(resultant, previous) and timleq(previous_time, this_time)
	    then
		begin	! Times not in version number sequence.
		err_no_recovery(s_rnbeforep,cat(resultant, ' not earlier than ',previous));
		return false ;
		end ;	! Times not in version number sequence.

	! Save this file specification for version and time checks.
	$str_copy(string = resultant, target = previous) ;
	timcop(this_time, previous_time) ;
	need_to_delete = false ;

	end ;		! Good file.

    true
    end ;	! RECOVER_NON_LOG
%if VaxVms %then
routine rement(a_file_spec) =

!++
! Functional Description:
!
!	This routine removes a directory entry, without deleting any file
!	to which the entry might point.  If removal fails, the user is
!	informed, and the routine returns false.
!
! Formal Parameters:
!
!	A_FILE_SPEC	Address of a descriptor of the file specification
!			of the entry to be removed.
!
! Implicit Inputs:
!
!	None
!
! Implicit Outputs:
!
!	None
!
! Routine Value:
! Completion Codes:
!
!	TRUE means the entry has been removed. FALSE means not, and the user
!	has been informed.
!
! Side Effects:
!
!	None
!
!--

    begin	! REMENT
    bind
	file_spec = .a_file_spec : desc_block ;

    local
	expanded_buf : vector[nam$c_maxrss, byte],  ! NAM block buffer.
	fab : $fab_decl,
	nam : $nam_decl,
	status ;			! RMS status code.

    $fab_init(fab = fab, nam = nam, fns = .file_spec[desc_len],
				    fna = .file_spec[desc_ptr]) ;
    $nam_init(nam = nam, ess = nam$c_maxrss, esa = expanded_buf) ;

    ! Find the file entry in the directory.
    if not (status = $parse(fab = fab))
    then
	begin	! Cannot parse the specification.
	errsts(s_noparse,.status, cat('Can not parse ', file_spec)) ;
	return false ;
	end ;	! Cannot parse the specification.

    ! Remove the file entry from the directory.
    if not (status = $remove(fab = fab))
    then
	begin	! Cannot remove the entry.
	errsts(s_removfail,.status, cat('Can not remove ', file_spec)) ;
	return false ;
	end ;	! Cannot remove the entry.

    true

    end ;	! REMENT
%fi
routine rescind_bad_transaction =

!++
! Functional Description:
!
!	This routine cancels the indication that the last transaction
!	was not completed.  It should be called only when recovery is
!	complete in all other respects.
!
! Formal Parameters:
!
!	None
!
! Implicit Inputs:
!
!	None
!
! Implicit Outputs:
!
!	None
!
! Routine Value:
! Completion Codes:
!
!	TRUE means the transaction was successfully rescinded.
!	FALSE means the rescission was unsuccessful.
!
! Side Effects:
!
!	fac_name$LIB:00fac_name.BAD is deleted, meaning the library is now usable.
!
!--

    begin	! RESCIND_BAD_TRANSACTION
	
    delete_or_rename(lit(%string(lib, bad)))

    end ;	! RESCIND_BAD_TRANSACTION
%if VaxVms %then
routine rmsopen (fabptr)=

!++
! Functional Description:
!
!	When attempting to obtain the desired access, the routine will
!	wait a reasonable interval for other users to relinquish the
!	file.  The current user will be informed about this wait
!	and the reason for it.  If the wait is excessive (on the order of
!	4 minutes) an error will be returned.
!
! Formal Parameters:
!
!	fabptr - address of FAB
!
! Implicit Inputs:
!
!	none
!
! Implicit Outputs:
!
!	none
!
! Routine Value:
! Completion Codes:
!
!	Standard RMS values
!
! Side Effects:
!
!	The file is opened for the type of access requested.  This may
!	involve a delay until the desired access can be obtained.
!
!--

    begin	! rmsopen

    local
	attempts,			! Number of unsuccessful attempts
					! to open the file.
	status;				! Status code from $OPEN

    ! Grab the file as soon as it is available.
    attempts = 0 ;
    until
	(status = $open(fab = .fabptr))
    do
	begin	! Failed to get the file.

	! Limit the number of attempts.
	! Also quit if the error was not a file locked error
	attempts = .attempts + 1 ;
	if
	    .attempts geq k_max_attempts or
	    .status neq rms$_flk
	then
	    !Make it look like a normal call
	    exitloop;

	if
	    .attempts eql k_first_inform
	then
	    sysmsg(s_inuse,lit(%string('Your ',fac_name,' library is in use;  please wait')),0)
	else
	    if
		.attempts gtr k_first_inform and
		((.attempts - 1) mod k_inform_every_nth) eql 0
	    then
		sysmsg(s_waiting,lit('Still waiting'),0) ;

	hibernate(k_retry_seconds) ;

	end ;	! Failed to get the library.

    ! Tell the user his vigil is over.
    if
	.attempts geq k_first_inform
    then
	sysmsg(s_proceed,lit('Proceeding'),0) ;

    .status

    end ;	! rmsopen
%fi
end				! Module RECOVR
eludom