.TITLE	LOCK	locking mechanism
	.IDENT	/01.01/
;
; This file implements a simple locking facility for GRUMPF.
;
; A lock is just a named entity which is not allowed to exist more than once.
; Any relations between a lock and an actual system resource are defined by
; the context of their use, the name is just informal.
;
; macros provided:
;	.L$INIT		initializes the locking facility, to be called at
;			system initialization
;	.L$ALLO		allocates a lock, arguments are two RAD50 words
;			containing the name. If a lock of this name already
;			exists, the job requesting the lock will be set waiting
;			for the name of the lock.
;	.L$FREE		frees a lock, arguments are two RAD50 words containing
;			the name. It is not an error if no lock of this name
;			exists. Any job waiting for the name of the lock is
;			set running.
;
; system calls:
;	$L$ALLO		see .L$ALLO
;	$L$FREE		see .L$FREE
;
; tunable constants:
;	TBLSIZ		size of the hash table used for locks
;
; 09-JUL-2005	H. Rosenfeld
;
	.LIST	ME
	.NLIST	CND
	.ENABL	REG
	.LIBRARY	/CALL.SML/
	.LIBRARY	/JOBCTL.SML/
	.LIBRARY	/SYSCLL.SML/
	.LIBRARY	/UTIL.SML/
	.LIBRARY	/MEMORY.SML/
	.MCALL	.P$ALLO,.P$FREE,.P$ERR
	.MCALL	.CALL,.ENTRY,.RETRN
	.MCALL	.WAIT,.DONE
	.MCALL	$SYS,$REGSYS
	.MCALL	.R50HSH

	L$NEXT=0
	L$NAME=2

	SIZE$L=6

	TBLSIZ=17	; hash table size
	
	.CSECT

; L$INIT, initializes locking facility

	.MACRO	.L$INIT
		.GLOBL	L$INIT
		.CALL	L$INIT
	.ENDM

L$INIT::.ENTRY
	MOV	#LOKTBL,R4	; get lock table
	MOV	#TBLSIZ,R3	; get lock table size
1$:	CLR	(R4)+		; clear lock table
	SOB	R3,1$
	$REGSYS	#^RL$A,#^RLLO,#L$ALLO,#340
	$REGSYS	#^RL$F,#^RREE,#L$FREE,#340
	.RETRN

; L$ALLO, allocates a lock
; input: two RAD50 words containing the lock name
; output: lock added to LOKTBL
; return: carry clear on success, carry set on internal error
; this call will set the job waiting if there already is a lock with same name

	.MACRO	.L$ALLO	NAM1,NAM2
		.GLOBL	L$ALLO
		.CALL	L$ALLO,NAM1,NAM2
	.ENDM

	.MACRO	$L$ALLO	NAM1,NAM2
		$SYS	#^RL$A,#^RLLO,NAM1,NAM2
	.ENDM

L$ALLO::.ENTRY
	MOV	10(R5),R4	; second part of name
	MOV	6(R5),R3	; first part of name
	.R50HSH	R3,R4,#TBLSIZ	; calculate hash
	ASL	R0		; convert to table index
	ADD	#LOKTBL,R0	; calculate table entry
	MOV	R0,R2		; save for reuse
1$:	MOV	(R0),R0		; get entry
	BEQ	2$		; empty, add here
	CMP	R3,L$NAME(R0)	; compare first part of name
	BNE	1$		; try next if not equal
	CMP	R4,L$NAME+2(R0)	; compare second part of name
	BNE	1$		; try next if not equal
	.WAIT	R3,R4		; wait for lock
	MOV	R2,R0		; try again at beginning
	BR	1$
2$:	.P$ALLO	#SIZE$L		; allocate buffer to hold lock
	BCC	3$		; continue if no error
	.P$ERR			; print error message
	SEC			; indicate error
	.RETRN
3$:	MOV	R4,L$NAME+2(R0)	; set name
	MOV	R3,L$NAME(R0)
	MOV	(R2),L$NEXT(R0)	; prepend to list
	MOV	R0,(R2)
	CLC			; no error
	.RETRN

; L$FREE, free a lock
; input: two RAD50 words containing the lock name
; output: lock removed from LOKTBL if it exists
; return: none
; this routine will wake up any job waiting for the lock name

	.MACRO	.L$FREE	NAM1,NAM2
		.GLOBL	L$FREE
		.CALL	L$FREE,NAM1,NAM2
	.ENDM

	.MACRO	$L$FREE	NAM1,NAM2
		$SYS	#^RL$F,#^RREE,NAM1,NAM2
	.ENDM

L$FREE::.ENTRY
	MOV	10(R5),R4	; second part of name
	MOV	6(R5),R3	; first part of name
	.R50HSH	R3,R4,#TBLSIZ	; calculate hash
	ASL	R0		; convert to table index
	ADD	#LOKTBL,R0	; calculate table entry
1$:	MOV	(R0),R2		; get entry
	BEQ	3$		; stop at end of list
	CMP	R3,L$NAME(R2)	; first part of name matching?
	BNE	2$		; no, try next
	CMP	R4,L$NAME+2(R2)	; second part of name matching?
	BNE	2$		; no, try next
	MOV	(R2),(R0)	; remove from list
	.P$FREE	R2,#SIZE$L	; free buffer
	BR	3$
2$:	MOV	R2,R0		; continue with next entry
	BR	1$
3$:	.DONE	R3,R4		; wake up anyone waiting for this lock
	.RETRN

	.PSECT	DATA
LOKTBL::.BLKW	TBLSIZ

	.END