.TITLE WATCH5_USS - User system service dispatcher for WATCH5 .IDENT '1.1' ;+ ; This is a user-written system service dispatcher and image run-down handler ; for the WATCH5 program. The vanilla version of WATCH5 from the 1989 fall ; DECUS symposium tape used an ordinary exit handler and left non-paged pool ; and modified device drivers around if somebody did a $ STOP /ID on a process ; running WATCH5. ; ; This program is intended to provide a sure-fire way to restore the device ; driver to its original state and to deallocate non-paged pool. It also ; encapsulates the privileged functionality of WATCH so that the user interface ; can be easily modified. ; ; There are three entry points plus the rundown handler. ; ; LOAD_CODE ( device_name ) - Start watching a terminal ; ; DEVICE_NAME - Character string, read-only, by descriptor ; ; device to monitor ; ; o Checks privileges ; o Allocates non-paged pool, copies itself and branches there. ; o Looks up the device UCB ; o Verifies that it is a terminal, on-line, available, not a template ; o Gets the physical UCB (if it is a virtual terminal) ; o Makes sure that the terminal uses TTDRIVER ; o Checks that the port/class interface is not already in use. ; o Hooks its own action routines into the port/class vector interface ; o Sets a flag indicating that LOAD_CODE has been run ; o Exits ; ; The action routines will copy output characters destined for the ; remote terminal into a ring buffer in non-paged pool. ; ; COPY_BUFFER ( buffer, length ) - Retrieve data from non-paged pool ; ; BUFFER - character string, write-only, by descriptor ; ; Buffer to receive data from non-paged buffer ; ; LENGTH - unsigned word, write-only, by reference ; ; Number of bytes copied ; ; o Makes sure that LOAD_CODE has been run ; o Copies from the ring buffer in non-paged pool to the "buffer" ; o If there is more space in BUFFER than in the non-paged pool ; ring buffer then copy what is there and set LENGTH to the ; number of bytes copied. ; o If there is less (or equal) space, copy what will fit and set ; LENGTH to the size of BUFFER. ; ; SEND ( char ) - write a character to remote terminal ; ; CHAR - unsigned byte, read-only, by value ; ; o Check that LOAD_CODE has been run ; o Branch to pool ; o Send the character ; ; (rundown handler) ; ; o Clear the indication that LOAD_CODE has been run. ; o If the driver UCB port/class vectors have been manipulated then ; restore them from non-paged pool. ; o If pool has been allocated, deallocate it. ; o Don't worry about stopping other threads of execution. If they ; are process based, image rundown has already taken care of them. ; If they are outside of process context, they must have been at ; elevated IPL and, consequently, are already gone. ; ; Build Command File Example: ; ; $ MACRO WATCH5_USS ; $ LINK /NOSYSSHR /SHARE=WATCH5_USS /PROT SYS$INPUT/OPT ; SYS$SYSTEM:SYS.STB /SELECTIVE ; CLUSTER=TRANSFER_VECTOR ! Sort transfer vector up front ; CLUSTER=REST_OF_IT,,,SYS$DISK:[]WATCH5_USS.OBJ ; COLLECT=TRANSFER_VECTOR,$$$TRANSFER_VECTOR ; GSMATCH=LEQUAL,1,1 ; $ COPY WATCH5_USS.EXE SYS$COMMON:[SYSLIB] ; $ INSTALL REPLACE SYS$SHARE:WATCH5_USS ; $ LIBRARY /SHARE /REPLACE SYS$COMMON:[SYSLIB]WATCH5_USS.OLB - ; SYS$COMMON:[SYSLIB]WATCH5_USS.EXE ;-- .PAGE .SBTTL Declarations and Equates ; ; Include Files ; .LIBRARY /SYS$LIBRARY:LIB/ $CCBDEF ; Channel control block offsets $DDBDEF $IPLDEF ; Define IPL levels $PRVDEF $TTYDEF ; Define term driver structures $TTYDEFS ; ditto $TTYMDMDEF ; Define modem control signals $TTYVECDEF ; Define port/class vectors $TT2DEF ; Define terminal chars $SSDEF ; Define system service returns $DVIDEF ; GETDVI definitions $DCDEF ; GETDVI DEVCLASS definitions $DPTDEF $DYNDEF ; Dynamic memory struct types $FKBDEF ; Define fork block $UCBDEF ; UCB$ definitions ;+ ; Macro Definitions ; ; DEFINE_SERVICE - A macro to make the appropriate entries in several ; different PSECTs required to define an EXEC or KERNEL ; mode service. These include the transfer vector, ; the case table for dispatching, and a table containing ; the number of required arguments. ; ; DEFINE_SERVICE Name,Number_of_Arguments,Mode ; .MACRO DEFINE_SERVICE,NAME,NARG=0,MODE=KERNEL .PSECT $$$TRANSFER_VECTOR,PAGE,NOWRT,EXE,PIC .ALIGN QUAD ; Align entry points for speed and style .TRANSFER NAME ; Define name as universal symbol for entry .MASK NAME ; Use entry mask defined in main routine .IF IDN MODE,KERNEL CHMK # ; Change to kernel mode and execute RET ; Return KERNEL_COUNTER=KERNEL_COUNTER+1 ; Advance counter .PSECT KERNEL_NARG,BYTE,NOWRT,EXE,PIC .BYTE NARG ; Define number of required arguments .PSECT USER_KERNEL_DISP1,BYTE,NOWRT,EXE,PIC .SIGNED_WORD 2+NAME-KCASE_BASE ; Make entry in kernel mode CASE table .IFF CHME # ; Change to executive mode and execute RET ; Return EXEC_COUNTER=EXEC_COUNTER+1 ; Advance counter .PSECT EXEC_NARG,BYTE,NOWRT,EXE,PIC .BYTE NARG ; Define number of required arguments .PSECT USER_EXEC_DISP1,BYTE,NOWRT,EXE,PIC .SIGNED_WORD 2+NAME-ECASE_BASE ; Make entry in exec mode CASE table .ENDC ; .ENDM DEFINE_SERVICE ; ; ; Equated Symbols ; $PHDDEF ; Define process header offsets $PLVDEF ; Define PLV offsets and values $SSDEF ; Define system status codes ; ; Initialize counters for change mode dispatching codes ; KERNEL_COUNTER=0 ; Kernel code counter EXEC_COUNTER=0 ; Exec code counter ; ; Own Storage ; .PSECT KERNEL_NARG,BYTE,NOWRT,EXE,PIC KERNEL_NARG: ; Base of byte table containing the ; number of required arguments. .PSECT EXEC_NARG,BYTE,NOWRT,EXE,PIC EXEC_NARG: ; Base of byte table containing the ; number of required arguments. .PAGE .SBTTL Transfer Vector and Service Definitions ;+ ; Define user-accessible entry points in transfer vectors. ;- DEFINE_SERVICE LOAD_CODE,1,KERNEL ; Load and start terminal ; monitor. DEFINE_SERVICE COPY_BUFFER,2,KERNEL ; Retrieve monitor data from ; buffer in non-paged pool. DEFINE_SERVICE SEND,1,KERNEL ; Send 1 character to remote ; terminal. ; ; The base values used to generate the dispatching codes should be negative for ; user services and must be chosen to avoid overlap with any other privileged ; shareable images that will be used concurrently. Their definition is ; deferred to this point in the assembly to cause their use in the preceding ; macro calls to be forward references that guarantee the size of the change ; mode instructions to be four bytes. This satisfies an assumption that is ; made by for services that have to wait and be retried. The PC for retrying ; the change mode instruction that invokes the service is assumed to be 4 bytes ; less than that saved in the change mode exception frame. Of course, the ; particular service routine determines whether this is possible. ; KCODE_BASE=-1024 ; Base CHMK code value for these services ECODE_BASE=-1024 ; Base CHME code value for these services .PAGE .SBTTL Change Mode Dispatcher Vector Block ;++ ; This vector is used by the image activator to connect the privileged shareable ; image to the VMS change mode dispatcher. The offsets in the vector are self- ; relative to enable the construction of position independent images. The system ; version number will be used by the image activator to verify that this shareable ; image was linked with the symbol table for the current system. ; ; Change Mode Vector Format ; ; +------------------------------------------+ ; ! Vector Type Code ! PLV$L_TYPE ; ! (PLV$C_TYP_CMOD) ! ; +------------------------------------------+ ; ! Reserved ! ; ! ! ; +------------------------------------------+ ; ! Kernel Mode Dispatcher Offset ! PLV$L_KERNEL ; ! ! ; +------------------------------------------+ ; ! Exec Mode Entry Offset ! PLV$L_EXEC ; ! ! ; +------------------------------------------+ ; ! User Rundown Service Offset ! PLV$L_USRUNDWN ; ! ! ; +------------------------------------------+ ; ! Reserved ! ; ! ! ; +------------------------------------------+ ; ! RMS Dispatcher Offset ! PLV$L_RMS ; ! ! ; +------------------------------------------+ ; ! Address Check ! PLV$L_CHECK ; ! ! ; +------------------------------------------+ ; ; ; .PSECT USER_SERVICES,PAGE,VEC,PIC,NOWRT,EXE .LONG PLV$C_TYP_CMOD ; Set type of vector to change mode dispatcher .LONG 0 ; Reserved .LONG KERNEL_DISPATCH-. ; Offset to kernel mode dispatcher .LONG EXEC_DISPATCH-. ; Offset to executive mode dispatcher .LONG USER_RUNDOWN-. ; Offset to user rundown service .LONG 0 ; Reserved. .LONG 0 ; No RMS dispatcher .LONG 0 ; Address check - PIC image .PAGE .SBTTL Kernel Mode Dispatcher ;++ ; Input Parameters: ; ; (SP) - Return address if bad change mode value ; ; R0 - Change mode argument value. ; ; R4 - Current PCB Address. (Therefore R4 must be specified in all ; register save masks for kernel routines.) ; ; AP - Argument pointer existing when the change ; mode instruction was executed. ; ; FP - Address of minimal call frame to exit ; the change mode dispatcher and return to ; the original mode. ;-- .PSECT USER_KERNEL_DISP0,BYTE,NOWRT,EXE,PIC KACCVIO: ; Kernel access violation MOVZWL #SS$_ACCVIO,R0 ; Set access violation status code RET ; and return KINSFARG: ; Kernel insufficient arguments. MOVZWL #SS$_INSFARG,R0 ; Set status code and RET ; return KNOTME: RSB ; RSB to forward request KERNEL_DISPATCH:: ; Entry to dispatcher MOVAB W^-KCODE_BASE(R0),R1 ; Normalize dispatch code value BLSS KNOTME ; Branch if code value too low CMPW R1,#KERNEL_COUNTER ; Check high limit BGEQU KNOTME ; Branch if out of range ; ; The dispatch code has now been verified as being handled by this dispatcher, ; now the argument list will be probed and the required number of arguments ; verified. ; MOVZBL W^KERNEL_NARG[R1],R1 ; Get required argument count MOVAL @#4[R1],R1 ; Compute byte count including arg count IFNORD R1,(AP),KACCVIO ; Branch if arglist not readable CMPB (AP),W^[R0] ; Check for required number BLSSU KINSFARG ; of arguments MOVL FP,SP ; Reset stack for service routine CASEW R0,- ; Case on change mode - ; argument value #KCODE_BASE,- ; Base value # ; Limit value (number of entries) KCASE_BASE: ; Case table base address for DEFINE_SERVICE ; ; Case table entries are made in the PSECT USER_KERNEL_DISP1 by ; invocations of the DEFINE_SERVICE macro. The three PSECTS, ; USER_KERNEL_DISP0,1,2 will be abutted in lexical order at link-time. ; .PSECT USER_KERNEL_DISP2,BYTE,NOWRT,EXE,PIC BUG_CHECK IVSSRVRQST,FATAL ; Since the change mode code is validated ; above, we should never get here .PAGE .SBTTL Executive Mode Dispatcher ;++ ; Input Parameters: ; ; (SP) - Return address if bad change mode value ; ; R0 - Change mode argument value. ; ; AP - Argument pointer existing when the change ; mode instruction was executed. ; ; FP - Address of minimal call frame to exit ; the change mode dispatcher and return to ; the original mode. ;-- .PSECT USER_EXEC_DISP0,BYTE,NOWRT,EXE,PIC EACCVIO: ; Exec access violation MOVZWL #SS$_ACCVIO,R0 ; Set access violation status code RET ; and return EINSFARG: ; Exec insufficient arguments. MOVZWL #SS$_INSFARG,R0 ; Set status code and RET ; return ENOTME: RSB ; RSB to forward request EXEC_DISPATCH:: ; Entry to dispatcher MOVAB W^-ECODE_BASE(R0),R1 ; Normalize dispatch code value BLSS ENOTME ; Branch if code value too low CMPW R1,#EXEC_COUNTER ; Check high limit BGEQU ENOTME ; Branch if out of range ; ; The dispatch code has now been verified as being handled by this dispatcher, ; now the argument list will be probed and the required number of arguments ; verified. ; MOVZBL W^EXEC_NARG[R1],R1 ; Get required argument count MOVAL @#4[R1],R1 ; Compute byte count including arg count IFNORD R1,(AP),EACCVIO ; Branch if arglist not readable CMPB (AP),W^[R0] ; Check for required number BLSSU EINSFARG ; of arguments MOVL FP,SP ; Reset stack for service routine CASEW R0,- ; Case on change mode - ; argument value #ECODE_BASE,- ; Base value # ; Limit value (number of entries) ECASE_BASE: ; Case table base address for DEFINE_SERVICE ; ; Case table entries are made in the PSECT USER_EXEC_DISP1 by ; invocations of the DEFINE_SERVICE macro. The three PSECTS, ; USER_EXEC_DISP0,1,2 will be abutted in lexical order at link-time. ; .PSECT USER_EXEC_DISP2,BYTE,NOWRT,EXE,PIC BUG_CHECK IVSSRVRQST,FATAL ; Since the change mode code is validated ; above, we should never get here .PAGE .SBTTL User Rundown Service ;++ ; Functional description: ; This service is invoked from within the kernel mode system service ; that performs image rundown. It is invoked before any system ; rundown functions (i.e. deassign channels, release memory) are ; performed. User code should not invoked any RMS services or RTL ; routines, must not signal any exceptions. User code can invoke ; most system services execpt those that use RMS (e.g. $PUTMSG). ; ; Calling sequence: ; JSB USER_RUNDOWN ; Entered at IPL=0 and must leave at IPL=0. ; ; Input Parameters: ; R4 - Current PCB Address. (Therefore R4 must be specified in all ; register save masks for kernel routines.) ; ; R7 - Access mode parameter to $RUNDWN maximized with previous mode ; ; AP - Argument pointer existing when the $RUNDWN system ; service was invoked. ; ; 4(AP) - Access mode parameter to $RUNDWN ; ;-- .PSECT USER_CODE,BYTE,NOWRT,EXE,PIC USER_RUNDOWN:: ; Entry point for service MOVL POOL_ADDRESS,R0 ; Get pool address BNEQ 10$ RSB ; No pool -- just exit 10$: TSTL UCB-KERNEL_CODE(R0) ; If UCB is zero, there is nothing BEQL 20$ ; to restore ; Non-zero UCB -- jump into pool to restore UCB port/class vectors JSB NONPAGED_RUNDOWN_CODE-KERNEL_CODE(R0) 20$: ; UCB fixed up -- now deallocate pool. MOVL POOL_ADDRESS,R0 ; Get pool address back JSB G^EXE$DEANONPAGED ; Deallocate pool CLRL POOL_ADDRESS ; Clear pool address RSB .PAGE .SBTTL LOAD_CODE ;++ ; Input Parameters: ; 04(AP) - Descriptor of terminal device name to monitor ; R4 - Address of current PCB ; ; Output Parameters: ; R0 - Completion Status Code ;-- .ENTRY LOAD_CODE,^M ; Check user privileges BBC #PRV$V_PHY_IO,- G^CTL$GQ_PROCPRIV,10$ ; User must have PHY_IO, OPER BBC #PRV$V_OPER,- G^CTL$GQ_PROCPRIV,10$ ; and SYSPRV to use this service BBS #PRV$V_SYSPRV,- G^CTL$GQ_PROCPRIV,20$ 10$: MOVL #SS$_NOPRIV,R0 RET 20$: ; Is somebody trying to call us twice? -- naughty, naughty! BLBC LOAD_CODE_DONE,21$ MOVL #SS$_VECINUSE,R0 ; If so, fail RET 21$: ; Validate parameter accessibility MOVL 4(AP),R1 ; Get address of device name descriptor IFNORD #8,(R1),30$ ; Branch if not readable MOVQ (R1),R2 ; Get descriptor into R2/R3 MOVZWL R2,R2 ; Drop descriptor type/class from R0 CMPL R2,#512 ; Device name longer than 512? BGTR 30$ ; If so, IFRD could be spoofed. IFRD R2,(R3),40$ ; Branch if readable 30$: MOVZWL #SS$_ACCVIO,R0 ; Indicate access violation RET ; 40$: ; Allocate pool and copy our non-pageable code and data therein DSBINT #IPL$_ASTDEL ; Prevent process deletion for a moment MOVL #KERN_SIZE,R1 ; Size of pool to get JSB G^EXE$ALONONPAGED ; Get the pool BLBS R0,50$ ; Skip if OK ENBINT RET ; Can't get it! 50$: MOVW R1,- ; Set block size... BLOCK_SIZE-KERNEL_CODE(R2) MOVW #DYN$C_FRK,- ; ...and type BLOCK_TYPE-KERNEL_CODE(R2) CLRL UCB-KERNEL_CODE(R2) ; Clear UCB (in case rundown happens) MOVL R2,POOL_ADDRESS ; Store pointer ENBINT ; Now that pointer is stored the rundown ; handler can take care of deallocation MOVC3 #COPIED_SIZE,- ; Copy our kernel data into the block COPIED_PORTION_START,- ; of pool COPIED_PORTION_START-KERNEL_CODE(R2) ; Lookup device UCB MOVL G^CTL$GL_PCB,R4 ; Get our PCB (destroyed by MOVCx) JSB G^SCH$IOLOCKR ; Lock I/O database for read MOVL 4(AP),R1 ; R1 = device name descriptor JSB G^IOC$SEARCHDEV ; Search for device (R1 = descr address ; R4 = PCB address) BLBS R0,60$ ; Exit on failure JSB G^SCH$IOUNLOCK RET 60$: ; Got UCB in R1 -- validate it as terminal, online, available, etc. CMPB UCB$B_DEVCLASS(R1),- ; Terminal? #DC$_TERM BNEQ 70$ BBC #UCB$V_ONLINE,- UCB$L_STS(R1),70$ ; On-line? BBC #DEV$V_AVL,- UCB$L_DEVCHAR(R1),70$ ; Available? BBS #UCB$V_TEMPLATE,- UCB$L_STS(R1),70$ ; Template device? MOVL UCB$L_TL_PHYUCB(R1),R6 ; Get physical UCB address (if any) BEQL 80$ ; Not a virtual terminal BBS #DEV$V_DET,- UCB$L_DEVCHAR2(R1),70$ ; Disconnected virtual terminal? MOVL R6,R1 BRB 80$ 70$: ; Device is not OK to monitor JSB G^SCH$IOUNLOCK ; Unlock the I/O database MOVL #SS$_DEVOFFLINE,R0 ; Indicate device offline RET 80$: ; Save device UCB MOVL POOL_ADDRESS,R2 MOVL R1,UCB-KERNEL_CODE(R2) ; Save UCB ; Now, branch to the pool and work from there JSB NONPAGED_LOAD_CODE-KERNEL_CODE(R2) BLBC R0,90$ MCOMB #0,LOAD_CODE_DONE ; Indicate successful loading 90$: RET .PAGE .SBTTL COPY_BUFFER ( buffer, length ) - Retrieve data from pool buffer ;+ ; COPY_BUFFER ( buffer, length ) - Retrieve data from non-paged pool ; ; BUFFER - character string, write-only, by descriptor ; ; Buffer to receive data from non-paged ring buffer ; ; LENGTH - unsigned word, write-only, by reference ; ; Number of bytes copied ; ; o Makes sure that LOAD_CODE has been run ; o Copies from the ring buffer in non-paged pool to the "buffer" ; o If there is more space in "buffer" than in the non-paged pool ; ring buffer then copy what is there and set "length" to the ; number of bytes copied. ; o If there is less (or equal) space, copy what will fit and set ; "length" to the size of "buffer" ; o If the overflow bit is set, it will be cleared and SS$_DATAOVERUN ; will be returned as the completion status. ; o If the buffer is empty and the disconnect bit is set, SS$_HANGUP ; will be returned. ;- .ENTRY COPY_BUFFER,^M IFNOWRT #2,@8(AP),20$ ; Target length writeable? MOVL 4(AP),R1 ; Get target buffer descr address => R1 IFNORD #8,(R1),20$ ; Branch if descriptor not readable MOVQ (R1),R2 ; Get descriptor into R2/R3 MOVZWL R2,R2 ; Drop descriptor type/class from R2 MOVL R2,R0 ; Get scratch copy of length in R0 10$: IFNOWRT R0,(R3),20$ ; Branch if buffer area not writable ACBL #0,#-512,R0,10$ ; If longer than 512 bytes, check BRB 30$ ; accessibility of every page. 20$: MOVZWL #SS$_ACCVIO,R0 ; Indicate access violation RET ; 21$: MOVZWL #SS$_HANGUP,R0 ; Indicate no connection RET 30$: BLBC LOAD_CODE_DONE,21$ ; Check whether our software is loaded ; R2 = target length ; R3 = target address MOVL POOL_ADDRESS,R6 ; R6 = pool address BEQL 21$ MOVL FIRST_FULL-KERNEL_CODE(R6),R0 ; R0 = source index SUBL3 R0,FIRST_EMPTY-KERNEL_CODE(R6),R1 ; R1 = source length BEQL 70$ ; If zero, ring buffer is empty BGEQ 40$ ; If positive, source length is OK ADDL2 #RING_BUFFER_SIZE,R1 ; If negative, compensate for wraparound 40$: ; Set transfer size CMPL R2,R1 ; Target buffer smaller than source? BLEQ 50$ ; If smaller (or equal), use target size MOVL R1,R2 ; If larger, use source size 50$: MOVW R2,@8(AP) ; Save transfer length MOVAB -RING_BUFFER_SIZE - ; Tricky calculation to get negative of (R0)[R2],R1 ; bytes remaining before wrap. BGEQ 60$ ; If positive there is data wrap ; If zero, FIRST_FULL will wrap ; No wrap. Just move data and update the pointer. ADDL3 R2,R0,-(SP) ; Save updated value for FIRST_FULL MOVC3 R2,RING_BUFFER-KERNEL_CODE(R6)[R0],(R3) ; Move data POPL FIRST_FULL-KERNEL_CODE(R6) ; Update ring buffer pointer BLBS RING_BUFFER_OVERFLOW-KERNEL_CODE(R6),90$ ; Data overrun? MOVL #SS$_NORMAL,R0 RET 60$: ; Wraparound. Transfer data in two pieces. SUBL3 R0,#RING_BUFFER_SIZE,R1 ; R1 = bytes to move before wrap SUBL3 R1,R2,-(SP) ; save byte count after 1st move MOVC3 R1,RING_BUFFER-KERNEL_CODE(R6)[R0],(R3) ; Move data up to ring buffer end ; R3 is updated automatically MOVC3 (SP),RING_BUFFER-KERNEL_CODE(R6),(R3) ; Move data from ring buffer start POPL FIRST_FULL-KERNEL_CODE(R6) ; Set new FIRST_FULL BLBS RING_BUFFER_OVERFLOW-KERNEL_CODE(R6),90$ ; Data overrun? MOVL #SS$_NORMAL,R0 RET 70$: ; Empty buffer CLRW @8(AP) BLBS DEVICE_DISCONNECTED-KERNEL_CODE(R6),80$ ; Terminal has gone away? BLBS RING_BUFFER_OVERFLOW-KERNEL_CODE(R6),90$ ; Data overrun? MOVL #SS$_NORMAL,R0 RET 80$: MOVL #SS$_HANGUP,R0 ; Indicate terminal gone RET 90$: MOVL #SS$_DATAOVERUN,R0 ; Indicate data overrun RET .PAGE .SBTTL SEND ( char ) - write a character to remote terminal ;+ ; SEND ( char ) - write a character to remote terminal ; ; CHAR - unsigned byte, read-only, by value ; ; o Check that LOAD_CODE has been run ; o Branch to pool ; o Send the character ;- .ENTRY SEND,^M BLBC LOAD_CODE_DONE,10$ ; Code loaded? MOVL POOL_ADDRESS,R0 ; Get pool address BEQL 10$ ; Pool there? JSB NONPAGED_SEND_ROUTINE-KERNEL_CODE(R0) ; Jump in and do it RET ; And return to caller 10$: MOVL #SS$_HANGUP,R0 ; No pool or code not loaded. RET .PSECT LOADED RD,WRT,PIC,NOSHR,EXE,PAGE KERNEL_CODE: .BLKQ 1 BLOCK_SIZE: .BLKW 1 ; Block size BLOCK_TYPE: .BLKW 1 ; DYN$C_FRK INITIALIZED_PORTION_SIZE = .-KERNEL_CODE COPIED_PORTION_START: .PAGE .SBTTL NONPAGED LOAD CODE ; This code continues the LOAD_CODE routine in non-paged context NONPAGED_LOAD_CODE: ; Set up ring buffer pointers. CLRL FIRST_EMPTY ; Set up full and empty pointers to CLRL FIRST_FULL ; indicate empty buffer. CLRB RING_BUFFER_OVERFLOW CLRB DEVICE_DISCONNECTED MOVL UCB,R2 ; Get UCB in R2 ; Lock the device DEVICELOCK - ; lock the device while validating and LOCKADDR=UCB$L_DLCK(R2),- ; saving the port and class vectors SAVIPL=-(SP) MOVL @#TTY$GL_DPT,R0 ; Get generic terminal DPT MOVZWL DPT$W_VECTOR(R0),R1 ; Offset to class vector ADDL2 R0,R1 ; Address of class vector table CMPL R1,UCB$L_TT_CLASS(R2) ; Class table untouched? BNEQ 20$ ; Changed, don't monitor CMPL (R1),- ; GETNXT changed? UCB$L_TT_GETNXT(R2) BNEQ 20$ CMPL 4(R1),- ; PUTNXT been altered? UCB$L_TT_PUTNXT(R2) BEQL 30$ 20$: ; Non-standard class vectors DEVICEUNLOCK - LOCKADDR=UCB$L_DLCK(R2),- NEWIPL=(SP)+,- CONDITION=RESTORE,- PRESERVE=YES JSB @#SCH$IOUNLOCK ; Don't monitor. MOVL #SS$_VECINUSE,R0 RSB 30$: ; UCB is OK to monitor. ; Save port vector and build modified port vector table MOVL UCB$L_TT_PORT(R2),R0 ; R0 points to original port table MOVL R0,SAVED_PORT ; Save port table pointer MOVAL PORT_TABLE,R1 ; R1 points to our modified port table PUSHR #^M ; Save across MOVC MOVC3 #PORT_LENGTH,(R0),(R1) ; Copy original port to our copy POPR #^M ; Restore registers MOVL PORT_STARTIO(R0),- SAVED_PORT_STARTIO ; Save old port startio MOVAB GRAB_PORT_STARTIO,- PORT_STARTIO(R1) ; Point new to hook code MOVL PORT_DISCONNECT(R0),- SAVED_PORT_DISCONNECT ; Save old port disconnect MOVAB GRAB_PORT_DISCONNECT,- PORT_DISCONNECT(R1) ; Set new disconnect ; Save class vector and build modified class vector table MOVL UCB$L_TT_CLASS(R2),R0 ; R0 points to original class table MOVL R0,SAVED_CLASS ; Save class table pointer MOVAL CLASS_TABLE,R1 ; R1 points to our copied table PUSHR #^M ; Save registers MOVC3 #CLASS_LENGTH,(R0),(R1) ; Copy class vector POPR #^M ; Restore regs MOVL CLASS_GETNXT(R0),- SAVED_CLASS_GETNXT ; Save original getnxt vector MOVAL GRAB_CLASS_GETNXT,- CLASS_GETNXT(R1) ; Set new getnxt vector MOVL CLASS_PUTNXT(R0),- SAVED_CLASS_PUTNXT ; Save original putnxt vector MOVAL GRAB_CLASS_PUTNXT,- CLASS_PUTNXT(R1) ; Set new putnxt vector MOVL CLASS_DISCONNECT(R0),- SAVED_CLASS_DISCONNECT ; Save original class disconect vector MOVAL GRAB_CLASS_DISCONNECT,- CLASS_DISCONNECT(R1) ; Set new class disconnect vector ; Update the UCB with new GETNXT and PUTNXT entries in the ; UCB and modified port and class transfer vector tables. MOVAL GRAB_CLASS_GETNXT,- ; Hook up GETNXT routine UCB$L_TT_GETNXT(R2) ; MOVAL GRAB_CLASS_PUTNXT,- ; Hook up PUTNXT routine UCB$L_TT_PUTNXT(R2) MOVAL CLASS_TABLE,- ; Switch class vector table UCB$L_TT_CLASS(R2) MOVAL PORT_TABLE,- ; Switch port vector table UCB$L_TT_PORT(R2) DEVICEUNLOCK - LOCKADDR=UCB$L_DLCK(R2),- NEWIPL=(SP)+,- CONDITION=RESTORE,- PRESERVE=YES JSB @#SCH$IOUNLOCK MOVL #SS$_NORMAL,R0 ; Set normal status RSB ; All done .PAGE .SBTTL NONPAGED RUNDOWN CODE NONPAGED_RUNDOWN_CODE: ; This routine is called by the user rundown handler to restore the ; target UCB's original port and class vectors. It is also called by ; the PORT_DISCONNECT and CLASS_DISCONNECT routines when the terminal ; is being disconnected. It destroys R0 and R1. MOVL UCB,R1 ; Get UCB BNEQ 10$ RSB ; UCB is zero -- nothing to restore 10$: ; Lock device UCB for modification DEVICELOCK - LOCKADDR=UCB$L_DLCK(R1),- SAVIPL=-(SP) MOVL SAVED_CLASS_PUTNXT,R0 ; Get saved putnxt vector BEQL 20$ ; Skip if zero MOVL R0,UCB$L_TT_PUTNXT(R1) ; Restore putnxt vector in UCB 20$: MOVL SAVED_CLASS_GETNXT,R0 ; Get saved getnxt vector BEQL 30$ ; Skip if zero MOVL R0,UCB$L_TT_GETNXT(R1) ; Restore getnxt vector in UCB 30$: MOVL SAVED_CLASS,R0 ; Get saved class table address BEQL 40$ ; Skip if zero MOVL R0,UCB$L_TT_CLASS(R1) ; Restore class table 40$: MOVL SAVED_PORT,R0 ; Get saved port table address BEQL 50$ ; Skip if zero MOVL R0,UCB$L_TT_PORT(R1) ; Restore port vector table 50$: CLRL UCB ; Clear UCB pointer (nonpaged copy) ; Finished restoring original class/port vectors. Unlock device ; and return to pageable context. DEVICEUNLOCK - LOCKADDR=UCB$L_DLCK(R1),- NEWIPL=(SP)+,- CONDITION=RESTORE,- PRESERVE=YES RSB .PAGE .SBTTL COPY_DATA_TO_BUFFER - Common subroutine to copy data to buffer ;+ ; Called from GRAB_PORT_STARTIO, GRAB_CLASS_GETNXT and GRAB_CLASS_PUTNXT ; to copy output data to the ring buffer. In all cases: ; ; R0 = First I/O status longword (unused by us) ; R3 = Character to be output if UCB$B_TT_OUTTYPE = 1 ; R5 = UCB address ; UCB$B_TT_OUTTYPE = 0 for no op ; = positive for 1 character to output ; = negative for burst of more than 1 character ; UCB$L_TT_OUTADR = address of output if UCB$B_TT_OUTTYPE is negative ; UCB$W_TT_OUTLEN = length of output if UCB$B_TT_OUTTYPE is negative ;- COPY_DATA_TO_BUFFER: TSTB UCB$B_TT_OUTYPE(R5) ; Zero, one or more characters to do? BEQL 20$ ; Zero -- do nothing BLSS 40$ ; Burst of more than one character ;+ ; Put one character into ring buffer ;- PUSHL R0 ; Save R0 MOVL FIRST_EMPTY,R0 ; Get index to next available slot MOVB R3,RING_BUFFER[R0] ; Stick the character in the slot AOBLSS #RING_BUFFER_SIZE,R0,10$; Update index and check for wraparound CLRL R0 ; Wraparound 10$: CMPL R0,FIRST_FULL ; Check for buffer overflow BEQL 30$ ; No overflow MOVL R0,FIRST_EMPTY ; Update buffer pointer POPL R0 ; Restore R0 20$: RSB ; Return 30$: ; Overflow MCOMB #0,RING_BUFFER_OVERFLOW ; Set overflow indicator POPL R0 ; Restore R0 RSB ; Return ;+ ; Put burst of characters in ring buffer ;- 40$: PUSHR #^M ; Save registers MOVL FIRST_EMPTY,R0 ; R0 = destination index MOVL UCB$L_TT_OUTADR(R5),R1 ; R1 = source address MOVZWL UCB$W_TT_OUTLEN(R5),R2 ; R2 = transfer length ; Check for available space SUBL3 R0,FIRST_FULL,R3 ; R3 = full index - empty index BGTR 50$ ; If result is negative, add buffer size ADDL2 #RING_BUFFER_SIZE,R3 ; to get true free space. 50$: DECL R3 ; Offset by 1 since circular buffer ; cannot utilize very last byte. CMPL R3,R2 ; Enough space? BGEQ 60$ MOVL R3,R2 ; No. Set transfer size to available MCOMB #0,RING_BUFFER_OVERFLOW ; space and set overflow bit. 60$: MOVAB -RING_BUFFER_SIZE - ; R3 = R0 + R2 - BUFFER_SIZE (R2)[R0],R3 BGEQ 70$ ; If positive, there is data wrap. ; If zero, FIRST_EMPTY has to wrap. ; No wraparound ADDL2 R2,FIRST_EMPTY ; Update next available slot before R2 ; is destroyed. This leaves the buffer ; in an inconsistent state momentarily, ; but we're in kernel mode, so the user ; can't get in before it's OK again. MOVC3 R2,(R1),RING_BUFFER[R0] ; Copy the characters to the buffer POPR #^M ; Restore registers RSB ; Return 70$: ; Transfer will wrap at end of ring buffer SUBL3 R0,#RING_BUFFER_SIZE,R3 ; R3 = available space before wrap SUBL3 R3,R2,FIRST_EMPTY ; Save remaining transfer size (and ; update next available slot!) Since ; we're in kernel mode, user won't see ; this inconsistent setting until we've ; made the buffer consistent again. MOVC3 R3,(R1),RING_BUFFER[R0] ; Copy up to buffer end MOVC3 FIRST_EMPTY,(R1),- ; Copy remainder RING_BUFFER POPR #^M RSB .PAGE .SBTTL NONPAGED_SEND_ROUTINE NONPAGED_SEND_ROUTINE: MOVL UCB,R5 ; Get UCB pointer BEQL 30$ ; Quit if none MOVL 4(AP),R3 ; Get character DEVICELOCK - ; Go to device IPL LOCKADDR=UCB$L_DLCK(R5),- SAVIPL=-(SP) JSB @SAVED_CLASS_PUTNXT ; Call putnxt routine to send char TSTB UCB$B_TT_OUTYPE(R5) ; Any echo to process? BEQL 10$ ; No echo (or port driver busy) BSBW GRAB_PORT_STARTIO ; Get the echo and start the port ; driver on the remote terminal's own ; echo. 10$: DEVICEUNLOCK - ; Return to normal IPL LOCKADDR=UCB$L_DLCK(R5),- NEWIPL=(SP)+,- CONDITION=RESTORE,- PRESERVE=YES MOVL #SS$_NORMAL, R0 ; Normal exit RSB 30$: MOVL #SS$_HANGUP,R0 RSB .PAGE .SBTTL GRAB_PORT_STARTIO - Hook to copy data into ring buffer ;+ ; This routine is called at device IPL to send ; the data to the port driver. ; ; R0 = First I/O status longword (unused by us) ; R3 = Character to be output if UCB$B_TT_OUTYPE = 1 ; (Condition codes are set according to the value of R3) ; R5 = UCB address ; UCB$B_TT_OUTYPE = 0 for no op ; = positive for 1 character to output ; = negative for burst of more than 1 character ; UCB$L_TT_OUTADR = address of output if UCB$B_TT_OUTTYPE is negative ; UCB$W_TT_OUTLEN = length of output if UCB$B_TT_OUTTYPE is negative ; ; We'll call COPY_DATA_TO_BUFFER to copy the data to the ring buffer ; and then chain to the real PORT_STARTIO routine. ;- GRAB_PORT_STARTIO: JSB COPY_DATA_TO_BUFFER ; Copy data to buffer (preserving reg's) TSTB UCB$B_TT_OUTYPE(R5) ; Reset condition code JMP @SAVED_PORT_STARTIO ; Call original port startio routine .PAGE .SBTTL GRAB_CLASS_GETNXT - Hook to copy data into ring buffer ;+ ; This routine is called at device IPL by the port driver to ask for some ; more print data from the class driver. ; ; After calling the real CLASS_GETNXT routine the port driver expects: ; ; R1 = destroyed ; R2 = number of characters (if R3 contains an address) ; R3 = character to be output (if UCB$B_TT_OUTYPE is positive) ; address of characters to be output (if UCB$B_TT_OUTYPE is negative) ; nothing if UCB$B_TT_OUTYPE is zero ; (condition code set based on value in R3) ; R4 = destroyed ; R5 = UCB address ; UCB$B_TT_OUTYPE = 0 for no op ; = positive for 1 character to output ; = negative for burst of more than 1 character ; UCB$L_TT_OUTADR = address of output if UCB$B_TT_OUTYPE is negative ; UCB$W_TT_OUTLEN = length of output if UCB$B_TT_OUTYPE is negative ; ; We'll call the real CLASS_GETNXT to set the registers as above. Then ; we'll call COPY_DATA_TO_BUFFER to copy the data to the ring buffer. ;- GRAB_CLASS_GETNXT: JSB @SAVED_CLASS_GETNXT ; Ask class driver for output data JSB COPY_DATA_TO_BUFFER ; Copy it to the buffer TSTB UCB$B_TT_OUTYPE(R5) ; Reset condition code RSB ; Return to port driver .PAGE .SBTTL GRAB_CLASS_PUTNXT - Hook to copy data into ring buffer ;+ ; This routine is called at device IPL by the port driver to send input ; data to the class driver. After the call, the real class PUTNXT routine ; calls CLASS_GETNXT to return any echo to the caller as follows: ; ; R1 = destroyed ; R2 = number of characters (if R3 contains an address) ; R3 = character to be output (if UCB$B_TT_OUTYPE is positive) ; address of characters to be output (if UCB$B_TT_OUTYPE is negative) ; nothing if UCB$B_TT_OUTYPE is zero ; (condition code set based on value in R3) ; R4 = destroyed ; R5 = UCB address ; UCB$B_TT_OUTYPE = 0 for no op ; = positive for 1 character to output ; = negative for burst of more than 1 character ; UCB$L_TT_OUTADR = address of output if UCB$B_TT_OUTTYPE is negative ; UCB$W_TT_OUTLEN = length of output if UCB$B_TT_OUTTYPE is negative ; ; We'll call the real CLASS_PUTNXT to set the registers as above. Then ; we'll call COPY_DATA_TO_BUFFER to copy the data to the ring buffer. ;- GRAB_CLASS_PUTNXT: JSB @SAVED_CLASS_PUTNXT ; Ask class driver for output data JSB COPY_DATA_TO_BUFFER ; Copy it to the buffer TSTB UCB$B_TT_OUTYPE(R5) ; Reset condition code RSB ; Return to port driver .PAGE .SBTTL GRAB_CLASS_DISCONNECT - Hook to notice UCB going bye bye ;+ ; The port driver calls this entry point to notify the class driver that the ; terminal is no longer connected to the system. Our response is to clean ; up the UCB, removing our hooks and then call the real CLASS_DISCONNECT ; routine. We'll set the DEVICE_DISCONNECTED flag so that the COPY_BUFFER ; routine will eventually realize that the terminal is gone. Pool will be ; deallocated by the user rundown handler. ;- GRAB_CLASS_DISCONNECT: PUSHQ R0 ; Save registers JSB NONPAGED_RUNDOWN_CODE ; Clean up UCB MOVQ (SP)+,R0 ; Restore registers MCOMB #0,DEVICE_DISCONNECTED ; Set disconnect flag JMP @SAVED_CLASS_DISCONNECT .PAGE .SBTTL GRAB_PORT_DISCONNECT - Hook to notice user going away ;+ ; The class driver calls this entry point to notify the port driver that the ; last channel to the terminal has been deassigned. ; ; If the R0 bit 0 (NOHANGUP) is set then the UCB is going to stick around. ; We'll keep monitoring. ; ; Otherwise, if UCB$V_DELMBX in UCB$W_DEVSTS is set, the UCB is going away. ; We'll clean up and get out. ; ; Otherwise, we need to check unit 0 to see if it is a template device. LAT ; devices in particular do not set the UCB$V_DELMBX bit, but still delete the ; UCB. We chain to UCB$L_DDB => DDB$L_UCB => UCB$L_STS and check UCB$V_TEMPLATE ; and UCB$V_ONLINE. If the first unit is off-line or is a template, we assume ; that the port driver is going to delete our UCB and we clean up and get out ; now. ;- GRAB_PORT_DISCONNECT: BLBS R0,20$ ; If NOHANGUP is requested, stay alive BBS #UCB$V_DELMBX,- ; If UCB will go away, clean up UCB$W_DEVSTS(R5),10$ MOVL UCB$L_DDB(R5),R0 ; Chain to DDB MOVL DDB$L_UCB(R0),R0 ; Chain to UCB of first unit BBS #UCB$V_TEMPLATE,- ; If first unit is a template then UCB$L_STS(R0),10$ ; clean up and get out. BBS #UCB$V_ONLINE,- ; If first unit is on-line then UCB$L_STS(R0),20$ ; we're still OK. ; UCB is going away, clean up our hooks and indicate disconnect. 10$: PUSHQ R0 ; Save registers JSB NONPAGED_RUNDOWN_CODE ; Clean up UCB MOVQ (SP)+,R0 ; Restore registers MCOMB #0,DEVICE_DISCONNECTED ; Set disconnect flag ; In any case, call the port disconnect routine 20$: JMP @SAVED_PORT_DISCONNECT .ALIGN LONG UCB: .LONG 0 ; UCB being monitored ; Saved and modified port and class vector tables SAVED_CLASS: .LONG 0 ; Original class vector table address SAVED_PORT: .LONG 0 ; Original port vector table address PORT_TABLE: .BLKB PORT_LENGTH ; Copied/munged port vector table SAVED_PORT_STARTIO: .LONG 0 ; Gets original port startio vector SAVED_PORT_DISCONNECT: .LONG 0 ; Gets original port disconnect vector CLASS_TABLE: .BLKB CLASS_LENGTH ; Copied/munged class vector SAVED_CLASS_GETNXT: .LONG 0 ; Gets original class getnxt vector SAVED_CLASS_PUTNXT: .LONG 0 ; Gets original class putnxt vector SAVED_CLASS_DISCONNECT: .LONG 0 ; Gets original class disconnect vector RING_BUFFER_SIZE = 4096 RING_BUFFER: .BLKB RING_BUFFER_SIZE FIRST_EMPTY: .BLKL 1 FIRST_FULL: .BLKL 1 RING_BUFFER_OVERFLOW: .BLKB 1 DEVICE_DISCONNECTED: .BLKB 1 COPIED_SIZE=.-COPIED_PORTION_START KERN_SIZE=.-KERNEL_CODE POOL_ADDRESS: .LONG 0 LOAD_CODE_DONE: .BYTE 0 .END