Trailing-Edge
-
PDP-10 Archives
-
DEC_CMS-20_V1.0_SRC
-
cms/sources/vcntrl.bli
There are no other files named vcntrl.bli in the archive.
MODULE vcntrl (
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 will perform the VERIFY Functions as required for the
! control files in the Library
!
! ENVIRONMENT: VAX/VMS, DS-20, TOPS-10
!
! AUTHOR: R. Wheater CREATION DATE: 8-Aug-80
!
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
vcntrl, ! scan library for verify functions
verfil, ! verifies an individual file
vergen; ! perform general verify functions
!
! INCLUDE FILES:
!
%if %bliss(bliss32) %then
library 'SYS$LIBRARY:STARLET';
undeclare %quote $descriptor; !Remove duplicate symbol
%fi
%if %bliss(bliss36) %then
%if %switches(tops20) %then
require 'JSYS:';
%fi
%fi
library 'XPORT:';
require 'SCONFG:';
require 'BLISSX:';
require 'COMUSR:';
require 'HOSUSR:';
require 'TIMUSR:';
require 'VCNUSR:';
!
! MACROS:
!
!
! EQUATED SYMBOLS:
!
!
! OWN STORAGE:
!
own
d_prev_file:desc_block, ! previous file string
%if %bliss(bliss32) %then
prev_file_buf: vector[nam$c_maxrss,byte],
%fi
%if %bliss(bliss36) %then
prev_file_buf: vector[ch$allocation(file_spec_size)],
%fi
prev_time: time_block ; ! rev date-time of previous file
own
c_int_file:initial(0), ! count of number of int files
c_lok_file:initial(0), ! count of number of lok files
f_bad_elm:initial(false), ! element file failed on verify test
! flags set when verification test is passed
f_lok_file:initial(false), ! lock file
f_log_file:initial(false), ! log file
f_xxx_file:initial(false), ! xxx file
f_int_file:initial(false), ! int file
f_err_file:initial(false), ! err file
f_bad_file:initial(false), ! bad file
f_rep_file:initial(false), ! rep file
f_fin_file:initial(false), ! fin file
f_atr_file:initial(false), ! atr file
f_def_file:initial(false), ! def file
f_res_file:initial(false), ! res file
f_search:initial(false), ! library search in progress
f_skip:initial(false), ! skip to new filename
f_skip_fin:initial(false), ! skip fin files
f_1st_fin:initial(false), ! set when encounter in 1st fin file
f_step_close:initial(false), ! set when closed by CMS
trnx_time: time_block; ! official transaction time from
! highest fin file
!
! EXTERNAL REFERENCES:
!
external
repair;
external literal
s_closeerr, !file was not closed by CMS,
s_consecerr, !the version #s are not consecutive
s_earlyterm, !inv file-premature termin of tcf search
s_ertimrev, !revision time not decreasing or equal
s_filebad, !bad file is present
s_invdir, !invalid library directory
s_invelemfl, !invalid elem files caused verif failure
s_invtcfile, !trans compl files invalid or missing
s_libempty, !no files found in library
s_Lonlyone, !only one lock file allowed in library
s_nodfile, !no definition file found in library
s_nodattim, !can't get date/time for highest file version
s_nohfile, !history file invalid or missing
s_nolfile, !lock file invalid or missing
s_norfile, !reservation file invalid or missing
s_nocfile, !class file invalid or missing
s_notcfile, !transaction completion file invalid or missing
s_notdone, !last transaction didn't complete properly
! s_novers1BI, !( no longer used ) batch interlock file must have a vers of 1
s_ver1forlk, !lock file must have a version of 1
! s_BIonlyone, !( no longer used ) only one batch interlock allowed in library
s_tcfgone, !no trans completion file exists in library
s_transplus; !file created after last good transaction
external routine
bug, ! print bug message(TERMIO)
bye, ! print error message and abort (TERMIO)
ckfile, ! check file for correctness (VERIFY)
delvrs, ! Delete INT file if there is a problem
err, ! print error message
fixhdr, ! repair file header
nateql, ! compare filename and type(FILOPS)
revmrk, ! get rev date-time and CMS close info(FILOPS)
vernum, ! return version number(FILOPS)
say, ! write line to terminal(TERMIO)
timcop, ! copy time block(TIME)
timeql,
timleq, ! comare times for equivalence(TIME)
wilds; ! wild card search of directory(FILOPS)
GLOBAL ROUTINE vcntrl =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine performs the scanning of the library necessary to
! do the verify functions.
!
! FORMAL PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! true = control files verified.
! false = Unable to verify control files.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
local
n_files,
valid ;
! initialize
n_files = 0;
valid = false ;
! set search flag - search in progress
f_search = true;
! make a pass through library for fin files
n_files = wilds(len_comma_ptr(%string(lib,fin,sys_wild_gen_spec)),
verfil,valid) ;
if
not .valid
then
begin
err(s_invdir,lit('Invalid library directory')) ;
return false ;
end ;
if
.n_files eql 0
then
begin ! empty library
err(s_tcfgone,
lit('No transaction completion files exist in the library')) ;
return false ;
end ; ! empty library
if
not .f_fin_file
then
begin
err(s_invtcfile,
lit('Transaction completion files invalid or missing')) ;
return false ;
end ;
! make final call for search clean up
verfil(k_null,-1) ;
! check for early termination of fin search
if
.f_search or not .f_skip_fin
then
begin
err(s_earlyterm,
lit(%string('Premature termination of transaction ',
'completion file search due to invalid file(s)'))) ;
return false ;
end;
! initialize
n_files = 0 ;
valid = false ;
! set search flag - search in progress
f_search = true;
! make a pass through library for control files
n_files = wilds(len_comma_ptr(%string(lib,sys_wild_file_spec)),
verfil,valid) ;
if
not .valid
then
begin
err(s_invdir,lit('Invalid library directory')) ;
return false ;
end ;
if
.n_files eql 0
then
begin ! empty library
err(s_libempty,lit('No files exist in the library')) ;
return false ;
end ; ! empty library
! make final call for cleanup
verfil(k_null,-1) ;
!+
! check if individual control files found
!+
if
.f_lok_file and .f_log_file and
.f_atr_file and .f_def_file and .f_res_file and
not .f_bad_file and not .f_bad_elm
then
return true ;
if
not .f_lok_file or .f_bad_file
then
begin ! bad or lok error
if
not .f_lok_file
then
err(s_nolfile,lit('Lock file is invalid or missing')) ;
if
.f_bad_file
then
err(s_notdone,lit('Last transaction did not complete properly')) ;
f_search = false ;
end ; ! bad or lok error
if
not .f_log_file
then
err(s_nohfile,lit('History file is invalid or missing')) ;
if
not .f_fin_file
then
err(s_notcfile,
lit('Transaction completion file is invalid or missing')) ;
if
not .f_atr_file
then
err(s_nocfile,lit('Class file is invalid or missing')) ;
if
not .f_def_file
then
err(s_nodfile,lit('Definition file is invalid or missing')) ;
if
not .f_res_file
then
err(s_norfile,lit('Reservation file is invalid or missing')) ;
if
.f_bad_elm
then
err(s_invelemfl,
lit('Verification failed due to invalid element file(s)')) ;
! return unable to verify status
return false ;
END; ! end of routine vcntrl
ROUTINE verfil(a_id,n_calls) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine perform individual file verification. It is assumed that
! this routine is called directly by the WILDS Routine. This is to
! insure that the files are presented in consecutively order.
!
! 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 call for each file in the
! directory. The first call in the sequence is 1, and
! a -1 indicates the end of the sequence and the final
! call after all the calls for all the files.
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! The flags defined at module level for control files may be set.
! "f_search" is cleared if the search completes.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! true = successful processing and ready to process next file.
! false = stop this sequence of calls. False is always returned
! if n_calls = -1.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
own
d_cur_file:desc_block, ! current file string on this call
c_files; ! count of control files
own
file_code ; ! code designating file type
%if %bliss(bliss36) %then
%if %switches(tops20) %then
own
f_id: ref block[1] ; ! file id (JFN)
own
f_len, ! file name len
file_id, ! temporay work area
file_str: block[ch$allocation(extended_file_spec+8)],
! area to store ascii file string
p_upd, ! updated string pointer
req_mask; ! request mask
%fi
%fi
! check for last call
if
.n_calls eql -1
then
begin
f_search = false ;
if
.f_1st_fin
then
f_skip_fin = true ;
return false ; ! end sequence
end ;
%if %bliss(bliss32) %then
! a_id contains filename - point to it
begin
bind
fab = .a_id:$fab_decl,
nam = .fab[fab$l_nam]:$nam_decl ;
$str_desc_init(descriptor=d_cur_file,
string=(.nam[nam$b_rsl],.nam[nam$l_rsa])) ;
end;
%fi
%if %bliss(bliss36) %then
%if %switches(tops20) %then
begin
f_id = .a_id;
file_id = 0 ;
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=d_cur_file,
string=(.f_len,ch$ptr(file_str))) ;
end ;
%else
! a_id contains filename - point to it
begin
bind
desc = .a_id: desc_block;
$str_desc_init(descriptor=d_cur_file,
string=(.desc[desc_len],.desc[desc_ptr]));
end;
%fi
%fi
!+
! now set file codes
!+
file_code =
(selectone true of
set
[nateql(d_cur_file,lit(%string(lib,lok)))] : k_lok_code ;
[nateql(d_cur_file,lit(%string(lib,log)))] : k_log_code ;
[nateql(d_cur_file,lit(%string(lib,xxx)))] : k_xxx_code ;
[nateql(d_cur_file,lit(%string(lib,erlg)))] : k_err_code ;
[nateql(d_cur_file,lit(%string(lib,intlck)))] : k_int_code ;
[nateql(d_cur_file,lit(%string(lib,bad)))] : k_bad_code ;
[nateql(d_cur_file,lit(%string(lib,repr)))] : k_rep_code ;
[nateql(d_cur_file,lit(%string(lib,fin)))] : k_fin_code ;
[nateql(d_cur_file,lit(%string(lib,atf)))] : k_atr_code ;
[nateql(d_cur_file,lit(%string(lib,cdir)))] : k_def_code ;
[nateql(d_cur_file,lit(%string(lib,res)))] : k_res_code ;
[otherwise] : k_unk_code ;
tes);
! initialize for start of sequence
if
.n_calls eql 1
then
begin ! first call
! set previous to null
$str_desc_init(descriptor=d_prev_file,
string=(0,ch$ptr(prev_file_buf))) ;
! set file counts to zero
c_files = 0 ;
end; ! first call
! check for skipping to new filename
if
.f_skip
then
begin
if
nateql(d_cur_file,d_prev_file)
then
begin ! skip this file
ch$move(len_comma_ptr(d_cur_file),ch$ptr(prev_file_buf));
$str_desc_init(descriptor=d_prev_file,
string=(.d_cur_file[desc_len],
ch$ptr(prev_file_buf))) ;
return true ;
end ! skip this file
else
f_skip = false ;
end ;
!+
! perform appropriate action for each of the control files
!
! 1. In all cases the error message is printed and
! processing continues looking for other errors.
!+
selectone .file_code of
set
[k_lok_code]:
begin ! lok file present
if
.c_lok_file eql 0
then
begin ! first lok file
if
vernum(d_cur_file) eql 1
then
begin
f_lok_file = true ;
c_lok_file = .c_lok_file + 1 ;
end
else
begin
err(s_ver1forlk,
lit('The lock file must have a version number of 1')) ;
! increment lok file count
c_lok_file = .c_lok_file + 1 ;
return true ;
end ;
! increment control file count
c_files = .c_files + 1;
end ! first lok file
else
begin ! more than one lok file
if
.c_lok_file eql 1
then
err(s_Lonlyone,
lit('Only one lock file is allowed in the library')) ;
c_lok_file = .c_lok_file + 1 ;
! set flag for printing error message
f_lok_file = false ;
return true ;
end ; ! more than one lok file
end; ! lok file present
[k_int_code]:
begin ! int file present
if
.c_int_file eql 0
then
begin ! first int file
if
vernum(d_cur_file) eql 1
then
begin
f_int_file = true ;
c_int_file = .c_int_file + 1 ;
end
else
begin
delvrs(0,len_comma_ptr(lit(%string(lib,intlck)))) ;
return true
end;
! increment control file count
c_files = .c_files + 1;
end ! first int file
else
begin ! more than one int file
delvrs(0,len_comma_ptr(lit(%string(lib,intlck)))) ;
return true ;
end ; ! more than one int file
end; ! int file present
[k_log_code]:
begin ! log file present
if
not .f_log_file
then
f_log_file = true ;
end; ! log file present
[k_xxx_code]:
begin ! xxx file present
if
not .f_xxx_file
then
f_xxx_file = true ;
end; ! xxx file present
[k_err_code]:
begin ! err file present
f_err_file = true ;
c_files = .c_files + 1;
end ; ! err file present
[k_bad_code]:
if not .repair
then
begin ! bad file present
err(s_filebad,lit(%string('File ', bad, ' is present'))) ;
f_bad_file = true ;
return true ;
end ; ! bad file present
[k_rep_code]:
f_rep_file = true ;
[k_fin_code]:
begin ! fin file present
if
not .f_skip_fin
then
begin ! 1st pass on fin files
if
not .f_fin_file
then
begin ! highest version fin file only
! obtain revision date-time for comparison with other files
if
not revmrk(len_comma_ptr(d_cur_file),trnx_time,
f_step_close)
then
bye(s_nodattim,lit(%string('Unable to get revision',
' date-time for highest version number of ',
'fin file'))) ;
if
.f_step_close
then
begin
f_fin_file = true ;
c_files = .c_files + 1 ;
end ;
f_1st_fin = true ;
! copy this file to previous
ch$move(len_comma_ptr(d_cur_file),ch$ptr(prev_file_buf)) ;
$str_desc_init(descriptor=d_prev_file,
string=(.d_cur_file[desc_len],
ch$ptr(prev_file_buf))) ;
! copy transaction time to previous
timcop(trnx_time,prev_time) ;
end ! highest version fin file only
else
begin ! more than one fin file
if
.f_1st_fin
then
begin
if
not vergen(d_cur_file)
then
begin
if
.f_fin_file
then
f_fin_file = false ;
return false ;
end ;
end;
end; ! more than one fin file
end ; ! 1st pass on fin files
end; ! fin file present
[k_atr_code]:
begin ! atr file present
if
not vergen(d_cur_file)
then
begin
f_skip = true ;
f_atr_file = false ;
end
else
begin
if
not .f_atr_file
then
begin
f_atr_file = true ;
c_files = .c_files + 1 ;
end
end ;
end; ! atr file present
[k_def_code]:
begin ! def file present
if
not vergen(d_cur_file)
then
begin
f_skip = true ;
f_def_file = false ;
end
else
begin
if
not .f_def_file
then
begin
f_def_file = true ;
c_files = .c_files + 1 ;
end
end ;
end; ! def file present
[k_res_code]:
begin ! res file present
if
not vergen(d_cur_file)
then
begin
f_skip = true ;
f_res_file = false ;
end
else
begin
if
not .f_res_file
then
begin
f_res_file = true ;
c_files = .c_files + 1 ;
end
end ;
end; ! res file present
[k_unk_code]:
begin ! element files
if
not vergen(d_cur_file)
then
f_bad_elm = true
else
!Verify the contents of the file proper
begin
if
not ckfile(d_cur_file)
then
f_bad_elm=true
else
say(cat('File ',d_cur_file,' verified'))
end
end ; ! element files
tes;
! return to WILDS Routine
true
END; ! end of routine verfil
ROUTINE vergen(a_cur_file)=
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine performs the general verify functions enumerated
! below:
!
! 1. The file must have been closed by CMS.
! 2. Revision Date-Time is less than or equal that of the
! highest version of "00fac_name.FIN".
! 3. If more than one instance of this filename:
! - must have consecutive version numbers.
! - revision Date-Time fields must decrease with
! decreasing version numbers
!
! This routine updates the previous file name descriptor. It also
! assumes that both previous and current filename descriptor are
! properly initialized.
!
! FORMAL PARAMETERS:
!
! a_cur_file Address of current file descriptor
!
! IMPLICIT INPUTS:
!
! d_prev_file descriptor of previous filename
!
! IMPLICIT OUTPUTS:
!
! d_prev_file is updated.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! true = passed all verification test performed by this routine.
! false = failed to pass one of the verification tests
!
! SIDE EFFECTS:
!
!
!
!--
BEGIN
bind
d_cur_file = .a_cur_file:desc_block ;
own
cur_time: time_block; ! rev date_time of current file
local
f_new_file ;
if
nateql(d_prev_file,d_cur_file)
then
f_new_file = false
else
f_new_file = true ;
if
.f_new_file
then
begin ! new file processing
! see if file closed by CMS
if
not revmrk(len_comma_ptr(d_cur_file),cur_time,f_step_close)
then
f_step_close = false ;
if
not .f_step_close
then
begin
if
not .repair
then
err(s_closeerr,cat('File ', d_cur_file, ' was not',
%string(' closed by ',fac_name))) ;
ch$move(len_comma_ptr(d_cur_file),ch$ptr(prev_file_buf)) ;
$str_desc_init(descriptor=d_prev_file,
string=(.d_cur_file[desc_len],
ch$ptr(prev_file_buf))) ;
timcop(cur_time,prev_time) ;
!See if we are allowed to try a repair
if
.repair
then
begin
if
not fixhdr(d_cur_file,trnx_time)
then
return false
end
else
return false
end ;
! is revision date-time less or equal to date-time of highest fin file
if
.f_step_close and not timleq(cur_time,trnx_time)
then
begin
if
not .repair
then
err(s_transplus,cat('File ', d_cur_file, ' was created after',
' last successful transaction')) ;
ch$move(len_comma_ptr(d_cur_file),ch$ptr(prev_file_buf)) ;
$str_desc_init(descriptor=d_prev_file,
string=(.d_cur_file[desc_len],
ch$ptr(prev_file_buf))) ;
timcop(cur_time,prev_time) ;
!try to fix it if we are allowed
if
.repair
then
begin
if
not fixhdr(d_cur_file,trnx_time)
then
return false
end
else
return false
end ;
! move current values to previous values
ch$move(len_comma_ptr(d_cur_file),ch$ptr(prev_file_buf)) ;
$str_desc_init(descriptor=d_prev_file,
string=(.d_cur_file[desc_len],
ch$ptr(prev_file_buf))) ;
timcop(cur_time,prev_time) ;
end
else
begin ! consecutive file processing
if
not revmrk(len_comma_ptr(d_cur_file),cur_time,f_step_close)
then
f_step_close = false ;
if
not .f_step_close
then
begin
if
not .repair
then
err(s_closeerr,cat('File ', d_cur_file, ' was not closed',
%string(' by ',fac_name)));
ch$move(len_comma_ptr(d_cur_file),ch$ptr(prev_file_buf)) ;
$str_desc_init(descriptor=d_prev_file,
string=(.d_cur_file[desc_len],
ch$ptr(prev_file_buf))) ;
timcop(cur_time,prev_time) ;
!see if we are allowed to try a repair
if
.repair
then
begin
if
not fixhdr(d_cur_file,trnx_time)
then
return false
end
else
return false
end ;
! compare version numbers
if
vernum(d_prev_file) neq vernum(d_cur_file) + 1
then
err(s_consecerr,cat('The version numbers of ',d_prev_file,
' and ',d_cur_file,' are not consecutive')) ;
! make sure revision times are decreasing or equal
if
.f_step_close and
timleq(prev_time,cur_time) and
not timeql(prev_time,cur_time)
then
begin
err(s_ertimrev,cat('The revision date-time of file ', d_cur_file,
' is not less than the previous file ', d_prev_file)) ;
ch$move(len_comma_ptr(d_cur_file),ch$ptr(prev_file_buf)) ;
$str_desc_init(descriptor=d_prev_file,
string=(.d_cur_file[desc_len],
ch$ptr(prev_file_buf))) ;
timcop(cur_time,prev_time) ;
return false ;
end ;
! move current values to previous values
ch$move(len_comma_ptr(d_cur_file),ch$ptr(prev_file_buf)) ;
$str_desc_init(descriptor=d_prev_file,
string=(.d_cur_file[desc_len],
ch$ptr(prev_file_buf))) ;
timcop(cur_time,prev_time) ;
end ;
true
END; ! end of routine vergen
END ! End of module
ELUDOM