Trailing-Edge
-
PDP-10 Archives
-
bb-m080w-sm_t20_v7_0_02_mon_src_mod
-
monitor-sources/enq.mac
There are 50 other files named enq.mac in the archive. Click here to see a list.
; Edit= 8965 to ENQ.MAC on 12-Sep-88 by BROOKS, for SPR #21912
;Add ENQ-DEQ capability to ENQC% .ENQCD function
; Edit= 8846 to ENQ.MAC on 24-May-88 by LOMARTIRE (TCO 7.1286)
;Prevent jobs hung in ENQTST and missing notification
; Don't let QSKDRC base a reply on a Q-Block which is not locked.
; In QDEQ, call LOKSKD before QDLBFS so that notification is sent.
; UPD ID= 8685, RIP:<7.MONITOR>ENQ.MAC.11, 17-Mar-88 19:22:28 by RASPUZZI
;TCO 7.1258 - Take another whack at fixing FSPOUT problems. FSPREM now
; returns the biggest block in the pool when called.
; UPD ID= 8511, RIP:<7.MONITOR>ENQ.MAC.10, 9-Feb-88 15:20:17 by GSCOTT
;TCO 7.1218 - Update copyright date.
; UPD ID= 8346, RIP:<7.MONITOR>ENQ.MAC.9, 15-Jan-88 15:44:46 by LOMARTIRE
;TCO 7.1180 - Remove ENQSPC and ENQMXF - use FSPREM instead.
; UPD ID= 8340, RIP:<7.MONITOR>ENQ.MAC.8, 14-Jan-88 16:04:04 by LOMARTIRE
;TCO 7.1179 - Make EN.CLL present in the Lock-Block to represent a
; cluster-wide lock whenever there is at least one Q-Block with EN.CLL set.
; UPD ID= 8334, RIP:<7.MONITOR>ENQ.MAC.7, 6-Jan-88 13:59:38 by LOMARTIRE
;TCO 7.1172 - Prevent ILLUUO and ILFPTE BUGHLTs on CI-less systems
; UPD ID= 261, RIP:<7.MONITOR>ENQ.MAC.6, 5-Nov-87 15:42:39 by LOMARTIRE
;TCO 7.1115 - Add counter EQLBCT; the number of blocks on EQLBLT
; UPD ID= 219, RIP:<7.MONITOR>ENQ.MAC.5, 27-Oct-87 16:00:27 by LOMARTIRE
;TCO 7.1088 - Prevent corrupted hash chain and free space crashes by
;correctly managing EQLBLT in LOKREL. Also, fix a bug in ENQCD which
;prevents the dumping of several blocks chained off of the same hash
;table index.
; UPD ID= 159, RIP:<7.MONITOR>ENQ.MAC.4, 19-Oct-87 17:09:30 by LOMARTIRE
;TCO 7.1072 - Add support for cluster-wide ENQ
; UPD ID= 81, RIP:<7.MONITOR>ENQ.MAC.3, 19-Aug-87 13:00:33 by LOMARTIRE
;TCO 7.1041 - Fix ENQC% functions 1 and 2 to use the correct job number
;TCO 7.1040 - Move most of code into XCDSEC. The only code remaining in
; MSEC1 is: .ENQ, .DEQ, .ENQC, ENQCD, ENQTST, ENQFKR, ENQCLS, and ENQINI.
; *** Edit 7348 to ENQ.MAC by LOMARTIRE on 1-Aug-86
; Prevent OPNX9 errors from stale ENQ tokens remaining on system
; UPD ID= 2070, SNARK:<6.1.MONITOR>ENQ.MAC.26, 3-Jun-85 14:33:41 by MCCOLLUM
;TCO 6.1.1406 - Update copyright notice.
; UPD ID= 4932, SNARK:<6.MONITOR>ENQ.MAC.25, 15-Oct-84 13:02:17 by GRANT
;The assembly switch CFSCOD has been eliminated
; UPD ID= 4794, SNARK:<6.MONITOR>ENQ.MAC.24, 7-Sep-84 00:02:36 by TGRADY
;Fix ENQC% Function 1/2 check of user specified job number
; UPD ID= 4793, SNARK:<6.MONITOR>ENQ.MAC.23, 6-Sep-84 23:03:55 by TGRADY
;TCO 6.1996 - Remove this tco...proper fix was in previous edit.
; UPD ID= 4780, SNARK:<6.MONITOR>ENQ.MAC.22, 30-Aug-84 14:49:51 by TGRADY
;More of TCO 6.2174, convert local job index returned by ENQDM2 to a global
; UPD ID= 4768, SNARK:<6.MONITOR>ENQ.MAC.21, 29-Aug-84 13:55:38 by TGRADY
;TCO 6.2174 (QAR 706200) Fix ENQDMP to properly identify job-wide resources.
; UPD ID= 4740, SNARK:<6.MONITOR>ENQ.MAC.20, 24-Aug-84 09:42:07 by PAETZOLD
;TCO 6.2191 - Change unsafe SETJSB calls to MAPJSB.
; UPD ID= 4516, SNARK:<6.MONITOR>ENQ.MAC.19, 13-Jul-84 19:35:02 by PURRETTA
;Update copyright notice
; UPD ID= 4183, SNARK:<6.MONITOR>ENQ.MAC.18, 8-May-84 14:19:55 by GRANT
;In CFETST, error code should be OPNX9. Previous edit had changed it.
; UPD ID= 4167, SNARK:<6.MONITOR>ENQ.MAC.17, 1-May-84 14:55:07 by GRANT
;Call CFS whenever user tries to ENQ% a long term lock, in particular, when
;the lock block already exists.
; UPD ID= 3922, SNARK:<6.MONITOR>ENQ.MAC.16, 14-Mar-84 10:50:27 by TGRADY
;TCO 6.1996 - Fix missed job index being handed to user.
; - In ENQDMP, Translate Local Job index to Global Job Number before
; returning it to the user.
;
; UPD ID= 3796, SNARK:<6.MONITOR>ENQ.MAC.15, 29-Feb-84 01:41:51 by TGRADY
; Implement Global Job Numbers
; - In ENQOK, translate user-specified Global Job Number to local index
; - In VALRQ1, use GBLJNO, instead of JOBNO.
; - In ENCF0H, Translate Local Job index to Global Job Number before
; returning it to the user.
;
; UPD ID= 3662, SNARK:<6.MONITOR>ENQ.MAC.14, 7-Feb-84 16:36:21 by VATNE
; UPD ID= 3662, SNARK:<6.MONITOR>ENQ.MAC.14, 7-Feb-84 16:36:21 by VATNE
; UPD ID= 3294, SNARK:<6.MONITOR>ENQ.MAC.12, 12-Dec-83 15:00:46 by CJOHNSON
;TCO 6.1899 - Make ENQC% return job # owning lock and EN%QCB
; UPD ID= 2860, SNARK:<6.MONITOR>ENQ.MAC.11, 23-Aug-83 15:06:47 by LOMARTIRE
;TCO 6.1692 - Change macro name from LCKINI to INILCK so routine is usable
; UPD ID= 2793, SNARK:<6.MONITOR>ENQ.MAC.10, 4-Aug-83 00:29:10 by LEACHE
;TCO 6.1641 Move swappable freespace out of section zero
; UPD ID= 2596, SNARK:<6.MONITOR>ENQ.MAC.9, 20-Jun-83 10:40:23 by HALL
;TCO 6.1689 - Move fork tables to extended section
; Reference FKJOB via DEFSTR
; UPD ID= 1688, SNARK:<6.MONITOR>ENQ.MAC.8, 20-Jan-83 09:53:41 by MILLER
; UPD ID= 1687, SNARK:<6.MONITOR>ENQ.MAC.7, 20-Jan-83 09:39:26 by MILLER
;TCO 6.1474. Implement CFS ENQ/DEQ detector.
; UPD ID= 204, SNARK:<5.MONITOR>ENQ.MAC.6, 22-Sep-81 16:57:52 by PAETZOLD
;More TCO 5.1481 - Fix the problem
; UPD ID= 165, SNARK:<5.MONITOR>ENQ.MAC.5, 10-Sep-81 14:45:03 by PAETZOLD
;TCO 5.1481 - Check for illegal OWGBP's
; UPD ID= 1763, SNARK:<5.MONITOR>ENQ.MAC.4, 24-Mar-81 14:07:53 by BLOUNT
;change STRCMP+5 from CAIN T2,NUMVAL to CAIN T3,NUMVAL
; UPD ID= 1003, SNARK:<5.MONITOR>ENQ.MAC.3, 11-Sep-80 18:00:47 by GRANT
;Change MONX01 to MONX06 in ASGEQ routine
; UPD ID= 935, SNARK:<5.MONITOR>ENQ.MAC.2, 20-Aug-80 15:15:43 by ENGEL
;TCO #5.1136 - CHANGE ALL LOCKS TO CONFORM TO THE NEW LOCK SCHEME
; UPD ID= 46, SNARK:<4.1.MONITOR>ENQ.MAC.16, 28-Nov-79 17:25:57 by HALL
;REMOVE CODE FOR INTERNAL ENQ AND DEQ OPERATIONS BECAUSE NO ONE CALLS IT
;<4.MONITOR>ENQ.MAC.14, 21-Oct-79 18:43:46, EDIT BY MAGRATH
;TCO 4.2540 - Routine FNDQ, add JFN check to search criteria
;<OSMAN.MON>ENQ.MAC.1, 10-Sep-79 15:28:06, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>ENQ.MAC.12, 29-Aug-79 20:06:49, EDIT BY ZIMA
;USE THE PREFERRED MNEMONICS TO CHECK FOR NUMVAL
;<4.MONITOR>ENQ.MAC.11, 10-Jul-79 12:56:44, EDIT BY ZIMA
;TCO 4.2321 - FIX STRCMP TO RECOGNIZE MISMATCH OF USER CODE AND STRING.
;<4.MONITOR>ENQ.MAC.10, 1-May-79 23:31:04, Edit by MCLEAN
;MAKE JOB NUMBER OF 0,,-1 BE -1 FOR GTOKM .GOENQ..
;<4.MONITOR>ENQ.MAC.9, 18-Apr-79 16:46:41, Edit by MCLEAN
;REMOVE EXTRANEOUS NOINT ON CALL TO SETJSB IN ENQOK
;<4.MONITOR>ENQ.MAC.8, 18-Apr-79 15:10:00, Edit by MCLEAN
;ADD JOB NUMBER TO ENQ QUOTA CHANGE
;<4.MONITOR>ENQ.MAC.7, 5-Apr-79 11:44:12, Edit by MCLEAN
;<4.MONITOR>ENQ.MAC.6, 5-Apr-79 11:25:10, Edit by MCLEAN
;REMOVE 1ST ARG FROM GTOKM
;<4.MONITOR>ENQ.MAC.5, 9-Mar-79 14:05:32, Edit by MCLEAN
;FIX GTOKM TO RETERR NOT ITRAP
;<4.MONITOR>ENQ.MAC.4, 4-Mar-79 15:34:01, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>ENQ.MAC.3, 23-Jul-78 16:54:03, Edit by MCLEAN
;ADD GETOK TO SETTING QUOTAS FOR ENQ FOR NON PRIV USERS
;<4.MONITOR>ENQ.MAC.2, 23-Jul-78 16:52:40, Edit by MCLEAN
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
; 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.
SEARCH ENQPAR,PROLOG ;[7.1072]
SALL ;[7.1072]
TTITLE (ENQ,,< - ENQ%, DEQ% and ENQC%>)
EXTN <CFSENQ,CFSDEQ>
EXTERN ASGENQ,RELENQ,ENQQOT
;[7.1072] Local storage declared in STG.MAC
EXTN <HSHTBL,HSHLEN,ENFKTB,ENFKTL> ;[7.1072]
Subttl Table of Contents
; Table of Contents for ENQ
;
; Section Page
;
;
; 1. The ENQ% JSYS . . . . . . . . . . . . . . . . . . . . 7
; 1.1 ENQREQ (Worker routine for .ENQ) . . . . . . . 12
; 1.2 ENQFN3 (The .ENQMA function of ENQ%) . . . . . 17
; 1.3 CFETST (CFS resource check on OFNs) . . . . . 18
; 2. The DEQ% JSYS . . . . . . . . . . . . . . . . . . . . 19
; 2.1 DEQREQ (Worker routine for .DEQ) . . . . . . . 20
; 2.2 DEQFN0 (Function 0) . . . . . . . . . . . . . 21
; 2.3 DEQMSK (Check for fully DEQed request) . . . . 23
; 2.4 DEQFN1 (Function 1) . . . . . . . . . . . . . 24
; 2.5 DEQFN2 (Function 2) . . . . . . . . . . . . . 25
; 3. The ENQC% JSYS . . . . . . . . . . . . . . . . . . . . 26
; 3.1 ENQCF0 (Function 0) . . . . . . . . . . . . . 27
; 3.2 ENQC1 (Functions 1 and 2) . . . . . . . . . . 31
; 3.3 ENQCD (Function 3) . . . . . . . . . . . . . . 32
; 3.3.1 ENQDMP (Dump database) . . . . . . . . . 33
; 4. VALARG (Validate user argument block) . . . . . . . . 35
; 5. VALREQ (Validate a lock request) . . . . . . . . . . . 36
; 6. CHKENP (Check for ENQ privs) . . . . . . . . . . . . . 38
; 7. CHKWHL (Check for WHEEL/OPERATOR privs) . . . . . . . 39
; 8. CHKJFN (Check for legal JFN) . . . . . . . . . . . . . 40
; 9. FNDLOK (Find a Lock-Block) . . . . . . . . . . . . . . 41
; 10. FNDQ (Find a Q-Block) . . . . . . . . . . . . . . . . 42
; 11. GETLVL (Get highest locked level) . . . . . . . . . . 43
; 12. CNTQ/CNTQLQ (Get share counts) . . . . . . . . . . . . 44
; 13. STRCMP/STVCMP (Compare strings or user codes) . . . . 45
; 14. CRELOK (Create a Lock-Block) . . . . . . . . . . . . . 46
; 15. CREQ (Create a Q-Block and link to Lock-Block) . . . . 48
; 16. REQDEQ (DEQ an entire request) . . . . . . . . . . . . 50
; 17. SQDEQ (DEQ a single Q-Block) . . . . . . . . . . . . . 51
; 18. QDEQ (DEQ a Q-Block) . . . . . . . . . . . . . . . . . 52
; 19. QDLBFS (Set LB Flags after QB Release) . . . . . . . . 54
; 20. LOKREL (Release a Lock-Block) . . . . . . . . . . . . 55
; 21. QSKD/QSKDRC (Perform a scheduling pass on Q-Block) . . 57
; 22. SETINV (Set Q-Block invisible) . . . . . . . . . . . . 61
; 23. LOKSKD/REESKD (Perform a scheduling pass on Lock-Block 62
; 24. INTQ (Wake up a waiting fork when lock is locked) . . 64
; 25. ENQTST (Scheduler test) . . . . . . . . . . . . . . . 65
; 26. ASGEQ (Get space for an ENQ block) . . . . . . . . . . 66
; 27. RELEQ (Release ENQ block space) . . . . . . . . . . . 67
; 28. ENQGC (Garbage collection of long term locks) . . . . 68
; 29. HASH (Calculate hash index) . . . . . . . . . . . . . 69
; 29.1 MHASH (Hash two numbers) . . . . . . . . . . . 70
; 29.2 STHASH (Hash a string) . . . . . . . . . . . . 71
; 30. ENQFKR (DEQ all requests for a fork) . . . . . . . . . 72
; 30.1 DEQFRK (Worker routine) . . . . . . . . . . . 73
; 31. ENQJBI (Initialize JSB upon job creation) . . . . . . 74
; 32. ENQCLS (Check for ENQ lock on OFN) . . . . . . . . . . 75
; 33. ENQINI (Initialize ENQ database upon system startup) . 76
;[7.1072] THE ENQ, DEQ, AND ENQC JSYS'S
REPEAT 0,<
;Q-BLOCK FORMAT
+-------------------------+-------------------------+
0 !ENQLJQ: !
! BACK POINTER TO LAST Q-BLOCK FOR JOB !
+-------------------------+-------------------------+
1 !ENQNJQ: !
! FORWARD POINTER TO NEXT Q-BLOCK FOR JOB !
+-------------------------+-------------------------+
2 !ENQLLQ: !
! BACK POINTER TO LAST Q-BLOCK !
+----------------+--------+-------------------------+
3 !ENQNLQ: !
! FORWARD POINTER TO NEXT Q-BLOCK !
+----------------+--------+-------------------------+
4 !ENQFLG: !ENQCHN: !ENQFRK: !
! FLAGS ! PSI ! FORK TO INTERRUPT !
! ! CHANNEL! WHEN REQUEST IS LOCKED !
+----------------+--------+-------------------------+
5 !ENQNR: !ENQID: !
! # OF RESOURCES ! REQUEST ID CODE !
! REQUESTED FROM POOL ! !
+-------------------------+-------------------------+
6 !ENQLRQ: !
! BACK POINTER TO LAST Q-BLOCK OF REQUEST !
+-------------------------+-------------------------+
7 !ENQFQ: !
! FORWARD POINTER TO NEXT Q-BLOCK OF REQUEST !
+-------------------------+-------------------------+
10 !ENQLBP: !
! POINTER TO LOCK-BLOCK !
+-------------------------+-------------------------+
11 ! !ENQGRP: !
! ! GROUP # FOR !
! RESERVED ! SHARABLE REQUESTS !
+-------------------------+-------------------------+
12 !ENQNST: !ENQJFN: !
! NEST COUNT ! JFN OF REQUEST !
! ! OR -1, -2, OR -3 !
+-------------------------+-------------------------+
13 !ENQMSK: !
! POINTER TO MASK-BLOCK !
+-------------------------+-------------------------+
;LOCK-BLOCK FORMAT
;NOTE THAT ITEMS SURROUNDED BY '*' INDICATE THAT THEY ARE PRESENT ONLY
;WHEN THE CLUSTER ENQ CODE IS PRESENT (CLEQIN IS NON-ZERO).
+-------------------------+-------------------------+
0 !ENQLHC: !
! POINTER TO LAST LOCK-BLOCK ON HASH CHAIN !
+-------------------------+-------------------------+
1 !ENQNHC: !
! POINTER TO NEXT LOCK-BLOCK ON HASH CHAIN !
+-------------------------+-------------------------+
2 !ENQLLQ: !
! POINTER TO LAST Q-BLOCK ON QUEUE !
+-------------------------+-------------------------+
3 !ENQNLQ: !
! POINTER TO FIRST Q-BLOCK ON QUEUE !
+-------------------------+-------------------------+
4 !ENQFLG: ! !ENQLVL: !
! FLAGS ! ! LEVEL NUMBER !
! ! ! OF THIS LOCK !
+---------------+---------+-------------------------+
5 !ENQTR: !ENQRR: !
! TOTAL # OF RESOURCES ! REMAINING NUMBER OF !
! IN THIS POOL ! RESOURCES IN THIS POOL !
+-------------------------+-------------------------+
6 !ENQTS: !
! TIME STAMP !
! TIME OF LAST REQUEST LOCKED !
+-------------------------+-------------------------+
7 !ENQFBP: !
! POINTER TO FREE Q-BLOCK !
+-------------------------+-------------------------+
10 !ENQLT: !
! LONG TERM LOCK LIST FOR SYSTEM !
+-------------------------+-------------------------+
11 !ENQOFN: !ENQLEN: !
! OFN, OR -2, OR -3, ! LENGTH OF THIS !
! OR 400000 + JOB NUMBER ! LOCK-BLOCK !
+-------------------------+-------------------------+
12 !ENQNMS: !*ENQHSH:* !
! NUMBER OF WORDS IN ! HASH VALUE FOR THIS !
! THE MASK BLOCK ! LOCK BLOCK !
+-------------------------+-------------------------+
*13* !ENQAFP: !
! FORWARD POINTER FOR LOCK BLOCK ACTION LIST !
+-------------------------+-------------------------+
*14* !ENQABP: !
! BACKWARD POINTER FOR LOCK BLOCK ACTION LIST !
+-------------------------+-------------------------+
15 !ENQTXT: ASCIZ STRING !
! OR !
! 500000 + USER CODE !
+---------------------------------------------------+
FORMAT OF ENQ% ARGUMENT BLOCK:
!0 8!9 17!18 35!
+-------------+-----------+-------------------------+
.ENQLN: 0 ! HDR SIZE ! # LOCKS ! ARG BLOCK LENGTH !
+-------------------------+-------------------------+
.ENQID: 1 ! PSI CHANNEL ! REQUEST ID !
+-------------------------+-------------------------+
+-------------------------+-------------------------+
.ENQLV: 2 ! FLAGS ! LEVEL # ! JFN !
! ! or -1, -2, or -3 !
+-------------------------+-------------------------+
.ENQUC: 3 ! STRING POINTER OR 5B2+33-BIT USER CODE !
+-------------------------+-------------------------+
.ENQRS: 4 ! # RESOURCES IN POOL ! # RESOURCES REQUESTED !
! or !
! 0 ! GROUP # !
+-------------------------+-------------------------+
.ENQMS: 5 ! ADDRESS OF MASK BLOCK !
+-------------------------+-------------------------+
> ;END OF REPEAT 0
SUBTTL The ENQ% JSYS
;THE ENQ JSYS
;ACCEPTS IN 1/ FUNCTION CODE
; 2/ LOCATION OF ARGUMENT BLOCK
; ENQ
;RETURNS +1: ERROR - ERROR CODE IN T1
; +2: SUCCESSFUL, SPECIFIED LOCKS ARE LOCKED
;THE ARGUMENT BLOCK HAS THE FOLLOWING FORMAT:
;LOC/ # OF LOCKS ,, LENGTH OF ARG BLOCK
;LOC+1/ PSI CHANNEL # ,, REQUEST ID
;LOC+2/ FLAGS & LEVEL NUMBER ,, JFN, -1, -2, OR -3
;LOC+3/ POINTER TO STRING OR 500000+USER CODE
;LOC+4/ # OF RESOURCES IN POOL ,, # OF RESOURCES REQUESTED
; .
; .
; .
;LOC+N/ FLAGS & LEVEL NUMBER ,, JFN, -1, -2, OR -3
;LOC+N+1/ POINTER TO STRING OR 500000 + USER CODE
;LOC+N+2/ # OF RESOURCES IN POOL ,, # OF RESOURCES REQUESTED
SWAPCD ;[7.1040]
.ENQ:: MCENT ;ENTER JSYS
NOINT ;DONT ALLOW INTERRUPTS DURING CALL
LOKK ENQLKK ;LOCK UP THE ENQ DATA BASE
IFN CLEQIN,< ;[7.1072]
STKVAR <OLDWRD> ;[7.1072]
MOVE T1,ENQWRD ;[7.1072] Get the ENQ word for the process
MOVEM T1,OLDWRD ;[7.1072] Remember it for later
TXNE T1,EQ%ENA ;[7.1072] Has fork enabled cluster-wide ENQ?
CALL CFEQLK ;[7.1072] ()Now lock database cluster-wide
> ;[7.1072]
SETO T1, ;MARK THAT THIS IS A NORMAL TYPE ENQ
CALL ENQREQ ;GO SERVICE THIS REQUEST
JRST ENUNLE ;ERROR RETURN, GO UNLOCK
UMOVEM T2,1 ;RETURN ANSWER FOR USER
IFN CLEQIN,< ;[7.1072]
MOVE CX,OLDWRD ;[7.1072] Get original ENQ word
TXNE CX,EQ%ENA ;[7.1072] Had fork enabled cluster-wide ENQ?
CALL CFEQUL ;[7.1072] ()Unlock database cluster-wide
> ;[7.1072]
UNLOKK ENQLKK ;FREE UP THE DATA BASE
OKINT ;ALLOW INTERRUPTS
SKIPE T1 ;DO MDISMS?
MDISMS ;YES, WAIT FOR LOCK TO FREE UP
SMRETN ;GIVE SUCCESSFUL RETURN TO USER
ENUNLE: CALL ULOKIT ;[7.1072] ()Release the database locks
RETERR ;GIVE ERROR RETURN TO USER
IFN CLEQIN,< ;[7.1072]
ENDSV. ;[7.1072]
> ;[7.1072]
;[7.1072]
;LOCKIT - Routine to obtain the local ENQ Database lock and the
; cluster-wide one if necessary.
;
;Returns +1: Always, with lock(s) obtained and NOINT.
; SWAPCD
LOCKIT: NOINT ;[7.1072] Must be NOINT for lock
LOKK ENQLKK ;[7.1072] Get local database lock first
IFN CLEQIN,< ;[7.1072]
MOVE CX,ENQWRD ;[7.1072] Get ENQ word
TXNE CX,EQ%ENA ;[7.1072] Has fork enabled cluster-wide ENQ?
CALL CFEQLK ;[7.1072] ()Now lock database cluster-wide
> ;[7.1072]
RET ;[7.1072] Done
;[7.1072]
;ULOKIT - Routine to release the local ENQ Database lock and the
; cluster-wide one if necessary.
;
;Must be called NOINT and with the lock(s) obtained.
;
;Returns +1: Always, with lock(s) released and OKINT.
; SWAPCD
ULOKIT: ;[7.1072]
IFN CLEQIN,< ;[7.1072]
MOVE CX,ENQWRD ;[7.1072] Get ENQ word
TXNE CX,EQ%ENA ;[7.1072] Has fork enabled cluster-wide ENQ?
CALL CFEQUL ;[7.1072] ()Unlock database cluster-wide
> ;[7.1072]
UNLOKK ENQLKK ;[7.1072] Unlock the local database
OKINT ;[7.1072] No longer need to be NOINT
RET ;[7.1072]
REPEAT 0,<
;INTERNAL MONITOR ROUTINE TO ENQ ON A 33-BIT NUMBER
;ACCEPTS IN T1/ 33-BIT NUMBER
;ASSUMES A -3 LOCK, LEVEL # OF 0, ONE LOCK, ID = 0, AND ALWAYS WAIT
; CALL ENQUE
;RETURNS +1: ALWAYS, LOCK LOCKED
ENQUE: CALL LOCKIT ;[7.1072] ()Obtain needed database locks
SAVEPQ ;SAVE ALL PERMANENT ACS
CALL MONVAL ;GET ARGUMENTS SET UP
CALL ENQREQ ;DO THE ENQ
BUG(ENQMLF)
CALL ULOKIT ;[7.1072] ()Release the database locks
SKIPE T1 ;NEED TO MDISMS?
MDISMS ;YES, WAIT TILL LOCK IS LOCKED
RET ;AND RETURN
;ROUTINE TO SET UP Q1-Q3, P1-P5 FOR INTERNAL ENQ AND DEQ CALLS
; CALL MONVAL
;RETURNS +1: ALWAYS
MONVAL: TLZ T1,700000 ;SET UP 500000,,0 + 33-BIT NUMBER
TLO T1,500000
MOVE P2,T1 ;P2 = USER CODE TO LOCK ON
MOVEI P1,-3 ;P1 = LEVEL 0, -3 LOCK TYPE
SETZB Q1,Q2 ;Q1 = 1 LOCK, Q2 = 0 ID VALUE
SETZB Q3,P3 ;MONITOR LEVEL = 0, EXCULSIVE LOCK
SETZB T1,P5 ;SHARABLE GROUP 0
RET
> ;[7.1072]
;ROUTINE TO SET UP GLOBAL VARIABLES USED BY CALLERS OF VALARG AND VALREQ
; JSP T1,SETVAR
;RETURNS +1: ALWAYS
XSWAPCD ;[7.1040]
SETVAR: TRVAR <EDNMS,EDMSK,EDSTP,EDSTB>
CALLRET 0(T1)
;EDNMS = NUMBER OF WORDS IN THE MASK BLOCK (MINUS COUNT WORD)
;EDMSK = ADDRESS OF THE FIRST MASK WORD OF MASK BLOCK
;EDSTP = -1 ,, LENGTH OF LOCK REQUEST BLOCK
;EDSTB = ADDRESS OF STATUS BLOCK FOR ENQC FUNCTION 0
SUBTTL The ENQ% JSYS -- ENQREQ (Worker routine for .ENQ)
;ROUTINE TO DO THE ENQ JSYS
;THIS ROUTINE MUST BE CALLED NOINT AND WITH ENQLKK LOCKED
;ACCEPTS IN T1/ 0 = INTERNAL MONITOR CALL
; -1 = NORMAL JSYS CALL
; CALL ENQREQ
;RETURNS +1: ERROR - CODE IN T1
; +2: OK
; T1 = 0, REQUEST IS LOCKED
; T1 NOT 0, DO MDISMS FIRST, THEN RETURN
; T2 = VALUE TO BE RETURNED IN USER AC 1
XNENT (ENQREQ) ;[7.1040] ENQREQ: and XENQRE:
JSP T1,SETVAR ;SET UP GLOBAL VARIABLES
STKVAR <ENQFC,ENQHI,ENQQ,ENQLB,ENQERC,ENQOKR>
IFN CLEQIN,< ;[7.1072]
XCTU [HRRZ T4,T1] ;[7.1072] Get user's function code
CAIE T4,.ENECL ;[7.1072] Enabling cluster wide functionality?
IFSKP. ;[7.1072] Yes
MOVE T4,ENQWRD ;[7.1072] Get the ENQWRD for the process
TXO T4,EQ%ENA ;[7.1072] Set enabled bit
MOVEM T4,ENQWRD ;[7.1072] Replace new word
SETZ T1, ;[7.1072] Say request was satisfied
MOVEI T2,.ENECL ;[7.1072] Preserve user's AC1
RETSKP ;[7.1072] Return success
ENDIF. ;[7.1072]
> ;[7.1072]
SETZM ENQFC ;INITIALIZE FUNCTION CODE
JUMPE T1,ENQ5 ;IF 0, THIS IS A MONITOR CALL
SETZM ENQERC ;INITIALIZE ERROR CODE REGISTER
SETZM ENQOKR ;INITIALIZE OK RETURN ANSWER
SETZM ENQQ ;INITIALIZE THE Q-BLOCK ADDDRESS
SETZM ENQLB ;INITIALIZE LOCK BLOCK ADDRESS
CALL VALARG ;VALIDATE THE USER'S ARGUMENT BLOCK
RET ;SOMETHING ILLEGAL
XCTU [HRRZ T1,1] ;GET FUNCTION CODE
CAILE T1,ENQMFN ;MAKE SURE IT IS LEGAL
RETBAD (ENQX1) ;OUT OF BOUNDS, GIVE ERROR RETURN
MOVEM T1,ENQFC ;SAVE FUNCTION CODE FOR LATER
CAIN T1,0 ;IS THIS FUNCTION 0?
HRRI Q2,.ENWCH ;YES, MARK THE WAKFRK IS TO BE CALLED
ENQ0: CALL VALREQ ;VALIDATE THIS LOCK REQUEST
JRST ENQERR ;UNDO WHAT WAS JUST DONE
ENQ5: MOVE T1,ENQFC ;GET FUNCTION CODE
CAIN T1,.ENQMA ;IS IT MODIFY ACCESS FUNCTION?
JRST ENQFN3 ;YES, HANDLE THIS SEPERATELY
CALL HASH ;HASH THIS REQUEST
JRST ENQERR ;COULDNT HASH, GO UNDO REQUEST
MOVEM T1,ENQHI ;REMEMBER THE HASH INDEX VALUE
CALL FNDLOK ;(T1,P1-P4/T1) FIND THE LOCK BLOCK
JRST [ MOVE T1,ENQHI ;NO LOCK BLOCK, GET HASH INDEX AGAIN
CALL CRELOK ;(T1,P1-P4/T1) CREATE A LOCK BLOCK FOR THIS LOCK
JRST ENQERR ;FAILED! GO UNDO REQUEST
MOVEM T1,ENQLB ;SAVE THE LOCK-BLOCK ADDRESS
JRST ENQ9]
MOVEM T1,ENQLB ;SAVE THE LOCK-BLOCK ADDRESS
; IFN CFSCOD,< ;If CFS stuff
LOAD T2,ENQFLG,(T1) ;GET LOCK BLOCK FLAGS
TXNN T2,EN.LTL ;LONG TERM LOCK?
IFSKP.
LOAD T2,ENQNLQ,(T1) ;[7348] Now see if the lock is free
CAME T2,T1 ;[7348] It is free if it points to itself
ANSKP. ;[7348] Yes, it is free
CALL CFETST ;[7348] (P1/) Must check if owned CFS resource?
JRST ENQERR ;[7348] Yes - owned on another system
MOVE T1,ENQLB ;[7348] Ok to lock - retrieve the Lock-block address
IFN CLEQIN,< ;[7.1072]
LOAD T2,ENQFLG,(T1) ;[7.1072] Get the flags from Lock-Block
TXZ T2,EN.CLL ;[7.1179] Assume not a cluster-wide lock
STOR T2,ENQFLG,(T1) ;[7.1072] Replace the flags in Lock-Block
JRST ENQ9 ;[7.1072] Skip consistency check
> ;[7.1072]
ENDIF.
; > ;IFN CFSCOD
IFN CLEQIN,< ;[7.1072]
;[7.1072] At this point, we have a lock which is active (has at least one
;[7.1072] Q-Block associated with it). We must check for consistent modes
;[7.1072] for locks which are on files.
LOAD T2,ENQOFN,(T1) ;[7.1072] Get the type of lock
HRRES T2 ;[7.1072] Extend the sign
SKIPGE T2 ;[7.1072] Is this a file lock?
IFSKP. ;[7.1072] Yes, must check for consistent mode
LOAD T2,ENQFLG,(T1) ;[7.1072] Get lock block flags
MOVE T3,ENQWRD ;[7.1072] Get ENQ word for this process
TXNN T2,EN.CLL ;[7.1072] Is this marked as cluster-wide?
IFSKP. ;[7.1072] Yes
TXNN T3,EQ%ENA ;[7.1072] Process better have cluster-wide privs
JRST ENQMER ;[7.1072] Doesn't - return the error
ELSE. ;[7.1072] No
TXNE T3,EQ%ENA ;[7.1072] Better not have cluster-wide privs
JRST ENQMER ;[7.1072] Does - return the error
ENDIF. ;[7.1072]
ENDIF. ;[7.1072]
> ;[7.1072]
ENQ9: LOAD T2,ENQNMS,(T1) ;GET SIZE OF MASK BLOCK FROM LOCK BLOCK
JUMPE T2,ENQ8 ;IF NONE SPECIFIED YET, THEN OK
CAME T2,EDNMS ;IF NOT 0, THEN BOTH BLOCKS MUST BE EQUAL
SKIPN EDNMS ;UNLESS THE CALLER IS NOT GIVING A BLOCK
SKIPA ;MASK BLOCKS ARE COMPATIBLE
RETBAD (ENQX23) ;MISMATCHED MASK BLOCK SIZE
ENQ8: LOAD T2,ENQLVL,(T1) ;GET LEVEL NUMBER OF THIS LOCK
HRRZ T4,P1 ;GET OFN
HRRE T3,Q3 ;GET USER MINIMUM LOCK LEVEL
CAIN T4,-3 ;IS THIS A MONITOR LOCK?
HLRE T3,Q3 ;YES, GET MONITOR MINIMUM LEVEL
CAMG T2,T3 ;IS THIS LEVEL NUMBER LEGAL?
JRST [ TLNE P1,(EN%BLN) ;USER BYPASSING LEVEL NUMBERS?
JRST [ MOVEI T3,ENQX2 ;YES, SET UP ANSWER FOR USER
MOVEM T3,ENQOKR
JRST ENQ4]
MOVEI T1,ENQX2 ;NO, GO UNDO THE REQUEST
JRST ENQERR]
;..
;..
ENQ4: LDB T3,[POINT 9,P1,17] ;GET LEVEL NUMBER SPECIFIED IN REQ
CAME T2,T3 ;LEVEL NUMBERS MATCH?
JRST [ TLNE P1,(EN%BLN) ;BYPASSING LEVEL #'S?
JRST [ MOVEI T3,ENQX3 ;YES, SET UP ERROR CODE
MOVEM T3,ENQOKR ;FOR SKIP RETURN
JRST ENQ6]
MOVEI T1,ENQX3 ;NO, THIS IS ILLEGAL
JRST ENQERR] ;GO UNDO EVERYTHING
ENQ6: LOAD T2,ENQTR,(T1) ;GET TOTAL NUMBER OF RESOURCES IN POOL
HLRZ T3,P3 ;GET USER'S VALUE
CAME T2,T3 ;ARE THEY IDENTICAL?
JRST [ MOVEI T1,ENQX4 ;NO, THIS IS NOT ALLOWED
JRST ENQERR] ;GO UNDO
CALL FNDQ ;SEE IF THERE IS ALREADY A REQUEST IN
SKIPA T1,ENQLB ;NO, GET LOCK BLOCK BACK
JRST [ TXNE P1,EN%NST ;NESTED LOCK?
JRST ENQ7 ;YES
MOVEI T1,ENQX5 ;YES, THIS IS NOT ALLOWED
JRST ENQERR] ;GO UNDO THE REQUEST
MOVE T2,ENQQ ;GET LAST Q-BLOCK IN THIS REQUEST
SETZ T3, ;INITIALIZE FLAGS
JUMPN P3,ENQ1 ;IF POOLED REQUEST, DONT SET ANY FLAGS
TLNN P1,(EN%SHR) ;IS THIS A SHARED REQUEST
TRO T3,EN.EXC ;NO, SET EXCLUSIVE FLAG
IFN CLEQIN,< ;[7.1072]
ENQ1: MOVE CX,ENQWRD ;[7.1072] Get ENQ word
TXNE CX,EQ%ENA ;[7.1072] Has fork enabled cluster-wide ENQ?
TXO T3,EN.CLL ;[7.1072] Yes, remember this in Q-Block
CALL CREQ ;[7.1072] (T1,T2,T3/T1)Create the Q-Block
JRST ENQERR ;[7.1072] Failed, go undo the request
MOVEM T1,ENQQ ;[7.1072] Save Q-Block address for other entries
CALL EQEOKR ;[7.1072] (T1/T1)Perform cluster-wide arbitration
JRST ENQERR ;[7.1072] Failed, go undo the request
> ;[7.1072]
IFE CLEQIN,< ;[7.1072]
ENQ1: CALL CREQ ;CREATE THE Q-BLOCK FOR THE REQUEST
JRST ENQERR ;FAILED, GO UNDO THE REQUEST
MOVEM T1,ENQQ ;[7.1072] SAVE THE Q-BLOCK ADR FOR OTHER ENTRIES
> ;[7.1072]
ENQ2: ADD Q1,EDSTP ;ADVANCE THE POINTER TO THE NEXT REQ
JUMPG Q1,ENQ0 ;LOOP BACK FOR ALL REQUESTS
SKIPE T1,ENQERC ;ANY ERRORS SEEN?
RET ;YES, TAKE ERROR RETURN NOW
SKIPN T1,ENQQ ;GET A Q-BLOCK ADDRESS IF ANY
JRST ENQ3 ;NONE, MUST BE CHANGE ACCESS CALL
CALL QSKD ;DO A SCHEDULING PASS OVER QUEUE
JRST ENQNL ;LOCK NOT LOCKED
ENQ3: SETZ T1, ;FLAG THAT MDISMS IS NOT NEEDED
MOVE T2,ENQOKR ;SET UP USER'S AC
RETSKP ;REQUEST IS FULLY LOCKED
ENQ7: ;[7.1072] Here if nesting a lock request
IFN CLEQIN,< ;[7.1072]
CALL EQEOKR ;[7.1072] (T1/T1)Perform cluster-wide arbitration
JRST ENQERR ;[7.1072] Failed, go undo the request
> ;[7.1072]
INCR ENQNST,(T1) ;COUNT UP THE NEST COUNT
MOVEM T1,ENQQ ;[7.1072] SAVE THE Q-BLOCK ADR FOR OTHER ENTRIES
JRST ENQ2 ;[7.1072] AND ALLOW THIS ENQ TO CONTINUE
ENQNL: MOVE T1,ENQFC ;GET THE FUNCTION CODE
JRST @ENQNLT(T1) ;GO PERFORM THE PROPER EXITING
ENQNLT: XADDR. (ENQWAT) ;[7.1040] 0 - WAIT UNTIL LOCKED
XADDR. (ENQDEQ) ;[7.1040] 1 - DEQ THIS REQUEST
XADDR. (ENQRET) ;[7.1040] 2 - JUST EXIT AND WAIT FOR INTERRUPT
ENQWAT: MOVE T1,FORKX ;WAIT UNTIL THE REQUEST IS SATISFIED
CALL <XENT GETMSK> ;[7.1040] CLEAR OUT WAITING CONDITION
ANDCAM T2,ENFKTB(T1) ;...
HRRI T1,ENQTST ;SET UP FOR MDISMS
HRL T1,FORKX
RETSKP ;RETURN AND DO AN MDISMS UNTIL LOCKED
ENQDEQ: MOVE T1,ENQQ ;GET Q-BLOCK ADDRESS
CALL REQDEQ ;DEQUEUE THIS REQUSET
ENQRET: MOVEI T1,ENQX6 ;GET "LOCK NOT SET" ERROR CODE
RET ;GIVE ERROR RETURN
IFN CLEQIN,< ;[7.1072]
ENQMER: MOVEI T1,OPNX9 ;[7.1072] Invalid mode for file lock
> ;[7.1072]
ENQERR: MOVEM T1,ENQERC ;SAVE ERROR CODE
SKIPN T1,ENQLB ;WAS A LOCK-BLOCK FOUND?
JRST ENQER1 ;NO, JUST EXIT
LOAD T2,ENQNLQ,(T1) ;IS IT AN EMPTY LOCK-BLOCK?
CAMN T2,T1 ;...
CALL LOKREL ;YES, DELETE IT
SKIPE T1,ENQQ ;WAS A Q-BLOCK CREATED?
CALL REQDEQ ;YES, DELETE THE REQUEST
ENQER1: MOVE T1,ENQERC ;GET ERROR CODE BACK
RET ;AND GIVE NON-SKIP RETURN
SUBTTL The ENQ% JSYS -- ENQFN3 (The .ENQMA function of ENQ%)
;FUNCTION CODE 3 (.ENQMA)
ENQFN3: CALL HASH ;HASH THIS REQUEST
JRST ENQF3F ;ERROR
CALL FNDLOK ;FIND THE LOCK BLOCK
JRST ENQF3F ;NOT ENQ'D ON THIS LOCK
MOVEM T1,ENQLB ;SAVE LOCK-BLOCK ADDRESS
CALL FNDQ ;FIND THE Q-BLOCK FOR THIS REQUEST
JRST ENQF3F ;NOT ENQ'D ON THIS LOCK
LOAD T2,ENQTR,(T1) ;GET TOTAL # REQUESTED
JUMPN T2,ENQF3E ;CANT CHANGE POOLED REQUESTS
LOAD T2,ENQFLG,(T1) ;GET FLAGS OF REQUEST
TLNE P1,(EN%SHR) ;WANT IT TO BE SHARABLE
JRST [ TRZN T2,EN.EXC ;YES, SET IT SHARABLE
JRST ENQ2 ;ALREADY WAS SHARABLE
STOR T2,ENQFLG,(T1) ;STORE UPDATED FLAGS
MOVE T1,ENQLB ;GET LOCK BLOCK ADDRESS AGAIN
CALL LOKSKD ;SCHEDULE THIS LOCK
JRST ENQ2] ;LOOP BACK FOR ALL REQUESTS
TROE T2,EN.EXC ;SEE IF ALREADY EXCLUSIVE
JRST ENQ2 ;YES, THIS IS OK SINCE NOT CHANGING IT
LOAD T3,ENQLLQ,(T1) ;SEE IF THIS IS THE ONLY SHARER
LOAD T4,ENQNLQ,(T1) ;GET POINTER TO LAST AND NEXT Q-BLOCK
CAME T3,T4 ;IF EQUAL, THEN THIS IS THE ONLY SHARER
JRST ENQF3E ;NOT EQUAL, GIVE ERROR RETURN
IFN CLEQIN,< ;[7.1072]
MOVEM T1,ENQLB ;[7.1072] Save the Q-Block address for a moment
CALL EQCNTS ;[7.1072] (T1/T1)Check the remote counts
JUMPN T1,ENQF3E ;[7.1072] Can't change if any count returned
MOVE T1,ENQLB ;[7.1072] Restore Q-Block address
> ;[7.1072]
STOR T2,ENQFLG,(T1) ;MAKE THIS BE AN EXCLUSIVE LOCK
JRST ENQ2 ;AND LOOP BACK FOR THE OTHERS
ENQF3E: MOVEI T1,ENQX8 ;FUNCTION 3 ERROR
ENQF3F: MOVEM T1,ENQERC ;REMEMBER THAT AN ERROR OCCURED
JRST ENQ2 ;GO DO AS MUCH AS POSSIBLE
SUBTTL The ENQ% JSYS -- CFETST (CFS resource check on OFNs)
;CHECK TO SEE IF OFN IS AN OWNED CFS RESOURCE
;ACCEPTS: P1/ OFN
;RETURNS: +1 ALREADY OWNED
; +2 AVAILABLE FOR LOCKING
; IFN CFSCOD,< ;If doing CFS ENQ detection
CFETST: HRRE T1,P1 ;Get the OFN
IFG. T1 ;Is this a CFS lock?
CALLX (MSEC1,CFSENQ) ;[7.1040] Yes. Do ENQ stuff then
RETBAD (OPNX9) ;File is busy! CAN'T HAVE LOCK
ENDIF.
RETSKP
; > ;IFN CFSCOD
SUBTTL The DEQ% JSYS
;THE DEQ JSYS - DEQUEUE REQUESTS
;ACCEPTS IN 1/ FUNCTION
; 2/ LOCATION OF ARGUMENT BLOCK (FUNCTION 0 ONLY)
; DEQ
;RETURNS +1: UNSUCCESSFUL - ERROR CODE IN T1
; (AS MUCH AS POSSIBLE DEQUEUED)
; +2: SUCCESSFUL - REQUEST DEQUEUED
;THE ARGUMENT BLOCK IS IDENTICAL TO THAT OF ENQ
SWAPCD ;[7.1040]
.DEQ:: MCENT ;ENTER JSYS
CALL LOCKIT ;[7.1072] ()Obtain needed database locks
CALL DEQREQ ;GO DO THE DEQUEUEING
JRST ENUNLE ;ERROR DURING DEQ, RETURN ERROR CODE
DEQOKR: CALL LGTAD ;GET TIME OF DAY
CAMLE T1,ENQLTS ;IS IT TIME TO DO A GARBAGE COLLECT?
JRST [ ADDI T1,^D<10*60*3> ;YES, SAVE TIME OF NEXT GC
EXCH T1,ENQLTS ;DO A GARBAGE COLLECT EVERY 10 MINUTES
CALL ENQGC
JRST .+1]
CALL ULOKIT ;[7.1072] ()Release the database locks
SMRETN ;GIVE SUCCESSFUL RETURN TO USER
SUBTTL The DEQ% JSYS -- DEQREQ (Worker routine for .DEQ)
;ROUTINE TO DO THE ACTUAL DEQUEUEING
; XSWAPCD ;[7.1040]
XNENT (DEQREQ) ;[7.1040] DEQREQ: and XDEQRE:
XCTU [HRRZ T2,1] ;GET THE FUNCTION CODE
CAIL T2,DQTABL ;IS THIS A LEGAL FUNCTION CODE?
RETBAD (ENQX1) ;NO, TELL USER
SETO T1, ;THIS IS A JSYS CALL
JRST @DEQTAB(T2) ;DISPATCH TO FUNCTION CODE
DEQTAB: XADDR. (DEQFN0) ;[7.1040] NORMAL DEQ
XADDR. (DEQFN1) ;[7.1040] DEQ ALL RESOURCES
XADDR. (DEQFN2) ;[7.1040] DEQ THIS ID
DQTABL==.-DEQTAB
REPEAT 0,<
;INTERNAL MONITOR ROUTINE TO DO A DEQ (FUNCTION 0 ONLY)
;ACCEPTS IN T1/ 33-BIT NUMBER
;ASSUMES A -3 LOCK, LEVEL # OF 0, ONE LOCK, ID = 0, AND ALWAYS WAIT
; CALL DEQUE
;RETURNS +1: ALWAYS
DEQUE: CALL LOCKIT ;[7.1072] ()Obtain needed database locks
SAVEPQ ;SAVE THE PERMANENT ACS
CALL MONVAL ;SET UP THE ARGUMENTS IN Q1-Q3, P1-P4
CALL DEQFN0 ;DO THE DEQ
BUG(DEQMDF)
CALL ULOKIT ;[7.1072] ()Release the database locks
RET ;AND RETURN TO CALLER
>
SUBTTL The DEQ% JSYS -- DEQFN0 (Function 0)
;DEQ FUNCTION 0
;ACCEPTS IN T1/ 0 = INTERNAL MONITOR CALL
; -1 = JSYS CALL (READ ARGUMENTS FROM USER SPACE)
DEQFN0: JSP T1,SETVAR ;SET UP GLOBAL VARIABLES
STKVAR <DQFN0T,DQFN0Q>
SETZM DQFN0T ;INITIALIZE ERROR COUNTER
JUMPE T1,DQFN0D ;IF MONITOR CALL, ARGS ARE SET UP
CALL VALARG ;VALIDATE THE ARGUMENT BLOCK
RET ;ILLEGAL ARGUMENT BLOCK
DQFN0A: CALL VALREQ ;VALIDATE THIS LOCK SPECIFICATION
JRST DQFN0B ;ERROR
DQFN0D: CALL HASH ;HASH THIS REQUEST
JRST DQFN0B ;ERROR DURING HASH
CALL FNDLOK ;FIND THE LOCK-BLOCK
JRST DQFN0B ;NO SUCH LOCK-BLOCK
LOAD T2,ENQFLG,(T1) ;GET FLAGS OF THE LOCK BLOCK
IFN CLEQIN,< ;[7.1072]
SKIPE ELBCSH ;[7.1072] Is Lock-Block caching enabled?
TXO T2,EN.LTL ;[7.1072] Yes, so set LTL always
> ;[7.1072]
TXNE P1,EN%LTL ;IS THIS A LONG TERM LOCK
TXO T2,EN.LTL ;YES, REMEMBER THIS IN THE LOCK BLOCK
STOR T2,ENQFLG,(T1)
CALL FNDQ ;FIND THE Q-BLOCK FOR THIS FORK
JRST DQFN0B ;COULD NOT FIND THE Q-BLOCK
MOVEM T1,DQFN0Q ;SAVE THE Q-BLOCK ADDRESS
LOAD T2,ENQNST,(T1) ;GET NEST COUNT
JUMPG T2,[DECR ENQNST,(T1)
JRST DQFN0C] ;THIS WAS A NESTED ENQ, DONT DEQ IT
LOAD T2,ENQNR,(T1) ;GET NUMBER LOCKED IN ORIGINAL ENQ
JUMPE T2,[CALL DEQMSK ;IF 0, SEE IF DEQ'ING A MASK
JRST DQFN0E ;NOT COMPLETELY DEQUEUED
MOVE T1,DQFN0Q ;OK TO DELETE THIS Q-BLOCK
CALL SQDEQ ;GO DELETE THIS Q-BLOCK
JRST DQFN0C] ;STEP TO NEXT REQUEST
SUBI T2,0(P3) ;SEE IF DEQ'ING ALL RESOURCES
JUMPL T2,[MOVEI T1,ENQX12
JRST DQFN0B] ;DEQ'ING TOO MANY RESOURCES
JUMPE T2,[CALL SQDEQ ;DEQ'ING ALL OF THEM, DELETE Q-BLOCK
JRST DQFN0C]
STOR T2,ENQNR,(T1) ;PUT BACK NEW # OF RESOURCES LOCKED
LOAD T1,ENQLBP,(T1) ;GET ADDRESS OF LOCK BLOCK
LOAD T2,ENQRR,(T1) ;GET # OF REMAINING RESOURCES
ADDI T2,0(P3) ;UPDATE THE COUNT
STOR T2,ENQRR,(T1) ;STORE NEW COUNT OF REMAINING RESOURCES
DQFN0E: MOVE T1,DQFN0Q ;GET Q-BLOCK ADDRESS
LOAD T1,ENQLBP,(T1) ;GET ADDRESS OF THE LOCK BLOCK
CALL LOKSKD ;GO SCHEDULE THIS LOCK
JRST DQFN0C ;DONT COUNT UP ERROR COUNTER
DQFN0B: MOVEM T1,DQFN0T ;SAVE THIS ERROR CODE
DQFN0C: ADD Q1,EDSTP ;STEP TO THE NEXT LOCK REQUEST
JUMPG Q1,DQFN0A ;LOOP BACK FOR ALL LOCKS
SKIPG T1,DQFN0T ;ANY ERRORS SEEN?
RETSKP ;NO, DEQUEUING COMPLETED
RET ;YES, RETURN ERROR CODE IN T1
SUBTTL The DEQ% JSYS -- DEQMSK (Check for fully DEQed request)
;ROUTINE TO SEE IF A REQUEST IS COMPLETELY DEQ'ED
;ACCEPTS IN T1/ Q-BLOCK ADDRESS
; CALL DEQMSK
;RETURNS +1: NOT COMPLETELY DEQUEUED
; +2: OK TO DELETE THIS Q-BLOCK
DEQMSK: STKVAR <DEQMSF>
SETZM DEQMSF ;INITIALIZE THE FLAG WORD
SKIPN T4,EDMSK ;IS THERE A MASK SPECIFIED?
RETSKP ;NO, THEN DEQ THE WHOLE THING
LOAD T3,ENQMSK,(T1) ;GET THE POINTER TO THE MASK BLOCK
JUMPE T3,RSKP ;IF NONE, THEN DEQ THE WHOLE THING
LOAD T2,ENQLBP,(T1) ;GET LOCK BLOCK ADDRESS
LOAD T2,ENQNMS,(T2) ;GET LENGTH OF MASK BLOCK
CAMLE T2,EDNMS ;DO THE LENGTHS MATCH?
SETOM DEQMSF ;NO, MARK THIS AS NOT COMPLETELY DEQ'D
CAMLE T2,EDNMS ;GET THE LESSER OF THE TWO LENGTHS
MOVE T2,EDNMS ;...
DEQMS1: MOVE T1,0(T3) ;GET FIRST WORD OF MASK BLOCK
XCTU [ANDCM T1,0(T4)] ;TURN OFF THE BITS BEING DEQUEUED
MOVEM T1,0(T3) ;UPDATE THE MASK IN THE Q-BLOCK
SKIPE T1 ;ANY RESOURCES LEFT ON?
SETOM DEQMSF ;YES, MARK THAT THE LOCK IS STILL LOCKED
AOS T3 ;STEP THE MASK POINTER
AOS T4 ;STEP THE USER MASK POINTER
SOJG T2,DEQMS1 ;LOOP BACK THROUGH THE WHOLE MASK BLOCK
SKIPE DEQMSF ;ANY PART OF THE LOCK STILL LOCKED?
RET ;YES
RETSKP ;NO, GO DELETE IT
SUBTTL The DEQ% JSYS -- DEQFN1 (Function 1)
;DEQ FUNCTION 1
DEQFN1: HRRZ T1,FORKX ;GET SYSTEM FORK HANDLE
SETO T2, ;DEQ ALL
CALL <XENT DEQFRK> ;[7.1040] DELETE ALL REQUESTS FOR THIS FORK
JUMPG T1,RSKP ;WERE ANY RELEASED?
RETBAD (ENQX7) ;NO, THIS IS AN ERROR
SUBTTL The DEQ% JSYS -- DEQFN2 (Function 2)
;DEQ FUNCTION 2 - DEQ AN ID
DEQFN2: HRRZ T1,FORKX ;FOR THIS FORK ONLY
XCTU [HRRZ T2,2] ;GET THE ID
CALL <XENT DEQFRK> ;[7.1040] DEQ THIS ID ONLY
JUMPG T1,RSKP ;WERE ANY RELEASED?
RETBAD (ENQX7) ;NO, THIS IS AN ERROR
SUBTTL The ENQC% JSYS
;THE ENQC JSYS - ENQ CONTROL
;USED TO GET STATUS OF LOCKS AND GET AND SET QUOTA
;ACCEPTS IN T1/ FUNCTION CODE - 0, 1, OR 2
; T2/ LOCATION OF ARGUMENT BLOCK
; T3/ ADDRESS OF STATUS BLOCK (FUNCTION 0 ONLY)
; ENQC
;RETURNS +1: ERROR - CODE IN T1
; +2: SUCCESSFUL
;ARGUMENT BLOCK FOR FUNCTION 0 IS SAME AS FOR ENQ
; FUNCTION 1 AND 2 ARGUMENT BLOCK IS: QUOTA ,, JOB NUMBER
SWAPCD ;[7.1040]
.ENQC:: MCENT ;ENTER JSYS
XCTU [HRRZ T1,1] ;GET FUNCTION CODE
CAIN T1,.ENQCD ;DOING A DUMP?
JRST ENQCD ;YES, GO DUMP
JUMPN T1,ENQC1 ;ALL EXCEPT FUNCTION 0 GO TO ENQC1
CALL LOCKIT ;[7.1072] ()Obtain needed database locks
CALL ENQCF0 ;DO FUNCTION 0
JRST ENUNLE ;ERROR, GO UNLOCK AND RETURN THE CODE
JRST DEQOKR ;SUCCESSFUL
SUBTTL The ENQC% JSYS -- ENQCF0 (Function 0)
;ENQC FUNCTION 0
; XSWAPCD ;[7.1040]
XNENT (ENQCF0) ;[7.1040] ENQCF0: and XENQCF:
JSP T1,SETVAR ;SET UP THE GLOBAL VARIABLES
STKVAR <ENCF0L,ENCF0T,ENCF0S,ENCF0I,REMACL,REMCNT,REMJOB> ;[7.1072]
SETZM ENCF0L ;INITIALIZE LOCK BLOCK ADR
SETZM ENCF0T ;INITIALIZE ERROR CODE REGISTER
SETZM REMCNT ;[7.1072] Initialize the remote count
SETOM REMJOB ;[7.1072] Initialize job number of remote owner
SETZM REMACL ;[7.1072] Initialize remote access,,level
UMOVE T1,3 ;GET ADDRESS OF STATUS BLOCK
MOVEM T1,EDSTB ;SAVE THE ADR OF THE STATUS BLOCK
CALL VALARG ;VALIDATE THE ARGUMENT BLOCK
RET ;ERROR IN FORMAT
ENCF0A: SETZM ENCF0S ;INITIALIZE TIME STAMP REGISTER
SETZM ENCF0I ;..AND REQUEST ID REGISTER
CALL VALREQ ;GET INFO ABOUT THE NEXT LOCK REQUEST
JRST ENCF0E ;ERROR ON THIS SPECIFICATION
CALL HASH ;HASH IT
JRST ENCF0E ;ERROR
IFN CLEQIN,< ;[7.1072]
MOVEM T1,REMACL ;[7.1072] Save hash index for a moment
> ;[7.1072]
CALL FNDLOK ;FIND THE LOCK
JRST ENCF0F ;NOT DEFINED, IT MUST BE AVAILABLE
MOVEM T1,ENCF0L ;REMEMBER THE LOCK ADDRESS
IFN CLEQIN,< ;[7.1072]
MOVE T2,T1 ;[7.1072] Reposition Lock-Block address
MOVE T1,REMACL ;[7.1072] Get saved hash index
CALL EQRSTS ;[7.1072] (T1,T2/T1,T3,T4)Get remote status
MOVEM T1,REMACL ;[7.1072] Save access,,level
HLRM T3,REMJOB ;[7.1072] Save the job number of remote owner
HRRM T3,REMCNT ;[7.1072] Save number of remote sharers
MOVEM T4,ENCF0S ;[7.1072] Save time stamp
MOVE T1,ENCF0L ;[7.1072] Get Lock-Block address back
> ;[7.1072]
CALL FNDQ ;FIND OUR REQUEST IF THERE IS ONE
TDZA T2,T2 ;NOT IN Q, ZERO FLAG REGISTER
MOVX T2,EN%QCQ ;WE ARE IN THE QUEUE
JUMPE T2,ENCF0B ;IN THE QUEUE?
LOAD T3,ENQID,(T1) ;YES, GET REQUEST ID OF US
MOVEM T3,ENCF0I ;SAVE IT FOR LATER
ENCF0B: HRR T2,REMJOB ;[7.1072] Get lock owner (-1 if unowned)
SKIPGE REMACL ;[7.1072] Is this held exclusively remotely?
TXO T2,EN%QCX ;[7.1072] Yes, set the exclusive bit now
MOVE T1,ENCF0L ;GET ADDRESS OF LOCK AGAIN
LOAD T3,ENQTS,(T1) ;GET TIME STAMP OF LOCK
CAMLE T3,ENCF0S ;[7.1072] Greater than what is known remotely?
MOVEM T3,ENCF0S ;SAVE IT
LOAD T3,ENQLVL,(T1) ;GET LEVEL NUMBER
DPB T3,[POINT LVLLEN,T2,17]
ENCF0G: LOAD T1,ENQNLQ,(T1) ;SCAN THE LIST LOOKING FOR US
LOAD T3,ENQFLG,(T1) ;GET FLAGS
TRNE T3,EN.LB ;BACK TO THE LOCK BLOCK?
JRST ENCF0D ;YES, NOT FOUND
LOAD T4,ENQFRK,(T1) ;GET FORK NUMBER OF OWNER
CAME T4,FORKX ;US?
JRST ENCF0G ;NO, LOOP BACK THRU LIST
TXNE T2,EN%QCQ ;Are we in the queue?
TXNN T3,EN.EXC ;Yes, exclusive access requested?
SKIPA ;No
TXO T2,EN%QCB ;Yes to both, we're in q for exclusive access
TXNN T3,EN.LOK ;Have we got it locked?
JRST ENCF0G ;No, remember our q status, find locker
JRST ENCF0H ;YES
ENCF0D: MOVE T1,ENCF0L ;GET LOCK BLOCK ADR AGAIN
LOAD T1,ENQNLQ,(T1) ;GET FIRST Q ON LIST
LOAD T3,ENQFLG,(T1) ;GET FLAGS OF Q ENTRY
TRNN T3,EN.LB ;IS THIS THE LOCK BLOCK?
TRNE T3,EN.INV ;NO, IS THIS INVISIBLE?
JRST ENCF0C ;YES, NOBODY OWNS LOCK
LOAD T4,ENQFRK,(T1) ;GET FORK NUMBER OF THIS Q-BLOCK
TRNN T3,EN.LOK ;[7.1072] Is it locked?
JRST ENCF0C ;[7.1072] No, not locked on this system
CAME T4,FORKX ;AND DOES THIS BELONG TO OUR FORK?
SKIPA ;NO, DONT SET LOCKED BIT
ENCF0H: TLO T2,(EN%QCO) ;YES, MARK THAT WE OWN IT
TRNE T3,EN.EXC ;IS THIS AN EXCLUSIVE REQUEST?
TLO T2,(EN%QCX) ;YES, SET THE EXCLUSIVE BIT
SKIPGE REMACL ;[7.1072] Is this held exclusively remotely?
IFSKP. ;[7.1072] No, so valid to use our block then
LOAD T3,ENQFRK,(T1) ;[7.1072] GET THE OWNER OF THIS Q-BLOCK
LOAD T3,FKJO%,(T3) ;[7.1072] GET JOB NUMBER
EXCH T1,T3 ;[7.1072] LCL2GL expects job index in T1
CALLX (MSEC1,LCL2GL) ;[7.1072] [7.1040] Get Global Job Number from CFS
RET ;[7.1072] No such job/invalid job index
EXCH T1,T3 ;[7.1072] Put things back where we expect them
HRR T2,T3 ;[7.1072] PUT JOB NUMBER IN RIGHT HALF WORD
ENDIF. ;[7.1072]
LOAD T3,ENQID,(T1) ;GET REQUEST ID
SKIPN ENCF0I ;IF IT'S NOT ALREADY SET...
MOVEM T3,ENCF0I ;..DO SO
ENCF0C: MOVE T3,EDSTB ;GET ADR OF TEH STATUS BLOCK
UMOVEM T2,0(T3) ;STORE ANSWER IN STATUS BLOCK
MOVE T2,ENCF0S ;GET TIME STAMP OF LOCK
UMOVEM T2,1(T3) ;GIVE IT TO THE USER
SKIPE T1,ENCF0L ;GET ADR OF LOCK BLOCK
CALL CNTQ ;COUNT THE NUMBER OF SHARERS
MOVE T3,EDSTB ;GET BACK THE ADR OF THE STATUS BLOCK
MOVE T2,ENCF0I ;GET REQUEST ID
ADD T1,REMCNT ;[7.1072] Add remote count to local count
HRL T2,T1 ;PUT THE COUNT OF SHARERS IN LH
UMOVEM T2,2(T3) ;STORE IN STATUS BLOCK
HRRI T3,3(T3) ;INCREMENT POINTER TO STATUS BLOCK
MOVEM T3,EDSTB ;SAVE THE UPDATED ADR OF THE STATUS BLOCK
ADD Q1,EDSTP ;STEP TO NEXT LOCK REQUEST
JUMPG Q1,ENCF0A ;LOOP BACK IF ANY MORE LOCKS TO CHECK
SKIPN T1,ENCF0T ;DID ANY ERRORS OCCUR DURING TESTING?
RETSKP ;NO, GIVE OK RETURN
RET ;YES, GIVE ERROR RETURN
ENCF0E: HRLI T1,(EN%QCE) ;SET ERROR BIT IN LH OF WORD
MOVE T2,T1 ;SET UP TO STORE ERROR CODE IN LIST
HRRZM T1,ENCF0T ;STORE ERROR CODE FOR ERROR RETURN
JRST ENCF0C ;GO STORE CODE IN STATUS BLOCK
;[7.1072] Here if lock is not known on this system.
ENCF0F:
IFN CLEQIN,< ;[7.1072]
MOVE T1,REMACL ;[7.1072] Get saved hash index
SETZ T2, ;[7.1072] No Lock-Block address
CALL EQRSTS ;[7.1072] (T1,T2/T1,T3,T4)Get remote status
SKIPGE T1 ;[7.1072] Is this exclusive access?
TXO T2,EN%QCX ;[7.1072] Yes, so indicate it
DPB T1,[POINT LVLLEN,T2,17] ;[7.1072] Store level number of lock
HLR T2,T3 ;[7.1072] Store job number of lock owner
MOVEM T4,ENCF0S ;[7.1072] Store the time stamp
HRRM T3,REMCNT ;[7.1072] Store the remote count
> ;[7.1072]
IFE CLEQIN,< ;[7.1072] If no cluster ENQ code present
MOVEI T2,-1 ;MARK THAT THE LOCK IS FREE
> ;[7.1072]
JRST ENCF0C ;GO STORE ANSWER IN STATUS BLOCK
SUBTTL The ENQC% JSYS -- ENQC1 (Functions 1 and 2)
;ENQC FUNCTIONS 1 AND 2
XNENT (ENQC1) ;[7.1040] ENQC1: and XENQC1:
UMOVE P1,2 ;GET POINTER TO ARG BLOCK
MOVE P2,T1 ;SAVE FUNCTION CODE
CAILE P2,ENQCMF ;LEGAL FUNCTION CODE?
RETERR (ENQX1) ;NO, GIVE ERROR RETURN
CAIN P2,.ENQCC ;SETTING QUOTA?
JRST [ CALL CHKWHL ;YES, MUST BE A WHEEL
JRST ENQGOK ;NOT PRIVILEGED ASK PERMISSION
JRST .+1]
ENQOK: XCTU [HRRZ T1,0(P1)] ;GET JOB NUMBER
CAIN T1,-1 ;-1 Means user wants self
IFSKP. ;[7.1041] No - user specified global job number
CALLX (MSEC1,GL2LCL) ;[7.1041][7.1040] (T1/T1)Get the local index
RETERR(ENQX21) ;ILLEGAL JOB NUMBER
ELSE. ;[7.1041] User supplied a -1 for job number
MOVE T1,JOBNO ;GET OUR LOCAL JOB INDEX
ENDIF. ;[7.1041]
CALLX (MSEC1,MAPJSB) ;[7.1040] MAP IN THIS JSB
RETERR(ENQX21) ;JOB NOT LOGGED IN ERROR
XCTU [HLRZ T2,0(P1)] ;GET NEW QUOTA
CAIN P2,.ENQCC ;SETTING QUOTA?
STOR T2,ENQOTA,(T1) ;YES, SET IT
LOAD T3,ENQOTA,(T1) ;GET CURRENT QUOTA
CAIN P2,.ENQCG ;USER WANTS QUOTA?
UMOVEM T3,1 ;YES, GIVE IT TO HIM
CALLX (MSEC1,CLRJSB) ;[7.1040] UNMAP JSB AND ENABLE INTERRUPTS
SMRETN ;GIVE OK RETURN
ENQGOK: XCTU [HLRZ T2,0(P1)] ;GET QUOTA
XCTU [HRRE T1,0(P1)] ;GET JOB NUMBER
TOSWAPCD ;[7.1040] Go to section 1 for GETOK
GTOKM (.GOENQ,<T2,T1>,[RETERR ()])
TOXSWAPCD ;[7.1040] Back to extended section
JRST ENQOK
SUBTTL The ENQC% JSYS -- ENQCD (Function 3)
;ENQC FUNCTION 3 - DUMP THE LOCKS AND QUEUES
SWAPCD ;[7.1040]
ENQCD: XCALL (XCDSEC,CHKENP) ;[7.8965] REQUIRES WHEEL, OPR OR ENQ PRIV
RETERR ;NOT PRIVILEGED!
NOINT ;LOCK THE LOCKS
LOKK ENQLKK ;[7.1072] Only want local database lock for dump
MOVSI Q1,-HSHLEN ;SET UP COUNTER FOR MAIN LOOP
MOVE Q3,[HSHTBL] ;GET ADDRESS OF HASH TABLE
UMOVE P1,2 ;GET POINTER TO DATA BLOCK
XCTU [MOVN T1,0(P1)] ;GET NEGATIVE LENGTH
HRL P1,T1 ;SET UP AOBJP WORD
ENQCD1: MOVE Q2,(Q3) ;GET POINTER TO LOCK BLOCK, IF ANY
ENQCD2: CAMN Q2,Q3 ;BACK TO HASH TABLE?
JRST ENQCD3 ;YES, GO STEP TO NEXT HASH ENTRY
MOVE T1,Q2 ;GET ADDRESS OF LOCK BLOCK
CALL ENQDMP ;GO DUMP LOCK AND QUEUE BLOCKS
JRST ENQCD4 ;ALL DONE
LOAD Q2,ENQLHC,(Q2) ;[7.1088] Step to previous block on chain
JRST ENQCD2 ;LOOP BACK FOR ALL LOCKS
ENQCD3: ADDI Q3,2 ;STEP TO NEXT LOGICAL ENTRY
AOBJN Q1,ENQCD1 ;LOOP BACK FOR ALL HASH ENTRIES
AOBJP P1,ENQCD4 ;STEP THE USER'S DATA POINTER
XCTU [SETOM 0(P1)] ;MARK THE END OF THE DUMP
ENQCD4: UNLOKK ENQLKK ;UNLOCK THE ENQ DATA BASE
OKINT
SMRETN ;AND GIVE OK RETURN
SUBTTL The ENQC% JSYS -- ENQCD (Function 3) -- ENQDMP (Dump database)
;ROUTINE TO DUMP THE ENQ DATA BASE
;ACCEPTS IN T1/ ADDRESS OF A LOCK BLOCK
; P1/ ADDRESS IN USER SPACE OF BLOCK TO RECEIVE DATA
; CALL ENQDMP
;RETURNS +1: RAN OUT OF SPACE IN USER BUFFER
; +2: OK RETURN
; XSWAPCD ;[7.1040]
XNENT (ENQDMP) ;[7.1040] ENQDMP: and XENQDM:
LOAD T2,ENQOFN,(T1) ;GET OFN OR -2, -3, OR 400000+JOB
LOAD T3,ENQFLG,(T1) ;GET LOCK BLOCK FLAGS
LOAD T4,ENQLVL,(T1) ;GET LEVEL NUMBER OF THIS LOCK
HRL T2,T4 ;SET UP ANSWER IN T2
TLO T2,(EN%QCL) ;MARK THAT THIS IS A LOCK BLOCK
TRNE T3,EN.TXT ;STRING POINTER?
TLO T2,(EN%QCT) ;YES, MARK THAT IN ANSWER
IFN CLEQIN,< ;[7.1072]
TRNE T3,EN.CLL ;[7.1072] Is this a cluster wide lock?
TXO T2,EN%QCC ;[7.1072] Yes, mark it
TRNE T3,EN.NOV ;[7.1072] Is voting required for lock?
TXO T2,EN%QCN ;[7.1072] No, mark it
TRNE T3,EN.SDO ;[7.1072] Does this lock need scheduling?
TXO T2,EN%QCS ;[7.1072] Yes, mark it
> ;[7.1072]
AOBJP P1,R ;ENOUGH ROOM LEFT?
UMOVEM T2,0(P1) ;YES, STORE ANSWER IN DATA BLOCK
LOAD T2,ENQTR,(T1) ;GET # IN POOL
LOAD T4,ENQRR,(T1) ;GET # REMAINING
HRL T4,T2 ;SET UP ANSWER
AOBJP P1,R ;IS THERE MORE ROOM?
UMOVEM T4,0(P1) ;YES, STORE DATA IN BUFFER
LOAD T2,ENQTS,(T1) ;GET TIME STAMP OF LOCK
AOBJP P1,R ;UPDATE POINTER TO USER AREA
UMOVEM T2,0(P1) ;GIVE TIME STAMP TO USER
LOAD T2,ENQLEN,(T1) ;GET LENGTH OF BLOCK
SUBI T2,LBLEN ;GET LENGTH OF DATA OR TEXT AREA
MOVE T3,T1 ;GET COPY OF LOCK BLOCK ADDRESS
ENQDM1: LOAD T4,ENQTXT,(T3) ;GET NEXT WORD OF STRING
AOBJP P1,R ;STEP TO NEXT WORD
UMOVEM T4,0(P1) ;GIVE TEXT WORD TO USER
AOS T3 ;STEP TO NEXT WORD OF TEXT
SOJG T2,ENQDM1 ;ANY MORE TO GET?
MOVE T2,T1 ;NO, NOW GET Q-BLOCK INFO
ENQDM2: LOAD T2,ENQNLQ,(T2) ;GET ADDRESS OF NEXT Q-BLOCK
CAMN T2,T1 ;BACK TO LOCK BLOCK?
RETSKP ;YES, ALL FINISHED
LOAD T3,ENQFRK,(T2) ;GET FORK NUMBER OF OWNER
LOAD T3,FKJO%,(T3) ;GET JOB NUMBER OF CREATOR OF ENTRY
EXCH T1,T3 ;Put the local index where LCL2GL needs it
CALLX (MSEC1,LCL2GL) ;[7.1040] Convert local to global job number
RET ;Bad data, can't do anything with it
EXCH T1,T3 ;Put things back where they belong
LOAD T4,ENQCHN,(T2) ;GET PSI CHANNEL #
HRL T3,T4 ;SET UP ANSWER
CAIN T4,.ENWCH ;THIS FORK WAITING?
TLC T3,.ENWCH+<EN%QCB>_-^D18 ;YES, SET BLOCKED BIT
LOAD T4,ENQFLG,(T2) ;GET FLAGS OF ENTRY
TRNE T4,EN.LOK ;IS THIS LOCKED?
TLO T3,(EN%QCO) ;YES, SET THE OWNER BIT
TRNE T4,EN.LOK ;LOCKED?
TLZ T3,(EN%QCB) ;YES, MAKE SURE BLOCKED BIT IS OFF
TRNE T4,EN.EXC ;EXCLUSIVE LOCK
TLO T3,(EN%QCX) ;YES
IFN CLEQIN,< ;[7.1072]
TRNE T4,EN.CLL ;[7.1072] Is this a cluster wide request?
TXO T3,EN%QCC ;[7.1072] Yes, mark it
> ;[7.1072]
AOBJP P1,R ;ENOUGH ROOM?
UMOVEM T3,0(P1) ;YES, GIVE IT TO USER
LOAD T3,ENQID,(T2) ;GET ID NUMBER
LOAD T4,ENQNR,(T2) ;GET NUMBER REQUESTED IF POOLED
SKIPN T4 ;IS THIS A NON-POOLED LOCK?
LOAD T4,ENQGRP,(T2) ;YES, GET GROUP NUMBER INSTEAD
HRL T3,T4 ;CONSTRUCT ANSWER
AOBJP P1,R ;STEP POINTER TO DATA BLOCK
UMOVEM T3,0(P1) ;STORE IN USER BLOCK
JRST ENQDM2 ;LOOP BACK FOR OTHER Q ENTRIES
SUBTTL VALARG (Validate user argument block)
;ROUTINE TO VALIDATE THE ARGUMENT BLOCK FROM THE USER
;THIS ROUTINE LOADS Q1 - Q3 WITH THE FOLLOWING VALUES:
; Q1/ # OF LOCKS-1 ,, ADDRESS OF FIRST LOCK REQUEST
; Q2/ ID ,, PSI CHANNEL #
; Q3/ MINIMUM MONITOR LEVEL ,, MINIMUM USER LOCK LEVEL
; EDSTP/ -1 ,, LENGTH OF LOCK REQUEST BLOCK
VALARG: UMOVE Q1,2 ;GET LOCATION OF ARGUMENT BLOCK
HRRZS Q1 ;MUST CONTAIN USER SECTION WHEN SEC NON ZERO***
UMOVE T1,.ENQLN(Q1) ;GET THE HEADER WORD OF THE ARG BLOCK
HRRZ T4,T1 ;GET LENGTH OF ARG BLOCK INTO T4
LOAD T3,.ENNLK,T1 ;GET NUMBER OF LOCKS INTO T3
JUMPE T3,[RETBAD (ENQX9)] ;0 LOCKS IS NOT ALLOWED
HRLI Q1,-1(T3) ;SAVE NUMBER OF LOCKS-1
LOAD T2,.ENHLN,T1 ;GET THE LENGTH OF HEADER AREA
HRRZ T1,Q1 ;GET ADDRESS OF USER ARG BLOCK
CAIGE T2,.ENQHL ;IS IT AN OLD STYLE HEADER?
MOVEI T2,.ENQHL ;YES, SET UP THE LENGTH MANUALLY
ADD Q1,T2 ;MAKE Q1 POINT TO START OF FIRST LOCK BLOCK
SUBM T4,T2 ;GET LENGTH OF LOCK AREA INTO T2
IDIV T2,T3 ;GET SIZE OF EACH LOCK BLOCK
SKIPE T3 ;MUST BE NO REMAINDER TO BE VALID
RETBAD (ENQX10) ;ILLEGALLY FORMATTED ARGUMENT BLOCK
HRROM T2,EDSTP ;SET UP THE STEP VARIABLE
XCTU [MOVS Q2,.ENQID(T1)] ;GET ID ,, CHANNEL #
HRRZ T1,Q2 ;VALIDATE PSI CHANNEL NUMBER
CAILE T1,^D35 ;IS IT A LEGAL CHANNEL #
RETBAD (ENQX11) ;NO, GIVE ERROR RETURN
CALL GETLVL ;GET THE MINIMUM ALLOWABLE LEVEL
MOVE Q3,T1 ;SAVE IN Q3
RETSKP ;GIVE OK RETURN
SUBTTL VALREQ (Validate a lock request)
;ROUTINE TO VALIDATE A LOCK REQUEST
;THIS ROUTINE ASSUMES Q1 - Q3 SET UP BY VALARG
;THIS ROUTINE SETS UP P1 - P3 WITH THE FOLLOWING INFORMATION:
; P1/ FLAGS & LEVEL NUMBER ,, OFN
; P2/ STRING POINTER OR 500000,,0 + USER CODE
; P3/ # OF RESOURCES ,, # REQUESTED
; P4 GETS SET UP WITH WORD LENGTH OF STRING BY HASH
; P5/ JFN OF REQUEST ,, GROUP #
; EDNMS/ NUMBER OF WORDS IN MASK BLOCK MINUS THE COUNT WORD
; EDMSK/ ADR OF FIRST MASK WORD IN USERS MASK BLOCK
VALREQ: HRRZ P3,Q1 ;GET ADDRESS OF LOCK REQUEST
SETZM EDMSK ;INITIALIZE GLOBAL VARIABLES
SETZM EDNMS
HRRZ T1,EDSTP ;GET SIZE OF LOCK REQUEST BLOCK
CAIGE T1,4 ;LONG ENOUGH TO CONTAIN A MASK BLOCK?
JRST VALRQ2 ;NO
UMOVE T1,3(P3) ;YES, GET ADR OF MASK BLOCK
JUMPE T1,VALRQ2 ;IS THERE ONE?
UMOVE T2,0(T1) ;YES, GET ITS LENGTH
SUBI T2,1 ;DONT COUNT THE COUNT WORD
SKIPLE T2 ;IS IT A LEGAL LENGTH
CAILE T2,<^D512+^D35>/^D36
RETBAD (ENQX22) ;ILLEGAL MASK BLOCK LENGTH
MOVEM T1,EDMSK ;SAVE THE MASK BLOCK ADDRESS
MOVEM T2,EDNMS ;NUMBER OF WORDS IN MASK BLOCK
AOS EDMSK ;STEP MASK BLOCK ADR OVER COUNT WORD
VALRQ2: UMOVE P3,2(P3) ;GET # OF RESOURCES
HRR P5,P3 ;GET GROUP NUMBER IN P5
TLNN P3,-1 ;IS THIS A POOLED REQUEST
JRST [ SETZ P3, ;NO, ZERO P3
JRST VALRQ0]
HLLZS P5 ;YES, MAKE GROUP # BE 0
TRNN P3,-1 ;YES, MUST REQUEST AT LEAST 1
RETBAD (ENQX12) ;ERROR IF 0
HLRZ T1,P3 ;GET TOTAL # IN POOL
CAIGE T1,0(P3) ;CAN THIS REQUEST BE MET?
RETBAD (ENQX12) ;NO, GIVE ERROR RETURN
VALRQ0: HRRZ P2,Q1 ;GET ADDRESS OF LOCK REQUEST
UMOVE P2,1(P2) ;GET STRING POINTER TO RESOURCE ID
TLC P2,-1 ;SEE IF -1 IN LH
TLCN P2,-1 ;...
HRLI P2,(POINT 7,0) ;YES, SET UP ASCII POINTER
LDB T2,[POINT 3,P2,2] ;GET HIGH ORDER 3 BITS
CAIN T2,5 ;IS THIS A USER CODE?
JRST VALRQ1 ;YES
TLZE P2,37 ;NO, INDIRECT OR INDEXED POINTER?
RETBAD (ENQX13) ;YES, THIS IS NOT ALLOWED
MOVE T1,P2 ;GET THE POINTER FOR A CALL
CALLX (MSEC1,PTRCHK) ;[7.1040] SEE IF THIS IS AN ILLEGAL OWGBP
RETBAD(ENQX14) ;YES...INVALID BYTE SIZE ERROR
VALRQ1: HRRZ P1,Q1 ;GET ADDRESS ONLY
UMOVE P1,0(P1) ;GET FLAGS, LEVEL #, AND JFN
HRL P5,P1 ;SAVE JFN OF REQUEST
HRRZ T1,P1 ;GET JFN AGAIN
CAIN T1,-1 ;JOB WIDE LOCK?
JRST [ HRR P1,GBLJNO ;YES, GET GLOBAL JOB NUMBER
TRO P1,400000 ;MAKE IT 400000 + JOB NUMBER
RETSKP] ;ALL THROUGH
CAIN T1,-2 ;GLOBAL LOCK?
CALLRET CHKENP ;[7.1072] YES, CHECK IF PRIVILEGED
CAIN T1,-3 ;SYSTEM LOCK?
CALLRET CHKWHL ;[7.1072] YES, CHECK WHEEL PRIVILEGE
CALL CHKENJ ;CHECK IF THIS IS A LEGAL JFN
RET ;NO, GIVE ERROR RETURN
HRR P1,T1 ;SAVE OFN
RETSKP ;GIVE OK RETURN
SUBTTL CHKENP (Check for ENQ privs)
;ROUTINE TO CHECK IF ENQ PRIVILEGE IS SET
; CALL CHKENP
;RETURNS +1: PRIVILEGE NOT SET - ERROR CODE IN T1
; +2: PRIVELEGE SET
CHKENP: MOVE T1,CAPENB ;GET ENABLED PRIVILEGES
TRNN T1,SC%WHL!SC%OPR!SC%ENQ
RETBAD (ENQX15) ;NOT PRIVILEGED
RETSKP ;HAS ENOUGH PRIVILEGES
SUBTTL CHKWHL (Check for WHEEL/OPERATOR privs)
;ROUTINE TO CHECK IF THE USER IS A WHEEL OR OPERATOR
CHKWHL: MOVE T1,CAPENB ;GET CAPABILITIES
TRNN T1,SC%WHL!SC%OPR ;WHEEL OR OPERATOR
RETBAD (ENQX16) ;NO
RETSKP ;YES
SUBTTL CHKJFN (Check for legal JFN)
;ROUTINE TO CHECK A JFN FOR LEGALITY AND GET THE OFN
;ACCEPTS IN T1/ JFN
; CALL CHKENJ
;RETURNS +1: NOT A LEGAL JFN FOR LOCKING ON
; +2: JFN LEGAL - OFN IN T1
CHKENJ: HRLZS T1 ;LH = JFN ,, RH = PAGE # 0
CALLX (MSEC1,JFNOFN) ;[7.1040] GET OFN,,PAGE # FOR PAGE 0 OF THIS JFN
JRST [ SKIPGE T1 ;SEE IF THERE IS AN ERROR CODE IN T1
MOVEI T1,ENQX17 ;NO, ILLEGAL JFN
RET] ;GIVE ERROR RETURN
HLRZS T1 ;GET OFN IN RH
RETSKP ;GIVE OK RETURN
SUBTTL FNDLOK (Find a Lock-Block)
;ROUTINE TO FIND A LOCK-BLOCK
;ACCEPTS IN T1/ HASH INDEX
; P1-P4/ AS SET UP BY VALREQ
; CALL FNDLOK
;RETURNS +1: NOT FOUND
; +2: LOCK-BLOCK FOUND, ADDRESS IN T1
FNDLOK: STKVAR <FNDLKI,FNDLKO,FNDLKP,FNDLKL>
ADD T1,[HSHTBL] ;ADD HASH-TABLE ADDRESS
MOVEM T1,FNDLKI ;SAVE THE HASH CHAIN ADDRESS
FNDLK1: LOAD T1,ENQNHC,(T1) ;GET NEXT LOCK-BLOCK ON CHAIN
CAMN T1,FNDLKI ;HAVE WE EXHAUSTED LIST?
RETBAD (ENQX7) ;YES, LOCK BLOCK WAS NOT FOUND
MOVEM T1,FNDLKL ;REMEMBER THIS LOCK-BLOCK ADDRESS
LOAD T2,ENQOFN,(T1) ;GET OFN NUMBER
CAIE T2,(P1) ;IS THIS A MATCH?
JRST FNDLK2 ;NO, TRY NEXT ENTRY
MOVE T2,P2 ;GET STRING POINTER
CALL STRCMP ;COMPARE STRINGS
JRST FNDLK2 ;NO MATCH
MOVE T1,FNDLKL ;GET BACK LOCK-BLOCK ADDRESS
RETSKP ;LOCK-BLOCK WAS FOUND
FNDLK2: MOVE T1,FNDLKL ;GET LOCK-BLOCK ADDRESS
JRST FNDLK1 ;LOOP BACK TILL LIST SCANNED
SUBTTL FNDQ (Find a Q-Block)
;ROUTINE TO FIND A Q-BLOCK
;ACCEPTS IN T1/ LOCK-BLOCK ADDRESS
; CALL FNDQ
;RETURNS +1: NO Q-BLOCK UNDER THIS LOCK
; +2: Q-BLOCK FOUND, Q-BLOCK ADDRESS IN T1
FNDQ: LOAD T2,ENQNLQ,(T1) ;GET ADDRESS OF FIRST Q-BLOCK
EXCH T1,T2 ;GET Q-BLOCK ADR INTO T1 FOR RETURN
FNDQ1: CAMN T2,T1 ;HAVE WE ARRIVED BACK AT LOCK-BLOCK?
RETBAD (ENQX7) ;YES, GIVE UNSUCCESSFUL RETURN
LOAD T3,ENQGRP,(T1) ;GET GROUP # OF BLOCK
CAIE T3,0(P5) ;MATCH?
JRST FNDQ2 ;NO, KEEP LOOKING
LOAD T3,ENQFRK,(T1) ;GET OWNER OF BLOCK
CAME T3,FORKX ;IS THIS OUR Q-BLOCK?
JRST FNDQ2 ;NO, KEEP LOOKING
LOAD T3,ENQJFN,(T1) ;GET JFN FROM Q-BLOCK
HLRZ T4,P5 ;AND JFN FOR NEW REQUEST
CAMN T4,T3 ;DO THE JFNS MATCH?
RETSKP ;YES, RETURN WITH ADR IN T1
FNDQ2: LOAD T1,ENQNLQ,(T1) ;STEP TO NEXT Q-BLOCK
JRST FNDQ1 ;LOOP BACK FOR ALL Q-BLOCKS
SUBTTL GETLVL (Get highest locked level)
;ROUTINE TO GET THE HIGHEST LOCKED LEVEL #
; CALL GETLVL
;RETURNS +1: ALWAYS
; T1/ LH = MONITOR LEVEL #, RH = USER LEVEL #
GETLVL: STKVAR <GETLVU,GETLVM>
SETOM GETLVU ;INITIALIZE USER LEVEL TO -1
SETOM GETLVM ;SAME FOR MONITOR LEVEL #
MOVEI T1,ENQLST ;GET FIRST Q-BLOCK OF JOB
LOAD T1,ENQNJQ,(T1) ;...
GETLV1: JUMPE T1,GETLV3 ;IF 0, END OF JOB LIST
LOAD T2,ENQFRK,(T1) ;GET FORK # OF OWNER
CAME T2,FORKX ;IS THIS OUR FORK?
JRST GETLV2 ;NO, IGNORE IT
LOAD T2,ENQLBP,(T1) ;GET ADDRESS OF LOCK BLOCK
LOAD T3,ENQLVL,(T2) ;GET LEVEL NUMBER OF THIS LOCK
LOAD T4,ENQOFN,(T2) ;GET OFN OF LOCK
CAIN T4,-3 ;IS THIS A MONITOR LOCK?
JRST [ CAMLE T3,GETLVM ;YES, IS THIS A NEW HIGH MONITOR LEVEL?
MOVEM T3,GETLVM ;YES, STORE THIS NEW LEVEL NUMBER
JRST GETLV2] ;GO CHECK OTHER LEVELS
CAMLE T3,GETLVU ;NO, IS THIS A NEW HIGH USER LEVEL?
MOVEM T3,GETLVU ;YES, REMEMBER IT
GETLV2: LOAD T1,ENQNJQ,(T1) ;STEP TO NEXT ENTRY IN JOB LIST
JRST GETLV1 ;LOOP BACK FOR ALL Q-BLOCKS
GETLV3: HRL T1,GETLVM ;SET UP ANSWER
HRR T1,GETLVU ;...
RET ;AND RETURN
SUBTTL CNTQ/CNTQLQ (Get share counts)
;ROUTINE TO COUNT UP THE NUMBER OF SHARERS OF A LOCK
;ACCEPTS IN T1/ LOCK BLOCK ADDRESS
; CALL CNTQ
;Returns +1: Always, with:
;[7.1072] T1/ access!fork number of latest sharer,,count of sharers
;[7.1072]
;[7.1072] The access is held in bit 0 and is 1 for shared and 0 for
;[7.1072] exclusive. The fork number is in bits 1 - 17 and the count
;[7.1072] of sharers (lockers) is in bits 18 - 35. If the lock is not
;[7.1072] owned, then both the fork number and share count will be 0.
;[7.1072]
;[7.1072] Routine CNTQLQ is an alternate entry point which returns
;[7.1072] Count of waiters,,Count of lockers in T1.
CNTQLQ::STKVAR <EFLG> ;[7.1072] Entry flag
SETOM EFLG ;[7.1072] Indicate entered CNTQLQ
SETZ T4, ;[7.1072] Initialize count
JRST CNTQ1 ;[7.1072] Continue at common code
CNTQ:: STKVAR <EFLG> ;[7.1072] Entry flag
SETZM EFLG ;[7.1072] Indicate entered CNTQ
HRLZI T4,(1B0) ;[7.1072] Initialize access!fork-number,,count
CNTQ1: MOVE T2,T1 ;SAVE ADR OF LOCK BLOCK
CNTQL: LOAD T2,ENQNLQ,(T2) ;STEP TO THE NEXT QUEUE BLOCK
CAMN T2,T1 ;BACK TO THE LOCK BLOCK YET?
JRST [ MOVE T1,T4 ;YES, GET THE COUNT INTO T1
RET] ;AND RETURN
LOAD T3,ENQFLG,(T2) ;GET THE FLAGS OF THIS BLOCK
TXNN T3,EN.LOK ;[7.1072] Is the lock locked?
IFSKP. ;[7.1072] Yes
AOS T4 ;[7.1072] Increment number of lockers (sharers)
LOAD T3,ENQFRK,(T2) ;[7.1072] Get the fork number of this sharer
DPB T3,[POINT 9,T4,17];[7.1072] Save it
LOAD T3,ENQFLG,(T2) ;[7.1072] Get the flags
TXNE T3,EN.EXC ;[7.1072] Is this an exclusive lock?
TLZ T4,(1B0) ;[7.1072] Yes, clear bit 0
ELSE. ;[7.1072] Not locked
SKIPE EFLG ;[7.1072] Was CNTQLQ called?
ADD T4,[1,,0] ;[7.1072] Increment number of waiters
ENDIF. ;[7.1072]
JRST CNTQL ;LOOP BACK TILL BACK TO LOCK BLOCK
ENDSV. ;[7.1072]
SUBTTL STRCMP/STVCMP (Compare strings or user codes)
;ROUTINE TO COMPARE STRINGS OR USER CODES
;ACCEPTS IN T1/ LOCK BLOCK ADDRESS
; T2/ STRING POINTER OR USER CODE
; CALL STRCMP
;RETURNS +1: NO MATCH
; +2: MATCH
;
;[7.1072] STVCMP is an alternate entry point used by LOCLOK in ENQSRV.
;[7.1072] The only difference is that the string pointer points to a string
;[7.1072] in the VRQA and not in user address space.
IFN CLEQIN,< ;[7.1072] If cluster ENQ code present
STVCMP::STKVAR <STRCPP,STRENT> ;[7.1072]
SETOM STRENT ;[7.1072] Indicate entry to STVCMP
JRST STRCM1 ;[7.1072] Continue at common code
> ;[7.1072]
STRCMP: STKVAR <STRCPP,STRENT> ;[7.1072]
SETZM STRENT ;[7.1072] Indicate entry to STRCMP
STRCM1: LOAD T3,ENQFLG,(T1) ;[7.1072] GET FLAGS OF LOCK-BLOCK
TRNN T3,EN.TXT ;TEXT OR USER CODE?
JRST STRCMC ;USER CODE
LOAD T3,NMFLG,T2 ;GET BITS 0-2 TO SEE IF USER SPECIFIED CODE
CAIN T3,NUMVAL ; 5B2 CANNOT BE A STRING POINTER
RET ; SO RETURN NO MATCH ON TYPE MISMATCH
MOVE T3,T2 ;BUILD THE STRING POINTER
AND T3,[007700,,0] ;GET THE BYTE SIZE OF THE OTHER STRING
TDO T3,[POINT 0,.ENTXT(T1)] ;SET UP THE REST OF THE BYTE POINTER
MOVEM T3,STRCPP ;SAVE BYTE POINTER INTO LOCK-BLOCK
STRCM0: SKIPE STRENT ;[7.1072] Was STRCMP called?
IFSKP. ;[7.1072] Yes
XCTBU [ILDB T3,T2] ;[7.1072] Get user's byte from user space
ELSE. ;[7.1072] No, STVCMP was called
ILDB T3,T2 ;[7.1072] Get byte from VRQA
ENDIF. ;[7.1072]
ILDB T4,STRCPP ;GET LOCK'S BYTE
CAME T3,T4 ;A MATCH?
RET ;NO, RETURN
JUMPN T3,STRCM0 ;IF NOT 0, LOOP BACK
RETSKP ;STRING MATCHED
STRCMC: LOAD T3,ENQTXT,(T1) ;GET USER CODE
CAME T2,T3 ;IS THIS A MATCH?
RET ;NO
RETSKP ;YES
ENDSV. ;[7.1072]
SUBTTL CRELOK (Create a Lock-Block)
;ROUTINE TO CREATE A LOCK-BLOCK
;ACCEPTS IN T1/ HASH INDEX
; P1-P4/ AS SET UP BY VALREQ
; CALL CRELOK
;RETURNS +1: COULD NOT CREATE LOCK-BLOCK
; +2: SUCCESSFUL - LOCK-BLOCK ADDRESS IN T1
CRELOK: STKVAR <CRELKH,CRELKL>
MOVEM T1,CRELKH ;SAVE THE HASH INDEX
; IFN CFSCOD,< ;If CFS stuff
CALL CFETST ;(P1) IS IT AN OWNED CFS RESOURCE?
RETBAD () ;YES
; > ;IFN CFSCOD
SKIPN T1,P4 ;STRING OR CODE?
MOVEI T1,1 ;USER CODE NEEDS ONLY ONE WORD
ADDI T1,LBLEN ;ADD IN LOCK-BLOCK LENGTH
MOVEM T1,CRELKL ;REMEMBER THE LOCK-BLOCK LENGTH
CALL ASGEQ ;GET FREE BLOCK FOR LOCK
; IFN CFSCOD,< ;If CFS stuff
IFNSK. ;If failed
PUSH P,T1 ;Save error code
HRRE T1,P1 ;Get the OFN
SKIPLE T1 ;Is this a CFS lock?
CALLX (MSEC1,CFSDEQ) ;[7.1040] yep. Undo the lock
CALLRET PA1 ;Done
ENDIF.
; > ;IFN CFSCOD
REPEAT 0,< ;CFSCOD NO LONGER USED
IFE CFSCOD,< RETBAD()>
> ;END REPEAT 0
MOVE T2,CRELKH ;PUT BLOCK ON HASH LIST
IFN CLEQIN,< ;[7.1072]
STOR T2,ENQHSH,(T1) ;[7.1072] Save hash value in Lock-Block
> ;[7.1072]
ADD T2,[HSHTBL] ;TURN INDEX INTO HASH TABLE OFFSET
STOR T2,ENQLHC,(T1) ;POINT BACK TO HASH TABLE ENTRY
LOAD T3,ENQNHC,(T2) ;GET HASH TABLE FORWARD POINTER
STOR T1,ENQNHC,(T2) ;MAKE THIS LOCK-BLOCK FIRST ON LIST
STOR T3,ENQNHC,(T1) ;MAKE NEW LOCK POINT TO NEXT LOCK
STOR T1,ENQLHC,(T3) ;MAKE SECOND ENTRY POINT BACK TO US
STOR T1,ENQLLQ,(T1) ;THIS IS AN EMPTY LOCK
STOR T1,ENQNLQ,(T1) ;IT POINTS TO ITSELF
LDB T2,[POINT 9,P1,17] ;GET THE LEVEL NUMBER
STOR T2,ENQLVL,(T1) ;REMEMBER THE LEVEL # OF THIS LOCK
HLRZ T2,P3 ;GET # OF RESOURCES
STOR T2,ENQRR,(T1) ;SET UP REMAINING RESOURCES
STOR T2,ENQTR,(T1) ;AND TOTAL RESOURCES
STOR P1,ENQOFN,(T1) ;SAVE OFN CODE
MOVE T2,CRELKL ;GET LOCK-BLOCK LENGTH
STOR T2,ENQLEN,(T1) ;SAVE LENGTH FOR RETURNING LOCK-BLOCK
MOVEI T3,-1 ;MARK THAT THIS LOCK IS NOT ON LTL LIST
STOR T3,ENQLT,(T1) ;THIS CAUSES IT TO BE PUT ON LIST LATER
IFN CLEQIN,< ;[7.1072]
STOR T3,ENQAFP,(T1) ;[7.1072] This block is going on end of action list
MOVE T2,EQLBLT ;[7.1072] Get the head of the action list
CAIE T2,-1 ;[7.1072] Is the action list empty?
IFSKP. ;[7.1072] Yes, so set up first entry specially
STOR T1,ENQABP,(T1) ;[7.1072] The last block is us, forward pointer stays -1
MOVEM T1,EQLBLT ;[7.1072] The first block on the list is us, too
ELSE. ;[7.1072] Not empty - add to end of action list
LOAD T3,ENQABP,(T2) ;[7.1072] Get last block on action list
STOR T1,ENQAFP,(T3) ;[7.1072] Make last block's FLINK point to new block
STOR T3,ENQABP,(T1) ;[7.1072] New BLINK point to last - FLINK stays -1
STOR T1,ENQABP,(T2) ;[7.1072] First block's BLINK points to new block
ENDIF. ;[7.1072]
AOS EQLBCT ;[7.1115] Count one more block on the list
> ;[7.1072]
MOVEI T2,EN.LB ;GET FLAGS
IFN CLEQIN,< ;[7.1072]
HRRE T3,P1 ;[7.1072] Get lock type and extend sign
IFL. T3 ;[7.1179] Is this a non-file lock?
TRNN T3,77000 ;[7.1179] Yes. Is this a -1 type of lock?
TXO T2,EN.NOV ;[7.1072] Yes, so no vote is ever required
ENDIF. ;[7.1072]
> ;[7.1072]
LDB T3,[POINT 3,P2,2] ;GET HIGH ORDER 3 BITS
CAIE T3,5 ;A USER CODE?
TRO T2,EN.TXT ;NO, SET TEXT FLAG
IFN CLEQIN,< ;[7.1072]
SKIPE ELBCSH ;[7.1072] Is Lock-Block caching enabled?
TXO T2,EN.LTL ;[7.1072] Yes, so set LTL always
> ;[7.1072]
TXNE P1,EN%LTL ;LONG TERM LOCK?
TXO T2,EN.LTL ;YES, REMEMBER THIS IN THE LOCK BLOCK
STOR T2,ENQFLG,(T1) ;STORE FLAGS OF LOCK-BLOCK
TRNN T2,EN.TXT ;TEXT?
JRST [ STOR P2,ENQTXT,(T1) ;NO, STORE USER CODE
RETSKP] ;ALL DONE
MOVE T2,P2 ;BUILD THE BYTE POINTER
AND T2,[007700,,0] ;GET BYTE SIZE FROM OTHE BYTE POINTER
TDO T2,[POINT 0,.ENTXT(T1)]
CRELK1: XCTBU [ILDB T3,P2] ;COPY USER STRING INTO MONITOR BLOCK
IDPB T3,T2 ;...
JUMPN T3,CRELK1 ;IF NOT 0, LOOP BACK FOR ALL CHARS
RETSKP ;LOCK-BLOCK CREATED
SUBTTL CREQ (Create a Q-Block and link to Lock-Block)
;ROUTINE TO CREATE A Q-BLOCK AND PUT IT ON A LOCK-BLOCK CHAIN
;ACCEPTS IN T1/ LOCK-BLOCK ADR
; T2/ Q-BLOCK ADR OF MEMBER OF MULTIPLE REQUEST
; T3/ FLAGS FOR NEW Q-BLOCK
; Q1-Q3, P1-P4 AS SET UP BY VALARG AND VALREQ
; CALL CREQ
;RETURNS +1: CANNOT CREATE Q-BLOCK
; +2: Q-BLOCK ADDRESS IN T1
CREQ: STKVAR <CREQL,CREQQ,CREQF,CREQA>
MOVEM T1,CREQL ;SAVE LOCK-BLOCK ADDRESS
MOVEM T2,CREQQ ;SAVE MULTIPLE REQUEST Q-BLOCK
MOVEM T3,CREQF ;SAVE FLAGS
LOAD T1,ENQOTA ;GET QUOTA FOR THIS JOB
LOAD T2,ENQCNT ;GET CURRENT COUNT
HRRZ T3,P1 ;GET OFN
CAIN T3,-3 ;SYSTEM LOCK?
JRST CREQ1 ;YES, DONT COUNT UP QUOTA
CAMG T1,T2 ;ROOM LEFT FOR MORE ENTRIES?
RETBAD (ENQX18) ;NO, DONT CREATE QUEUE
AOS T2 ;COUNT UP COUNT
STOR T2,ENQCNT ;STORE UPDATED COUNT
CREQ1: MOVE T2,CREQL ;GET ADR OF THE LOCK BLOCK
LOAD T1,ENQFBP,(T2) ;SEE IF THERE IS A FREE Q-BLOCK
SETZRO ENQFBP,(T2) ;CLEAR OUT POINTER TO THE BLOCK
JUMPN T1,CREQ2 ;IF THERE IS A FREE BLOCK, GO USE IT
MOVEI T1,QBLEN ;GET LENGTH OF Q-BLOCK
CALL ASGEQ ;GET FREE BLOCK FOR Q
RET ;NO SPACE LEFT
CREQ2: MOVEM T1,CREQA ;SAVE THE ADDRESS OF THE Q-BLOCK
MOVEI T2,ENQLST ;GET ADDRESS OF Q-LIST HEADER FOR JOB
STOR T2,ENQLJQ,(T1) ;POINT THIS Q-BLOCK BACK TO HEADER
LOAD T3,ENQNJQ,(T2) ;GET FORWARD POINTER FROM Q-LIST HEADER
STOR T1,ENQNJQ,(T2) ;MAKE Q-LIST HEADER POINT TO THIS Q-BLOCK
STOR T3,ENQNJQ,(T1) ;MAKE US POINT FORWARD
SKIPE T3 ;IS THIS THE END OF THE LIST
STOR T1,ENQLJQ,(T3) ;NO, MAKE SECOND ITEM POINT BACK TO US
MOVE T2,CREQL ;GET LOCK BLOCK ADDRESS AGAIN
STOR T2,ENQNLQ,(T1) ;MAKE US POINT FORWARD TO LOCK-BLOCK
LOAD T3,ENQLLQ,(T2) ;GET BACK OF QUEUE FROM LOCK-BLOCK
STOR T3,ENQLLQ,(T1) ;MAKE US POINT BACK TO IT
STOR T1,ENQNLQ,(T3) ;MAKE IT POINT TO US
STOR T1,ENQLLQ,(T2) ;MAKE LOCK-BLOCK POINT BACK TO US
STOR T2,ENQLBP,(T1) ;SET UP A POINTER TO THE LOCK-BLOCK
STOR Q2,ENQCHN,(T1) ;SAVE PSI CHANNEL NUMBER
HLRZ T2,Q2 ;GET ID
STOR T2,ENQID,(T1) ;SAVE THE ID NUMBER
MOVE T2,CREQF ;GET FLAGS
STOR T2,ENQFLG,(T1) ;SAVE THEM
MOVE T2,FORKX ;GET FORK NUMBER OF THIS FORK
STOR T2,ENQFRK,(T1) ;SAVE IT FOR INTERRUPTING
STOR P3,ENQNR,(T1) ;STORE # OF RESOURCES REQUESTED
HLRZ T2,P5 ;GET JFN OF REQUEST
STOR T2,ENQJFN,(T1) ;STORE JFN
HRRZ T2,P5 ;GET GROUP #
STOR T2,ENQGRP,(T1) ;STORE GROUP NUMBER
LOAD T1,ENQMSK,(T1) ;DO WE HAVE A MASK BLOCK YET?
JUMPE T1,CREQ3 ;...
MOVE T2,CREQL ;YES, GET ITS SIZE
LOAD T2,ENQNMS,(T2) ; FROM THE LOCK BLOCK
CAMN T2,EDNMS ;IS THIS THE SAME SIZE AS REQUESTED
JRST CREQ3A ;YES, GO USE IT
CALL RELEQ ;NO, RELEASE IT
MOVE T1,CREQA ;GET THE ADR OF THE Q-BLOCK AGAIN
SETZRO ENQMSK,(T1) ;CLEAR THE MASK BLOCK ADDRESS
CREQ3: SKIPN T1,EDNMS ;IS THERE A MASK BLOCK SPECIFIED?
JRST CREQ5 ;NO
CALL ASGEQ ;YES, GET SPACE FOR IT
RETBAD (,<MOVE T1,CREQA ;FAILED, RETURN Q-BLOCK
MOVEI T2,QBLEN
CALL RELEQ
MOVE T1,LSTERR>) ;GET BACK ERROR CODE
CREQ3A: MOVE T2,CREQA ;GET ADR OF Q-BLOCK
STOR T1,ENQMSK,(T2) ;SAVE ADR OF MASK BLOCK IN Q-BLOCK
MOVE T4,EDNMS ;GET THE LENGTH OF THE BLOCK
MOVE T3,CREQL ;GET ADR OF LOCK BLOCK
STOR T4,ENQNMS,(T3) ;STORE THE LENGTH OF THE MASK BLOCK
MOVE T3,EDMSK ;GET THE ADR OF THE USER'S MASK BLOCK
CREQ4: UMOVE T2,0(T3) ;GET THE NEXT USER MASK WORD
MOVEM T2,0(T1) ;COPY IT TO THE MASK BLOCK
AOS T1 ;STEP THE USER'S ADR
AOS T3 ;STEP THE MONITOR'S ADR
SOJG T4,CREQ4 ;LOOP BACK TILL THE BLOCK IS COPIED
CREQ5:
IFN CLEQIN,< ;[7.1179]
MOVE T1,CREQL ;[7.1179] Get address of Lock-Block
LOAD T2,ENQFLG,(T1) ;[7.1179] Get flags from Lock-Block
MOVE T3,CREQF ;[7.1179] Get flags stored in Q-Block
TXNE T3,EN.CLL ;[7.1179] Is this a cluster-wide request?
TXO T2,EN.CLL ;[7.1179] Yes, so this is cluster-wide lock
STOR T2,ENQFLG,(T1) ;[7.1179] Put flags into Lock-Block
> ;[7.1179]
MOVE T1,CREQA ;GET BACK THE ADR OF THE Q-BLOCK
SKIPN T2,CREQQ ;IS THIS A MULTIPLE REQUEST?
JRST [ STOR T1,ENQFQ,(T1) ;NO, MAKE AN EMPTY LIST
STOR T1,ENQLRQ,(T1)
RETSKP] ;ALL DONE
LOAD T3,ENQFQ,(T2) ;ADD THIS Q-BLOCK ONTO LIST OF REQUESTS
STOR T1,ENQFQ,(T2) ; POINT FORWARD TO US
STOR T1,ENQLRQ,(T3) ; POINT BACK TO US
STOR T3,ENQFQ,(T1) ; WE POINT FORWARD
STOR T2,ENQLRQ,(T1) ; AND WE POINT BACKWARD
RETSKP ;ALL THROUGH
SUBTTL REQDEQ (DEQ an entire request)
;ROUTINE TO DEQ AN ENTIRE REQUEST
;ACCEPTS IN T1/ Q-BLOCK ADDRESS
; CALL REQDEQ
;RETURNS +1: ALWAYS, REQUEST DEQUEUED
REQDEQ: CALL QDEQ ;DEQUEUE THIS Q-BLOCK
JUMPN T1,REQDEQ ;IF ANY MORE Q-BLOCKS, DEQ THEM TOO
RET ;EXIT SUCCESSFULLY
SUBTTL SQDEQ (DEQ a single Q-Block)
;ROUTINE TO DEQ A SINGLE Q-BLOCK
;ACCEPTS IN T1/ Q-BLOCK ADDRESS TO BE DEQUEUED
; CALL SQDEQ
;RETURNS +1: ALWAYS - Q-BLOCK DEQUEUED AND SCHEDULING PERFORMED
SQDEQ: STKVAR <SQDEQQ,SQDEQF>
LOAD T2,ENQFLG,(T1) ;GET FLAGS OF THIS Q-BLOCK
MOVEM T2,SQDEQF ;SAVE FOR LATER USE
CALL QDEQ ;DEQ THIS Q-BLOCK
JUMPE T1,R ;IF NOT A MULTIPLE REQUEST, RETURN
MOVEM T1,SQDEQQ ;SAVE Q-BLOCK ADDRESS
CALL QSKD ;SCHEDULE THIS Q ENTRY
RET ;LOCK NOT LOCKED YET
JUMPN T1,SQDEQ1 ;LOCKING WAS COMPLETED ON THIS CALL?
MOVE T1,SQDEQF ;NO, SEE IF USER NEEDS WAKING UP
TRNE T1,EN.LOK ;WAS THE ORGINAL Q ALREADY LOCKED?
RET ;YES, THEN USER HAD BEEN INFORMED
SQDEQ1: MOVE T1,SQDEQQ ;USER NEEDS AWAKENING, GET Q ADDRESS
CALLRET INTQ ;GO WAKE UP THE FORK
SUBTTL QDEQ (DEQ a Q-Block)
;ROUTINE TO DEQ A Q-BLOCK
;ACCEPTS IN T1/ Q-BLOCK ADDRESS
; CALL QDEQ
;RETURNS +1: ALWAYS - T1 CONTAINS 0 OR Q-BLOCK ADR OF NEXT Q IN THE
; MULTIPLE REQUEST CHAIN
QDEQ: STKVAR <QDEQRQ,QDEQLB,QDEQQA>
MOVEM T1,QDEQQA ;SAVE THE ADR OF THE Q-BLOCK
LOAD T2,ENQLJQ,(T1) ;REMOVE Q-BLOCK FROM JOB CHAIN
LOAD T3,ENQNJQ,(T1) ;GET POINTERS BACKWARD AND FORWARD
SKIPE T3 ;IF END OF LIST, DONT STORE BACK POINTER
STOR T2,ENQLJQ,(T3) ;FIX UP BACK POINTER
STOR T3,ENQNJQ,(T2) ;AND FORWARD POINTER
LOAD T2,ENQLLQ,(T1) ;NOW REMOVE IT FROM LOCK CHAIN
LOAD T3,ENQNLQ,(T1)
STOR T2,ENQLLQ,(T3)
STOR T3,ENQNLQ,(T2)
LOAD T2,ENQLRQ,(T1) ;NOW REMOVE IT FROM THE MULTIPLE LIST
LOAD T3,ENQFQ,(T1)
STOR T2,ENQLRQ,(T3)
STOR T3,ENQFQ,(T2)
MOVEM T2,QDEQRQ ;SAVE ADDRESS OF NEXT Q-BLOCK
CAMN T2,T1 ;IS THE MULTIPLE LIST EMPTY?
SETZM QDEQRQ ;YES, RETURN 0 IN T1 ON RETURN
LOAD T2,ENQLBP,(T1) ;GET ADDRESS OF LOCK BLOCK
LOAD T3,ENQNR,(T1) ;GET NUMBER OF RESOURCES REQUESTED
LOAD T4,ENQRR,(T2) ;GET REMAINING RESOURCES COUNT
ADD T4,T3 ;GIVE BACK OUR RESOURCES
LOAD T3,ENQFLG,(T1) ;GET FLAGS OF REQUEST
TRNE T3,EN.LOK ;WAS LOCK LOCKED?
STOR T4,ENQRR,(T2) ;YES, GIVE BACK RESOURCES
MOVEM T2,QDEQLB ;REMEMBER THE LOCK-BLOCK FOR LATER
LOAD T3,ENQCNT ;DECREMENT THE QUOTA COUNT
SOS T3
LOAD T4,ENQOFN,(T2) ;GET THE OFN VALUE
CAIE T4,-3 ;IF -3 LOCK, DONT DECREMENT QUOTA
STOR T3,ENQCNT ;STORE UPDATED COUNT
MOVE T3,QDEQLB ;GET ADR OF LOCK BLOCK
LOAD T4,ENQFBP,(T3) ;GET POINTER TO FREE Q-BLOCK IF ANY
JUMPE T4,[STOR T1,ENQFBP,(T3)
JRST QDEQ0] ;IF NO FREE Q-BLOCK, SAVE THIS ONE
LOAD T2,ENQNMS,(T3) ;GET THE SIZE OF THE MASK BLOCK
LOAD T1,ENQMSK,(T1) ;GET THE ADDRESS OF THE MASK BLOCK
SKIPE T1 ;IS THERE A MASK BLOCK?
CALL RELEQ ;YES, RELEASE ITS SPACE
MOVE T1,QDEQQA ;GET BACK THE ADR OF THE Q-BLOCK
MOVEI T2,QBLEN ;NOW GIVE BACK THE Q-BLOCK SPACE
CALL RELEQ ;...
QDEQ0: MOVE T1,QDEQLB ;GET ADR OF LOCK-BLOCK
CALL LOKSKD ;[7.1072] (T1/T1)Do a scheduling pass on the lock
IFN CLEQIN,< ;[8846][7.1179]
CALL QDLBFS ;[8846][7.1179] (T1/T1)Set Lock-Block flags
> ;[8846][7.1179]
;[7.1072] Note: The scheduling pass is done on locks that may be empty so that
;[7.1072] other nodes will be notified of the rescheduling event. This is done
;[7.1072] through the call to EQLKSD. Should the Lock-Block have no Q-Blocks,
;[7.1072] then LOKSKD will do nothing more than notify the other nodes and return.
;[8846] LOKSKD is called before QDLBFS so that a notification will be sent if
;[8846] the lock was a cluster-wide lock and the last Q-Block was just DEQed.
;[8846] When this happens, the Lock-Block will have EN.CLL cleared because it
;[8846] does not have Q-Blocks with EN.CLL set (so it is not a cluster-wide
;[8846] lock).
LOAD T2,ENQNLQ,(T1) ;SEE IF LOCK IS EMPTY
CAMN T2,T1 ;[7.1072] ...
CALL LOKREL ;RELEASE THE LOCK-BLOCK
QDEQ1: MOVE T1,QDEQRQ ;GET Q-BLOCK ADR OF MULTIPLE REQUEST
RET ;AND RETURN
SUBTTL QDLBFS (Set LB Flags after QB Release)
IFN CLEQIN,< ;[7.1179]
;[7.1179] QDLBFS - Set Lock-Block flags after Q-Block release
;
;This routine is used to properly set flag EN.CLL after a Q-Block has
;been dequeued. It inspects the flags of every Q-Block still
;associated with the Lock-Block. If any have EN.CLL set then it will
;set EN.CLL in the Lock-Block flags. Otherwise, EN.CLL will be cleared
;since there are no cluster-wide requests associated with the lock.
;Note that EN.CLL should always be cleared for a Lock-Block with no
;Q-Blocks (as is the case for a cached Lock-Block or a long-term lock
;with no associated requests.)
;
; T1/ Lock-Block address
;
; CALL QDLBFS
;
;Returns +1: Always with EN.CLL correctly set in the Lock-Block flags.
; Preseves T1.
QDLBFS: MOVE T2,T1 ;Save address of Lock-Block
LOAD T3,ENQFLG,(T1) ;Get Lock-Block flags
TXZ T3,EN.CLL ;Assume not a cluster-wide lock
QDLOOP: LOAD T2,ENQNLQ,(T2) ;Step to the next Q-Block
CAMN T2,T1 ;Back to the Lock-Block yet?
JRST QDDONE ;Yes, done
LOAD T4,ENQFLG,(T2) ;Get the flags of this Q-Block
JXE T4,EN.CLL,QDLOOP ;Keep looking if not a cluster-wide request
TXO T3,EN.CLL ;Found a cluster-wide request
QDDONE: STOR T3,ENQFLG,(T1) ;Store updated flags
RET ;All done
> ;[7.1179]
SUBTTL LOKREL (Release a Lock-Block)
;ROUTINE TO RELEASE A LOCK-BLOCK
;ACCETPS IN T1/ LOCK BLOCK ADDRESS
; CALL LOKREL
;RETURNS +1: ALWAYS - LOCK BLOCK GIVEN BACK TO FREE POOL
LOKREL: STKVAR <LOKRLQ,LOKRLM,LOKRLN>
; IFN CFSCOD,< ;If CFS
MOVEM T1,LOKRLQ ;Save the block address
LOAD T1,ENQOFN,(T1) ;Get the OFN
HRRES T1
SKIPLE T1 ;An OFN?
CALLX (MSEC1,CFSDEQ) ;[7.1040] yes. Release the resource
MOVE T1,LOKRLQ ;Restore block address
; > ;IFN CFSCOD
LOAD T2,ENQFBP,(T1) ;GET POINTER TO FREE Q-BLOCK IF ANY
MOVEM T2,LOKRLQ ;REMEMBER IT IF IT NEEDS RELEASING
SKIPE T3,T2 ;ANY FREE Q-BLOCK?
LOAD T3,ENQMSK,(T2) ;YES, GET THE POINTER TO THE MASK BLOCK
MOVEM T3,LOKRLM ;SAVE THE ADR TO THE MASK BLOCK
LOAD T3,ENQNMS,(T1) ;GET THE SIZE OF THE MASK BLOCK
MOVEM T3,LOKRLN ;SAVE IT FOR LATER
LOAD T2,ENQFLG,(T1) ;GET THE FLAGS
TXNE T2,EN.LTL ;IS THIS A LONG TERM LOCK?
JRST LOKRL1 ;YES, DO NOT RELEASE IT YET
LOAD T2,ENQLHC,(T1) ;REMOVE LOCK-BLOCK FROM HASH CHAIN
LOAD T3,ENQNHC,(T1)
STOR T2,ENQLHC,(T3)
STOR T3,ENQNHC,(T2)
IFN CLEQIN,< ;[7.1072]
SOS EQLBCT ;[7.1115] One less block on the list
LOAD T2,ENQABP,(T1) ;[7.1072] Get previous block on action list
LOAD T3,ENQAFP,(T1) ;[7.1072] Get the next block
CAME T1,EQLBLT ;[7.1072] Are we deleting the first block?
IFSKP. ;[7.1072] Yes
MOVEM T3,EQLBLT ;[7.1072] Make head of list be next block
CAIN T3,-1 ;[7.1088] Was first block the only block?
JRST LOKRL2 ;[7.1088] Yes
STOR T2,ENQABP,(T3) ;[7.1088] Make new BLINK point to last block
ELSE. ;[7.1072] Not removing first block
STOR T3,ENQAFP,(T2) ;[7.1072] Make previous FLINK point to next
ENDIF. ;[7.1072]
CAIN T3,-1 ;[7.1088] Is the last block being deleted?
MOVE T3,EQLBLT ;[7.1088] Yes, so first block BLINK must change
STOR T2,ENQABP,(T3) ;[7.1072] Make next BLINK point back to previous
> ;[7.1072]
LOKRL2: LOAD T2,ENQLEN,(T1) ;[7.1088] GET THE LENGTH OF THE LOCK-BLOCK
CALL RELEQ ;RELEASE THE SPACE
MOVEI T2,QBLEN ;NOW RELEASE THE Q-BLOCK
SKIPE T1,LOKRLQ ;IF THERE WAS ONE
CALL RELEQ ;RELEASE IT
MOVE T2,LOKRLN ;GET THE LENGTH OF THE MASK BLOCK
SKIPE T1,LOKRLM ;IS THERE A MASK BLOCK TO RELEASE
CALL RELEQ ;YES, RELEASE IT
RET ;ALL DONE
LOKRL1: LOAD T2,ENQLT,(T1) ;GET POINTER TO LONG TERM LOCK LIST
CAIE T2,-1 ;IS THIS ALREADY ON A LIST?
RET ;YES, NO NEED TO PUT IT ON AGAIN
MOVEI T3,ENQLTL-.ENQLT ;GET ORIGIN OF LIST HEADER FOR LONG TERM LOCK
LOAD T2,ENQLT,(T3) ;GET POINTER TO FIRST LOCK
STOR T2,ENQLT,(T1) ;LINK THIS LOCK ONTO HEAD OF THAT LIST
STOR T1,ENQLT,(T3) ;THIS LOCK IS NOW FIRST ON THE LIST
RET ;AND EXIT, LOCK GETS RELEASED LATER
SUBTTL QSKD/QSKDRC (Perform a scheduling pass on Q-Block)
;ROUTINE TO DO A SCHEDULING PASS GIVEN A Q-BLOCK ADDRESS
;ACCEPTS IN T1/ Q-BLOCK ADDRESS
; CALL QSKD
;RETURNS +1: THIS REQUEST IS NOT FULLY LOCKED YET
; +2: THIS REQUEST IS FULLY LOCKED
; T1 = 0 IF ALREADY LOCKED BEFORE THIS CALL
; T1 = -1 IF THE LOCKING WAS COMPLETED ON THIS CALL
;[7.1072]
;[7.1072] QSKDRC is an alternate entry point used by EVQSKD to check on Q-Block
;[7.1072] compatibility. It only performs the checks at CHKLK1 (and beyond) and
;[7.1072] does not actually schedule anything.
;[7.1072]
;[7.1072] T1/ Lock-Block address
;[7.1072] T2/ Mask block address in VRQA
;[7.1072] T3/ Mask block size in VRQA
;[7.1072] T4/ Flags (from EBQFLG),,Group number (from EBGRP)
;[7.1072]
;[7.1072] Returns +1: Vote request not compatible with local Q-Blocks
;[7.1072] +2: Vote request is compatible with local Q-Blocks
;[7.1072]
;[7.1072] Preserves T1. Note that the STKVAR must match the one in QSKD.
IFN CLEQIN,< ;[7.1072]
QSKDRC::SAVEAC <T1,Q1,Q2,Q3> ;[7.1072]
STKVAR <QSKDQ,QSKDT,CKLOKQ,QSKDF,QSKDG,QSKDM,QSKDN,QSFLG,QSENT> ;[7.1072]
SETOM QSENT ;[7.1072] Entered CHKLKV
HLRZM T4,QSFLG ;[7.1072] Save flags
HRRZM T4,QSKDG ;[7.1072] Save group number
MOVEM T3,QSKDN ;[7.1072] Save mask block length
MOVEM T2,QSKDM ;[7.1072] Save mask block address
JRST CHKLK1 ;[7.1072] Perform the compatibility checks
> ;[7.1072]
QSKD: SAVEQ
STKVAR <QSKDQ,QSKDT,CKLOKQ,QSKDF,QSKDG,QSKDM,QSKDN,QSFLG,QSENT> ;[7.1072]
SETZM QSENT ;[7.1072] Entered QSKD
SETZM QSKDF ;ASSUME LOCK ALREADY LOCKED ON CALL
MOVEM T1,QSKDQ ;SAVE THE ADDRESS OF THIS Q-BLOCK
CALL SETINV ;MAKE SURE INVISIBLE BITS SET OK
JRST QSKD0 ;GO MAKE SCHEDULING PASS
JRST QSKD3 ;LOCK IS ALREADY LOCKED
QSKD0: MOVE T1,QSKDQ ;GET ADDRESS OF THIS Q-BLOCK AGAIN
QSKD1: MOVEM T1,QSKDT ;SAVE IT IN A TEMPORARY REGISTER
LOAD T2,ENQMSK,(T1) ;GET THE ADR TO THE MASK BLOCK
MOVEM T2,QSKDM ;SAVE THE ADR OF THE MASK BLOCK
LOAD T2,ENQLBP,(T1) ;GET THE POINTER TO THE LOCK BLOCK
LOAD T2,ENQNMS,(T2) ;GET THE LENGTH OF THE MASK BLOCK
MOVEM T2,QSKDN ;SAVE IT FOR LATER
LOAD T2,ENQGRP,(T1) ;GET GROUP # OF THIS Q ENTRY
MOVEM T2,QSKDG ;SAVE FOR COMPARISON LATER
LOAD T2,ENQFLG,(T1) ;GET THE FLAGS OF THIS Q-BLOCK
TRNE T2,EN.LOK!EN.INV ;IS THE LOCK LOCKED BY THIS Q-BLOCK
; OR AN INVISIBLE Q-BLOCK?
JRST QSKD2 ;YES, GO CONTINUE SCANNING SIDEWAYS
MOVEM T2,QSFLG ;[7.1072] Save for later comparison
CHKLK1: LOAD T1,ENQLLQ,(T1) ;GET PREVIOUS BLOCK ON QUEUE
MOVE T3,QSFLG ;[7.1072] Get flags of original block
LOAD T4,ENQFLG,(T1) ;GET THE FLAGS OF THIS BLOCK
TRNE T4,EN.LB ;IS THIS THE LOCK-BLOCK?
JRST CHKLK2 ;YES, WE ARE AT TOP OF QUEUE
TRNE T4,EN.INV ;NO, IS THIS Q-BLOCK INVISIBLE?
JRST CHKLK1 ;YES, IGNORE THIS BLOCK ENTIRELY
IFN CLEQIN,< ;[8846] Only for cluster-wide code
SKIPN QSENT ;[8846] Did we enter QSKDRC?
IFSKP. ;[8846] Yes
TXNN T4,EN.LOK ;[8846] Does Q-Block have lock locked?
JRST CHKLK1 ;[8846] No, its waiting so just ignore it
ENDIF. ;[8846]
> ;[8846] End of IFN CLEQIN
TRNN T4,EN.EXC ;IS THIS AN EXCLUSIVE REQUEST?
TRNE T3,EN.EXC ;OR IS ORIGINAL REQUEST EXCLUSIVE?
JRST CHKLK3 ;YES, GO CHECK MASK BLOCKS
LOAD T2,ENQGRP,(T1) ;GET GROUP NUMBER OF THIS Q
CAME T2,QSKDG ;IS THIS THE SAME GROUP
RET ;NO, CANNOT SCHEDULE THIS REQUEST
JRST CHKLK1 ;LOOP BACK UNTIL AT LOCK-BLOCK
CHKLK2: SKIPE QSENT ;[7.1072] Did we enter QSKED?
RETSKP ;[7.1072] No, return - no incompatibilites
IFN CLEQIN,< ;[7.1072]
MOVE T1,QSKDT ;[7.1072] Get the Q-Block address
CALL EQQSKD ;[7.1072] (T1/T1,T4)Cluster-wide arbitration
RET ;[7.1072] Someone said "NO"!
LOAD T1,ENQLBP,(T1) ;[7.1072] Get pointer to Lock-Block
> ;[7.1072]
IFE CLEQIN,< ;[7.1072] If cluster code not present
LOAD T4,ENQRR,(T1) ;GET THE # OF REMAINING RESOURCES
> ;[7.1072]
MOVE T3,QSKDT ;GET THE NUMBER OF RESOURCES NEEDED
LOAD T3,ENQNR,(T3) ;...
SUB T4,T3 ;SEE IF ENOUGH LEFT FOR THIS REQUEST
JUMPL T4,R ;IF NOT, LOCK CANNOT BE LOCKED
STOR T4,ENQRR,(T1) ;THERE ARE ENOUGH, LOCK THE LOCK
MOVE T3,QSKDT ;GET BACK ADR OF Q-BLOCK
LOAD T2,ENQFLG,(T3) ;GET FLAGS AGAIN
TRO T2,EN.LOK ;LOCK THE LOCK BIT
STOR T2,ENQFLG,(T3) ;STORE THE UPDATED FLAGS
LOAD T2,ENQNLQ,(T3) ;NOW MOVE THIS Q-BLOCK TO THE HEAD
LOAD T4,ENQLLQ,(T3) ; OF THE QUEUE FOR THIS LOCK
STOR T2,ENQNLQ,(T4) ;FIRST REMOVE IT FROM THE QUEUE
STOR T4,ENQLLQ,(T2) ;...
LOAD T2,ENQNLQ,(T1) ;NOW ADD IT TO THE START OF THE QUEUE
STOR T3,ENQLLQ,(T2) ; POINTER BACK TO Q-BLOCK FROM Q-2
STOR T3,ENQNLQ,(T1) ; POINTER TO Q-BLOCK FROM LOCK-BLOCK
STOR T2,ENQNLQ,(T3) ; POINTER TO SECOND Q-BLOCK
STOR T1,ENQLLQ,(T3) ; POINTER BACK TO LOCK-BLOCK
CALLX (MSEC1,LGTAD) ;[7.1040] GET TIME AND DATE
MOVE T3,QSKDT ;GET Q-BLOCK ADDRESS
LOAD T3,ENQLBP,(T3) ;GET LOCK BLOCK ADDRESS
STOR T1,ENQTS,(T3) ;STORE NEW TIME STAMP IN LOCK BLOCK
MOVE T1,QSKDQ ;GET ORIGINAL Q-BLOCK ADDRESS
SETOM QSKDF ;MARK THAT A LOCK WAS LOCKED
CALL SETINV ;GO CLEAR ANY INVISIBLE BITS
JRST QSKD0 ;LOCK NOT FULLY LOCKED YET, TRY AGAIN
JRST QSKD3 ;LOCK IS LOCKED, GO GIVE OK RETURN
QSKD2: MOVE T2,QSKDT ;GET Q-BLOCK ADR OF PRESENT Q-BLOCK
LOAD T1,ENQFQ,(T2) ;STEP TO NEXT Q-BLOCK IN THIS REQUEST
CAME T1,QSKDQ ;ARE WE BACK TO THE Q-BLOCK STARTED AT?
JRST QSKD1 ;NO, GO CHECK IF THIS Q LOCKED
QSKD3: MOVE T1,QSKDF ;GET BACK ANSWER TO BE RETURNED
RETSKP ;AND SKIP RETURN
CHKLK3: LOAD T3,ENQMSK,(T1) ;YES, CHECK FOR MASKS
SKIPE T4,QSKDM ;IS THERE A MASK FOR THIS Q-BLOCK
JUMPN T3,CHKLK4 ;YES, DO BOTH BLOCKS HAVE A MASK?
JUMPN T4,CHKLK5 ;NO, ONLY ONE HAVE A MASK?
JUMPE T3,R ;IF NEITHER HAVE A MASK, THEN CANNOT LOCK
MOVE T4,T3 ;GET ADR OF MASK BLOCK TO USE
CHKLK5: MOVE T3,QSKDN ;GET LENGTH OF MASK BLOCK
CHKLK6: SKIPE 0(T4) ;ARE THERE ANY BITS ON IN MASK?
RET ;YES, THEN CANNOT LOCK IT NOW
AOS T4 ;STEP TO NEXT WORD IN MASK
SOJG T3,CHKLK6 ;LOOP BACK TIL SCANNED WHOLE MASK
JRST CHKLK1 ;THESE Q-BLOCKS CAN CO-EXIST
CHKLK4: MOVE Q1,QSKDN ;GET LENGTH OF MASK BLOCK
CHKLK7: MOVE Q2,0(T3) ;GET NEXT WORD IN MASK BLOCK
AND Q2,0(T4) ;AND IN THE NEXT MASK BLOCK IN OTHER BLOCK
JUMPN Q2,R ;IF OVERLAPPED, THEN CANNOT LOCK YET
AOS T3 ;STEP TO NEXT MASK WORD
AOS T4 ;IN BOTH BLOCKS
SOJG Q1,CHKLK7 ;LOOP BACK
JRST CHKLK1 ;THESE Q-BLOCKS CAN CO-EXIST
ENDSV. ;[7.1072]
SUBTTL SETINV (Set Q-Block invisible)
;ROUTINE TO CLEAR INVISIBLE BITS AS Q-BLOCKS GET LOCKED
;ACCEPTS IN T1/ Q-BLOCK ADDRESS OF ONE ELEMENT OF A REQUEST
; CALL SETINV
;RETURNS +1: REQUEST NOT FULLY LOCKED YET
; +2: REQUEST IS NOW FULLY LOCKED
SETINV: STKVAR <SETINQ,SETINU>
MOVSI T2,1 ;INITIALIZE LEVEL NUMBER SCANNER
MOVEM T2,SETINU ;...
MOVEM T1,SETINQ ;REMEMBER Q-BLOCK ADDRESS
SETIN1: LOAD T2,ENQLBP,(T1) ;GET ADDRESS OF LOCK-BLOCK FOR Q
LOAD T4,ENQLVL,(T2) ;GET LEVEL NUMBER OF THIS LOCK
LOAD T3,ENQFLG,(T1) ;GET Q FLAGS
TRNE T3,EN.LOK ;IS THIS Q ALREADY LOCKED?
JRST SETIN2 ;YES
CAMG T4,SETINU ;NO, IS THIS A NEW LOW VALUE?
MOVEM T4,SETINU ;YES, REMEMBER LOWEST NON-LOCKED LEVEL
SETIN2: LOAD T1,ENQFQ,(T1) ;GET NEXT Q-BLOCK IN THIS REQUEST
CAME T1,SETINQ ;ARE WE BACK TO STARTING POINT?
JRST SETIN1 ;NO, LOOP BACK FOR OTHER Q-BLOCKS
MOVE T2,SETINU ;GET LEVEL NUMBER
TLNE T2,-1 ;SEE IF AN UNLOCKED LOCK WAS SEEN
RETSKP ;NONE SEEN, THE LOCK IS FULLY LOCKED
SETIN3: LOAD T2,ENQLBP,(T1) ;GET ADR OF LOCK-BLOCK FOR THIS Q
LOAD T4,ENQLVL,(T2) ;GET LEVEL NUMBER OF LOCK
LOAD T3,ENQFLG,(T1) ;GET FLAGS OF THIS Q-BLOCK
CAMG T4,SETINU ;IS LEVEL ABOVE LOWEST UNLOCKED LEVEL?
TRZA T3,EN.INV ;NO, MAKE THIS Q-BLOCK VISIBLE
TRO T3,EN.INV ;YES, THE Q-BLOCK MUST REMAIN INVISIBLE
STOR T3,ENQFLG,(T1) ;STORE UPDATED FLAGS
LOAD T1,ENQFQ,(T1) ;GET ADR OF NEXT Q-BLOCK IN REQUEST
CAME T1,SETINQ ;HAVE WE SEEN ALL Q-BLOCKS?
JRST SETIN3 ;NO, LOOP BACK UNTIL ALL SEEN
RET ;YES, ALL THROUGH (REQ NOT TOTALLY
; LOCKED)
SUBTTL LOKSKD/REESKD (Perform a scheduling pass on Lock-Block)
;ROUTINE TO MAKE A SCHEDULING PASS GIVEN A LOCK-BLOCK ADDRESS
;ACCEPTS IN T1/ LOCK-BLOCK ADDRESS
; CALL LOKSKD
;RETURNS +1: ALWAYS - ALL NEWLY LOCKED REQUESTS INTERRUPTED
;
;[7.1072] Preserves T1.
;[7.1072]
;[7.1072] Routine REESKD is an alternate entry point, used by the ENQ fork,
;[7.1072] to perform a rescheduling without sending notification to the
;[7.1072] other nodes in the cluster.
IFN CLEQIN,< ;[7.1072]
REESKD::SAVEAC <T1> ;[7.1072] Preserve T1
STKVAR <LOKSKL,LOKSKQ,LOKSKC,LOKENT> ;[7.1072]
SETZM LOKENT ;[7.1072] Say that REESKD was entered
JRST LOKSDC ;[7.1072] Join the common code
> ;[7.1072]
LOKSKD: SAVEAC <T1> ;[7.1072] Preserve T1
STKVAR <LOKSKL,LOKSKQ,LOKSKC,LOKENT> ;[7.1072]
SETOM LOKENT ;[7.1072] Say that LOKSKD was entered
LOKSDC: MOVEM T1,LOKSKL ;[7.1072] SAVE ADDRESS OF LOCK FOR LATER
MOVEM T1,LOKSKQ ;INITIALIZE Q-BLOCK ADDRESS REGISTER
IFN CLEQIN,< ;[7.1072]
SKIPE LOKENT ;[7.1072] Should other nodes be notified?
CALL EQLKSD ;[7.1072] (T1/T1)Yes so do it
CALL EQPOOL ;[7.1072] (T1/T1,T2)Get remaining resources
> ;[7.1072] Also notifies other nodes of scheduling
IFE CLEQIN,< ;[7.1072] If cluster ENQ code not present
LOAD T2,ENQRR,(T1) ;GET REMAINING RESOURCES IN POOL
> ;[7.1072]
MOVEM T2,LOKSKC ;SAVE COUNT OF RESOURCES
LOKSK1: LOAD T1,ENQNLQ,(T1) ;STEP TO NEXT Q-BLOCK ON QUEUE
CAMN T1,LOKSKL ;BACK TO THE LOCK-BLOCK YET?
RET ;YES, SCHEDULING PASS IS DONE
MOVEM T1,LOKSKQ ;UPDATE POINTER TO CURRENT Q-BLOCK
LOAD T2,ENQFLG,(T1) ;GET FLAGS OF THE Q-BLOCK
TRNE T2,EN.INV ;INVISIBLE?
JRST LOKSK1 ;YES, IGNORE IT
TRNE T2,EN.LOK ;THIS Q ALREADY LOCKED?
JRST LOKSK3 ;YES, DONT DECREMENT RESOURCE COUNT
LOAD T2,ENQNR,(T1) ;GET NUMBER OF RESOURCES REQUESTED
MOVE T3,LOKSKC ;GET REMAINING RESOURCES
SUB T3,T2 ;DECREMENT COUNT
JUMPL T3,R ;IF NOT ENOUGH LEFT, EXIT
MOVEM T3,LOKSKC ;STORE NEW COUNT
LOKSK3: CALL QSKD ;GO SEE IF THIS REQUEST IS LOCKED
JRST LOKSK2 ;NO
JUMPE T1,LOKSK2 ;IF NOT JUST LOCKED, DONT INTERRUPT
MOVE T1,LOKSKQ ;GET Q-BLOCK ADDRESS
CALL INTQ ;INTERRUPT THE PROCESS
LOKSK2: MOVE T1,LOKSKQ ;GET Q-BLOCK ADDRESS AGAIN
JRST LOKSK1 ;LOOP BACK FOR REST OF QUEUE
SUBTTL INTQ (Wake up a waiting fork when lock is locked)
;ROUTINES TO WAKE UP OR INTERRUPT WAITING FORKS WHEN LOCK IS LOCKED
;ROUTINE TO WAKE UP A FORK GIVEN THE Q-BLOCK JUST LOCKED
;ACCEPTS IN T1/ Q-BLOCK ADDRESS
; CALL INTQ
;RETURNS +1: ALWAYS - FORK AWAKENED OR INTERRUPTED AS APPROPRIATE
INTQ: LOAD T2,ENQFRK,(T1) ;GET FORK TO BE AWAKENED
LOAD T1,ENQCHN,(T1) ;GET CHANNEL #
CAIN T1,.ENWCH ;[7.1040] IS FORK BLOCKED OR NOT
IFSKP. ;[7.1040]
XCALLRET (MSEC1,PSIRQ);[7.1040] NOT BLOCKED, GIVE IT AN INTERRUPT
ENDIF. ;[7.1040]
MOVE T1,T2 ;GET FORK # IN T1
PUSH P,T1 ;SAVE FORK #
CALL <XENT GETMSK> ;[7.1040] GET THE BIT POSITION AND WORD INDEX
IORM T2,ENFKTB(T1) ;SET BIT IN ENQ FORK TABLE
POP P,T1 ;GET BACK FORK NUMBER
XCALLRET (MSEC1,UNBLKF) ;[7.1040] UNBLOCK THE FORK
SUBTTL ENQTST (Scheduler test)
;ROUTINE TO TEST IF A FORK IS READY TO CONTINUE (CALLED BY SCHEDULER)
;ACCEPTS IN T1/ FORK #
; JSP T4,ENQTST
;RETURNS +1: FORK NOT READY TO CONTINUE
; +2: FORK IS READY TO BE CONTINUED, LOCK IS LOCKED
RESCD
ENQTST: PUSH P,T4 ;SAVE RETURN ADDRESS
XCALL (XCDSEC,GETMSK) ;[7.1040] GET BIT POSITION AND WORD INDEX
TDNN T2,ENFKTB(T1) ;IS FORK READY TO CONTINUE?
RET ;NO
RETSKP ;YES
XSWAPCD ;[7.1040]
SUBTTL ASGEQ (Get space for an ENQ block)
;ROUTINE TO GET SPACE FOR AN ENQ BLOCK
;ACCEPTS IN 1/ LENGTH OF BLOCK DESIRED
; CALL ASGEQ
;RETURNS +1: NO ROOM
; +2 T1/ ADR OF BLOCK
ASGEQ: STKVAR <ASGENC>
MOVEM T1,ASGENC ;SAVE COUNT OF WORDS NEEDED
MOVEI T1,ENQFSX ;[7.1180] Get ENQ freespace pool index
CALLX (MSEC1,FSPREM) ;[7.1180] (T1/T1,T2,T3) Get the space left
CAMGE T3,ASGENC ;[7.1258] Do we have a block that we will fit into?
JRST ASGEN2 ;[7.1258] No, so free up some space
MOVE T1,ASGENC ;[7.1180] Get number of words needed
CALLX (MSEC1,ASGENQ) ;[7.1040] (T1/T1)Get space
JRST ASGEN2 ;[7.1180] Failed, go try to free up some
RETSKP
ASGEN2: HRLOI T1,377777 ;RELEASE ALL LONG TERM LOCKS
CALL <XENT ENQGC> ;[7.1072] BRUTE FORCE TECHNIQUE TO GET SPACE
MOVEI T1,ENQFSX ;[7.1180] Get ENQ freespace pool index
CALLX (MSEC1,FSPREM) ;[7.1180] (T1/T1,T2,T3) Get the space left
CAMGE T3,ASGENC ;[7.1258] Do we have a block that we will fit into?
RETBAD (MONX06) ;[7.1258] No, return error to user
MOVE T1,ASGENC ;GET NUMBER OF WORDS NEEDED
CALLX (MSEC1,ASGENQ) ;[7.1040] (T1/T1)Get space
RETBAD () ;[7.1180]
RETSKP
ENDSV. ;[7.1180]
SUBTTL RELEQ (Release ENQ block space)
;ROUTINE TO RELEASE ENQ SPACE
;ACCEPTS IN T1/ ADR OF BLOCK
; T2/ LENGTH OF BLOCK
; CALL RELEQ
;RETURNS +1: ALWAYS
RELEQ: XCALLRET (MSEC1,RELENQ) ;[7.1040] Release the block
SUBTTL ENQGC (Garbage collection of long term locks)
;ROUTINE TO GARBAGE COLLECT LONG TERM LOCKS
;ACCEPTS IN T1/ TIME STAMP FOR DELETING LOCK BLOCKS
; CALL ENQGC
;RETURNS +1: ALWAYS
XNENT (ENQGC) ;[7.1040] ENQGC: and XENQGC:
MOVE T2,ENQLTL ;ANY LOCKS ON THE LIST?
JUMPE T2,R ;NO
SAVEQ ;GET SOME ACS TO USE
MOVEI Q1,ENQLTL-.ENQLT ;GET POINTER TO HEAD OF LIST
MOVE Q3,T1 ;SAVE TIME STAMP
ENQGC1: LOAD T1,ENQLT,(Q1) ;GET NEXT LOCK ON LIST
JUMPE T1,R ;0 MEANS NO MORE
LOAD T2,ENQTS,(T1) ;WHEN WAS THE LAST TIME IT WAS USED
CAMGE T2,Q3 ;IS IT TOO OLD?
JRST ENQGC2 ;YES, GO DELETE IT
MOVE Q1,T1 ;GET POINTER TO THIS LOCK INTO Q1
JRST ENQGC1 ;LOOP BACK FOR ALL LOCKS ON LIST
ENQGC2: LOAD T2,ENQLT,(T1) ;NOW REMOVE THIS LOCK FROM THE LIST
STOR T2,ENQLT,(Q1) ;MAKE LIST SKIP OVER THIS ONE
MOVEI T2,-1 ;MARK THAT THIS ONE IS NOT ON LIST
STOR T2,ENQLT,(T1)
LOAD T2,ENQFLG,(T1) ;TURN OFF THE LONG TERM LOCK FLAG
TXZ T2,EN.LTL ;SO IT WILL BE RELEASED
STOR T2,ENQFLG,(T1)
LOAD T2,ENQNLQ,(T1) ;NOW SEE IF THE LOCK IS FREE
CAME T2,T1 ;[7348] It is free if it points to itself
IFSKP. ;[7348]
SETZRO ENQOFN,(T1) ;[7348] It is free - zero OFN to avoid call ...
CALL LOKREL ;[7348] (T1/) ... to CFSDEQ when releasing it
ENDIF. ;[7348]
JRST ENQGC1 ;LOOP BACK FOR REST OF LIST
SUBTTL HASH (Calculate hash index)
;ROUTINE TO CALCULATE AN INDEX INTO THE HASH TABLE
;REQUIRES THAT P1 - P4 BE SET UP BY VALREQ
; CALL HASH
;RETURNS +1: ILLEGAL ARGUMENT - ERROR CODE IN T1
; +2: HASH INDEX IN T1
; P4 CONTAINS WORD LENGTH OF STRING
HASH: SETZ P4, ;INITIALIZE CHARACTER COUNT
MOVE T1,P2 ;GET STRING POINTER
LDB T2,[POINT 3,T1,2] ;SEE IF A CODE OR STRING POINTER
CAIN T2,5 ;...
JRST HASH1 ;USER CODE (500000,,0 + 33-BIT NUMBER)
CALL STHASH ;HASH THE STRING
RET ;ILLEGAL STRING POINTER
MOVEM T2,P4 ;SAVE CHARACTER COUNT
IFN CLEQIN,< ;[7.1072]
HASH1: MOVE T4,T1 ;[7.1072] Save the first number for a moment
HRRE T2,P1 ;[7.1072] Get OFN code and extend sign
SKIPGE T2 ;[7.1072] Is this a file lock?
IFSKP. ;[7.1072] Yes
LOAD T1,STRX,(T2) ;[7.1072] Get the structure number for this OFN
LOAD T2,STGADR,SPTH(T2) ;[7.1072] Get index block address
MOVE T1,STRTAB(T1) ;[7.1072] Get SDB address
SKIPE SDBALS(T1) ;[7.1072] Is there an alias?
SKIPA T1,SDBALS(T1) ;[7.1072] Yes use it
MOVE T1,SDBNAM(T1) ;[7.1072] No, use physical name
CALL MHASH ;[7.1072] (T1,T2/T1)Hash these two values
MOVE T2,T1 ;[7.1072] Make returned value the second number
MOVE T1,T4 ;[7.1072] Get saved first value
ELSE. ;[7.1072] No
HRRZS T2 ;[7.1072] So get OFN code again
ENDIF. ;[7.1072]
>
IFE CLEQIN,< ;[7.1072]
HASH1: HRRZ T2,P1 ;GET OFN CODE
> ;[7.1072]
CALL MHASH ;HASH THE TWO NUMBERS TOGETHER
MOVMS T1 ;MAKE SURE IT IS POSITIVE
IDIVI T1,HSHLEN ;GET FINAL HASH INDEX
MOVE T1,T2 ;USE REMAINDER
IMULI T1,2 ;ACCOUNT FOR THE FACT THAT A HSHTBL SLOT IS
; 2 WORDS IN LENGTH
RETSKP ;AND GIVE OK RETURN
SUBTTL HASH (Calculate hash index) -- MHASH (Hash two numbers)
;ROUTINE TO HASH TWO NUMBERS TOGETHER
;ACCEPTS IN T1/ NUMBER
; T2/ NUMBER
; CALL MHASH
;RETURNS +1: ALWAYS - T1/ HASH
MHASH: XOR T1,RANDOM ;GUARD AGAINST A ZERO IN T1
XOR T2,RANDOM ;OR IN T2
MUL T2,RANDOM ;GET A RANDOM NUMBER
MUL T1,T2 ;...
RET
RANDOM: 5*5*5*5*5*5*5*5*5*5*5*5*5*5*5
SUBTTL HASH (Calculate hash index) -- STHASH (Hash a string)
;ROUTINE TO HASH A STRING
;ACCEPTS IN T1/ STRING POINTER IN USER SPACE
; CALL STHASH
;RETURNS +1: ILLEGAL STRING POINTER - ERROR CODE IN T1
; +2: HASH IN T1
; # OF WORDS IN STRING IN T2
STHASH: STKVAR <STHSHP,STHSHX,STHSHC,STHSHB,STHSHN,STHSHM>
MOVEM T1,STHSHP ;SAVE POINTER
LDB T2,[POINT 6,T1,11] ;GET THE BYTE SIZE
MOVEI T3,^D36 ;GET NUMBER OF BYTES PER WORD
IDIVI T3,(T2) ;...
MOVEM T3,STHSHN ;SAVE NUMBER OF BYTES PER WORD
IMULI T3,ENQMXW ;GET MAX NUMBER OF CHARACTERS ALLOWED
MOVEM T3,STHSHM ;SAVE FOR LATER
AND T1,[007700,,0] ;BUILD A BYTE POINTER
TDO T1,[POINT 0,T2] ;POINTING TO AC T2
MOVEM T1,STHSHB ;SAVE IT FOR LATER
SETZM STHSHC ;INITIALIZE THE COUNT OF CHARACTERS
SETZM STHSHX ;INITIALIZE ANSWER REGISTER
STHSH1: MOVE T4,STHSHN ;INITIALIZE COUNTER
MOVE T3,STHSHB ;AND BYTE POINTER
SETZ T2, ;INITIALIZE RECEIVER AC
STHSH2: AOS T1,STHSHC ;COUNT UP CHARACTER COUNTER
CAMLE T1,STHSHM ;STRING TOO LONG?
RETBAD (ENQX19) ;YES, GIVE ERROR RETURN
XCTBU [ILDB T1,STHSHP] ;GET A BYTE FROM THE USER'S STRING
JUMPE T1,STHSH3 ;END OF STRING?
IDPB T1,T3 ;NO, STORE CHARACTER IN T2
SOJG T4,STHSH2 ;LOOP BACK FOR 5 CHARACTERS
XORM T2,STHSHX ;XOR THIS INTO ANSWER WORD
JRST STHSH1 ;LOOP BACK UNTIL END OF STRING
STHSH3: XORM T2,STHSHX ;STORE PARTIAL WORD TOO
MOVE T1,STHSHX ;GET ANSWER
MOVE T2,STHSHC ;GET CHARACTER COUNT
IDIV T2,STHSHN ;GET NUMBER OF WORDS
SKIPE T3 ;AND PARTIAL WORDS IN THE STRING
AOS T2
RETSKP ;AND RETURN
SUBTTL ENQFKR (DEQ all requests for a fork)
;ROUTINE TO DEQ ALL REQUESTS FOR A FORK
;ACCEPTS IN T1/ FORK NUMBER
; CALL ENQFKR OR CALL DEQFRK (IF DATA BASE ALREADY LOCKED)
;RETURNS +1: ALWAYS
SWAPCD ;[7.1040]
ENQFKR::MOVEI T2,ENQLST ;GET FIRST Q-BLOCK OF JOB
LOAD T2,ENQNJQ,(T2) ;ANY LOCKS LOCKED FOR THIS JOB?
JUMPE T2,R ;IF NOT, THEN EXIT NOW
CALL LOCKIT ;[7.1072] ()Obtain needed database locks
SETO T2, ;DEQ ALL
CALL DEQFRK ;DEQUEUE ALL ENTRIES FOR THIS FORK
CALL ULOKIT ;[7.1072] ()Release the database locks
RET ;AND RETURN
SUBTTL ENQFKR (DEQ all requests for a fork) -- DEQFRK (Worker routine)
;ROUTINE TO DEQ FOR A FORK
;ACCEPTS IN T1/ FORK #
; T2/ -1 FOR ALL, OR AN ID TO BE MATCHED
; CALL DEQFRK
;RETURNS +1 ALWAYS - T1/ COUNT OF LOCKS DEQUEUED
; XSWAPCD ;[7.1040]
XNENT (DEQFRK) ;[7.1040] DEQFRK: and XDEQFR:
STKVAR <DEQFKF,DEQFKQ,DEQFKI,DEQFCT>
SETZM DEQFCT ;INIT COUNT OF DEQUEUED LOCKS TO 0
MOVEM T1,DEQFKF ;SAVE FORK NUMBER ON STACK
MOVEM T2,DEQFKI ;SAVE ID
DEQFK0: MOVEI T1,ENQLST ;GET FIRST Q-BLOCK OF JOB
LOAD T1,ENQNJQ,(T1) ;...
DEQFK1: JUMPE T1,DEQFK2 ;IF NO MORE, GO EXIT
LOAD T2,ENQFRK,(T1) ;GET FORK NUMBER OF CREATOR OF Q
LOAD T3,ENQID,(T1) ;GET ID OF Q-ENTRY
SKIPL DEQFKI ;IS THIS A DELETE ALL REQUEST?
CAMN T3,DEQFKI ;NO, IS THIS A MATCH?
CAME T2,DEQFKF ;YES, IS THIS TO BE DELETED?
JRST [ LOAD T1,ENQNJQ,(T1) ;NO, STEP TO NEXT Q-BLOCK IN CHAIN
JRST DEQFK1] ;LOOP BACK TILL END OF LIST
CALL REQDEQ ;YES, DELETE IT
AOS DEQFCT ;COUNT UP NUMBER OF LOCKS DEQUEUED
JRST DEQFK0 ;START OVER AGAIN AT START OF LIST
DEQFK2: MOVE T1,DEQFCT ;GET THE COUNT OF LOCKS RELEASED
RET ;AND RETURN
SUBTTL ENQJBI (Initialize JSB upon job creation)
;ROUTINE TO INITIALIZE THE JSB ON JOB CREATION
XNENT (ENQJBI,G) ;[7.1040] ENQJBI:: and XENQJB::
SAVEAC <T1,T2>
MOVEI T2,ENQLST ;GET ADDRESS OF Q-LIST HEADER
SETZM T1 ;GET A ZERO
STOR T1,ENQLJQ,(T2) ;ZERO BACK POINTER
STOR T1,ENQNJQ,(T2) ;ZERO FORWARD POINTER
STOR T1,ENQCNT ;ZERO COUNT OF REQUESTS
MOVEI T1,ENQSTQ ;GET STANDARD ENQ/DEQ QUOTA
STOR T1,ENQOTA ;STORE IN JSB
RET ;AND RETURN
SUBTTL ENQCLS (Check for ENQ lock on OFN)
;ROUTINE TO CHECK IF AN OFN HAS A LOCK SET ON IT
;ACCEPTS IN T1/ OFN
; T2/ JFN
; CALL ENQCLS
;RETURNS +1: OFN IS LOCKED, FILE CANNOT BE CLOSED OR MADE LONG
; +2: OFN IS NOT LOCKED BY THIS JOB
SWAPCD ;[7.1040]
ENQCLS::MOVEM T2,T4 ;SAVE JFN BEING CLOSED
NOINT ;LOCK UP THE DATA BASE DURING SCAN
LOKK ENQLKK ;[7.1072] Only need local database lock for check
MOVEI T2,ENQLST ;GET FIRST Q-BLOCK OF JOB
LOAD T2,ENQNJQ,(T2) ;...
ENQCL1: JUMPE T2,ENQCL2 ;IF 0, END OF LIST AND OFN IS OK
LOAD T3,ENQLBP,(T2) ;GET ADDRESS OF LOCK BLOCK
LOAD T3,ENQOFN,(T3) ;GET OFN OF LOCK
CAMN T1,T3 ;THE SAME OFN?
JRST [ LOAD T3,ENQJFN,(T2) ;YES, GET JFN OF REQUEST
CAME T3,T4 ;IS JFN OF REQUEST BEING CLOSED ?
JRST .+1 ;NO, GO SCAN REST OF THE LIST
UNLOKK ENQLKK ;YES, FILE CANNOT BE CLOSED
OKINT
MOVEI T1,ENQX20 ;GET ERROR CODE
RET] ;GIVE ERROR RETURN
LOAD T2,ENQNJQ,(T2) ;GET ADDRESS OF NEXT Q IN LIST
JRST ENQCL1 ;LOOP TIL END OF LIST
ENQCL2: UNLOKK ENQLKK ;UNLOCK THE LOCKS
OKINT
RETSKP ;GIVE OK RETURN
SUBTTL ENQINI (Initialize ENQ database upon system startup)
;ROUTINE TO INITIALIZE THE DATA BASE ON SYSTEM START UP
; CALL ENQINI
;RETURNS +1: ALWAYS
; SWAPCD ;[7.1040]
ENQINI:: ;[7.1172]
IFN CLEQIN,< ;[7.1172]
MOVEI T1,-1 ;[7.1172] Initialize ...
MOVEM T1,EQLBLT ;[7.1172] ... the action list
SETZM EQLBCT ;[7.1172][7.1115] And initialize count of blocks
> ;[7.1172]
SETZM ENFKTB ;ZERO THE WAKEUP TABLE
MOVE T1,[ENFKTB,,ENFKTB+1]
MOVEI T2,ENFKTL
CAILE T2,1 ;DO BLT ONLY IF TABLE MORE THAN 1 WORD
BLT T1,ENFKTB-1+ENFKTL
MOVE T1,[HSHTBL] ;INITIALIZE HASH TABLE
MOVEI T2,HSHLEN ;GET NUMBER OF ELEMENTS IN TABLE
ENQIN1: MOVEM T1,0(T1) ;STORE POINTERS TO SELF
MOVEM T1,1(T1) ;...
ADDI T1,2 ;STEP TO NEXT LOGICAL CELL
SOJG T2,ENQIN1 ;LOOP BACK FOR ALL ENTRIES
SETZM ENQLTL ;INIT LONG TERM LOCK LIST
SETZM ENQLTS ;AND TIME STAMP
INILCK ENQLKK ;INIT THE ENQ LOCK BLOCK
RET ;RETURN
TNXEND
END