Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/rmsque.b36
There are 6 other files named rmsque.b36 in the archive. Click here to see a list.
%TITLE 'Q U E U E   -- ENQ/DEQ interface'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE queue (IDENT = '2.0'
		) =
BEGIN

GLOBAL BIND
    quev = 2^24 + 0^18 + 443;			! Edit date: 13-Dec-83

!+
!
!
!    FUNCTION:	THIS MODULE CONTAINS ALL ROUTINES WHICH INTERFACE
!    TO THE TOPS-10 or TOPS-20 ENQ/DEQ FACILITY.
!    AUTHOR:	S. BLOUNT
!
!
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1977, 1986.
!	ALL RIGHTS RESERVED.
!
!	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 THAT IS NOT SUPPLIED BY DIGITAL.
!
!
!
!
!    **********	TABLE OF CONTENTS	**************
!
!
!
!
!    ROUTINE			FUNCTION
!    =======			========
!
!    FILEQ			LOCK A FILE DURING AN $OPEN MACRO
!
!    LOCKIT			LOCK A RECORD FOR ANY ACCESS
!
!
!
!
!
!    REVISION HISTORY:
!
!    EDIT	INITIALS	DATE		PURPOSE
!    ====	========	====		=======
!
!    1	JK		16-JUL-76	SETBUSYFLAG IF UNABLE TO LOCK
!    2	JK		16-JUL-76	CAPABILITIES ARE NOT SHARABLE
!    3	JK		16-JUL-76	SEPARATE STATUS FOR UNEXPECTED
!					    ENQUE/DEQUE ERRORS
!    4	JK		19-JUL-76	ADD 'ACCESS' ARGUMENT TO 'LOCKIT'
!    5	JK		26-JUL-76	'LOCKIT' NOW SUPPORTS CAPABILITIES
!    6	JK		26-JUL-76	ALLOW ZERO FOR ID IN 'LOCKIT'.
!    7	JK		27-JUL-76	'LOCKIT' SHOULDN'T SET 'USRSTS'.
!    8	SB		3-JAN-77	RETURN ERFLK IN FILEQ
!    9	SB		24-JAN-77	MAKE FB$UPD,FB$DEL IMPLY
!					    FB$GET IN FILEQ
!    10	SB		31-JAN-77	USE QBLKFLAGS IN LOCKIT
!    11	SB		3-MAY-77	ADD NESTING BIT TO ENQ TO ALLOW OPENING
!					    OF SAME FILE TWICE.
!
!    *************************************************
!    *						*
!    *		NEW REVISION HISTORY		*
!    *						*
!    *************************************************
!
!    PRODUCT	MODULE	 SPR
!    EDIT	 EDIT	 QAR		DESCRIPTION
!    ======	======	=====		===========
!
!	**  Begin RMS v2 Development **
!
!	400	400	xxxxx	    Clean up BLISS code (RL,22-Apr-83)
!
!	443	 - 	xxxxx	    (RL,13-Dec-83) Provide separate lock
!				    requests for UPD and DEL rather than
!				    lumping UPD in as GET+PUT.
!
!    ***** END OF REVISION HISTORY *****
!
!
!
!
!
!-

%IF %SWITCHES(TOPS10)
%THEN
LIBRARY 'BLI:UUOSYM';
UNDECLARE
    ER$FUL;
%FI

REQUIRE 'RMSREQ';

REQUIRE 'RMSOSD';

!DO THE APPROPRIATE TYPE OF ENQ FOR THE OBJECT COMPUTER
!
%IF %SWITCHES(TOPS20)
%THEN

MACRO
    do_enq =
		do_jsys(enq)
%;

MACRO
    then_enq =
		JSYS(-1,enq,ac1,ac2)
	THEN	RETURN true
%;

!
!   DO THE APPROPRIATE TYPE OF DEQ FOR THE OBJECT COMPUTER
!

MACRO
    do_deq =
		do_jsys(deq)
%;

MACRO
    then_deq =
		JSYS(-1,deq,ac1,ac2)
	THEN	RETURN true
%;
%FI
%SBTTL 'FILEQ - File queuer'

GLOBAL ROUTINE fileq (lock_opr, fcode) : NOVALUE =
! FILEQ
! =====
!
! THIS ROUTINE IS USED TO PERFORM ALL FILE
!	SYNCHRONIZATION OPERATIONS WHEN A FILE
!	IS OPENED. IT CHECKS THE USER'S FILE ACCESS
!	FIELD ( FAC ) AND COMPARES IT TO THE SHARABILITY
!	ACCESS FIELD ( SHR ). IT THEN ISSUES
!	VARIOUS ENQ CALLS TO THE MONITOR
!	IN ORDER TO GUARANTEE COMPATIBLE FILE USE.
!
!
!			Note
!
!	Under TOPS-10 we do not have the "nesting" of locks
!	capability that is available under TOPS-20.  As a result,
!	accessing the same file with two FAB's in RMS-10 will
!	have a restriction.  Since we will get a duplicate request
!	error from TOPS-10 when we ENQ the locks for the second
!	FAB, we must ignore the error.  The fact that we are accessing
!	these two files from the saem job will assure compatible
!	access.  The only problem that can be forseen is that if
!	the first FAB is closed, and another job tries to open the
!	same file for incompatible access to that of the second FAB
!	a conflict occurs.  There seems to be no easy way around this.
!	It should not be a major problem since the record level locking
!	will still work.
!
! INPUT:
!	A CODE TO INDICATE THE JSYS TO BE PERFORMED
!		ENQ
!		DEQ
!	FUNCTION CODE OF JSYS
!
! OUTPUT:
!	TRUE: FILE LOCKED
!	FALSE: NOT LOCKED ( FILE WAS NOT AVAILABLE )
    BEGIN
%IF %SWITCHES(TOPS20)
%THEN
    regs;
%ELSE
    REGISTER
	t1;
%FI

    LOCAL
	qblock : VECTOR [qblklength],
	temp,
	mask,
	count,
	facvalue,				! VALUE OF USER'S FAC FIELD
	shrvalue,				! VALUE OF USER'S SHR FIELD
	blkptr;

    MAP
	qblock : BLOCK [1];

    MAP
	blkptr : REF BLOCK;

    TRACE ('FILEQ');
!+
!    GET THE USER'S FAC AND SHR FIELD AND SET FB$GET IF
!    HE SPECIFIED FB$UPD OR FB$DEL IN EITHER FIELD.
!-
    facvalue = .fab [fabfac, 0];
    shrvalue = .fab [fabshr, 0];

    IF chkflag (facvalue, axupd + axdel) NEQ 0	!
    THEN
	setflag (facvalue, axget);		! Set FB$GET bit

    IF chkflag (shrvalue, axupd + axdel) NEQ 0	!
    THEN
	setflag (shrvalue, axget);		! Set FB$GET bit

!+
!    MASK will contain the current access value.
!    COUNT will keep track of the # of locks used.
!-
    clear(qblock, qblklength);                  ! Clear the arg block     !a572

    blkptr = qblock + qblkhdrsz;		! Q-block pointer (past header)
    mask = 1;					! Init mask
    count = 0;					!   and counter
!+
!   Loop once for each possible access.
!   AXTRN can be excluded because TRUNCATE
!   requires SHR=NIL.
!-

    WHILE .mask LEQ axdel DO 			! 			!A443
	BEGIN					! TO SET UP A Q-BLOCK ENTRY
!d572	blkptr [0, lh] = 0;			! CLEAR FLAGS, LEVEL NUMBER
	blkptr [qblkjfn] = .userjfn;		! SET JFN
	blkptr [qblkcode] = rmsqcode + .mask;	! USER CODE
	blkptr [qblkltype] = ltypefile;		! SET LOCK TYPE
!d572	blkptr [qblkword3] = 0;			! CLEAR SHARER'S GROUP

	!+
	!    WE MUST NOW DETERMINE HOW WE ARE GOING TO
	!    LOCK EACH RESOURCE. IF THE FAC AND SHR
	!    BITS ARE EQUAL, THEN WE WILL LOCK THE
	!    RESOURCE "SHARED". THIS EITHER MEANS THAT
	!    WE WILL DO THE OPERATION AND WE WILL ALLOW
	!    OTHERS TO ALSO DO IT, OR WE WONT DO IT AND
	!    WE DONT WANT OTHERS TO DO IT EITHER. IN THE
	!    LATTER CASE, WE MUST USE A SHARER'S GROUP
	!    TO MAKE SURE THAT NOBODY DOES THE OPERATION,
	!    BUT OTHER PEOPLE WHO ALSO DONT WANT IT TO BE
	!    DONE CAN LOCK THE RESOURCE IN THE SAME MANNER
	!-

	IF (.facvalue AND .mask) EQL (.shrvalue AND .mask)
	THEN
	    BEGIN
	    blkptr [qblkflags] = enqshr + enqnst;	! SHARABLE AND NESTING
	    !
	    !   If both are off, use group #1
	    !

	    IF (.facvalue AND .mask) EQL 0
	    THEN
		blkptr [qblkgroup] = 1		! SET GROUP = 1
	    END;

	!+
	!    WE MUST NOW MAKE SURE THAT LEVEL NUMBERS ARE BYPASSED
	!-

	blkptr [qblkflags] = .blkptr [qblkflags] OR enqbln;

	!+
	!    NOW, THIS ENTRY IN THE QBLOCK IN SET UP
	!    BUT, IF WE ARE NOT GOING TO PERFORM THE OPERATION,
	!    BUT OTHERS MAY DO SO, THEN WE DON'T NEED
	!    TO EVEN QUEUE FOR IT. IN THAT CASE, WE WILL IGNORE
	!    THIS ENTRY
	!-

	IF ((.facvalue AND .mask) NEQ 0) OR 	! If we will do operation
	    ((.shrvalue AND .mask) EQL 0)	! or others can't do it.
	THEN
	    BEGIN
	    blkptr = .blkptr + qblkntrysz;	! Bump pointer past this entry
	    count = .count + 1;			! Bump the count of entries
	    END;

	mask = .mask^1;				! SHIFT MASK
	END;

    !+
    !    WE MUST NOW FILL IN THE Q-BLOCK HEADER
    !-

    qblock [qhdrcount] = .count;		! # OF LOCKS
    qblock [qhdrlength] = (.count*qblkntrysz) + 2;	! LENGTH
!   qblock [qhdrpsi] = 0;			! CLEAR PSI CHANNEL #   !d572
    qblock [qhdrid] = .userjfn;			! ID = JFN

    !+
    !   Debugging -- dump the q-block
    !-

%IF dbug
%THEN
    begindebug (dbblocks)bugout('DUMP OF FILE-Q:');
    temp = .qblock [qhdrlength];
    dump (.temp, .qblock)enddebug;
%FI

    !+
    !    NOW, DO THE ENQ/DEQ
    !-

    SELECT .lock_opr OF
	SET

	[enqcall] :

	    %IF %SWITCHES(TOPS20)
            %THEN
                IF NOT enq (.fcode, qblock) THEN monerr ();
            %ELSE
                BEGIN
                t1 = .fcode ^ 18 + qblock;

                IF NOT ENQ$_UUO(t1)
                THEN
                    IF .t1 NEQ ENQDR_ THEN monerr ();
                END;
            %FI
	[deqcall] :

	    %IF %SWITCHES(TOPS20)
            %THEN
                 IF NOT deq (.fcode, qblock) THEN monerr ();
            %ELSE
                BEGIN
                t1 = .fcode ^ 18 + qblock;

                IF NOT DEQ$_UUO(t1) THEN monerr ();
                END;
            %FI
	[OTHERWISE] :
	    rmsbug (msgjsys)			! BAD JSYS CODE
	TES;

    RETURN;
    END;					! End routine FILEQ
%SBTTL 'LOCKIT - record/capability locking'

GLOBAL ROUTINE lockit (lock_opr, fcode, id, access, locktype) =
! LOCKIT
! ======
!
!	     THIS ROUTINE PERFORMS THE LOCKING/UNLOCKING OF RECORDS AND
!	CAPABILITIES.
!
! INPUT:
!	LOCK_OPR		JSYS CODE FOR ENQ OR DEQ
!		ENQ		ENQ THIS RESOURCE
!		DEQ		DEQ THIS RESOURCE
!	FCODE			FUNCTION CODE FOR JSYS
!	ID			RESOURCE ID TO ENQ OR DEQ
!	ACCESS			LOCK ACCESS
!		ENQXCL		EXCLUSIVE ACCESS (FOR ENQ ONLY)
!		ENQSHR		SHARED ACCESS (FOR ENQ ONLY)
!		ENQLTL		LONG-TERM LOCK
!		(ENQBLN IS ALWAYS SET BY THIS ROUTINE)
!	LOCKTYPE		LOCK-TYPE CODE
!
! OUTPUT:
!	TRUE:	JSYS TOOK SKIP RETURN
!	FALSE:	ERROR (JSYS TOOK NON-SKIP RETURN)
!
! NOTES:
!
!	1.	IF THIS ROUTINE RETURNS "FALSE", THEN USRSTV
!		WILL CONTAIN THE MONITOR ERROR CODE RETURNED.
!
    BEGIN

    LOCAL
	qblock : VECTOR [qblkntrysz + 2],
	idtext,					! Debugging text pointer
	blockptr : REF BLOCK;

    MAP
	qblock : BLOCK [1];

    TRACE ('LOCKIT');

    !+
    !    CHECK PARAMETERS
    !-

    checkinput (id, GEQ, 0);			! ID MUST BE NON-NEGATIVE

    !+
    !    SET UP THE ENQ BLOCK FORMAT
    !-

    clear(qblock, qblkntrysz + 2);              ! Clear the enq block     !a572

    qblock [qhdrcount] = 1;			! SET UP HEADER
    qblock [qhdrlength] = qblkntrysz + qblkhdrsz;
!   qblock [qhdrpsi] = 0;			! CLEAR PSI CHANNEL NR    !d572
    qblock [qhdrid] = .rst;			! USE STREAM ID AS REQUEST ID
    blockptr = qblock + 2;			! SET UP POINTER
    blockptr [qblkflags] = enqbln + .access;	! SET "BYPASS LEVEL NUMBERS"
    blockptr [qblkjfn] = .fst [fstjfn];		!
    blockptr [qblkcode] = rmsqcode + .id;	! SET UP CODE
    blockptr [qblkltype] = .locktype;		! AND LOCK-TYPE
!   blockptr [qblkword3] = 0;			! CLEAR POOL COUNT        !d572

%IF dbug
%THEN
    begindebug (dbblocks)bugout(%STRING ('	Dump of QBLOCK:', 	!
	%CHAR (13, 10), ' '));
    dump (qblkntrysz + qblkhdrsz, .qblock)enddebug;
%FI

    !+
    !    DO ALL THIS CODE FOR DEBUGGING ONLY
    !-

%IF dbug
%THEN
    begindebug (dblock)idtext = (

	CASE .locktype FROM 0 TO 3 OF
	    SET

	    [0] :
		UPLIT (%ASCIZ' RECORD ');	! Record

	    [1] :
		UPLIT (%ASCIZ' FILE ');		! File

	    [2] :
		UPLIT (%ASCIZ' CAP ');		! Capability

	    [3] :
		UPLIT (%ASCIZ' BUCKET ');	! Bucket
	    TES);

    txtout (rm$asz, .idtext);

    IF .lock_opr EQL deqcall THEN bugout ('UN');

    printvalue ('LOCKING: ', id);
    enddebug;
%FI

    !+
    !    GENERATE THE ENQ/DEQ FUNCTION CODE AND ADDRESS OF THE BLOCK
    !-

    IF .lock_opr EQL enqcall
    THEN

    !+
    !    ENQ
    !-

    %IF %SWITCHES(TOPS20)
    %THEN
	BEGIN					! Processing of ENQ call

	LOCAL
	    enq_error;

!+
!    PERFORM THE ENQ JSYS. IF IT SUCCEEDS, WE
!    CAN EXIT IMMEDIATELY. IF IT FAILS, WE MUST
!    DETERMINE IF THE ERROR WAS EXPECTED (I.E.,
!    THE LOCK IS ALREADY BUSY, OR WE HAVE ALREADY
!    REQUESTED THE LOCK FOR MULTIPLE STREAMS)
!-

	IF enq (.fcode, qblock; enq_error)	! Do the JSYS
	THEN
	    RETURN true
	ELSE
	    BEGIN
	    usrstv = .enq_error;		! Save system error

	    IF (.usrstv EQL enqx6) OR 		! Requested locks not locked
		(.usrstv EQL enqx5)		! Lock already requested
	    THEN
		usrsts = er$rlk			! Record locked
	    ELSE
		usrsts = er$edq;		! Unexpected error

	    					! SET STATUS TO "ENQ/DEQ ERROR"
	    RETURN false
	    END

	END
    %ELSE  !TOPS10                                                       !a572v
	BEGIN					! Processing of ENQ call

	REGISTER
	    t1;

!+
!    PERFORM THE ENQ UUO. IF IT SUCCEEDS, WE
!    CAN EXIT IMMEDIATELY. IF IT FAILS, WE MUST
!    DETERMINE IF THE ERROR WAS EXPECTED (I.E.,
!    THE LOCK IS ALREADY BUSY, OR WE HAVE ALREADY
!    REQUESTED THE LOCK FOR MULTIPLE STREAMS)
!-

	t1 = .fcode ^ 18 + qblock;

	IF ENQ$_UUO(t1)				! Do the JSYS
	THEN
	    RETURN true
	ELSE
	    BEGIN
	    usrstv = .t1;			! Save system error

	    IF (.usrstv EQL ENQRU_) OR 		! Some resource not available
		(.usrstv EQL ENQDR_)		! Duplicate request
	    THEN
		usrsts = er$rlk			! Record locked
	    ELSE
		usrsts = er$edq;		! Unexpected error

	    					! SET STATUS TO "ENQ/DEQ ERROR"
	    RETURN false
	    END

	END
    %FI
    ELSE

    !+
    !    DEQ
    !-
    %IF %SWITCHES(TOPS20)
    %THEN
	BEGIN

	LOCAL
	    deq_error;

	IF deq (.fcode, qblock; deq_error)
	THEN
	    RETURN true
	ELSE
	    BEGIN
	    usrstv = .deq_error;		! Save monitor error
	    usrsts = er$edq;			! Should not happen
	    RETURN false
	    END

	END;
    %ELSE !TOPS10                                                   !a572vv

	BEGIN

	REGISTER
	    t1;

	t1 = .fcode ^ 18 + qblock;

	IF DEQ$_UUO(t1)
	THEN
	    RETURN true
	ELSE
	    BEGIN
	    usrstv = .t1;			! Save monitor error
	    usrsts = er$edq;			! Should not happen
	    RETURN false
	    END

	END;
    %FI                                                             !a572^^
    END;					! End LOCKIT

END

ELUDOM