Google
 

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