FIND_RIGHTS      Find Rights Held By Process                     5-DEC-1990 19:44:34    VAX DIBOL V4.1-00                   Page   1
                 Data  Division                                  5-DEC-1990 19:43:58    DUB0:[DECUS]FIND_RIGHTS.DBL;1               
 
           		.title	'Find Rights Held By Process'
           	
     1     	EXTERNAL FUNCTION
     2     		SYS$GETJPIW	,%VAL
           	
     3     	EXTERNAL FUNCTION
     4     		SYS$FIND_HELD	,%VAL
           	
     5     	EXTERNAL FUNCTION
     6     		SYS$IDTOASC	,%VAL
           	
           	.include	'$JPIDEF'	library 'sys$library:dblstarlet'
           	.include	'$SSDEF'	library 'sys$library:dblstarlet'
 
   528     	RECORD
   529     		GROUP	ITEM_LIST,[4]A
   530  1  			BUFF_LENGTH	,I2
   531  1  			ITEM_CODE	,I2
   532  1  			BUFFER_ADDR	,I4
   533  1  			RETURN_LENGTH	,I4
   534  1  		ENDGROUP
   535     		END_OF_LIST		,I4
           	
   536     	RECORD
   537     	BILLING		,A6,'BILLNG'
   538     	RET_PID		,I4	;PROCESS IDENTIFICATION
   539     	RET_UIC		,I4	;UIC RETURNED FROM GETJPIW
   540     	CONTEXT		,I2	;CONTEXT VALUE
   541     	RIGHTS_ID	,I4	;IDENTIFIER RETURNED
   542     	STATUS		,I4	;STATUS OF CALL
   543     	IOSB		,[4]I2	;I/O STATUS BLOCK
           	
   544     	RECORD	IDTOASC
   545     	ZERO		,I4,0	;INITIALIZE TO ZERO
   546     	TWO		,I4,2	;INITIALIZE TO TWO
   547     	NAMLEN		,I2	;LENGTH OF NAME RETURNED IN NAMBUF
   548     	NAMBUF		,A255	;ASCII TEXT STRING OF RIGHTS IDENTIFIER
   549     	RESID		,I4	;RESOURCE IDENTIFIER
   550     	ATTRIB		,I4	;ATTRIBUTES OF IDENTIFIER
   551     	ICONTEXT	,I4	;CONTEXT ARGUMENT
           	
   552     	RECORD
   553     	HOLDER		,I8
           	
   554     	RECORD	,X
   555     	UIC		,I4	;LONGWORD UIC
   556     	PAD		,I4	;PAD WITH ZERO
           	
FIND_RIGHTS      Find Rights Held By Process                     5-DEC-1990 19:44:34    VAX DIBOL V4.1-00                   Page  16
                 Procedure Division                              5-DEC-1990 19:43:58    DUB0:[DECUS]FIND_RIGHTS.DBL;1               
 
   557     		PROC
           	
   558     		item_list[1].buff_length=%size(RET_UIC)
   559     		item_list[1].item_code=JPI$_UIC
   560     		item_list[1].buffer_addr=%addr(RET_UIC)
   561     		item_list[1].RETURN_LENGTH=zero
           	
   562     		item_list[2].buff_length=%size(RET_PID)
   563     		item_list[2].item_code=JPI$_PID
   564     		item_list[2].buffer_addr=%addr(RET_PID)
   565     		item_list[2].RETURN_LENGTH=zero
           	
   566     		end_of_list = zero
           	
   567     		status = %sys$getjpiw (,,,%ref(item_list),%REF(iosb),,)
           	
   568     		if (.not.%success(status)) xcall lib$stop(%val(iosb[1]))
           	
   569     		uic = ret_uic
   570     		pad = zero
   571     		context = zero
   572     		icontext = zero
           	
   573     	loop,
           	
   574     		clear rights_id
   575     		status = %sys$find_held (%ref(holder)
           	&				,%ref(rights_id)
           	&				,
           	&				,%ref(context))
   576     		if (status .eq. ss$_nosuchid) goto no_more
           	
   577     	translate,
           	
   578     		clear namlen
   579     		clear nambuf
   580     		clear resid
   581     		clear attrib
   582     		status = %sys$idtoasc (%val(rights_id)
           	&				,%ref(namlen)
           	&				,nambuf
           	&				,%ref(resid)
           	&				,%ref(attrib)
           	&				,%ref(icontext))
   583     		if (nambuf .eq. billing) goto no_more
   584     		goto loop
   585     	no_more,
   586     		stop status
No errors detected
DIBOL/NOSTAND/OBJECT/LIS FIND_RIGHTS