Trailing-Edge
-
PDP-10 Archives
-
DEC_CMS-20_V1.0_SRC
-
cms/sources/rolbck.bli
There are no other files named rolbck.bli in the archive.
%TITLE 'Main ROLL BACK action routines'
MODULE ROLBCK (IDENT = '1',
%if
%bliss(bliss32)
%then
language(bliss32),
addressing_mode(external=general,
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 performs the Roll Back functions neccessary to restore
! the library to a consistent state after an error has occurred.
!
! ENVIRONMENT:
! VAX/VMS,DS-20
!
! AUTHOR: Bob Wheater, CREATION DATE: 4-AUG-1981
!
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
rbadd, ! Add an entry to the ROLBCK List
rbafn, ! add an entry to the closed file names list
rbapp, ! do roll back on file opened for append
rbcln, ! check for system logical name
rbsvap, ! save info required rolback an appended file.
rbmain, ! initiate roll-back and print status message
rbproc, ! main processing routine for roll back
rbread, ! do roll back on file open for reading
rbremv, ! remove rolbck list entry from list
rbwrit; ! do roll back on file open for writing
!
! INCLUDE FILES:
!
%if %bliss(bliss32) %then library 'SYS$LIBRARY:STARLET'; %fi
library 'XPORT:';
%if %bliss(bliss36) %then require 'JSYS:'; %fi
require 'BLISSX:';
require 'RBUSR:';
require 'BUFUSR:';
require 'SCONFG:';
require 'CNCUSR:';
require 'logusr:';
!
! MACROS:
!
keywordmacro
debug_comment (CAT_Param, LIT_Param, opn_blk, level=1) =
begin
!+
! This macro is used to generate in-line code for debugging
! purposed. The /VARIANT switch controls the generation of
! code. If code is generated, the /T_E_S_T_12 qualifier
! is used to activate it.
! level 1 trace operation of actual rolbck operation
! from routine RBPROC.
! 2 (1) plus creation of open-file and closed-
! file data structures
! 3 (2) plus trace routine RBCLN
! 4 (3) plus dump rbdefs structure
!-
%if _debug_ %then ! generate debug code or null
if .test[12] geq level then ! /TEST12 value >= value supplied
begin
%if not %null(lit_param) %then
lib$put_output(lit(%remove(lit_param)));
%fi
%if not %null(cat_param) %then
lib$put_output(cat(%remove(cat_param)));
%fi
%if not %null(opn_blk) %then
rbdefs(opn_blk);
%fi
end;
%fi
0 !(make final ";" legal)
end
%;
!
! EQUATED SYMBOLS:
!
literal
_debug_ = %variant gtr 0; ! generate debug code when compiled with /VAR:1 or greater
!
! OWN STORAGE:
!
global
as_file: vector[ch$allocation(extended_file_spec)],
! storage for show/append filename
d_as_file: desc_block, ! desc for show/append filename
bad_file: vector[ch$allocation(extended_file_spec)],
! storage for bad file name
d_bad_file: desc_block, ! desc for bad file
!+
! the following flags are set on the open of a particular file for
! appending and cleared when the restore address for the file is
! saved.
!-
f_ap_err_pending:initial(false), ! error file
f_ap_his_pending:initial(false), ! history file
f_ap_shw_pending:initial(false), ! show/append output file
f_as_setout:initial(false), ! set by routine SETOUT when opening
! a file for append ( only occurrs once
! per transaction )
f_bad_delay: initial(false), ! set when processing the bad file to
! delay deletion until just before the
! LOK file is close so as to leave the
! library in a consistent state if
! the roll back is interrupted before
! completion
f_rb_pending:initial(false), ! set when the first entry added to the list
! and remains set until ROLBCK IS
! initiated or cleared by Endtrn(TRANSA)
f_rb_in_progress:initial(false), ! set when rolbck is being performed
f_rb_clspd:initial(false), ! close pending, set by Endtrn(TRANSA)
! after bad file renamed to fin file.
! The transaction is COMMITTED at this
! time
f_lib_modified:initial(false), ! set when a library file is opened for writting
! used to costomize message to user after roll-back is completed
! reset by ENDTRN(TRANSA)
f_1st_ent:initial(false), ! set when first entry put in open iob list
f_cre_fn_lst: initial(false); ! set when closed file name list
! created and first entry added
own
f_del_lok_file: initial(false), ! set when the .LOK file must be deleted at end of ROLBCK
! This takes care of the special case of INIT command creating the .LOK file,
! closing it, then reopening it for append. The normal procedure would try
! to delete the file while it was still open for append.
f_rb_completed: initial(false), ! set when all rolbck activities are
! completed
a_blk: ref block[k_rb_def_size] field(rb_defs),
! address rolbck list entry user area
a_fn: ref block[k_rbfnent_size] field(rbfnent),
! address closed filenames list user area
d_fil_lst : ! file names list id desc
$str_descriptor(class = fixed,
string = 'filename_list'),
d_rblist : ! indicates rblist id string
$str_descriptor(class = fixed,
string = 'RBLIST');
!
! EXTERNAL REFERENCES:
!
external
f_show, !a show is in progress
f_del_log, !delete cms$lib:
repair, !a ver/repair is in progress
test: vector ; ! test vector set by test qual (RECTST)
external literal
s_inhibit, ! rolbck inhibited
s_alreadydn, ! command already completed
s_restordlb, ! library restored to original state
s_cnclrstrd, ! cmd canceled - lib restored
s_ccancldit, ! cmd canceled by ^C
s_illfilopn, ! file open after transaction completed
s_xtrarbc; ! Multiple illegal calls to rollback
external routine
badbug, ! print error message and abort(ERRMSG)
bad_to_fin, ! rename the bad to fin file
dellog, ! delete a logical name
dirspc, ! get directory portion of spec (DIROPS)
fuldir, ! get file spec and see if library (DIROPS)
isfile, ! is file in lib(FILOPS)
logtrn, ! log a transaction
lstadd, ! add list entry(LSTMGR)
lstdlk, ! delink an entry from the list(LSTMGR)
lstend, ! reset current pointer to end of list(LSTMGR)
lstini, ! initialize a linked list(LSTMGR)
lstpri, ! move list pointer to previous entry(LSTMGR)
lstrel, ! release the list (LSTMGR)
nateql, ! compare filename and typ (FILOPS)
%if _debug_ %then
rbdefs, ! print iob block - debug *** (RBDBG)
lib$put_output, ! print message - debug *** (TERMNL)
%fi
spcfil, ! check for special file rolbck should not work with
sysmsg, ! print message
trnlog, !translate logical name (LOGNAM)
truncate : novalue, ! truncate a file
vernum, ! find version number file(FILOPS)
zon_get, ! get memory from a zone(BUFMGR)
zon_init; ! initialize a zone(BUFMGR)
%SBTTL 'Add an entry to the roll back list'
GLOBAL ROUTINE rbadd(a_iob) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will add an entry to the rollback list. This routine
! is primarily called by the FILEIO routines to save the neccessary
! information required for rolbck
!
! FORMAL PARAMETERS:
!
! a_iob Address of IOB for this file.
! iob$g_comp_code status of OPEN operation
!
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! true = success
! false = failure
!
! SIDE EFFECTS:
!
! NOTE: All routines calling this routine should have disabled
! interrupts until this routine completes
!
!--
BEGIN
! pseudo-code design
! start:
! if
! first entry
! then
! initialize list
! else
! add list entry
! write info into block[0 rfa](true)
literal
k_max_lis_len = 7; ! maximum expected number of
! entries in the rolbck list
bind
iob = .a_iob: $xpo_iob() ;
own
d_result: desc_block, !
dirnam: desc_block, ! directory portion of spec
d_trn_nam: desc_block, ! translated name
is_library, ! flag for library directory
trnnam: vector[ch$allocation(extended_file_spec - file_spec_size)],
valid ; ! validity status
! check if this is the first entry to be written to the rolbck list
if
not .f_1st_ent
then
BEGIN ! first entry
!+
! the first entry to the rblist is to be written. thus, the
! rblist must be initialized at this time
!-
!initialize the list
if
not lstini(k_rb_def_size,k_max_lis_len,d_rblist,a_blk)
then
badbug(lit('Unable to initialize ROLL BACK List')) ;
! set rb pending flag
f_rb_pending = true ;
! set flag for first list entry
f_1st_ent = true ;
end ! first entry
else
begin ! add entry - list already exists
IF not lstadd(d_rblist,a_blk)
THEN
badbug(lit('Unable to add entry to roll back list')) ;
end ; ! add entry - list already exists
!+
! Now the block must be filled out with the following info
!
! 1. iob addres
! 2. operation code
! 3. zero append save info
! 4. type of file: user or library
!-
! set iob address
a_blk[add_iob] = .a_iob ;
!+
! set operation code
! The XPORT status bits are
! input
! output
! output and append
! output and overwrite
!-
SELECTONE true OF
SET
[.iob[iob$v_input]] : a_blk[op_code] = k_read ;
[.iob[iob$v_append]] :
BEGIN
IF nateql(iob[iob$t_resultant],lit(%string(lib,bad)))
THEN
BEGIN
!+
! force the BAD file to look like it was opened for write
! so that it will be deleted by rolbck.
!-
a_blk[op_code] = k_write
END
ELSE
BEGIN
IF .repair
THEN
BEGIN
!+
! force all files on a repair to look like reads so that
! they are closed instead of truncated.
!-
a_blk[op_code] = k_read;
END
ELSE
BEGIN
IF nateql(iob[iob$t_resultant],lit(%string(lib,lok)))
THEN
BEGIN
!+
! Force the LOK file to look like it was opened for
! read so that the only action taken by rolbck is
! to close it
!-
a_blk[op_code] = k_read;
END
ELSE
BEGIN
IF .iob[iob$g_comp_code] eql step$_created
THEN
BEGIN
!+
! This takes care of a few special cases. If user
! enters "CMS SHOW xxx/OUT/APPEND" and the output
! file does not exist, rolbck should delete it.
! The INITIALIZE command creates all of the
! control files with OPTIONS=APPEND, (I don't know
! why) but rolbck should delete them also.
!-
a_blk[op_code] = k_write ;
END
ELSE
a_blk[op_code] = k_append ;
END;
END;
END;
END;
[.iob[iob$v_overwrite]] :
BEGIN
IF nateql(iob[iob$t_resultant],lit(%string(lib,lok)))
THEN
BEGIN
!+
! The LOK file is opened for overwrite only by the INIT
! command for the initial creation.
! Force the LOK file to look like it was opened for read
! so that the only action taken by rolbck is to close it,
! then set the delete flag so it is deleted after it is
! closed.
!-
f_del_lok_file = true;
a_blk[op_code] = k_read
END
ELSE
a_blk[op_code] = k_write ;
END;
[.iob[iob$v_output]] : a_blk[op_code] = k_write ;
TES;
! file truncation data not filled in yet
a_blk[opn_trn_data_valid] = false;
!+
! Zero file truncation data for easer debugging. The truncation
! data is never looked at unless [xxx_trn_data_valid] is true.
!-
%if VaxVms %then
!zero rfa
ch$fill(0,rab$s_rfa,ch$ptr(a_blk[sav_rfa])) ;
%fi
%if Tops20 %then
a_blk[opn_sav_fbsiz] = 0;
%fi
%if Tops10 %then
%error('DS-10 code not yet implemented')
%fi
! determine type
$str_desc_init(descriptor=d_result,string=iob[iob$t_resultant]) ;
! get directory out of resultant
dirspc(d_result,dirnam) ;
%if vaxvms %then
! determine if a logical name in directory spec
If
.dirnam[desc_len] GTR 0
Then
Begin
$str_desc_init(descriptor=d_trn_nam,
string=((extended_file_spec - file_spec_size),ch$ptr(trnnam)));
If
TRNLOG(dirnam,d_trn_nam)
Then
$str_desc_init(descriptor=dirnam,string=d_trn_nam);
End;
%fi
! see if a library
is_library = false ;
fuldir(.dirnam[desc_len],.dirnam[desc_ptr],k_null,is_library) ;
a_blk[fil_typ] = (if .is_library
then k_lib
else k_user);
! set flag if writting into library
if .iob[iob$v_output] and .is_library
then
f_lib_modified = true;
debug_comment(cat_param=('RBADD: File ',iob[iob$t_resultant],
' added to open iob list'),
level = 2);
debug_comment(opn_blk = .a_blk, level = 4);
true
END; ! end of routine rbadd
%SBTTL 'Add an entry to the closed filenames list'
GLOBAL ROUTINE rbafn(a_iob) =
!++
!
! FUNCTIONAL DESCRIPTION:
!
! this routine adds entries to the closed filenames list maintained by
! the ROLBCK Module. This list contains the following items:
!
! 1. Descriptor and filename string
! 2. Operation code on original open
! 3. file type: library or user file
! 4. Restore address if applicable
!
! FORMAL PARAMETERS:
!
! a_iob Address of the iob as it is just before the close
! is actually issued.
!
! IMPLICIT INPUTS:
!
!
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! true = success
! false = failure
!
! SIDE EFFECTS:
!
!
!
!--
BEGIN
literal
k_fn_lst_len = 20, ! expected number of entries
k_fn_str_zone = extended_file_spec * k_fn_lst_len ;
! zone size for file strings
bind
iob = .a_iob: $xpo_iob();
own
a_str,
d_f_str: $str_descriptor(class = fixed, ! desc pointing to id string
string = 'file_strings'),
d_file: desc_block;
IF not .f_cre_fn_lst
THEN
BEGIN ! first entry
! get zone
IF not zon_init(k_char_mem,d_f_str,k_fn_str_zone)
THEN
badbug(lit('Unable to get zone for filenames string (RBAFN)')) ;
END; ! first entry
!+
! Common code for first, second, and subsequent entries.
!-
! get memory for filenames string and copy it out of iob
$str_desc_init(descriptor=d_file,string=iob[iob$t_resultant]) ;
IF not zon_get(k_char_mem,d_f_str,.d_file[desc_len],a_str)
THEN
badbug(lit('Unable to get memory for filename string (RBAFN)')) ;
ch$move(.d_file[desc_len],.d_file[desc_ptr],.a_str) ;
IF not .f_cre_fn_lst
THEN
BEGIN
! initialize list, add entry, and obtain address of user area
IF not lstini(k_rbfnent_size,k_fn_lst_len,d_fil_lst,a_fn)
THEN
badbug(lit('Unable to initialize filenames list (RBAFN)')) ;
END
ELSE
BEGIN
! add entry to list and obtain address of user area
IF not lstadd(d_fil_lst,a_fn)
THEN
badbug(lit('Unable to add list entry (RBAFN)')) ;
END;
! set up descriptor for this entry
$str_desc_init(descriptor=a_fn[fil_nam],
string=(.d_file[desc_len],.a_str)) ;
!+
! Now search list of open files for the matching entry
!-
! obtain current pointer
if
lstend(d_rblist,a_blk)
then
BEGIN ! current entry exist
! process and loop through rest of them
while true do
BEGIN ! processing loop
IF .a_blk[add_iob] eqla .a_iob
THEN
BEGIN ! found correct entry
! fill in rest of block
a_fn[fop_code] = .a_blk[op_code] ;
a_fn[f_type] = .a_blk[fil_typ] ;
%if VaxVms %then
ch$move(rab$s_rfa,ch$ptr(a_blk[sav_rfa]),a_fn[sv_add]) ;
%fi
%if Tops20 %then
a_fn[clo_sav_fbsiz] = .a_blk[opn_sav_fbsiz];
%fi
%if Tops10 %then
%warn ('DS-10 code not yet implemented')
%fi
a_fn[clo_trn_data_valid] = .a_blk[opn_trn_data_valid];
! set first time thru flag (if not already set)
f_cre_fn_lst = true;
! finished with the list
exitloop;
END; ! found correct entry
! backup up to previous entry
IF not lstpri(d_rblist,a_blk)
THEN
badbug(cat('Unable to find IOB in list (RBAFN)')) ;
END; ! processing loop
END; ! current entry exists
debug_comment (cat_param=('RBAFN: File ', a_fn[fil_nam],
' added to closed filename list'),
level=2);
true
END;
%SBTTL 'Roll back actions for file open for append'
ROUTINE rbapp(a_cell,a_rfa,f_status) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will roll back a file to its starting point before the
! open on an append operation.
!
! FORMAL PARAMETERS:
!
! a_cell If the file is open it is the address of
! the iob. If it is closed a_cell is the
! address of a desc of the filename string
!
! a_rfa VMS: Address of RFA cell(saved on first
! put operation to file.
! TOPS20: Address of original $FBSIZ value.
! TOPS10: nyi
!
! f_status current status of the file
! k_open currently open
! k_closed currently closed
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! true = success
! false = failure
!
! SIDE EFFECTS:
!
! NOTE: All routines calling this routine should have disabled
! interrupts until this routine completes
!
!--
BEGIN
! pseudo-code desig
! start;
! (VMS) | (TOPS-20)
! close file. | close file
! do rms open | do XPORT open
! do rms find record using RFA. | get job-file-number
! truncate record. | truncate
! close file. | XPORT close
local
d_file: desc_block, ! file name
status;
routine trun_err (status,a_d_msg) =
badbug (.a_d_msg);
IF .f_status eql k_open
THEN
Begin ! file open
bind
iob = .a_cell: $xpo_iob() ;
if not $cms_close(iob = iob,options=remember, failure = 0)
then
begin ! could not close appended file
badbug(cat('Unable to close file ',iob[iob$t_resultant],' (RBAPP)')) ;
return false ;
end ; ! could not close appended file
$str_desc_init(descriptor=d_file,string=iob[iob$t_resultant]);
end; ! file open
IF .f_status eql k_closed
THEN
$str_desc_init(descriptor=d_file,string=.a_cell) ;
debug_comment (cat_param=('RBAPP: Truncating file ', d_file));
!+
! Start system dependent truncate operation
!-
%if VaxVms %then ! restore address is rfa for VAX
begin
bind
rfa = .a_rfa;
truncate (d_file, rfa, trun_err);
end;
%fi ! restore address is rfa for VAX
%if Tops20 %then
BEGIN
BIND
original_size = .a_rfa;
truncate (d_file, original_size, trun_err); ! truncate file, call BADBUG if error occurs
END;
%fi
true
END; ! end of routine rbapp
%SBTTL 'check for system logical name'
GLOBAL ROUTINE rbcln(a_iob) =
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This routine check for system logical names such as: sys$input:,
! sys$output, sys$error, and sys$command or any other file which
! is not appropriate for rolbck to play with.
!
! FORMAL PARAMETERS:
!
! a_iob Address of an iob
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! true = is a system logical name
! false = is not a system logical name
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
bind
iob = .a_iob : $xpo_iob(),
d_filename = iob[iob$t_resultant];
local
ret_status;
! first check if IOB is valid
if not .iob[iob$v_open]
then
badbug(lit('Invalid IOB passed to RBCLN'));
ret_status =
spcfil(%if VaxVms %then .iob[iob$a_rms_fab] %fi
%if Tops20 %then .iob[iob$h_channel] %fi)
or
nateql(iob[iob$t_resultant],lit(%string(lib,INTLCK)));
if .ret_status
then
debug_comment (cat_param=('RBCLN: Returning TRUE for ', d_filename),
level=3)
else
debug_comment (cat_param=('RBCLN: Returning FALSE for ', d_filename),
level=3);
return .ret_status;
END;
%SBTTL 'save neccessary information to rolbck appended file'
GLOBAL ROUTINE rbsvap(a_iob) =
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This routine saves a file address of a file opened for appending
! so that it may be restored to its original state. In the case of
! VMS this routine is called by FILE$PUT after the first put operation
! on the file to save record file address(RFA) of the first record
! written. On TOPS-20, it is called just before the first put
! operation to save the file-btye-count.
!
! FORMAL PARAMETERS:
!
! a_iob Address of iob
!
! IMPLICIT INPUTS:
!
! %(/**/)%
!
! IMPLICIT OUTPUTS:
!
! %(/**/)%
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! %(/**/)%
!
! SIDE EFFECTS:
!
! NOTE: All routines calling this routine should have disabled
! interrupts until this routine completes
!
!--
BEGIN
bind
iob = .a_iob: $xpo_iob() ; ! iob
! get pointer to current rblist entry
IF lstend(d_rblist,a_blk)
THEN
BEGIN ! current entry exists
while true do
BEGIN ! back up thru list blocks
IF .a_blk[add_iob] eqla .a_iob
THEN
begin ! save restore address
%if VaxVms %then
local
rab: ref $rab_decl ; ! iob rab
! copy rfa into this block
rab = .iob[iob$a_rms_rab] ;
ch$move(rab$s_rfa,ch$ptr(rab[rab$w_rfa]),ch$ptr(a_blk[sav_rfa])) ;
%fi
%if Tops20 %then
LOCAL
jfn,
ret_code,
fbsiz;
jfn = .iob[iob$h_channel];
ret_code = gtfdb (.jfn, hwf(1,$fbsiz), fbsiz);
if .ret_code eql 0
then
badbug(lit('Roll Back unable to get $FBSIZ from GTFDB jsys'));
a_blk[opn_sav_fbsiz] = .fbsiz;
%fi
%if Tops10 %then
%warn ('DS-10 code not yet implemented')
%fi
! indicate to Roll Back that sav_add or opn_sav_fbsiz is valid
a_blk[opn_trn_data_valid] = true;
! get out of loop
exitloop;
END ! save restore address
ELSE
BEGIN ! back up to previous entry
IF not lstpri(d_rblist,a_blk)
THEN
! end of list without finding right iob address
badbug(lit('Roll Back unable to find right iob to save rfa')) ;
END; ! back up to previous entry
END; ! back up thru list blocks
END; ! current entry exists
true
END; ! end of routine rbsvap
GLOBAL ROUTINE RBMAIN (caller) =
!++
!
! FUNCTIONAL DESCRIPTION:
!
! Invoke command roll-back(RBPROC), then inform user of status.
! This routine should only be called if rolbck is needed, if not
! needed a bug call is done.
!
! FORMAL PARAMETERS:
!
! caller:
! k_from_ctrlc = from CTRL-C processing
! k_from_error = from error processing
!
! IMPLICIT INPUTS:
!
! f_rb_in_progress, f_rb_pending, f_rb_clspd
!
! IMPLICIT OUTPUTS:
!
! none
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! Status code of message sent to user.
!
! SIDE EFFECTS:
!
! roll back invoked, all files closed
!
!--
begin
local
rb_stat, ! status returned by RBPROC
ret_status; ! return status for this routine
! (a standard error code)
! find out if rolbck in progress
IF .f_rb_in_progress
THEN
badbug(lit('Fatal error occurred in Command Roll Back (RBMAIN)'))
ELSE
BEGIN ! rb not in progress
IF .f_rb_pending or .f_rb_clspd
THEN
BEGIN ! rolbck required
rb_stat = rbproc() ;
selectone .rb_stat of
set
! roll-back failed
[k_fail] :
badbug(lit('Command Roll Back failed')) ;
! impossible
[k_not_needed] :
badbug(lit('Flag mismatch in rolbck')) ;
! indicate rolbck successful
[k_uncommit_lib_restored_s] :
begin
if .caller eql k_from_ctrlc
then
begin
ret_status=s_cnclrstrd;
sysmsg(s_cnclrstrd,
lit('Command canceled - Library restored to original state'),0) ;
end
else
begin
ret_status=s_restordlb;
sysmsg(s_restordlb,
lit('Library restored to original state'),0) ;
end;
end;
! uncommitted transaction (library not modified in any way)
[k_uncommit_s] :
IF NOT .f_show
THEN
begin
ret_status=s_ccancldit;
sysmsg(s_ccancldit,
lit('Command canceled'),0) ;
end
ELSE
ret_status = k_uncommit_s;
[k_commit_s] :
begin
ret_status=s_alreadydn;
sysmsg(s_alreadydn,
lit('Command already completed'),0) ;
end;
[k_inhibit_f] :
begin
ret_status=s_inhibit;
sysmsg(s_inhibit,
lit('Roll Back Inhibited - Library not restored'),0);
end;
[otherwise] :
badbug(lit('Unknown status returned by RBPROC (RBMAIN)'));
tes;
end;
end;
return .ret_status;
end; !(of routine RBMAIN)
%SBTTL 'Main roll back processing routine'
GLOBAL ROUTINE rbproc =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine performs the functions required by command rolback.
! It is called by an ERR or BUG call. NOTE: CTRL/C interrupts are
! not allowed during ROLBCK.
!
! FORMAL PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! The ROLBCK list containing the files that I/O was performed
! upon during this transaction and are currently open.
!
! TEST /T_E_S_T_10:1 inhibits roll back
! /T_E_S_T_12 controls debug tracing
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! k_commit_s = success on rolbck of a committed transaction
! k_uncommit_s = success on rolbck of an uncommitted transaction
! k_uncommit_lib_restored = success on rolbck of uncommited transaction,
! similar to k_uncommit_s but indicates library was actually
! modified and needed to be restored.
! k_fail = failure
! k_not_needed = rolbck not required
!
! SIDE EFFECTS:
!
! IMPORTANT NOTE: This routine disables CTRL/Y from being
! recognized. It knows that it is the last
! function being executed during a CMS command
! and that the error message processor will be
! called to issue the final message AND to
! reset CTRL/Y after this routine exits.
!
!--
BEGIN
! pseudo-code design
! start:
! set pointer to start of rolbck list.
! loop:
! obtain operation code of this file.
! select:
! append := rbapp()
! read := rbread()
! write := rbwrit()
! endselect:
! advance to next entry in rolbck list.
! endloop:
! free rolbck list.
! set rolbck_completed flag.
! clr rolbck_in_progress flag.
! exit image;
local
d_file: desc_block ; ! file name in iob
OWN
f_log : initial(false); ! do we log the transaction
! illegal call?
IF .f_rb_completed
THEN
badbug(lit('Multiple illegal calls to Roll Back (RBPROC)')) ;
! test qual present?
IF .test[10] GTR 0
THEN
return k_inhibit_f ;
! set in progress
IF not .f_rb_pending and not .f_rb_clspd
THEN
! no entries in rolbck list yet - return without doing anything
begin
!this flag means cms$lib: must be delete as a logical name
IF .f_del_log
THEN
dellog(lit(lib));
return k_not_needed;
END;
!now we know rollback is required, so disable the CTRL/Y
! and let the final error message handling re-enable it.
disable_ctl_y;
IF .f_rb_pending
THEN
BEGIN ! rolbck uncommitted transaction
f_rb_in_progress = true ;
f_rb_pending = false ;
debug_comment (lit_param=('RBPROC: Start ROLBCK of uncommitted transaction'));
!+
! PROCESS CLOSED FILES LIST
!-
IF .f_cre_fn_lst
THEN
BEGIN ! closed filenames list created
debug_comment (lit_param=('RBPROC: Start processing closed files list')) ;
! list pointer is normally pointing to end of list after entries are
! added
! obtain current pointer
if
lstend(d_fil_lst,a_fn)
then
BEGIN ! current list exists
! process and loop through rest of them
while true do
BEGIN ! processing loop
IF
.a_fn[f_type] eql k_user or
.a_fn[f_type] eql k_lib
THEN
BEGIN ! validity check of list entries
debug_comment (cat_param=('RBPROC: Processing closed file ',
a_fn[fil_nam])) ;
SELECTONE .a_fn[fop_code] OF
SET
[k_append]:
begin ! open for append
debug_comment (lit_param=(' was open for append'));
IF .a_fn[clo_trn_data_valid]
THEN
BEGIN ! valid rfa
IF not rbapp(a_fn[fil_nam],
%if VaxVms %then a_fn[sv_add], %fi
%if Tops20 %then a_fn[clo_sav_fbsiz], %fi
%if Tops10 %then %error('DS-10 nyi') %fi
k_closed)
THEN
badbug(cat('Unable to restore appended file ',a_fn[fil_nam],
' (RBPROC)'));
END;
end; ! open for append
[k_write]:
begin ! open for write
debug_comment (lit_param=(' was open for write'));
!+
! on a repair we want to do something different
! Since on a repair all files are opened for read
! except for the bad file this must be the bad.
! we don't want to 'roll back' but rather we
! want to log the transaction and rename the
! bad to fin; in other words salvage as much
! of the transaction as possible.
!-
IF
.repair
THEN
f_log = true
ELSE
BEGIN
IF not rbwrit(a_fn[fil_nam],
.a_fn[f_type],
k_closed)
THEN
badbug(cat('Unable to delete file ',a_fn[fil_nam],
' open for writing (RBPROC)'));
END;
end ; ! open for write
[k_read]:
! do nothing
debug_comment (lit_param=(' was open for read'));
[otherwise]:
badbug(lit('Illegal operation code detected (rbproc)')) ;
TES;
ENd; ! validity check of list entries
! backup up to previous entry
IF not lstpri(d_fil_lst,a_fn)
THEN
exitloop;
END; ! processing loop
END; ! current list exists
END; ! closed filenames list created
! log the repair
IF .f_log and .repair
THEN
BEGIN
logtrn(k_unusual_log,0,0);
bad_to_fin();
END;
!+
! PROCESS THE OPEN FILES LIST
!-
IF .f_1st_ent
THEN
BEGIN ! Open iob list created
debug_comment (lit_param=('RBPROC: Start processing open files list')) ;
! list pointer is normally pointing to end of list after entries are
! added
! obtain current pointer
if
lstend(d_rblist,a_blk)
then
BEGIN ! current entry exists
! process and loop through rest of them
while true do
BEGIN ! processing loop
bind
iob = .a_blk[add_iob] : $xpo_iob();
IF
(.a_blk[fil_typ] eql k_user or
.a_blk[fil_typ] eql k_lib)
THEN
BEGIN ! validity check of entries
debug_comment (cat_param=('RBPROC: Processing open file ',
iob[iob$t_resultant])) ;
SELECTONE .a_blk[op_code] OF
SET
[k_append]:
begin ! open for append
debug_comment (lit_param=(' is open for append'));
IF .a_blk[opn_trn_data_valid]
THEN
BEGIN ! valid rfa
IF not rbapp(.a_blk[add_iob],
%if VaxVms %then a_blk[sav_rfa], %fi
%if Tops20 %then a_blk[opn_sav_fbsiz], %fi
%if Tops10 %then %error('DS-10 nyi') %fi
K_open)
THEN
badbug(cat('Unable to restore appended file ',iob[iob$t_resultant],
' (RBPROC)'));
END ! valid rfa
ELSE
begin ! insure that file closed
$cms_close(iob=.a_blk[add_iob]) ;
end;
end; ! open for append
[k_read]:
begin ! open for reading
debug_comment (lit_param=(' is open for read'));
IF not rbread(.a_blk[add_iob],.a_blk[fil_typ])
THEN
badbug(cat('Unable to restore file ',iob[iob$t_resultant],
' open for reading (RBPROC)'));
%if 0 %then
lib$put_output (cat('Complete rbread process of ',iob[iob$t_resultant],
' open list'));
%fi
end ; ! open for reading
[k_write]:
begin ! open for write
debug_comment (lit_param=(' is open for write'));
IF not rbwrit(.a_blk[add_iob],.a_blk[fil_typ],k_open)
THEN
badbug(cat('Unable to close and delete file ',iob[iob$t_resultant],
' open for writing (RBPROC)'));
%if 0 %then
lib$put_output (cat('completed rbwrit process of ',iob[iob$t_resultant],
' open list')) ;
%fi
end ; ! open for write
[otherwise]:
badbug(lit('Illegal operation code detected (rbproc)')) ;
TES;
END; ! validity check of entries
! backup up to previous entry
IF not lstpri(d_rblist,a_blk)
THEN
exitloop;
END; ! processing loop
END; ! current entry exists
! release rolbck list
IF not lstrel(d_rblist)
THEN
badbug(lit('Unable to release the ROLBCK List. (RBPROC)'));
END; ! Open iob list created
if .f_del_lok_file
then
begin
local
status,
$oc_block_decl(del_lok);
f_del_lok_file = false;
$oc_block_init(del_lok);
status = $step_delete(iob = del_lok_iob,
file_spec = %string(lib,lok),
failure = 0);
if not .status
then
badbug(lit(%string('Unable to delete ', lib,lok, ' (RBPROC)')));
debug_comment(lit_param=('RBPROC: .LOK file deleted'));
end;
IF .f_del_log
THEN
dellog(lit(lib));
! set appropriate flags
f_rb_completed = true ;
f_rb_in_progress = false ;
! set return value
if .f_lib_modified
then
begin
f_lib_modified = false;
return k_uncommit_lib_restored_s ;
end
else
return k_uncommit_s;
END; ! rolbck uncommitted transaction
IF .f_rb_clspd
THEN
BEGIN ! rolbck committed transaction
f_rb_in_progress = true ;
f_rb_clspd = false ;
debug_comment (lit_param=('RBPROC: Start ROLBCK for committed transaction'));
IF .f_1st_ent
THEN
BEGIN ! verify that open iob list exists
! list pointer is normally pointing to end of list after entries are
! added
! obtain current pointer
if
lstend(d_rblist,a_blk)
then
BEGIN ! current entry exists
! process and loop through rest of them
while true do
BEGIN ! processing loop
bind
iob = .a_blk[add_iob] : $xpo_iob();
SELECTONE .a_blk[op_code] OF
SET
[k_read]:
begin ! open for reading
IF not rbread(.a_blk[add_iob],.a_blk[fil_typ])
THEN
badbug(cat('Unable to restore file ',iob[iob$t_resultant],
' open for reading (RBPROC)'));
end ; ! open for reading
[K_append,k_write]:
BEGIN ! file open for read, write, or append
IF .iob[iob$v_open]
THEN
BEGIN ! open file
IF not nateql(iob[iob$t_resultant],lit(%string(lib,lok)))
THEN
badbug(cat('File ',iob[iob$t_resultant],
' open after transaction completed (RBPROC)')) ;
END; ! open file
END; ! file open for read, write, or append
TES;
! backup up to previous entry
IF not lstpri(d_rblist,a_blk)
THEN
exitloop;
END; ! processing loop
END; ! current entry exists
! release rolbck list
IF not lstrel(d_rblist)
THEN
badbug(lit('Unable to release the ROLBCK List. (RBPROC)'));
END; ! verify that open iob list exists
! set appropriate flags
f_rb_completed = true ;
f_rb_in_progress = false;
f_lib_modified = false;
f_del_lok_file = false;
! set return value
return k_commit_s;
END; ! rolbck committed transaction
k_not_needed
END; ! end of routine rbproc
%SBTTL 'Roll back actions on files open for reading'
ROUTINE rbread(a_iob,fil_typ) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine performs actions required for ROLBCK on a file
! that was opened for reading. this consists of closing the file
! both in the case of library files and user files.
!
! FORMAL PARAMETERS:
!
! a_iob address of iob
!
! fil_typ file type
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!
!
! SIDE EFFECTS:
!
! NOTE: All routines calling this routine should have disabled
! interrupts until this routine completes
!
!--
BEGIN
! psuedo-code design
! start:
! Close file.
bind
iob = .a_iob: $xpo_iob() ;
own
$io_block(del) ;
local
status ;
IF .iob[iob$v_open]
THEN
BEGIN ! open file
IF
.f_bad_delay and
nateql(iob[iob$t_resultant],lit(%string(lib,lok)))
THEN
BEGIN ! delete the bad file first
status=$step_delete(iob=del_iob,
file_spec=d_bad_file,
failure=xpo$io_failure) ;
IF not .status
THEN
badbug(cat('Unable to do delayed delete of file ',
del_iob[iob$t_resultant],
' during roll back (RBREAD)')) ;
END ; ! delete the bad file first
!close the file
status = $cms_close(iob=iob,options=remember,failure=0) ;
IF not .status
THEN
return false ;
END; ! open file
true
END; ! end of routine rbread
%SBTTL 'Remove an entry from the list of active rolbck files'
GLOBAL ROUTINE rbremv(a_iob) =
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This routine will de-link an entry from the roll back list
!
! FORMAL PARAMETERS:
!
! a_iob address of iob
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! true = success
! false = false
!
! SIDE EFFECTS:
!
! NOTE: All routines calling this routine should have disabled
! interrupts until this routine completes
!
!--
BEGIN
! obtain current pointer
if
lstend(d_rblist,a_blk)
then
BEGIN ! current entry exists
! process and loop through rest of them
while true do
BEGIN ! processing loop
IF .a_blk[add_iob] eqla .a_iob
THEN
BEGIN ! found correct entry
! de-link this entry
return lstdlk(d_rblist) ! propagate status from lstdlk
END; ! found correct entry
! backup up to previous entry
IF not lstpri(d_rblist,a_blk)
THEN
badbug(lit('Unable to find IOB in list (RBREMV)')) ;
END; ! processing loop
END; ! current entry exists
true
END; ! end of routine rbremv
%SBTTL 'Roll back actions for files open for writing'
ROUTINE rbwrit(a_cell,fil_typ,f_status) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will perform rollback actions required for files opened
! for writing. In most cases they are closed and deleted. However in the
! case of a library file a backup(if version greater than 1) must exist
! if deletion is to take place
!
! FORMAL PARAMETERS:
!
! a_cell address of the iob if open or address of desc
! if closed.
!
! fil_typ file type
!
! k_lib or
! k_user
!
! f_status file status
!
! k_open or
! k_closed
!
! IMPLICIT INPUTS:
!
! None.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!
!
! SIDE EFFECTS:
!
! NOTE: All routines calling this routine should have disabled
! interrupts until this routine completes
!
!--
BEGIN
! pseudo-code design
! start:
! close file.
! if
! user file
! then
! delete file(true)
! else
! if
! version = 1
! then
! delete file(true).
! if
! backup
! then
! delete file(true)
! else
! leave file intact
! send warning message(true).
own
$io_block(new);
local
d_file: desc_block,
status,
valid;
IF .f_status eql k_open
THEN
begin
bind
iob = .a_cell: $xpo_iob() ;
! save pointer to file string
$str_desc_init(descriptor=d_file,string=iob[iob$t_resultant]);
! close the file
status = $cms_close(iob=iob,options=remember,failure=0) ;
IF not .status
THEN
return false;
end
else
$str_desc_init(descriptor=d_file,string=.a_cell) ;
selectone .fil_typ of
set
[k_user] :
BEGIN ! user file
status = $step_delete(iob=new_iob,file_spec=d_file,failure=0) ;
IF not .status
THEN
return false;
return true ;
END; ! user file
[k_lib] :
BEGIN ! lib file
IF nateql(d_file,lit(%string(lib,bad)))
THEN
BEGIN ! bad file - delay delete
$str_desc_init(descriptor=d_bad_file,
string=(.d_file[desc_len],ch$ptr(bad_file)));
$str_copy(string=d_file, target=d_bad_file) ;
f_bad_delay = true ;
return true ;
END ; ! bad file - delay delete
IF vernum(d_file) eql 1
THEN
BEGIN ! version = 1
status = $step_delete(iob=new_iob,file_spec=d_file,failure=0) ;
IF not .status
THEN
return false;
return true;
END; ! version = 1
!+
! The file must be a library file with a version number greater
! than one thus, a check for a backup must be made.
!-
! nyi - temp
status = $step_delete(iob=new_iob,file_spec=d_file,failure=0) ;
IF not .status
THEN
return false;
return true ;
END; ! lib file
[otherwise] : ! not k_user or k_lib
return false;
tes;
END; ! end of routine rbwrit
END ! End of module
ELUDOM