	.title	crlock
;+
;	integer function crlock(text, lockid)
;
;	character text(ARB)
;	integer lockid
;
;	return (OK/ERR)
;
;	this routine creates a lock file in ~tmp with a name generated by
;	hashing the contents of `text'.  If successful, an id is returned
;	for use in `rmlock' calls.  The function values returned are
;	OK or ERR.
;-
ap=%5
text=2
lockid=4
	.psect	$r.rod,con,ro,rel,lcl,d
dspt:					; data set descriptor
	.word	devl
	.word	dev
	.word	uicl
	.word	uic
	.word	fill
	.word	fil
	.if ndf	IAS
dev:	.ascii	"ST1:"
	.iff		; IAS
dev:	.ascii	LB0:"
	.endc		; IAS
devl=.-dev
uic:	.ascii	"[105,3]"
uicl=.-uic
	.even
	.psect	$r.rwd,con,rw,rel,lcl,d
fil:	.ascii	"1234567.LCK;1"
fill=.-fil
	.even
	.psect	$r.roi,con,ro,rel,lcl,i
	.enabl	lsb
crlock::
	call	r$gffb			; get free RFDB address in r1
	bcs	100$			; c set ==> none available
	mov	r1,r4			; save in non-volatile register
	mov	text(ap),r0		; address of text string
	sub	#10.,sp			; space for resultant string
	mov	sp,r1			; address of hashed string
	call	r$hash			; generate 7-char hashed string
	mov	#fil,r0			; address for result
	mov	#7.,r2			; counter for copy
1$:
	movb	(r1)+,(r0)+		; copy character
	sob	r2,1$			; try again
	add	#10.,sp			; restore stack
	mov	r.fdb(r4),r0		; FDB address
	mov	#dspt,f.dspt(r0)	; place pointer to data-set descriptor
	call	r$pars			; parse the file name
	bcs	100$			; c set ==> bad stuff going on
	mov	r0,r1			; need name block address in r1
	add	#f.fnb,r1		; ...
	mov	r1,r2			; copy DID field into FID
	mov	r1,r3			; ...
	add	#n.did,r2		; ...
	add	#n.fid,r3		; ...
	mov	(r2)+,(r3)+		; ...
	mov	(r2)+,(r3)+		; ...
	mov	(r2)+,(r3)+		; ...
	call	.enter			; enter the file name in ~tmp
	bcs	100$			; name already exists
	mov	#rf.lck,(r4)		; mark file as open and lock file
	movb	r.lun(r4),r0		; return lun with appendage
	bis	#1000,r0		; ...
	mov	r0,@lockid(ap)		; return to user
	mov	#ok,r0			; return(OK)
	br	110$
100$:
	mov	#err,r0			; return(ERR)
110$:
	return
	.end
