        .title  acl
        $ACLDEF
        $ACEDEF
;
; readonly data section
;
        .psect  $PDATA quad,pic,con,lcl,shr,noexe,nowrt
objtyp: .long   ACL$C_FILE 
;
; writeread data section
;
        .psect  $LOCAL quad,pic,con,lcl,noshr,noexe,wrt
argl_asctoid:                           ; argumentlist SYS$ASCTOID
        .long   3
        .blkl   1                       ; mame
        .address uic                    ; id
        .long   0                       ; attributes
argl_idtoasc:                           ; argumetlist SYS$IDTOASC
        .long   6
        .blkl   1                       ; id
        .blkl   1                       ; namelength
        .blkl   1                       ; name
        .long   0                       ; resultant-id
        .long   0                       ; attribute
        .long   0                       ; context
argl_changeacl:                         ; argumentlist SYS$CHANGE_ACL
        .long   9
        .long   0                       ; channel
        .address objtyp                 ; object-type
        .blkl   1                       ; object-name
        .address itmlst                 ; item-list
        .long   0                       ; access-mode
        .long   0                       ; null
        .address cntx                   ; context
        .long   0                       ; null
        .long   0                       ; null
itmlst: .blkl   1
        .blkw   1
        .blkl   1
        .long   0
        .long   0
aceblk: .byte   12
        .byte   ACE$C_KEYID
        .word   0
        .blkl   1                       ; access
        .blkl   1                       ; identifier
uic:    .blkl   1
cntx:   .blkl   1
dumdes: .blkq   1
;
; code section
;
        .psect  $CODE quad,pic,con,lcl,shr,exe,nowrt
;********************
;
;  DELACL ( FNM )
;
;  delete ACL
;
;********************
        .entry  delacl,^m<>
        movl    B^4(ap),argl_changeacl+12
        movw    #0,itmlst
        movw    #ACL$C_DELETEACL,itmlst+2
        movl    #0,itmlst+4
        movl    #0,cntx
        callg   argl_changeacl,G^SYS$CHANGE_ACL
        ret
;********************
;
;  DELONEACL ( FNM , ID , ACCESS )
;
; delete one ACL
;
;********************
        .entry  deloneacl,^m<>
        movl    B^8(ap),argl_asctoid+4
        callg   argl_asctoid,G^SYS$ASCTOID
        movl    B^4(ap),argl_changeacl+12
        movw    #12,itmlst
        movw    #ACL$C_DELACLENT,itmlst+2
        moval   aceblk,itmlst+4
        movl    uic,aceblk+8
        movl    #0,cntx
        clrl    aceblk+4
        movl    B^12(ap),r1
        tstl    (r1)
        beql    100$
        bisl2   #ACE$M_READ,aceblk+4
100$:   addl2   #4,r1
        tstl    (r1)
        beql    200$
        bisl2   #ACE$M_WRITE,aceblk+4
200$:   addl2   #4,r1
        tstl    (r1)
        beql    300$
        bisl2   #ACE$M_EXECUTE,aceblk+4
300$:   addl2   #4,r1
        tstl    (r1)
        beql    400$
        bisl2   #ACE$M_DELETE,aceblk+4
400$:   addl2   #4,r1
        tstl    (r1)
        beql    500$
        bisl2   #ACE$M_CONTROL,aceblk+4
500$:   callg   argl_changeacl,G^SYS$CHANGE_ACL
        ret
;********************
;
;  GETACL ( FNM , N , ID , IDLEN , ACCESS )
;
;  get ACL
;
;********************
        .entry  getacl,^m<r2,r3>
        movq    @B^12(ap),dumdes
        movl    B^16(ap),r2
        movl    B^20(ap),r3
        movl    B^4(ap),argl_changeacl+12
        movw    #12,itmlst
        movw    #ACL$C_FNDACETYP,itmlst+2
        moval   aceblk,itmlst+4
        movl    #0,cntx
        movl    #0,@B^8(ap)
50$:    clrl    aceblk+8
        clrl    aceblk+4
        callg   argl_changeacl,G^SYS$CHANGE_ACL
        cmpl    r0,#SS$_NORMAL
        beql    75$
        brw     600$
75$:    incl    @B^8(ap)
        movl    aceblk+8,argl_idtoasc+4
        movl    r2,argl_idtoasc+8
        moval   dumdes,argl_idtoasc+12
        callg   argl_idtoasc,G^SYS$IDTOASC
        clrl    (r3)
        cmpzv   #ACE$V_READ,#1,aceblk+4,#1
        bneq    100$
        movl    #-1,(r3)
100$:   addl2   #4,r3
        clrl    (r3)
        cmpzv   #ACE$V_WRITE,#1,aceblk+4,#1
        bneq    200$
        movl    #-1,(r3)
200$:   addl2   #4,r3
        clrl    (r3)
        cmpzv   #ACE$V_EXECUTE,#1,aceblk+4,#1
        bneq    300$
        movl    #-1,(r3)
300$:   addl2   #4,r3
        clrl    (r3)
        cmpzv   #ACE$V_DELETE,#1,aceblk+4,#1
        bneq    400$
        movl    #-1,(r3)
400$:   addl2   #4,r3
        clrl    (r3)
        cmpzv   #ACE$V_CONTROL,#1,aceblk+4,#1
        bneq    500$
        movl    #-1,(r3)
500$:   addl2   #4,r3
        cvtbl   dumdes,r0
        addl2   r0,dumdes+4
        addl2   #4,r2
        brw     50$
600$:   ret
;********************
;
;  PUTACL ( FNM , ID , ACCESS )
;
;  put ACL
;
;********************
        .entry  putacl,^m<>
        movl    B^8(ap),argl_asctoid+4
        callg   argl_asctoid,G^SYS$ASCTOID
        movl    B^4(ap),argl_changeacl+12
        movw    #12,itmlst
        movw    #ACL$C_ADDACLENT,itmlst+2
        moval   aceblk,itmlst+4
        movl    uic,aceblk+8
        movl    #0,cntx
        clrl    aceblk+4
        movl    B^12(ap),r1
        tstl    (r1)
        beql    100$
        bisl2   #ACE$M_READ,aceblk+4
100$:   addl2   #4,r1
        tstl    (r1)
        beql    200$
        bisl2   #ACE$M_WRITE,aceblk+4
200$:   addl2   #4,r1
        tstl    (r1)
        beql    300$
        bisl2   #ACE$M_EXECUTE,aceblk+4
300$:   addl2   #4,r1
        tstl    (r1)
        beql    400$
        bisl2   #ACE$M_DELETE,aceblk+4
400$:   addl2   #4,r1
        tstl    (r1)
        beql    500$
        bisl2   #ACE$M_CONTROL,aceblk+4
500$:   callg   argl_changeacl,G^SYS$CHANGE_ACL
        ret
        .end
