.title  swapuser -- set up process account/username and UIC
      .library 'sys$library:lib'

;
;       Author: Chris Chaundy
;       Date:   13-May-1981
; This routine is a MACRO-32 rehash of the BLISS-32 hack routine from
; the VAX/VMS V2.0 microfiche kit to set up a new username for a process,
; expanded to also change UIC, and set up as a subroutine (which must be
; called in kernel mode).
;
;       Modified: 16-Nov-1982 for VAX/VMS V3, copy account to JIB as well
;                           and get PCB address from CTL$GL_PCB
;       Modified: 24-Mar-1985, Gordon Davisson: for VMS V4.0, get PCB$
;                           symbols from $pcbdef in sys$library:lib.mar
;       Modified: 31-Mar-1985, Gordon Davisson: for VMS V4.0, set LNM$GROUP
;                           so group logical names will work
;       Modified:  7-Mar-1985, Jim Belonis: for VMS V4.0, used correct
;                           field lengths for username and account
;

      $lnmdef
      $pcbdef
      $dscdef
      $jibdef
      $uafdef

      .psect  $code$, nowrt

;       Kernel mode routine to change account, username and UIC

p_usr =  4
p_uic =  8
p_acc = 12

access_mode:    .byte   0
table_name:     .ascid  /LNM$PROCESS_DIRECTORY/
logical_name:   .ascid  /LNM$GROUP/
equivalence_prototype:  .ascid   /LNM$GROUP_!6OW/
eqnam_len  = 255
itmlst_len =  16

      .entry  swapuser, ^m<r2,r3,r4,r5,r6>

; set group logical name table
      subl2   #<eqnam_len+itmlst_len>, sp       ; allocate space on stack
      movab   (sp), r2                ; r2 points to the space
      movzwl  #eqnam_len, (r2)        ; set up itmlst
      movab   itmlst_len(r2), 4(r2)
      clrq    8(r2)

      moval   @p_uic(ap), r0          ; parameters for sys$fao:
      movzwl  2(r0), -(sp)            ; p1 (uic member number)
      pushaq  (r2)                    ; output buffer
      pushaw  (r2)                    ; address to put output length
      pushaq  equivalence_prototype   ; control string
      calls   #4, g^sys$fao
      blbc    r0, exit                ; exit on error

      movw    #lnm$_string, 2(r2)     ; finish up itmlst
      pushab  (r2)                    ; parameters for sys$crelnm: itmlst
      pushaw  access_mode
      pushaq  logical_name
      pushaq  table_name
      pushl   #0
      calls   #5, g^sys$crelnm        ; redirect to the new group table
      blbc    r0, exit                ; exit on error

; set account in control region
      movaq   @p_acc(ap), r6          ; get account desc adr
      movc5   dsc$w_length(r6), @dsc$a_pointer(r6), -
               #^a/ /, -
               #jib$s_account, @#ctl$t_account   ; copy into control region
; NOTE: USING JIB FIELD SIZE WHICH MAY IN THE FUTURE CONFLICT WITH CTL SIZE

; set account in JIB
      movl    @#ctl$gl_pcb, r0        ; get our own PCB adr
      movab   @pcb$l_jib(r0), r1      ; from PCB, get our JIB adr
      movc5   dsc$w_length(r6), @dsc$a_pointer(r6), -
               #^a/ /, -
               #jib$s_account, jib$t_account(r1) ; copy new account into JIB

; set username in control region
      movl    p_usr(ap), r6           ; get username desc adr
      movc5   dsc$w_length(r6), @dsc$a_pointer(r6), -
               #^a/ /, -
               #jib$s_username, @#ctl$t_username ; copy into control region
; NOTE: USING JIB FIELD SIZE WHICH MAY IN THE FUTURE CONFLICT WITH CTL SIZE

; set uic in PCB
      movl    @#ctl$gl_pcb, r0        ; get our own PCB adr
      movl    @p_uic(ap), pcb$l_uic(r0) ; set new UIC

; set username in JIB
      movl    pcb$l_jib(r0), r1       ; from PCB, get our JIB adr
      movc5   dsc$w_length(r6), @dsc$a_pointer(r6), -
               #^a/ /, -
               #jib$s_username, jib$t_username(r1) ; copy new name into JIB

; done
      movl    #1, r0                  ; show success
exit: ret                             ; and return

      .end