Trailing-Edge
-
PDP-10 Archives
-
DEC_CMS-20_V1.0_SRC
-
cms/sources/filgen.bli
There are no other files named filgen.bli in the archive.
MODULE filgen (
IDENT = '1',
%if
%bliss(bliss32)
%then
LANGUAGE(BLISS32),
ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
NONEXTERNAL=LONG_RELATIVE)
%else
language(bliss36)
%fi
) =
BEGIN
!
! COPYRIGHT (c) 1982 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!++
! FACILITY: CMS Library Processor
!
! ABSTRACT:
!
! Verify that a file generation hasn't gone too high
!
! ENVIRONMENT: VAX/VMS, DS-20
!
! AUTHOR: D. Knight
!
!--
!
! TABLE OF CONTENTS
!
FORWARD ROUTINE
gen_lim, !See if generation limit has been reached
lookup; !rename file that has reached gen. limit
!
! INCLUDE FILES:
!
%if
%bliss(bliss32)
%then
library 'sys$library:starlet';
%fi
%if %bliss(bliss36) %then require 'jsys:'; %fi
LIBRARY 'XPORT:';
REQUIRE 'SCONFG:';
REQUIRE 'BLISSX:';
!
! MACROS:
!
!
! EQUATED SYMBOLS:
!
literal
%if VaxVms %then
max_gen_dig=5, !maximum number of digits in gen field
max_gen=32767, !should end up in sconfg.req
%fi
%if Tops20 %then
max_gen_dig = 6,
max_gen = 131071,
%fi
%if Tops10 %then
%warn('DS-10 support not written')
%fi
max_fil_cnt=100; !Maximum number of files that can
! be renamed
!
! OWN STORAGE:
!
own
file_count, !Number of files found
file_gen_list : vector[max_fil_cnt]; !list of generation numbers for
! files needing renaming
!
! EXTERNAL REFERENCES:
!
external routine
bug, !Bad error
decasc,
dirspc, !get directory portion of spec
isdir, !check for valid directory
vernum, !return version number
wilds; ! wild card search of directory
GLOBAL ROUTINE gen_lim (fil_ptr) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called when the file version limit is
! reached for a file in the library and does special
! renames of the files in question.
!
! FORMAL PARAMETERS:
!
! fil_ptr - address of file name descriptor
!
! IMPLICIT INPUTS:
!
! NONE.
!
! IMPLICIT OUTPUTS:
!
! NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! TRUE - successful rename
! FALSE - rename failed
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
map
fil_ptr : ref desc_block;
local
dir_spec : desc_block,
is_libr,
n_files,
$io_block_decl(ren),
status,
valid,
wild_buf : vector[ch$allocation(extended_file_spec)];
!See if the file is in the library
dirspc(.fil_ptr,dir_spec);
isdir(.dir_spec[desc_len],.dir_spec[desc_ptr],valid,is_libr);
if
not .valid or
not .is_libr
then
!don't try the rename, it either isn't in the library
!or isn't in a valid directory
return false;
!set up IOB for rename
$io_block_init(ren);
!Set no files seen yet
file_count=0;
!Make sure there are no wild cards already
if
not ch$fail(ch$find_ch(.fil_ptr[desc_len],.fil_ptr[desc_ptr],%c'*')) or
not ch$fail(ch$find_ch(.fil_ptr[desc_len],.fil_ptr[desc_ptr],%c'%'))
then
bug(cat('GEN_LIM found a wild card in ',.fil_ptr));
! add the wild card to the string
ch$copy(.fil_ptr[desc_len],.fil_ptr[desc_ptr],
%if VaxVms %then 2,ch$ptr(uplit(';*')), %fi
%if Tops20 %then 2,ch$ptr(uplit('.*')), %fi
0,
extended_file_spec,ch$ptr(wild_buf));
!lookup all generations of the file
n_files=wilds(.fil_ptr[desc_len]+2,ch$ptr(wild_buf),lookup,valid);
!See if everything worked OK
if
.n_files neq .file_count
then
!something doesn't match
bug(lit('GEN_LIM wild card mismatch'));
!make sure that there was a real generation overflow,
! not just a failure for other reasons
if
.file_gen_list[0] neq max_gen
then
!go away quietly if no rename is desirable
return false;
!now perform the actual renaming
! Walk through the list backwards and rename each file to a new
! generation where the last file in the list will be generation 1
! and the first file in the list will be generation N where N is the number
! of files to rename. WARNING - this must always be done in reverse order
! so that if a crash or failure occurs during this process, the user's files
! will still be in the correct ORDER in case he does a PURGE.
incr i from 1 to .file_count do
begin
!if it already has the right generation number, do nothing
if
.file_gen_list[.file_count-.i] neq .i
then
!This one needs a rename
begin
local
gen_field : vector[ch$allocation(max_gen_dig)],
gen_size,
new_file : vector[ch$allocation(extended_file_spec)],
new_size,
old_file : vector[ch$allocation(extended_file_spec)],
old_size;
!build the old file name
gen_size=decasc(.file_gen_list[.file_count-.i],ch$ptr(gen_field));
ch$copy(.fil_ptr[desc_len],.fil_ptr[desc_ptr],
1,ch$ptr(uplit(%if VaxVms %then ';' %fi
%if Tops20 %then '.' %fi )),
.gen_size,ch$ptr(gen_field),
0,
extended_file_spec,ch$ptr(old_file));
old_size=.fil_ptr[desc_len]+.gen_size+1;
!build the new file name
gen_size=decasc(.i,ch$ptr(gen_field));
ch$copy(.fil_ptr[desc_len],.fil_ptr[desc_ptr],
1,ch$ptr(uplit(%if VaxVms %then ';' %fi
%if Tops20 %then '.' %fi )),
.gen_size,ch$ptr(gen_field),
0,
extended_file_spec,ch$ptr(new_file));
new_size=.fil_ptr[desc_len]+.gen_size+1;
!now rename the file
status=$step_rename(iob=ren_iob,
file_spec=(.old_size,ch$ptr(old_file)),
new_spec=(.new_size,ch$ptr(new_file)),
failure=0);
!Go away if anything is wrong
if
not .status
then
return false
end
end;
!successful rename of all files
true
END; !End of GEN_LIM
ROUTINE lookup (handle,n_calls) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine looks up the individual files that need renaming.
! It builds a list of generation numbers to be looked at by GEN_LIM.
! It is assumed that this routine is always called from WILDS.
!
! FORMAL PARAMETERS:
!
! handle
! VMS Address of FAB block with a NAM block attached describing
! one file in the directory being scanned.
! TOPS20 Address of a full-word containing jfn.
!
! If n_calls is -1, then this parameter is meaningless.
!
! 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:
!
! NONE.
!
! ROUTINE VALUE:
! 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
%if Tops20 %then
local
buf : vector[ch$allocation(extended_file_spec)];
%fi
local
d_cur_file : desc_block, !current file string on this call
version_value;
!+
! Do system independent initial checking.
!-
!check for last call
if
.n_calls eql -1
then
return false;
!Don't let the table overflow
if
.file_count geq max_fil_cnt
then
bug(lit('FILGEN rename failure, too many files'));
!+
! System dependent code to get the file name.
!-
%if VaxVms
%then
begin
bind
fab=.handle : $fab_decl; ! handle passed is a FAB
local
f_nam : ref $nam_decl;
f_nam= .fab[fab$l_nam];
! a_fab contains the filename - point to it
$str_desc_init(descriptor = d_cur_file,
string = (.f_nam[nam$b_rsl],.f_nam[nam$l_rsa]));
end;
%fi
%if Tops20
%then
begin
bind
jfn = .handle; ! paramter passed is a JFN
literal
format_bits = %o'111110000001'; ! (coppied from wilds)
local
length,
updated_ptr;
! NOTE: Use routine JFNSTR after it is fixed (it now returns descriptor
! pointing to string allocated on stack.)
jfns(ch$ptr(buf), hwf(0,.jfn), format_bits, 0; updated_ptr);
length = ch$diff(.updated_ptr,ch$ptr(buf));
$str_desc_init(descriptor = d_cur_file,
string = (.length,ch$ptr(buf)));
end;
%fi
!pick up the version number
version_value=vernum(d_cur_file);
!if no version number then something is wrong
if
.version_value eql 0
then
bug(cat('FILGEN\LOOKUP didn''t find a version number in ',d_cur_file));
!Save the file version number in the working list
file_gen_list[.file_count]=.version_value;
file_count=.file_count+1;
!return to WILDS
true
END; !End of lookup
END !End of Module FILGEN
ELUDOM