Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE QUEUE =

BEGIN

GLOBAL BIND	QUEV = 1^24 + 0^18 + 12;	!EDIT DATE: 3-MAY-77

%([

FUNCTION:	THIS MODULE CONTAINS ALL ROUTINES WHICH INTERFACE
		TO THE TOPS-20 ENQ/DEQ FACILITY.
AUTHOR:	S. BLOUNT

THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1977, 1979 BY DIGITAL EQUIPMENT CORPORATION



**********	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		*
*						*
*************************************************

****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************

PRODUCT	MODULE	 SPR
 EDIT	 EDIT	 QAR		DESCRIPTION
======	======	=====		===========

 100	  12	Dev		Make declarations for routine names
				be EXTERNAL ROUTINE so RMS will compile 
				under BLISS V4 (RMT, 10/22/85).

	***** END OF REVISION HISTORY *****




])%



	%([ EXTERNAL DECLARATIONS ])%

EXTERNAL ROUTINE
    CRASH,
    DUMP;			

%([ ERROR MESSAGES REFERENCED WITHIN THIS MODULE ])%

EXTERNAL
    MSGFUNCTION,		! BAD FUNCTION CODE
    MSGJSYS,		! BAD JSYS CODE
    MSGINPUT;		! BAD INPUT VALUES





REQUIRE 'RMSREQ';
REQUIRE 'RMSOSD';

EXTDECLARATIONS;

!DO THE APPROPRIATE TYPE OF ENQ FOR THE OBJECT COMPUTER
!
MACRO DO_ENQ=
	%IF TOPS10
	%THEN
		BEGIN
		AC1=.AC1^18 OR .AC2;
		DO_UUO(ENQ$(AC1))
		END
	%FI
	%IF TOPS20
	%THEN
		DO_JSYS(ENQ)
	%FI
%;


MACRO THEN_ENQ=
	%IF TOPS10
	%THEN
		BEGIN
		AC1=.AC1^18 OR .AC2;
		UUO(1, ENQ$(AC1))
		END
	%FI
	%IF TOPS20
	%THEN
		JSYS(-1,ENQ,AC1,AC2)
	%FI
	THEN	GOODRETURN
%;

!DO THE APPROPRIATE TYPE OF DEQ FOR THE OBJECT COMPUTER
!
MACRO DO_DEQ=
	%IF TOPS10
	%THEN
		BEGIN
		AC1=.AC1^18 OR .AC2;
		DO_UUO(DEQ$(AC1))
		END
	%FI
	%IF TOPS20
	%THEN
		DO_JSYS(DEQ)
	%FI
%;

MACRO THEN_DEQ=
	%IF TOPS10
	%THEN
		BEGIN
		AC1=.AC1^18 OR .AC2;
		UUO(1, DEQ$(AC1))
		END
	%FI
	%IF TOPS20
	%THEN
		JSYS(-1,DEQ,AC1,AC2)
	%FI
	THEN	GOODRETURN
%;

! 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.

! 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 )

GLOBAL ROUTINE FILEQ ( LOCK_OPR, FCODE ) : NOVALUE =
BEGIN
	ARGUMENT (LOCK_OPR,VALUE);
	ARGUMENT (FCODE,VALUE);

REGS;

LOCAL
    QBLOCK:	VECTOR[ QBLKLENGTH ],
    TEMP,
    MASK,
    COUNT,
    FACVALUE,			! VALUE OF USER'S FAC FIELD
    SHRVALUE,			! VALUE OF USER'S SHR FIELD
    BLKPTR;

MAP
    QBLOCK:	FORMAT;
MAP
    BLKPTR:	POINTER;

	TRACE ( 'FILEQ' );

	! ***	IMPORTANT NOTE	***
	!
	!	COBOL AND BASIC ARE SUCH THAT AXUPD <--> AXDEL.
	!	ALSO GET+PUT IMPLIES UPDATE.
	!	THEREFORE FOR V1 CAN GET BY WITH 2 LOCKS

	%([ 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 ];
	SHRVALUE = .FAB [ FABSHR ];
	IF CHKFLAG ( FACVALUE, AXUPD+AXDEL ) ISON
	THEN
		SETFLAG (FACVALUE, AXGET );		! SET FB$GET BIT
	IF CHKFLAG ( SHRVALUE, AXUPD+AXDEL ) ISON
	THEN
		SETFLAG (SHRVALUE, AXGET );		! SET FB$GET BIT

	%([ "MASK" WILL CONTAIN THE CURRENT ACCESS VALUE
	COUNT WILL KEEP TRACK OF THE # OF LOCKS USED ])%

	BLKPTR = QBLOCK+QBLKHDRSZ;			! SET UP POINTER TO Q-BLOCK (PAST HEADER)
	MASK = 1;					! INIT MASK
	COUNT = ZERO;					! AND COUNTER

	%([ LOOP ONCE FOR EACH POSSIBLE ACCESS
	NOTE LIMIT OF AXDEL... MEANS ONLY GET, PUT, UPD LOCKS  ])%

	WHILE .MASK LSS AXDEL DO			! LOOP FOR ALL ACCESS VALUES
							! AXTRN CAN BE EXCLUDED CAUSE OF SHR=NIL REQIREMENT
	BEGIN						! TO SET UP A Q-BLOCK ENTRY
	    IF (.MASK AND AXUPD) EQL 0			!SKIP UPDATE BECAUSE
	    THEN BEGIN					!IMPLIED BY GET+PUT
		BLKPTR [ 0,LH ] = ZERO;			! CLEAR FLAGS, LEVEL NUMBER
		BLKPTR [ QBLKJFN ] = .USERJFN;		! SET JFN
		BLKPTR [ QBLKCODE ] = RMSQCODE + .MASK;	! USER CODE
		BLKPTR [ QBLKLTYPE ] = LTYPEFILE;	! SET LOCK TYPE
		BLKPTR [ QBLKWORD3 ] = ZERO;		! 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 ) IS ZERO THEN
				BLKPTR [ QBLKGROUP ] = 1 		! SET GROUP = 1
			END; %( OF IT FAC BIT EQUALS SHR BIT )%


		%([ 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 ) ISON ) 	%([IF WE WILL DO OPERATION])%
				OR
		   ( ( .SHRVALUE AND .MASK ) IS OFF )	%(OR OTHERS CAN'T DO IT)%
		THEN
			BEGIN
			INC ( BLKPTR, QBLKNTRYSZ );	! BUMP POINTER PAST THIS ENTRY
			INC ( COUNT,1 )			! BUMP THE COUNT OF ENTRIES
		END;

    	    END;					! END UPD BYPASS
	    MASK = .MASK ^ 1;		 		! SHIFT MASK

	END; %( OF RESOURCE LOOP )%



	%([ WE MUST NOW FILL IN THE Q-BLOCK HEADER ])%

	QBLOCK [ QHDRCOUNT ] = .COUNT;			! # OF LOCKS
	QBLOCK [ QHDRLENGTH ] = ( .COUNT * QBLKNTRYSZ )+2;	! LENGTH
	QBLOCK [ QHDRPSI ] = ZERO;			! CLEAR PSI CHANNEL #
	QBLOCK [ QHDRID ] = .USERJFN;			! ID = JFN



	%( DEBUGGING -- DUMP THE Q-BLOCK )%
	%IF DBUG %THEN
	BEGINDEBUG ( DBBLOCKS )
	BUGOUT ( 'DUMP OF FILE-Q:' );
	TEMP = .QBLOCK [ QHDRLENGTH ];
	CALLDUMP ( LCI ( TEMP ) , LCI ( QBLOCK ) )
	ENDDEBUG;
	%FI

	%([ NOW, DO THE ENQ/DEQ ])%

	AC1 = .FCODE;			! GET THE ENQ/DEQ FUNCTION CODE
	MOVEI	( AC2, QBLOCK );		! GENERATE 18-BIT ADDRESS

	SELECT .LOCK_OPR OF
	SET

	%( ENQ )%      [ENQCALL]:
			BEGIN
			DO_ENQ		!ABORT VERB IF FAILS
			END ;


	%( DEQ )%[DEQCALL]:
			BEGIN
			DO_DEQ		!ABORT VERB IF FAILS
			END;


	[OTHERWISE]:	RMSBUG ( MSGJSYS )		! BAD JSYS CODE
	TES; %( END OF SELECT LOCK_OPR )%

	RETURN;

END; %( OF FILEQ ROUTINE )%

! 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.


GLOBAL ROUTINE LOCKIT ( LOCK_OPR, FCODE, ID, ACCESS, LOCKTYPE ) =
BEGIN
	ARGUMENT (LOCK_OPR,VALUE);
	ARGUMENT (FCODE,VALUE);
	ARGUMENT (ID,VALUE);
	ARGUMENT (ACCESS,VALUE);
	ARGUMENT (LOCKTYPE,VALUE);

REGS;

LOCAL
    QBLOCK:	VECTOR[ QBLKNTRYSZ + 2 ],
    IDTEXT,			! LOCAL FOR DEBUGGING TEXT POINTER
    BLOCKPTR;

MAP
    BLOCKPTR:	POINTER;
MAP
    QBLOCK:	FORMAT;

	TRACE ( 'LOCKIT' );

	%([ CHECK PARAMETERS ])%

	CHECKINPUT(ID,GEQ,ZERO);		! ID MUST BE NON-NEGATIVE
	%([ SET UP THE ENQ BLOCK FORMAT ])%

	QBLOCK [ QHDRCOUNT ] = 1;		! SET UP HEADER
	QBLOCK [ QHDRLENGTH ] = QBLKNTRYSZ + QBLKHDRSZ;
	QBLOCK [ QHDRPSI ] = ZERO;		! CLEAR PSI CHANNEL NUMBER
	QBLOCK [ QHDRID ] = .RST;		! USE STREAM ID AS REQUEST ID
	BLOCKPTR = QBLOCK + 2;			! SET UP POINTER
	IF$10(ACCESS=.ACCESS AND (NOT ENQLTL);)	!T10 USES BIT FOR DIF PURP
	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 ] = ZERO;		! CLEAR POOL COUNT


	%IF DBUG %THEN
	BEGINDEBUG ( DBBLOCKS )
	BUGOUT ( %STRING('	DUMP OF QBLOCK:',%CHAR(13),%CHAR(10),' '));
	CALLDUMP ( PCI ( QBLKNTRYSZ + QBLKHDRSZ ), LCI ( 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]:			%(RECORD)%	UPLIT(%ASCIZ ' RECORD ');
[1]:			%(FILE)%	UPLIT(%ASCIZ ' FILE ');
[2]:			%(CAP)%		UPLIT(%ASCIZ ' CAP ');
[3]:			%(BUCKET)%	UPLIT(%ASCIZ ' BUCKET ');
			
		TES);
	TXTOUT (RM$ASZ,  .IDTEXT );
	IF .LOCK_OPR IS DEQCALL THEN BUGOUT ('UN');
	PRINTVALUE ( 'LOCKING: ', ID );
	ENDDEBUG;
	%FI

	%([ GENERATE THE ENQ/DEQ FUNCTION CODE AND ADDRESS OF THE BLOCK ])%

	AC1 = .FCODE;			! GET FUNCTION CODE
	MOVEI	( AC2, QBLOCK );		! ..AND ADDRESS OF BLOCK


	IF .LOCK_OPR IS ENQCALL
	THEN

	%([ ENQ ])%	
		BEGIN %( PROCESSING OF ENQ CALL )%
	
		%([ 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 THEN_ENQ
		ELSE BEGIN
			USRSTV = .AC1;				! SAVE SYSTEM ERROR
			IF$10( IF (.USRSTV IS ENQRU_) OR (.USRSTV IS ENQDR_))
			IF$20( IF (.USRSTV IS ADDR (ENQX6 )) OR (.USRSTV IS ADDR (ENQX5 )))
			THEN USRSTS = ER$RLK
			ELSE USRSTS = ER$EDQ;		! SET STATUS TO "ENQ/DEQ ERROR"
			BADRETURN
		END %( OF ELSE THEN_ENQ )%
	END	%( OF ENQ OPTION )%

	ELSE

	%([ DEQ ])%	
		BEGIN
		IF THEN_DEQ
		ELSE
			BEGIN
			USRSTV = .AC1;			! SAVE MONITOR ERROR
			USRSTS = ER$EDQ;			! SHOULD NOT HAPPEN
			BADRETURN
			END	%(OF IF DEQ FAILED)%
		END; %( OF DEQ JSYS )%


END; %( OF LOCKIT )%
END
ELUDOM