Trailing-Edge
-
PDP-10 Archives
-
DEC_CMS-20_V1.0_SRC
-
cms/sources/batinl.bli
There are no other files named batinl.bli in the archive.
module batinl (! Manage the interlocks between batch and interactive users
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:
!
! This module contains the interlock primitives to manage
! the interaction between batch and interactive use.
!
! Environment: VAX/VMS, DS-20
!
! Author: Dave Knight
!
!--
!
! Table of Contents:
!
forward routine
intclr : novalue, !Clear interlock flag
intset; !set interlock flag
!
! Include Files:
!
%if %bliss(bliss32) %then
library 'sys$library:starlet' ;
%else
require 'jsys:';
%fi
library 'XPORT:' ;
require 'BLISSX:' ;
require 'filusr:' ;
require 'SCONFG:' ;
require 'HOSUSR:' ;
!
! Macros:
!
!
! Equated Symbols:
!
!
! Own Storage:
!
own
$io_block(int), !interlock IOB
int_opn : initial(false); !TRUE if file has been opened
!
! External References:
!
external routine
badiob,
isfile, !Does file exist?
protec; !set the file protection
global routine intclr : novalue =
!++
! Functional Description:
!
! Clear the interlock flag that was set by INTSET
!
! Formal Parameters:
!
! None.
!
! Implicit Inputs:
!
! The state of the interlock is examined.
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None.
!
! Side Effects:
!
! None.
!
!--
begin
!Close the file, we don't care if it fails.
if
.int_opn
then
begin
$step_close(iob = int_iob, failure = 0);
int_opn=false
end
end; !End of routine INTCLR
global routine intset =
!++
! Functional Description:
!
! Set the batch interlock flag, if possible.
!
! Formal Parameters:
!
! None.
!
! Implicit Inputs:
!
! The batch interlock is examined, and set if possible.
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! TRUE - Interlock flag was set successfully
! FALSE - Interlock flag could not be set, since it is already
! set by someone else.
!
! Side Effects:
!
! None.
!
!--
begin
!return if already open
if
.int_opn
then
return true;
! Check the presence or absense of the interlock file
if
not isfile(len_comma_ptr(%string(lib, intlck)), k_null)
then
!Interlock file is not present
begin
literal
k_int_access = k_r_access or k_w_access or k_d_access or k_l_access ;
! Access rights for the interlock file.
! Create the file.
if step$_created neq ($step_open(iob = int_iob,
failure = 0, options = overwrite,
file_spec = %string(lib, intlck)))
then
badiob(int_iob, lit(%string('INTSET cannot create ', lib, intlck)));
! Set its protection, assuming a group library for now.
protec(int_iob, k_null, k_int_access, k_int_access, 0) ;
! Close the file to establish its protection codes.
if
not $step_close(iob = int_iob, failure = 0)
then
badiob(int_iob, lit('INTSET cannot close the interlock file.')) ;
end ; ! Create and protect the lock file
$io_block_init(int); !reinitialize interlock file
! Now try to open the file.
if
not $step_open(iob = int_iob,
failure = 0, options = overwrite,
file_spec = %string(lib, intlck))
then
int_opn=false
else
int_opn=true
end ; !End of INTSET
end ! Module BATINL
eludom