SUBROUTINE PCHEK ;Author: Paul F. Flaherty, Jr. ; DP Manager ; DANIELS AND CRONIN ; Attorneys at Law ; Three Center Plaza ; Boston, MA 02108-2003 ; (617) 227-5570 ;subroutine which allows a Dibol program ;running under RSTS/E Version 9.x to check ;whether or not the job under which it ;is running has a particular privilege. ;N.B. This subroutines calls other routines ; from LB:UNSUPP.OLB, Digital's ; UNSUPPORTED Dibol subroutines library. ; =========== PNAME ,A ;privilege name STATUS ,D ;meaningless incoming; outgoing 0 = has priv ;1 = no priv RECORD FIRQB ;the following are for xcall exemt, ;ptfrq, gtfrq FRQ ,2D3 SYS ,30D3 RECORD X ,D3 Y ,D3 ERR ,D3 UUO ,D6,104066 ;looks decimal, interpreted as octal PROC IF (PNAME.EQ.' ') GOTO ERROR ;ignore blanks UPCASE PNAME ;make upper case CLEAR ERR, FIRQB, Y, X ;initialize some variables DO INCR X UNTIL (X.GT.6.OR.PNAME(X,X).EQ.' ') ;find first blank X = X - 1 SYS(1) = 6 ;sys call to FIP SYS(2) = 32 ;sub call (UU.CHK) SYS(3) = 1 ;convert priv name to mask code FOR Y FROM 1 THRU X ;convert string to decimal XCALL DECML (PNAME(Y,Y),SYS(Y+6)) XCALL PTFRQ (FIRQB,FRQ) ;load the FIRQB ON ERROR ERROR ;only poss error is rsts error 5 XCALL EXEMT (ERR,UUO) ;and do XCALL GTFRQ (FIRQB,FRQ) ;get the result OFF ERROR STATUS = SYS(3) ;set up the return value RETURN ;return ERROR, STATUS = 1 ;if there's an error tell caller nopriv RETURN ;and return END