        .title  chnlst
;
;  Author     : Arne Vajhøj
;
;  Programmed : july/august 1994 by Arne Vajhøj
;
;  Modified   : september 1994 by Ferdinand Bolhar-Nordenkampf
;               and Arne Vajhøj
;
;  Purpose    : list channels for another process
;
        .link   "SYS$SYSTEM:SYS.STB"/SE
        .library "SYS$LIBRARY:LIB.MLB"
        $SFDEF
        $IPLDEF
        $PCBDEF
        $ACBDEF
        $DYNDEF
        $PRIDEF
        $PSLDEF
        $CCBDEF
        $UCBDEF
        $DDBDEF
        $WCBDEF
        $DYNDEF
        $FCBDEF
        $PHDDEF
        $SECDEF
        $SSDEF
EFN=17
CHNCNT=1200                             ; NOTE: must be equal SGN$GW_PCHANCNT
OUTSIZ=8*CHNCNT                         ; UCB og WCB pointer for hver UCB
        .psect  CHNLST quad,pic,con,lcl,noshr,exe,wrt
;
;  Entry : CHNLST ( PID, DEVNAM , DEVNAMLEN , UNIT , FID , NDEV)
;
;  Functionality : list all chncntchannels in the context of another process.
;
;
;  Arguments : PID
;              pid of target process
;              longword passed by reference
;              readonly
;
;              DEVNAM
;              device name
;              fixed length chracter string passed by descriptor
;              writeonly
;
;              DEVNAMLEN
;              device name length
;              longword passed by reference
;              writeonly
;
;              UNIT
;              device unit
;              longword passed by reference
;              writeonly
;
;              FID
;              file id
;              longword passed by reference
;              writeonly
;
;              NDEV
;              number of devices
;              longword passed by reference
;              writeonly
;
;  Priviliges required : CMKRNL    to enter kernel mode
;                        WORLD     to translate from pid/prcnam to pcb for
;                                  an arbitrary process
;
;  Return codes : SS$_NORMAL        succesfull
;                 SS$_NOPRIV        no CMKRNL privilige present
;                 SS$_NONEXPR       no such process
;                 SS$_INSFMEM       CHNCNT parameter is less than CHANNELCNT
;
;  Disclaimer : This is a kernel-mode-hack using several undocumented
;               features of VMS. I truly believe, that it will work
;               on any VMS 5.x system, but you use this code entirely at
;               your own risk.
;
;  Bugs : Please mail bug-reports to ARNE@KO.HHS.DK (Arne Vajhøj).
;
ucbandwcb:
        .blkl   CHNCNT
        .blkl   CHNCNT
        .align  quad
        .entry  chnlst,^m<>
        cmpw    #CHNCNT,@#SGN$GW_PCHANCNT
        bgeq    100$
        movl    #SS$_INSFMEM,r0
        brb     300$
100$:   movzwl  @#SGN$GW_PCHANCNT,nchan
        pushab  highipl_end
        pushab  highipl_start
        pushl   #0
        pushl   #0
        pushab  8(sp)
        calls   #3,G^SYS$LKWSET         ; lock pages in memory
        blbc    r0,300$
        pushl   ap
        pushab  G^chnlst2
        calls   #2,G^SYS$CMKRNL         ; goto kernel mode
        blbc    r0,300$
        pushl   #EFN
        calls   #1,G^SYS$WAITFR         ; wait for eventflag to be set
        blbc    r0,300$
        pushl   ap
        pushab  G^chnlstpost
        calls   #2,G^SYS$CMKRNL         ; goto kernel mode
300$:   ret
        .entry  chnlstpost,^m<r2,r3,r4,r5,r6,r7,r8,r9>
        movab   G^EXE$SIGTORET,SF$A_HANDLER(fp) ; set exception handler
        movl    nchan,r0
        moval   ucbandwcb,r1
        movl    B^8(ap),r2
        movzwl  (r2),r7
        movl    B^4(r2),r2
        movl    B^12(ap),r3
        movl    B^16(ap),r4
        movl    B^20(ap),r8
        clrl    @B^24(ap)
100$:   decl    r0
        blss    250$
        movl    (r1)+,r5                ; loop through UCB's and get info
        beql    100$
        movl    B^UCB$L_DDB(r5),r6      ; address of DDB
        movzbl  B^DDB$T_NAME(r6),(r3)+  ; device-name
        movq    B^DDB$T_NAME+1(r6),(r2)
        movl    B^DDB$T_NAME+9(r6),B^8(r2)
        movw    B^DDB$T_NAME+13(r6),B^12(r2)
        movb    B^DDB$T_NAME+15(r6),B^14(r2)
        movw    (r2),r9                 ; save first two letters of devicename
        addl2   r7,r2
        movzwl  B^UCB$W_UNIT(r5),(r4)+  ; unit-number
        incl    @B^24(ap)
        clrw    (r8)
        clrw    B^2(r8)
        clrw    B^4(r8)
        movl    (r1)+,r5                ; loop throgh WCB's and get info
        bgeq    200$                    ; test if WCB
        cmpb    #DYN$C_WCB,WCB$B_TYPE(r5) ; remove strange windows for
        bneq    200$                      ;   PCFS_SERVER's NET-devices
        movl    B^WCB$L_FCB(r5),r6      ; address of FCB
        movw    B^FCB$W_FID(r6),(r8)    ; fid
        movw    B^FCB$W_FID+2(r6),B^2(r8)
        movw    B^FCB$W_FID+4(r6),B^4(r8)
200$:   addl2   #6,r8
        brb     100$
250$:   movl    #SS$_NORMAL,r0
300$:   ret
        .entry  chnlst2,^m<r2,r3,r4,r5>
        movab   G^EXE$SIGTORET,SF$A_HANDLER(fp) ; set exception handler
        movl    r4,pcb                  ; save pcb
        movab   ucbandwcb,adr           ; save address
highipl_start:
        LOCK    LOCKNAME=SCHED,LOCKIPL=#IPL$_SCHED ; raise IPL
        movl    @B^4(ap),r0
        jsb     G^EXE$EPID_TO_PCB       ; convert EPID->PCB
        movl    r0,r4
        UNLOCK  LOCKNAME=SCHED,NEWIPL=#IPL$_ASTDEL ; lower IPL
        tstl    r4
        bneq    100$
        movl    #SS$_NONEXPR,r0
        brw     err
100$:   cmpl    PCB$L_PID(r4),G^SCH$GL_SWPPID ; test if swapper
        bneq    200$
        movl    #SS$_NONEXPR,r0
        brw     err
200$:   addl3   #kast_size,#ACB$K_LENGTH,r1
        jsb     G^EXE$ALONONPAGED       ; allocate ACB
        blbs    r0,300$
        brw     err
300$:   movw    r1,ACB$W_SIZE(r2)       ; fill ACB fields
        movb    #DYN$C_ACB,ACB$B_TYPE(r2)
        movb    #ACB$M_KAST!PSL$C_KERNEL,ACB$B_RMOD(r2)
        movl    PCB$L_PID(r4),ACB$L_PID(r2)
        movab   ACB$K_LENGTH(r2),ACB$L_KAST(r2)
        pushl   r2
        movc3   #kast_size,kast_code,ACB$K_LENGTH(r2) ; move AST code
        popl    r2
        pushr   #^m<r2,r4>
        movl    #EFN,r3
        movl    pcb,r4
        jsb     G^SCH$CLREF             ; clear event-flag
        popr    #^m<r2,r4>
        movl    r2,r5
        movl    #PRI$_TICOM,r2
        jsb     G^SCH$QAST              ; queue AST
        SETIPL  #0                      ; reset IPL
        movl    #SS$_NORMAL,r0          ; ok
        ret                             ; return
err:    SETIPL  #0                      ; reset IPL
        ret                             ; return
kast_code:
        pushr   #^m<r0,r1,r2,r3,r4,r5>
;
        movl    nchan,r0
        movl    @#CTL$GL_CCBBASE,r1     ; pointer to first CCB
        moval   outbuf,r2
1100$:  tstb    B^CCB$B_AMOD(r1)        ; test if used
        beql    1400$
        movl    B^CCB$L_UCB(r1),(r2)+   ; get UCB address
        movl    B^CCB$L_WIND(r1),r5
        bicl2   #1,r5
        tstl    r5
        blss    1200$
        beql    1300$
        movl    B^PCB$L_PHD(r4),r3      ; get PHD address
        addl2   PHD$L_PSTBASOFF(r3),r3  ; get PST address
        cvtwl   r5,r5
        mull2   #4,r5
        addl2   r5,r3                   ; get PSTE address
        movl    B^SEC$L_WINDOW(r3),(r2)+; get WCB address
        brb     1400$
1200$:  movl    r5,(r2)+                ; get WCB address
        brb     1400$
1300$:  clrl    (r2)+
1400$:  subl2   #CCB$S_CCBDEF,r1        ; next CCB
        decl    r0
        bgtr    1100$
;
        popr    #^m<r0,r1,r2,r3,r4,r5>
        movl    pcb,r4
        movl    PCB$L_PID(r4),ACB$L_PID(r5)
        addl2   #kast_code_size,ACB$L_KAST(r5)
        movb    #ACB$M_KAST!PSL$C_KERNEL,ACB$B_RMOD(r5)
        movl    #0,r2
        jmp     G^SCH$QAST              ; requeue AST
kast_code_size=.-kast_code
kast_code_2:
        pushr   #^m<r0,r1,r2,r3,r4,r5>
;
        movl    adr,r1
        movc3   #OUTSIZ,outbuf,(r1)
;
        popr    #^m<r0,r1,r2,r3,r4,r5>
        movl    PCB$L_PID(r4),r1
        movl    #0,r2
        movl    #EFN,r3
        jsb     G^SCH$POSTEF            ; set event-flag
        movl    r5,r0
        jmp     G^EXE$DEANONPAGED       ; deallocate ACB and disappear
nchan:  .blkl   1
pcb:    .blkl   1
adr:    .blkl   1
outbuf: .blkl   CHNCNT
        .blkl   CHNCNT
kast_size=.-kast_code
highipl_end:
        .end
