        .TITLE  ZEACP - Example "Pseudodevice" ACP
        .IDENT  \X01-000\

;++
; ZEACP - Example "Pseudodevice" ACP
;
; Register conventions used throughout this image:  
;
;       R3      IRP address
;       R4      PCB address
;       R5      UCB address
;       R6      AQB address
;       R7      VCB address
;--

        .SBTTL  External and local symbol definitions

;       standard VMS data structures

        .LIBRARY \SYS$LIBRARY:LIB\

        $ACBDEF                                 ; AST control block
        $AQBDEF                                 ; ACP queue block
        $CCBDEF                                 ; Channel control block
        $DCDEF                                  ; Device classes and types
        $DDBDEF                                 ; Device data block
        $DEVDEF                                 ; Device characteristics
        $DYNDEF                                 ; Data structure ID codes
        $IODEF                                  ; I/O function codes
        $IPLDEF                                 ; Interrupt priority levels
        $IRPDEF                                 ; I/O request packet
        $IRPEDEF                                ; IRP Extension
        $PCBDEF                                 ; Process control block
        $PSLDEF                                 ; Processor status longword
        $SSDEF                                  ; System status codes
        $UCBDEF                                 ; Unit control block
        $VCBDEF                                 ; Volume control block

        $DEFINI UCB

        _VIELD  UCB,0,<-                        ; bits in UCB$L_DEVDEPEND
                <ACPEXISTS,,M>>

. = UCB$K_LENGTH

$DEF    UCB_L_TMPLTUCB          .BLKL 1         ; pointer to template UCB
$DEF    UCB_Q_PNDIRP            .BLKQ 1         ; queue header for user's IRPs
$DEF    ZE_UCB_K_LENGTH

        $DEFEND UCB

        $DEFINI BUF                             ; I/O buffer
$DEF    BUF_L_SVAUSRDATA        .BLKL 1         ;  sva of user data in buffer
$DEF    BUF_L_PVAUSRBUFF        .BLKL 1         ;  process virt addr of user's buffer
$DEF    BUF_W_SIZE              .BLKW 1         ;  allocated size
$DEF    BUF_B_TYPE              .BLKB 1         ;  type = DYN$C_BUFIO
$DEF    BUF_B_spare             .BLKB 1         ;  not used
$DEF    BUF_T_DLL               .BLKB 8         ;  data link scratch area
$DEF    BUF_T_USRDATA                           ;  end of header
        $DEFEND BUF

ZE_K_ACPTYPE = 252
ZE_K_ACPCLASS = 253

        .PAGE
        .SBTTL  Local storage

        .PSECT  LOCAL_DATA      NOEXE, PIC, LONG
        .ALIGN  LONG

PHYD_CCB_ADDR:
        .BLKL   1

AQB_ADDR:
        .BLKL   1                               ; addr of our AQB

VCB_ADDR:
        .BLKL   1                               ; addr of our VCB

PHYD_CHAN:
        .BLKW   1                               ; channel to physical device

PHYD_DVCNAM:
        .ASCID  /ZE_PHY_DVC/                    ; physical device name

ZE_CHAN:
        .BLKW   1                               ; channel to pseudodevice

ZE_DVCNAM:
        .ASCID  /ZEA0/                          ; pseudodevice name

        .MACRO  CHK_STS STAT=R0, ?NEXT
        BLBS    stat, next      
        PUSHL   stat
        CALLS   #1, G^LIB$STOP
next:
        .ENDM
        
        .PSECT  CODE            SHR, NOWRT, PIC, LONG

        .PAGE
        .SBTTL  ACP_MAIN, Main Program

        .ENTRY  ACP_MAIN, ^M<>

        $CMKRNL_S       B^BEGIN                 ; change mode to kernel
        RET                                     ; all done

        .ENTRY  BEGIN, ^M<R2,R3,R4,R5,R6,R7>

;       we expect that we have been started as a detached process.  
;       We must perform ACP mount functions on the pseudodevice.  

        $ASSIGN_S  DEVNAM=ZE_DVCNAM, -          ; assign channel 
                CHAN=ZE_CHAN,-                  ;  to the device
                ACMODE=#PSL$C_USER              ;  at USER level
        CHK_STS

        MOVZWL  ZE_CHAN, R0                     ; obtain channel number
        JSB     G^IOC$VERIFYCHAN                ; get CCB addr in R1
        CHK_STS
        MOVL    CCB$L_UCB(R1), R5               ; get UCB address
        BBSSI   #UCB_V_ACPEXISTS, -             ; test and set "ACP exists"
                UCB$L_DEVDEPEND(R5), 10$        ;  bit
        BRB     20$

10$:    PUSHL   #SS$_DEVMOUNT                   ; if was already set, exit with 
        CALLS   #1, G^LIB$STOP                  ;  a semi-meaningful status code

20$:    CALLS   #0, LOCK_IODB                   ; lock I/O data base for writing

;       allocate the Volume Control Block (VCB)

        MOVZBL  #VCB$C_LENGTH, R1               ; set desired size 
        JSB     G^EXE$ALONONPAGED               ; attempt alloc, addr in R2
        MOVL    R2, R7                          ; use R7 for the VCB
        MOVL    R7, VCB_ADDR                    ; save VCB address
        
;       initialize VCB 

        MOVB    #DYN$C_VCB, VCB$B_TYPE(R7)      ; record type
        MOVZBW  #VCB$C_LENGTH, VCB$W_SIZE(R7)   ;  and size
        MOVW    #1, VCB$W_TRANS(R7)             ; initialize trans. count
        MOVL    R7, UCB$L_VCB(R5)               ; store VCB address in the UCB

;       Allocate an ACP Queue Block (AQB)

        MOVZBL  #AQB$C_LENGTH, R1               ; set length
        JSB     G^EXE$ALONONPAGED               ; allocate AQB, addr in R2
        CHK_STS
        MOVL    R2, R6                          ; use R6 for the AQB
        MOVL    R2, AQB_ADDR                    ; and save its address

;       Initialize the AQB 

        MOVZBW  #AQB$C_LENGTH, AQB$W_SIZE(R6)   ; record size                   
        MOVB    #DYN$C_AQB, AQB$B_TYPE(R6)      ;  and type 
        CLRQ    AQB$L_ACPQFL(R6)                ; init the IRP queue
        MOVB    #1, AQB$B_MNTCNT(R6)            ;  and the mount count
        MOVB    #ZE_K_ACPTYPE,-                 ; note that
                AQB$B_ACPTYPE(R6)               ;  it's ours
        MOVB    #ZE_K_ACPCLASS,-                ; ditto
                AQB$B_CLASS(R6)                 ;  

        MOVL    VCB_ADDR, R7                    ; recover VCB address
        MOVL    R6, VCB$L_AQB(R7)               ; put AQB address in VCB

        MOVL    G^CTL$GL_PCB, R4                ; get our PID from our PCB, 
        MOVL    PCB$L_PID(R4), AQB$L_ACPPID(R6) ;  and store in the AQB
        
;       Link AQB into the system's AQB list 

        MOVAB   G^IOC$GL_AQBLIST, R1            ; get AQB listhead
        MOVL    (R1), AQB$L_LINK(R6)            ; forward link
        MOVL    R6, (R1)                        ; put our AQB at head

        CALLS   #0, UNLOCK_IODB                 ; release the database

        BISL2   #UCB$M_TEMPLATE, UCB$L_STS(R5)  ; set "template" bit
        BISL2   #DEV$M_MNT!DEV$M_FOR,-          ; set "mounted" and
                UCB$L_DEVCHAR(R5)               ;  "foreign" bits

;       assign a channel to the physical device 

        $ASSIGN_S  DEVNAM=PHYD_DVCNAM,-
                CHAN=PHYD_CHAN,-                ; assign channel to PHYD
                ACMODE=#PSL$C_USER              ;  at USER level
        CHK_STS

;       deassign from the pseudodevice

        $DASSGN_S CHAN=ZE_CHAN
        CHK_STS

;       initialization done

        BRB     ACP_LOOP                        ; go look for work

        .PAGE
        .SBTTL  ACP_LOOP, ACP Main Processing Loop

ACP_LOOP:

;       look for and process all IRPs in the AQB queue

        MOVL    AQB_ADDR, R6                    ; get addr of ACP Queue Block
10$:    REMQHI  AQB$L_ACPQFL(R6), R3            ; try to get an IRP
        BVS     20$                             ;  br if queue empty

        PUSHL   R3                              ; else pass it to the 
        CALLS   #1, PROCESS_IRP                 ;  IRP processor
        BRB     10$                             ; and look for another
20$:

;       come here when queue empty

        CALLS   #0, CHECK_ACP_DONE              ; delete ACP if necessary

        $HIBER_S                                ; else hibernate; upon 
        BRW     10$                             ;  awakening, look for more work

        .PAGE
        .SBTTL  PROCESS_IRP, Process an IRP

; Inputs:
;       4(AP)   Address of the IRP

        .ENTRY  PROCESS_IRP, ^M<R2,R3,R5>

        MOVL    4(AP), R3                       ; get addr of IRP 
        MOVL    IRP$L_SVAPTE(R3), R2            ; ...of system buffer
        MOVAB   BUF_T_DLL(R2), R2               ; ...of area for header

        ; put "data link header" into buffer ahead of user's data

        PUSHL   R2                              ; 2nd arg - dest address
        PUSHL   IRP$L_PID(R3)                   ; 1st arg - requestor's PID
        CALLS   #2, BIN_TO_HEX

        MOVL    IRP$L_BCNT(R3), R1              ; get user's tfr size
        ADDL2   #8, R1                          ; bump by size of header

        ; save the user's IRP on a queue in the cloned UCB

        MOVL    IRP$L_UCB(R3), R5               ; get UCB address
        INSQTI  (R3), UCB_Q_PNDIRP(R5)          ; put IRP at end of queue

        $QIO_S  CHAN=PHYD_CHAN,-                ; issue $QIO on the channel
                FUNC=#IO$_WRITEVBLK,-           ;  ordinary write function
                IOSB=IRP$L_IOST1(R3),-          ;  put IOSB into user's IRP
                ASTADR=IO_COMPL_AST,-           ;  I/O completion AST proc
                ASTPRM=R5,-                     ;  AST parameter is UCB addr
                P1=(R2),-                       ;  point to data in system buffer
                P2=R1                           ;  size of data
        RET                                     ; return to main loop

        .PAGE
        .SBTTL  IO_COMPL_AST, I/O completion AST procedure

; Inputs:
;       4(AP)   - address of UCB to which user's I/O was queued

        .ENTRY  IO_COMPL_AST, ^M<R3,R5>

        MOVL    4(AP), R5                       ; get the UCB address
        REMQHI  UCB_Q_PNDIRP(R5), R3            ; get the IRP from the queue
        JSB     G^COM$POST                      ; send it to posting

        RET                                     ; all done

        .PAGE
        .SBTTL  CHECK_ACP_DONE, Check to see if ACP should terminate

        .ENTRY  CHECK_ACP_DONE, ^M<R2,R3,R4,R5,R6,R7,R8,R9>

        MOVL    VCB_ADDR, R7                    ; recover VCB address

        RET

        .PAGE
        .SBTTL  BIN_TO_HEX, Convert a binary number to eight hex characters

;       4(AP)   number to be converted, passed by value.
;       8(AP)   address of destination string.  

TABLE:  .ASCII  /0123456789ABCDEF/

        .ENTRY  BIN_TO_HEX, ^M<R2, R3>

        MOVL    4(AP), R3
        MOVL    8(AP), R1

        MOVL    #28, R0                 ; start with high-order nibble
10$:    EXTZV   R0, #4, R3, R2          ; get a nibble 
        MOVB    TABLE[R2], (R1)+        ; store the corresponding hex character
        ACBL    #0, #-4, R0, 10$        ; point to next nibble, br if not done

        MOVL    #SS$_NORMAL, R0
        RET

        .END    ACP_MAIN

