Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!uunet!seismo!husc6!necntc!ames!sdcsvax!ucbvax!ENGVAX.SCG.HAC.COM!KVC
From: KVC@ENGVAX.SCG.HAC.COM (Kevin Carosso)
Newsgroups: comp.os.vms
Subject: CMU pseudo-terminal drivers (part 2 of 3)  [DCL archive format]
Message-ID: <8707200047.AA02741@ucbvax.Berkeley.EDU>
Date: Thu, 16-Jul-87 19:51:00 EDT
Article-I.D.: ucbvax.8707200047.AA02741
Posted: Thu Jul 16 19:51:00 1987
Date-Received: Mon, 20-Jul-87 03:44:44 EDT
Sender: daemon@ucbvax.BERKELEY.EDU
Distribution: world
Organization: The ARPA Internet
Lines: 1014

$ show default
$ check_sum = 1596636955
$ write sys$output "Creating PYDRIVER.MAR"
$ create PYDRIVER.MAR
$ DECK/DOLLARS="$*$*EOD*$*$"
        .TITLE  PYDRIVER - Pseudo terminal driver interface
        .IDENT 'V04-007'

;
;++
; FACILITY:
;
;       VAX/VMS Pseudo Terminal Driver interface
;
; ABSTRACT:
;
;       The pseudo terminal consists of two devices.
;       This is the non terminal part of the two devices.
;
; AUTHOR:
;
;       19-Nov-1982     Dale Moore      Redid the TP driver for VMS 3.0
;
;       This program has been granted to the public domain by the author.
;
; Revision History:
;
;       Version 'V03-001'
;               DWM     - Added Page seperators
;                       - On Last cancel, invoke hangup on TP device
;                       - changed PY_STOP and PY_STOP2 to return instead
;                         of looping for more.
;                       - Changed last cancel to call ioc$reqcom instead of
;                         using macro REQCOM which is a branch ioc$reqcom.
;       Version V03-002 - Changed to Clear word rather than clear byte
;                         in startio routine on word field.
;
;       Version V03-003 (Thu Dec  9 12:42:38 1982) D. Kashtan
;                         Made into a TEMPLATE driver.
;       Version V03-004 (Fri Dec 10 11:40:35 1982) D. Kashtan
;                         Made EXE$... into +EXE$... in FDT dispatch table,
;                         fixing bug that crashed system in SET/SENSE MODE/CHAR
;       Version V03-005 (14-Jun-1983) Dale Moore
;                         Add R4 to calls to IOC$INITIATE.
;                         TTY$STARTIO mucks R4
;       Version V03-006 (12-Jul-1983) Mark London, MIT Plasma Fusion Center
;                       - Set terminal to NOBROADCAST when no READ QIO avail-
;                         able so as to allow Broadcasts without hanging up.
;                         (When no QIO available, UCB$M_INT is enabled, and
;                         the Broadcast don't get handled.  The sender of a
;                         Broadcast goes into a wait state until the broadcast
;                         is completed or timed-out, neither or which can
;                         happen.  Setting NOBROADCASTs at least allow the
;                         Broadcast to finish. What is needed is a CTRLS state
;                         that doesn't allow Broadcasts to break through.)
;                       - Added MOVC3 instruction for burst data in PY$STARTIO,
;                         which "should" speed up the transfers.
;                       - Fixed data transfer problem by raising to fork IPL
;                         while calling PUTNXT in PY$FDTWRITE. NOTE: TPA0 must
;                         be a mailbox to avoid TT reads from timing out.
;
;       Version V04-001 - Doug Davis, Digital Equipment
;                       - Most of the changes required for migration to
;                         Version 4.0 relate to the new handling of UCB
;                         creation and deletion. This includes adding
;                         a CLONEDUCB entry point to the dispatch table,
;                         and "cloning" the UNITINIT routine to handle the
;                         required entry. Also changed the call from
;                         IOC$CREATE_UCB to IOC$CLONE_UCB, with associated
;                         maintainence of the UCB$V_DELETEUCB bit in the
;                         UCB$L_STS field.
;                       - Changes were also incorporated reflecting new
;                         methods of  XON/XOFF flow control.
;                       - Although pieces of the original code have been
;                         superceded by these changes ( example - functions
;                         that were performed by Unit_Init for new units
;                         are are now performed by Clone_Init ), most of
;                         the original code was left in place and/or commented
;                         out.
;
;                       NOTE - No subroutines preambles were modified to
;                              reflect these changes.
;
;       Version V04-002 (20-Jan-1985) Mark London, MIT Plasma Fusion Center
;                       - Changed test for output characters after call to
;                         UCB$L_TT_PUTNXT and UCB$L_TT_GETNXT.  Output is
;                         indicated in UCB$B_TT_OUTYPE.
;
;       Version V04-003 (24-Jun-1985) Kevin Carosso, Hughes Aircraft Co., S&CG
;                       Cleaned this thing up quite a bit.
;                       - Got rid of MBX characteristic on the devices.  This
;                         was a holdover to before cloned devices really
;                         existed.
;                       - Got rid of the UNIT_INIT routine completely.  This
;                         was replaced by a CLONE_UCB routine.
;                       - Leave the PY template device OFFLINE.  This is what
;                         other TEMPLATE devices do, to indicate that you
;                         really cannot do I/O to the template.
;                       - Rewrote the CANCEL_IO routine to issue a DISCONNECT
;                         on the TP device at last deassign of the PY device.
;                         This causes the TP device to hangup on it's process.
;                         Works quite nicely with VMS V4 connect/disconnect
;                         mechanism.  Also, the devices should never stay
;                         around after last deassign on the PY, if you want to
;                         reconnect, count on VMS connect/disconnect instead,
;                         it's much less of a security hole.
;                       - Got rid of all modem operations.  Improper use tended
;                         to crash the system and they are not necessary.  TP
;                         device is always NOMODEM.  HANGUP works as you want
;                         it to without the modem stuff.
;                       - Got rid of the BRDCST on/off stuff.  It doesn't seem
;                         to be necessary any more.  It also had a bug in it
;                         somewhere that caused the terminal to start off
;                         NOBRDCST when it shouldn't.
;                       - General house-cleaning.  Got rid of commented out
;                         lines from VMS V3 version.  Fixed up typos in
;                         comments.
;
;       Version V04-004 (10-Feb-1986) Kevin Carosso, Hughes Aircraft Co., S&CG
;                       Changed all references to PTDRIVER to TPDRIVER because
;                       DEC (bless their little hearts) invented the *#&#$&
;                       TU81 and use PTA0: now.
;
;       Version V04-005 (3-Sep-1986) Kevin Carosso, Hughes Aircraft Co., S&CG
;                       Fixed bug whereby the sequence ^S followed by ^Y
;                       would cause a system hang.  The fix is really in
;                       TPDRIVER.
;
;       Version V04-006 (5-Dec-1986) Kevin Carosso, Hughes Aircraft Co., S&CG
;                       Fixed the infamous character munging bug.  Turns
;                       out that in FDTWRITE we were enabling interrupts
;                       after doing the PUTNXT and before checking for
;                       a char.  Now check for the character and then
;                       ENBINT after we've decided what to do.  I assume
;                       UCB$B_TT_OUTYPE field was getting corrupted.
;
;       Version V04-007 (10-JUL-1987) Kevin Carosso, Hughes Aircraft Co., S&CG
;                       Fix in TPDRIVER for timeouts.  Don't bother
;                       clearing the TIM bit all the time in here now.
;
;                       Also, while we're in here, lets make the device
;                       acquire "NODE$" prefixes, since mailboxes do.
;--









        .PAGE
        .SBTTL  Declarations

        .LIBRARY        /SYS$LIBRARY:LIB.MLB/

;
; External Definitions:
;

.NOCROSS
;       $ACBDEF                         ; Define ACB
        $CRBDEF                         ; Define CRB
        $CANDEF                         ; Define cancel codes
        $DDBDEF                         ; DEFINE DDB
        $DDTDEF                         ; DEFINE DDT
        $DEVDEF                         ; DEVICE CHARACTERISTICS
        $DYNDEF                         ; Dynamic structure definitions
        $IODEF                          ; I/O Function Codes
        $IRPDEF                         ; IRP definitions
        $JIBDEF                         ; Define JIB offsets
        $SSDEF                          ; DEFINE System Status
        $PCBDEF                         ; Define PCB
        $PRDEF                          ; Define PR
        $TTYDEF                         ; DEFINE TERMINAL DRIVER SYMBOLS
        $TTDEF                          ; DEFINE TERMINAL TYPES
        $TT2DEF                         ; Define Extended Characteristics
        $UCBDEF                         ; DEFINE UCB
        $VECDEF                         ; DEFINE VECTOR FOR CRB
        $TTYMACS                        ; DEFINE TERMINAL DRIVER MACROS
        $TTYDEFS                        ; DEFINE TERMINAL DRIVER SYMBOLS
.CROSS

;
; Local definitions
;
; QIO Argument list offsets
;
P1 = 0
P2 = 4
P3 = 8
P4 = 12
P5 = 16
P6 = 20
;
; New device class for control end
;
DC$_PY = ^XFF
DT$_PY = 0

;
; Definitions that follow the standard UCB fields for TP driver
;  This will all probably have to be the same as the standard term

        $DEFINI UCB                     ; Start of UCB definitions

        .=UCB$K_TT_LENGTH               ; Position at end of UCB

$DEF    UCB$L_TP_XUCB   .BLKL   1       ; UCB of corresponding
                                        ;  control/application unit
$DEF    UCB$K_TP_LEN                    ; Size of UCB

        $DEFEND UCB                     ; End of UCB definitions

;
; Definitions that follow the standard UCB fields in PY devices
;

        $DEFINI UCB                     ; Start of UCB definitions

        .=UCB$K_LENGTH          ; position at end of UCB

$DEF    UCB$L_PY_XUCB   .BLKL 1 ; UCB of terminal part of pseudo terminal

$DEF    UCB$K_PY_LEN            ; Size of UCB

        $DEFEND UCB             ; end of UCB definitions









        .PAGE
;
; LOCAL Storage
;
        .PSECT $$$105_PROLOGUE

        .SBTTL  Standard Tables

;
; Driver prologue table:
;
PY$DPT::
        DPTAB   -                       ; Driver Prologue table
                END = PY$END,-          ; End and offset to INIT's vectors
                UCBSIZE = UCB$K_PY_LEN,-; Size of UCB
                FLAGS=DPT$M_NOUNLOAD,-          ; Don't allow unload
                ADAPTER=NULL,-                  ; ADAPTER TYPE
                NAME    = PYDRIVER              ; Name of driver
        DPT_STORE INIT
        DPT_STORE UCB,UCB$W_UNIT_SEED,W,0       ; SET UNIT # SEED TO ZERO
        DPT_STORE UCB,UCB$B_FIPL,B,8            ; Fork IPL
        DPT_STORE UCB,UCB$W_STS,W,-             ; TEMPLATE device
                        
        DPT_STORE UCB,UCB$L_DEVCHAR,L,<-        ; Characteristics
                        DEV$M_REC!-             ;   record oriented
                        DEV$M_AVL!-             ;   available
                        DEV$M_IDV!-             ;   input device
                        DEV$M_ODV>              ;   output device
        DPT_STORE UCB,UCB$L_DEVCHAR2,L, -               ; Device characteristics
                                             ; prefix with "NODE$"
        DPT_STORE UCB,UCB$B_DEVCLASS,B,DC$_PY
        DPT_STORE UCB,UCB$B_DIPL,B,8            ; Device IPL = FIPL (no device)
        DPT_STORE DDB,DDB$L_DDT,D,PY$DDT

        DPT_STORE REINIT
        DPT_STORE CRB,CRB$L_INTD+VEC$L_INITIAL,D,PY$INITIAL     ; Controller
        DPT_STORE END









        .PAGE
        .SBTTL Driver Dispatch table and function decision table
;
; Driver Dispatch table
;
        DDTAB   DEVNAM  = PY,-                  ; Device name
                START   = PY$STARTIO,-          ; Start I/O routine
                FUNCTB  = PY$FUNCTAB,-          ; The function table
                CANCEL  = PY$CANCEL,-           ; the cancel i/o routine
                CLONEDUCB = PY$CLONE_INIT       ; Entry when template cloned.
;
; Function Decision table for PY devices
;
PY$FUNCTAB:
        FUNCTAB ,-                      ; Legal Functions
                
        FUNCTAB ,-                      ; Buffered I/O functions
                
        FUNCTAB PY$FDTREAD,
        FUNCTAB PY$FDTWRITE,
;       FUNCTAB +EXE$SETMODE,
;       FUNCTAB +EXE$SETCHAR,
        FUNCTAB +EXE$SENSEMODE,

        .SBTTL  Local Storage - Name of companion device

TPSTRING:       .ASCII  /TPA/
TPLENGTH = . - TPSTRING









        .PAGE
        .SBTTL  PY$FDTREAD - Function decision routine for PY control read
;++
; PY$FDTREAD
;
; Functional Description:
;
;       This routine is called from the function decision table dispatcher
;       to process a read physical, read logical, read virtual I/O function.
;
;       The function first verifies the caller's parameters, terminating
;       the request with immediate success or error if necessary.
;       A system buffer is allocated and its
;       address is saved in the IRP.  The caller's quota is updated, and
;       the read request is queued to the driver for startup.
;
; Inputs:
;
;       R0,R1,R2        = Scratch
;       R3              = IRP Address
;       R4              = Address of PCB for current process
;       R5              = Device UCB address
;       R6              = Address of CCB
;       R7              = I/O function code
;       R8              = FDT Dispatch addr
;       R9,R10,R11      = Scratch
;       AP              = Address of function parameter list
;                       P1(AP) = Buffer Address
;                       P2(AP) = Buffer Size
;
; Outputs:
;
;       R0,R1,R2,R11    = Destroyed
;       R3-R10,AP       = Preserved (pickled)
;       IRP$L_SVAPTE(R3)= Address of allocated system buffer
;       IRP$W_BOFF(R3)  = Requested byte count
;
;       System Buffer:
;               LONGWORD/0      = Address of start of data= buff+12
;               LONGWORD/1      = Address of user buffer
;
;--
PY$FDTREAD::
        MOVZWL  P2(AP),R1       ; Get buffer Size
        BNEQ    15$
        JMP     10$             ; Is the size zero? If so, go do it easy.
15$:    MOVL    P1(AP),R0       ; Get buffer Address
        JSB     G^EXE$READCHK   ; Do we have access to the buffer
        PUSHR   #^M      ; Save user buffer address and IRP address
        ADDL    #12,R1          ; Add 12 bytes for buffer header
        JSB     G^EXE$BUFFRQUOTA; Is there enough buffer space left in
                                ;  the quota?
        BLBC    R0, 30$         ; Branch if insufficient quota
        JSB     G^EXE$ALLOCBUF  ; Allocate a system buffer
        BLBC    R0, 30$         ; Branch if none available
        POPR    #^M      ; Restore user buffer and irp address
        MOVL    R2,IRP$L_SVAPTE(R3)     ; Save address of buffer
        MOVW    R1,IRP$W_BOFF(R3)       ;  and requested byte count
        MOVZWL  R1,R1                   ; convert to longword count
        MOVL    PCB$L_JIB(R4),R11       ; Get Jib address
        SUBL    R1,JIB$L_BYTCNT(R11)    ; Adjust quota count
        MOVAB   12(R2),(R2)             ; Save addr of start of user data
        MOVL    R0,4(R2)                ; Save user buffer address in 2nd
                                        ; longword
        JMP     G^EXE$QIODRVPKT ; Queue I/O packet to start I/O routine
;
; Did he request a read of zero bytes?
;
10$:    MOVL    #SS$_NORMAL,R0          ; Everything is ok
        JMP     G^EXE$FINISHIOC         ; complete I/O request
;
; Come here when something goes wrong
;
30$:    POPR    #^M              ; Clear buffer addr and restore IRP
        JMP     G^EXE$ABORTIO           ; complete I/O request









        .PAGE
        .SBTTL  PY$FDTWRITE - Function decision routine for PY control write
;++
; PY$FDTWRITE
;
; Functional Description:
;
;       This routine is called from the function decision table dispatcher
;       to process a write physical, write logical, write virtual I/O
;       function.
;
;       The function first verifies the caller's parameters, terminating
;       the request with immediate success or error if necessary.
;       The routine then immediately start cramming the characters into
;       the associated units typeahead buffer by calling putnxtchr.
;
; Inputs:
;
;       R0,R1,R2        = Scratch
;       R3              = IRP Address
;       R4              = Address of PCB for current process
;       R5              = Device UCB address
;       R6              = Address of CCB
;       R7              = I/O function code
;       R8              = FDT Dispatch addr
;       R9,R10,R11      = Scratch
;       AP              = Address of function parameter list
;               P1(AP)  = Buffer Address
;               P2(AP)  = Buffer Size
;
; Outputs:
;
;       R0,R1,R2        = Destroyed
;       R3-R8,AP        = Preserved (pickled)
;
; External Routines:
;
;       EXE$ABORTIO - FDT abort io routine
;       Input Parameters:
;               R0 - First longword of IOSB
;               R3 - IRP Address
;               R4 - PCB Address
;               R5 - UCB Address
;
;       EXE$FINISHIOC - FDT finish IO routine
;       Input Parameters:
;               R0 - First longword of IOSB
;               R3 - IRP Address
;               R4 - PCB Address
;               R5 - UCB Address
;
;       EXE$WRITECHK - Check access to buffer
;       Input Parameters:
;               R0 - Address of buffer
;               R1 - Size of buffer
;               R3 - IRP Address
;       Output Parameters:
;               R0,R1,R3 - Preserved
;               R2 - clear
;
;       @UCB$L_TT_PUTNXT(R5) - Port driver input character routine
;       Input Parameters:
;               R3 - character
;               R5 - UCB Address
;       Output Parameters:
;               R3 - if EQL then nothing
;                    if LSS then Burst address to output
;                    if GTR then char to output
;               R5 - UCB Address
;               R1,R2,R4 - trashed
;               R0 - Is this trashed or preserved? Documentation say preserve.
;
;--
PY$FDTWRITE::
        MOVZWL  P2(AP),R1       ; Get buffer Size
        BEQL    40$             ; Is the size zero? If so, go do it easy.
        MOVL    P1(AP),R0       ; Get buffer Address
        JSB     G^EXE$WRITECHK  ; Do we have access to the buffer
                                ; No return means no access
;
; Change the UCB's around abit
;
        PUSHR   #^M
        MOVZWL  R1,R9                   ; Set size in R9
        MOVL    UCB$L_PY_XUCB(R5),R5    ; Set fake UCB in R5
;
; Loop through the packet R0 is address R9 is size
;
10$:
        MOVZBL  (R0)+,R3                ; Get the byte and set address to next
        DSBINT  UCB$B_FIPL(R5)
        JSB     @UCB$L_TT_PUTNXT(R5)    ; Buffer the character
        TSTB    UCB$B_TT_OUTYPE(R5)     ; Test output
        BLEQ    20$                     ; None or string output
        ENBINT
        MOVB    R3,UCB$W_TT_HOLD(R5)    ; save the character in tank
        BISW    #TTY$M_TANK_HOLD,-
                UCB$W_TT_HOLD(R5)       ; Signal char in tank
        BRB     25$
20$:
        BEQL    30$                     ; No character
        ENBINT
        BISW    #TTY$M_TANK_BURST,-     ; Signal burst
                UCB$W_TT_HOLD(R5)
25$:    PUSHR   #^M     ; Save State
        MOVL    UCB$L_TP_XUCB(R5),R5    ; Switch to PY UCB
        DSBINT  UCB$B_FIPL(R5)
        BBC     #UCB$V_BSY,UCB$W_STS(R5),27$
        MOVL    UCB$L_IRP(R5),R3        ; Get IRP
        JSB     G^IOC$INITIATE          ; Go to the start I/O
27$:    ENBINT
        POPR    #^M     ; Restore State
        BRB     35$

30$:    ENBINT
35$:    DECW    R9                      ; decrease number to do
        BGTR    10$                     ; if gtr then more to do
        POPR    #^M           ; Restore real UCB and IRP
;
; Finish up the read
;
40$:
        MOVZWL  P2(AP),R0               ; Move number of bytes output
        ASHL    #16,R0,R0               ; Put it in the high word
        MOVW    #SS$_NORMAL,R0          ; Everything is just fine
        JMP     G^EXE$FINISHIOC         ; Complete the I/O request









        .PAGE
        .SBTTL  PY$CANCEL - Cancel the IO on the PY device
;++
;
; Functional Description:
;
;       This routine is entered to stop io on a PY unit.  If this is the last
;       deassign on the PY device, issue a CLASS_DISCONNECT on our associated
;       TP device to get it away from any processes using it.
;
; Inputs:
;
;       R2 = Negative of the Channel Number,
;               also called channel index number
;       R3 = Current IO package address
;       R4 = PCB of canceling process
;       R5 = UCB Address
;       R8 = CAN$C_CANCEL on CANCEL IO or CAN$C_DASSGN on DEASSIGN
;
; Outputs:
;       Everything should be preserved
;--
PY$CANCEL::                                     ; Cancel PY usage
        JSB     G^IOC$CANCELIO                  ; Call the cancel routine
        BBC     #UCB$V_CANCEL,UCB$W_STS(R5),10$ ; Branch if not for this guy
        MOVQ    #SS$_ABORT,R0                   ; Status is request canceled
        BICW    #,-     ;
                UCB$W_STS(R5)                   ; Clear unit status flags
        JSB     G^IOC$REQCOM                    ; Complete request
10$:    TSTW    UCB$W_REFC(R5)                  ; Last Deassign
        BNEQ    100$                            ; No, just exit
;
; Do a DISCONNECT on the TP device.
;
        pushr   #^M
        movl    UCB$L_PY_XUCB(r5), r5           ; Switch to TP UCB
        beql    20$                             ; if not there, skip
        clrl    UCB$L_TP_XUCB(r5)               ; Clear backlink to PY device
        bisl2   #UCB$M_DELETEUCB, UCB$L_STS(r5) ; Set it to go bye-bye
        bicw2   #UCB$M_ONLINE,UCB$W_STS(R5)     ; Mark offline
        bicb2   #UCB$M_INT, UCB$W_STS(r5)       ; Don't expect interrupt
        movl    UCB$L_TT_LOGUCB(r5), r1         ; Look at logical term UCB
        tstw    UCB$W_REFC(r1)                  ; See if TP has any references
        bneq    15$                             ; If so, go and do disconnect
        jsb     G^IOC$DELETE_UCB                ; if not, delete the UCB
        brb     20$
15$:    clrl    r0                              ; indicate that we must hangup
        movl    UCB$L_TT_CLASS(r5), r1
        jsb     @CLASS_DISCONNECT(r1)           ; Force disconnect
20$:    popr    #^M             ; Switch back to PY UCB
        clrl    UCB$L_PY_XUCB(r5)               ; Clear link to deleted TP
        bisl2   #UCB$M_DELETEUCB, UCB$L_STS(r5) ; Set our own delete bit
100$:   rsb









        .PAGE
        .SBTTL PY$INITIAL - Initialize Pseudo terminal interface

;++
; PY$INITIAL - Initialize the interface
;
; Functional Description:
;
;       This routine is entered at device connect time and power recovery.
;       There isn't much to do to the device.
;
; Inputs:
;
;       R4 = The devices CSR  (but there is no csr!)
;       R5 = address of IDB
;       R6 = address of DDB
;       R7 = address of CRB
;
; Outputs:
;
;       All registers preserved
;
;--
PY$INITIAL::
        RSB









        .PAGE
        .SBTTL  PY$CLONE_INIT - initialize the unit
;++
; PY$CLONE_INIT - Initialize new PY device
;
; Functional Description:
;
;       Main thing we do here is clone up an associated terminal device
;       and initialize fields in the two new UCB's.
;
; Inputs:
;
;       R5      = Address of UCB
;
; Outputs:
;
;       All preserved
;--

PY$CLONE_INIT::

;+ ---
;       Ignore inits on UNIT #0 (the template PY UCB)
;- ---
        TSTL    UCB$W_UNIT(R2)                  ;UNIT #0??
        BNEQ    10$                             ;No: Initialize
        RSB                                     ;Yes: Return

10$:    PUSHR   #^M
        Bicl2   #UCB$M_DELETEUCB,UCB$L_STS(R2)  ; Clear ucbdelete - dec
        Movl    R2,R5
;
; Find the associated device.
;
; NOTE: We can't call IOC$SEARCHDEV because it expects the string to
;       be accessible from the previous access mode. (It executes the
;       prober instruction with mode=#0). I don't know how to make the
;       string accessible from the previous access mode cleanly, but I
;       do know how to move most of IOC$SEARCHDEV into the py driver.
;
        MOVAL   G^IOC$GL_DEVLIST-DDB$L_LINK,-   ; Get address of i/o database
                R8                              ; listhead
        CLRL    R6                              ; Desired mate = PTY UNIT 0
        MOVAB   L^TPSTRING,R7                   ; String address for TPA
        MOVL    #TPLENGTH,R4                    ; String length
        BSBW    SEARCHDEV                       ; Find the DDB
        BNEQ    20$                             ; Device not found
        BSBW    SEARCHUNIT                      ; Search for specific unit
        BNEQ    30$                             ; unit found
20$:    POPR    #^M       ; NOT FOUND: Return
        RSB

;
; Create the PTY, R1 has template UCB of TP device
;
30$:    PUSHL   R5                              ; Save R5
        MOVL    UCB$L_DDB(R5),R0                ; Find UNIT #0 UCB FOR PY DEV.
        MOVL    DDB$L_UCB(R0),R0
        MOVL    R1,R5                           ; R5 = UCB to CLONE
        JSB     G^IOC$CLONE_UCB                 ; Clone UCB

        MOVL    R2,R1                           ; Put PTY UCB back into R1
        POPL    R5                              ; Restore R5
        BLBS    R0,40$                          ; WIN!!! (big deal.)
;+ ---
;       CREATE_UCB failed, mark our PY device offline
;- ---
        BICW2   #UCB$M_ONLINE,UCB$W_STS(R5)     ; Mark offline
        BRW     100$                            ; And return
;+ ---
;       PTY UCB created successfully, link the UCBs together
;- ---
40$:    MOVL    R1,UCB$L_PY_XUCB(R5)            ; Store associated UCB
        MOVL    R5,UCB$L_TP_XUCB(R1)            ; Store the other one back
        CLRL    UCB$L_PID(R1)                   ; Clear the owner PID in PTY
        CLRW    UCB$W_REFC(R1)                  ; Reference count is ZERO
        Bicl2   #UCB$M_DELETEUCB,UCB$L_STS(R1)  ; Inhibit deletion
        MOVW    UCB$W_UNIT(R1),-                ; Set associated TP unit
                UCB$L_DEVDEPEND(R5)             ; number in PY devdepend
;+ ---
;       Call the PTY unit init routine
;- ---
        MOVL    UCB$L_DDT(R1),R0                ; Get DDT
        MOVL    DDT$L_UNITINIT(R0),R0           ; Get Unit Init Addr in DDT
        CMPL    R0,#IOC$RETURN                  ; Null Address??
        BNEQ    50$                             ; No: Call it
        MOVL    UCB$L_CRB(R1),R0                ; Yes: Look in the CRB
        MOVL    CRB$L_INTD+VEC$L_UNITINIT(R0),R0
        BEQL    100$                            ; No: Unit init routine

50$:    PUSHL   R5                              ; Save R5
        MOVL    R1,R5                           ; R5 = PTY UCB
        JSB     (R0)                            ; CALL THE UNIT INIT ROUTINE
        POPL    R5                              ; Restore R5

100$:   POPR    #^M
        RSB









        .PAGE
        .SBTTL  DDB finding Routines
;++
; SearchDev - Search for device DDB
;
; This routine is called to search the device database for a DDB.
; This is the first step in finding another devices UCB.
;
; This routine copied out of IOC$SEARCHDEV in IOSUBPAGD
;
; Inputs:
;
;       R8 = DDB Head
;       R7 = Address of String
;               String = ddc format: example = /TTA/
;       R4 = Length of string
;
; Outputs:
;
;       R8 = DDB of desired device if EQL, otherwise not found
;       R0 is trashed
;       R1 is trashed
;--
SEARCHDEV:                              ; Search for device name
10$:    MOVL    DDB$L_LINK(R8),R8       ; Get address of next ddb
        BEQL    20$                     ; If eql end of list
        MOVAL   DDB$T_NAME(R8),R0       ; Get address of generic device name
        MOVB    (R0)+,R1                ; Calculate len of string to compare
        CMPB    R1,R4                   ; Length of names match?
        BNEQ    10$                     ; If neq no
        CMPC    R4,(R0),(R7)            ; Compare device names
        BNEQ    10$                     ; If neq names do not match
        RSB
20$:    INCL    R8                      ; indicate search failure
        RSB

        .SBTTL  UCB finding routine
;++
; SEARCHUNIT - Subroutine to search for UCB given DDB
;
; Given the DDB of a device, get the UCB and run down the ucb list until
; we get the ucb with the desired unit number.  This code is taken out of
; IOC$SEARCHDEV in IOSUBPAGD.
;
; Inputs:
;
;       R8 = DDB of device
;       R6 = unit number of desired UCB
;
; Outputs:
;
;       R1 = UCB of device if NEQ, otherwise not found
;       R0 is trashed
;
;--
SEARCHUNIT:                             ; Search for unit number
        MOVAL   DDB$L_UCB-UCB$L_LINK(R8),-
                R1                      ; Get address of next ucb address
10$:    MOVL    UCB$L_LINK(R1),R1       ; Get Address of next ucb
        BEQL    40$                     ; If EQL then end of list
        CMPW    R6,UCB$W_UNIT(R1)       ; Unit number match?
        BEQL    30$                     ; If eql yes
        BRB     10$
30$:    MOVL    #SS$_NORMAL,R0          ; Indicate match
40$:    RSB









        .PAGE
        .SBTTL  PY$STARTIO - Device Startio routines
;++
; PY$STARTIO    - Start Input on idle device
;
; Functional Description:
;
;       If after the read FDT routines are done and nobody is doing
;       anything on the device (UCB$V_BSY = 0) then call the start io
;       routine.
;
; Called from:
;
;       Called from any one of five places:
;       - The EXE$QIODRVPKT in the PY FDT READ routine
;               which calls EXE$INSIOQ which calls IOC$INITIATE
;       - The IOC$REQCOM at the end of this PY startio routine
;               which calls IOC$INITIATE
;       - The TP startio routine which calls IOC$INITIATE
;       - The PY write fdt routine which calls IOC$INITIATE.
;               In case we must echo a character.
;       - The PY$RESUME routine which calls IOC$INITIATE.
;
; Inputs:
;
;       R3 = IRP Address
;       R5 = UCB Address
;               UCB$W_BCNT and UCB$L_SVAPTE are written by IOC$INITIATE
;
; Outputs:
;
;       R5 - UCB Address
;
;--
PY$STARTIO::
        .ENABLE LSB

        MOVL    @UCB$L_SVAPTE(R5),-             ; Initialize buffer
                UCB$L_SVAPTE(R5)                ;  pointers
PY_OUT_LOOP:
;
; Here R5 must point at the PY device UCB and not at
;  the UCB of the associated TP device.
;
5$:     TSTW    UCB$W_BCNT(R5)                  ; Any space left in rd packet
        BLEQ    50$                             ; No, Completed I/O
;
; Switch to terminal UCB
;
        MOVL    UCB$L_PY_XUCB(R5),R5            ; Set to TP ucb
;
; Look for next output in state tank
;
; Change Case statement to reflect V4 changes in routines - DEC
;
10$:    FFS     #0,#6,UCB$W_TT_HOLD+1(R5),R3
        CASE    R3,TYPE=B,<-                    ; Dispatch
                PY_PREMPT,-                     ; Send Prempt Characte - DEC
                PY_STOP,-                       ; Stop output
                PY_CHAR,-                       ; Char in tank
                PY_BURST,-                      ; Burst in progress
                >
;
; No Pending Data - Look for next character
;
        BICB    #UCB$M_INT, UCB$W_STS(R5)       ; Clear interrupt expected
;
; Call class driver for more output
;
        JSB     @UCB$L_TT_GETNXT(R5)    ; Get the next character
        CASEB   UCB$B_TT_OUTYPE(R5),#-1,#1
1$:     .WORD   PY_START_BURST-1$       ; Burst specified
        .WORD   PY_DONE-1$              ; None
        BRW     BUFFER_CHAR             ; Buffer the character
;
; Output queue exhausted
PY_DONE:
        MOVL    UCB$L_TP_XUCB(R5),R5    ; Switch UCBs to PY UCB
        BBC     #UCB$V_BSY,-            ; If not BSY then ignore
                UCB$W_STS(R5),47$       ; the char
        MOVL    UCB$L_IRP(R5),R3        ; Restore IRP
        CMPW    IRP$W_BCNT(R3),-        ; Any characters moved
                UCB$W_BCNT(R5)
        BNEQ    50$                     ; Yes complete I/O
47$:    RSB
;
; read buffer exhausted
;
50$:    MOVL    UCB$L_IRP(R5),R3        ; Restore IRP
        MOVW    #SS$_NORMAL,-           ; Set successful completetion
                IRP$L_IOST1(R3)
        SUBW    UCB$W_BCNT(R5),-        ; Update byte count
                IRP$W_BCNT(R3)
        MOVW    IRP$W_BCNT(R3),-        ; Set in status
                IRP$L_IOST1+2(R3)
;
; If we wanted to here we could set the second longword of the device status
;
        CLRL    IRP$L_IOST2(R3)         ; No status
        MOVQ    IRP$L_IOST1(R3),R0      ; Load IOSB return values

        JMP     G^IOC$REQCOM
;
; Put the character into the read buffer
;
BUFFER_CHAR:
        MOVL    UCB$L_TP_XUCB(R5),R5    ; Switch UCBs to PY UCB
        BBC     #UCB$V_BSY,-
                UCB$W_STS(R5), 60$      ; If no PY IRP, ignore
        MOVB    R3,@UCB$L_SVAPTE(R5)    ; Add character to buffer
        INCL    UCB$L_SVAPTE(R5)        ; Bump pointer
        DECW    UCB$W_BCNT(R5)          ; Show character added
60$:    BRW     PY_OUT_LOOP             ; Go for another char
;
; Take care of Burst mode R5 must be TP UCB
;
PY_START_BURST:
        BISW    #TTY$M_TANK_BURST,-     ; Signal burst active
                UCB$W_TT_HOLD(R5)
;
; Continue burst
;
PY_BURST:
        MOVL    UCB$L_TP_XUCB(R5),R1    ; Save PY UCB in R1
        CLRL    R3                      ; Initialize output size
        CMPW    UCB$W_TT_OUTLEN(R5),UCB$W_BCNT(R1)  ; Is buffer too small?
        BGTR    61$                     ; Yes
        MOVW    UCB$W_TT_OUTLEN(R5),R3  ; Nope, so output all
        BRB     62$
61$:    MOVW    UCB$W_BCNT(R1),R3       ; Just output what we can

62$:    PUSHR   #^M  ; MOVC3 destroys these registers
        MOVC3   R3,@UCB$L_TT_OUTADR(R5),@UCB$L_SVAPTE(R1)
                                        ; Transfer burst to the buffer
        POPR    #^M  ; Restore the registers

        ADDL2   R3,UCB$L_SVAPTE(R1)     ; Update output pointer
        SUBW2   R3,UCB$W_BCNT(R1)       ; Update output count
        ADDL2   R3,UCB$L_TT_OUTADR(R5)  ; Update input pointer
        SUBW2   R3,UCB$W_TT_OUTLEN(R5)  ; Update input count
        BNEQ    65$                     ; Not the last character
        BICW    #TTY$M_TANK_BURST,-
                UCB$W_TT_HOLD(R5)       ; Reset burst not active
65$:    MOVL    UCB$L_TP_XUCB(R5),R5    ; Swicht UCBs to PY UCB
        BRW     PY_OUT_LOOP
;
; Get a single char from tt and put in read buffer R5 = TP UCB
;
PY_CHAR:
        MOVB    UCB$W_TT_HOLD(R5),R3    ; Get the next byte
        BICW    #TTY$M_TANK_HOLD,-      ; Show tank empty
                UCB$W_TT_HOLD(R5)
        BRW     BUFFER_CHAR
;
; Stop the output R5 = TP UCB
;
; Deleted PY_STOP2 routine and changed bit clear to byte operation - DEC
;
PY_STOP:
        BICB    #UCB$M_INT, -
                UCB$W_STS(R5)           ; Reset output active
        BRW     PY_DONE                 ; DON'T go for anymore
                                        ; Or we'll get into an infinite loop
;
; Send Xon or Xoff characters, R5 = TP UCB
;
; Changed PY_XOFF and PY_XON to be PY_PREMPT - DEC
;
PY_PREMPT:
        movb    UCB$B_TT_PREMPT(r5), r3 ; Pick up the character
        BICW    #TTY$M_TANK_PREMPT,-    ; Reset Xoff state
                UCB$W_TT_HOLD(R5)
        BRW     BUFFER_CHAR
        .DISABLE LSB

PY$END:
                                        ; End of driver
        .END
$*$*EOD*$*$
$ checksum PYDRIVER.MAR
$ if checksum$checksum .ne. check_sum then -
$   write sys$output "Checksum failed, file probably corrupted"
$ exit