Trailing-Edge
-
PDP-10 Archives
-
cuspbinsrc_2of2_bb-fp63b-sb
-
10,7/rms10/rmssrc/rmsque.b36
There are 6 other files named rmsque.b36 in the archive. Click here to see a list.
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