.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