From:	CSBVAX::MRGATE!HULL%CTSTATEU.BITNET@CUNYVM.CUNY.EDU@SMTP 14-OCT-1988 15:33
To:	ARISIA::EVERHART
Subj:	Return Process IDs correction


Received: from MITVMA.MIT.EDU by MITVMA.MIT.EDU (IBM VM SMTP R1.1) with BSMTP id 9483; Fri, 14 Oct 88 08:24:19 EDT
Received: from YALEVM.YCC.YALE.EDU by MITVMA.MIT.EDU (Mailer X1.25) with BSMTP
 id 9482; Fri, 14 Oct 88 08:23:46 EDT
Received: by YALEVM (Mailer X1.24) id 5032; Fri, 14 Oct 88 08:25:54 EST
Date:
From:         Matthew Hull <HULL%CTSTATEU.BITNET@MITVMA.MIT.EDU>
Subject:      Return Process IDs correction
To:           EVERHART%ARISIA.decnet@GE-CRD.ARPA

  Glenn,

    We don't have VMS V4.5 around here anymore, so I cannot test the code
  which I mailed you to see if it actually works.  However, I am reasonably
  certain it does because I got the code working for VMS V4.7, with no
  significant modifications.  Herewith is an updated and _tested_ version
  of the Return Identifiers routine.  I changed it to an Executive Mode
  routine because Kernal wasn't necessary and Exec is much safer (from a
  System Manager's point of view).  If anyone asks you for an update,
  or complains that the code as printed doesn't work, would you please
  pass on this update.  Again, the code was researched using ANALYZE/SYSTEM
  because we do not buy the microfiche, and therefore it operates on
  assumptions which may or may not hold true for VMS V5 (or any other version,
  really.  This version, however, has been tested, although not exhaustively).

                                                         Yours in reparation,
                                                         Matthew Hull


        .PAGE
        .SBTTL  Return Process Identifiers
        .LIBRARY  "SYS$LIBRARY:LIB.MLB"
;++
; Functional Description:
;       This routine returns the longword values of the current process'
;       Identifiers into a longword array.
;
; Input Parameters:
;       04(AP) - Number of longwords in longword array - Longword (Byte) value
;       08(AP) - Address of longword array             - Longword address
;
; Output Parameters:
;       R0      - Completion Status code
;       @08(AP) - Written with Process Identifiers
;
; Register Use:
;       R3 - Temp
;       R4 - PCB address of current process
;       R5 - Addr of Rights List Descriptor Pointers (ARB$_RIGHTSLIST)
;       R6 - Address of current ID
;       R7 - Counter of current ID list
;       R8 - Current pointer into user longword array
;       R9 - Count of User Space IDs stored
;       R10- Rights List Descriptor index (0 - 3)
;---

        $PCBDEF         ; Define Process Control Block offsets
        $ARBDEF         ; Define Access Rights Block offsets
        $SSDEF          ; Define System Services constants

        .ENTRY  USS_GET_IDS, ^M<R3,R4,R5,R6,R7,R8,R9,R10>
05$:    IFNORD  #12, (AP), 50$          ; Ensure readability of the arguments
        CMPL    #2, (AP)                ; Check number of arguments
        BNEQ    40$                     ; Error if not 2
        MOVL    8(AP), R8               ; Get address to store Identifiers
        BEQL    50$                     ; Branch if null address
        MOVZBL  4(AP), R9               ; Load User longword counter
        MULL3   #4, R9, R3              ; Determine # bytes to be written
        IFNOWRT R3, (R8), 50$           ; Check if array is writeable
        MOVL    #3, R10                 ; R10 = 3 (Start at 4th Pointer)
        MOVL    CTL$GL_PCB, R4          ; Put PCB addr into R4
        MOVL    PCB$L_ARB(R4), R5       ; Base Address of Access Rights Block
        MOVAL   ARB$L_RIGHTSLIST(R5), R5; Address of 4 RL Descriptor pointers
        BRB     10$                     ; Branch beyond Exits, Enter loop

40$:    MOVL    #SS$_INSFARG, R0        ; Indicate insufficient arguments
        RET                             ;  and return
50$:    MOVL    #SS$_ACCVIO, R0         ; Indicate access violation
        RET                             ;  and return
60$:    MOVL    #SS$_NORMAL, R0         ; Set normal completion status
        RET                             ;  and return

10$:    MOVL    (R5)[R10], R6           ; Load addr of next Rights List descrip
        BEQL    30$                     ; If empty, try next Rights List
        MOVZWL  (R6), R7                ; Load Identifier bytes counter
        ASHL    #-3, R7, R7             ; Divide by 8 (8 bytes per ID)
        MOVL    4(R6), R6               ; Load Address of ID List quadwords
20$:    TSTL    (R6)                    ; See if this ID is blank (zero)
        BEQL    30$                     ; If so, move to next list
        DECL    R9                      ; Decrement User Longword counter
        BLSS    60$                     ; Exit if no more memory
        MOVL    (R6)+, (R8)+            ; Copy Identifier into user space
        ADDL2   #4, R6                  ; Skip attribute flags longword
        SOBGTR  R7, 20$                 ; Next ID within list
30$:    SOBGEQ  R10, 10$                ; Next Rights list
        BRB     60$                     ; Exit normally

        .END


; Test program to test USS_Get_Ids in EXECUTIVE mode. (VMS V4.7)

        .LIBRARY "SYS$LIBRARY:STARLET.MLB"
;
; Program Data
;
        .PSECT MY_DATA  RD,WRT,NOEXE
ARRSIZE = 15                    ; Number of Ids my test program supports
IDENTS: .BLKL ARRSIZE           ; Output Longword Array (will receive IDs)
SCRATCH:.BLKL 5                 ; Buffer memory
ARGLIST:.LONG 2                 ; Two arguments
        .LONG ARRSIZE           ; Size of Output array
        .ADDRESS IDENTS         ; Addr of Identifer array


; Program Code
;
        .PSECT MY_CODE RD,NOWRT,EXE

        BEGIN TEST_GET_IDS_EXEC

        $CMEXEC_S ROUTIN=USS_GET_IDS, ARGLST=ARGLIST
                                ; Get the Identifers from Process Space
        MOVL    R0, R8

        $IF R8, NEQ, #SS$_NORMAL, L -
           THEN <PRINTBOMB ^| Error from USS_GET_IDS.|, R8>

DUMP:   DUMPMEM IDENTS, #<ARRSIZE*4>
        DUMPMEM SCRATCH, #20

DONE:   EXIT
        .END TEST_GET_IDS_EXEC
