.MCALL .MODULE .MODULE MTTINT, VERSION=3501, COMMENT= ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the ; inclusion of the above copyright notice. This software, or ; any other copies thereof, may not be provided or otherwise ; made available to any other person except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. .Sbttl Post Release Edit History ;+ ; ; (35/01) 10-Feb-95 Megan Gentry ; Add similar modifications already made to RMON for processing ; of RUBOUT/CTRLU and addition of CTRL-R processing ; ;- .NLIST CND .SBTTL ****************************************** .SBTTL * Multi-Terminal Interrupt Service For * .IF NE MMG$T .IF NE SB .SBTTL * The Extended Background (XB) Monitor * .IFF ;NE SB .SBTTL * The Extended Memory (XM) Monitor * .ENDC ;NE SB .IFF ;NE MMG$T .IF NE RTE$M .SBTTL * The RT-11 Emulator (RTEM) Monitor * .IFF ;NE RTE$M .IF NE SB .SBTTL * The Single Background (SB) Monitor * .IFF ;NE SB .SBTTL * The Foreground/Background (FB) Monitor * .ENDC ;NE SB .ENDC ;NE RTE$M .ENDC ;NE MMG$T .SBTTL ****************************************** .SBTTL Macro Calls .LIST CND .LIBRARY "SRC:EDTL.MLB" .LIBRARY "SRC:SYSTEM.MLB" ; .LIBRARY "SRC:HARDWA.MLB" ;+ ; Programmed Request and Miscellaneous Utility Macros ;- .MCALL .ADDR .ASSUME .BR ;SYSMAC ;+ ; Structure Definition Macros ;- .MCALL .IBKDF .IMPDF .INDDF .QELDF .QFKDF ;SYSTEM .MCALL .QTIDF .STWDF .SYCDF .TASDF .TCBDF ;SYSTEM .MCALL .TCFDF .TC2DF .THKDF .TSTDF ;SYSTEM ; Invoke structure definition macros .IBKDF ;I.BLOK Blocking Condition Bit Definitions FIX$ED=0 ;generate floating symbols .IMPDF ;Impure Area Layout FIX$ED=1 .INDDF ;INDSTA, IND Status Byte Bit Definitions .QELDF ;Queue Element Definition .QFKDF ;Fork Queue Block Format .QTIDF ;Timer Queue Element Format Definitions .SYCDF ;$SYCOM Definitions .STWDF ;STATWD Describes Current DCL/@File Status .TASDF ;Asynchronous Terminal Status Word Supplied by User FIX$ED=0 ;generate floating symbols .TCBDF ;Terminal Control Block Definitions FIX$ED=1 .TCFDF ;Terminal Configuration Bits .TC2DF ;T.CNF2 Second Terminal Status Word .THKDF ;Multi-terminal hooks data structure .TSTDF ;T.STAT Contains Dynamic Terminal Status ; Delete structure definition macros (free up workfile space) .MDELET .IBKDF .IMPDF .INDDF .QELDF .QFKDF .QTIDF .STWDF .MDELET .SYCDF .TASDF .TCBDF .TCFDF .TC2DF .THKDF .TSTDF .SBTTL Macro Definitions ;+ ; (Unused, kept for future use. Coded to work with RMON's PSW patch list.) ; ; .MACRO SPL N ; ; Set Priority to 'N', Fast ;- .MACRO SPL N .IIF NDF PSWMTI, PSW1ST: .IF NE < . - PSW1ST > .WORD PSWMTI .IFF .WORD PSWLST .ENDC PSWMTI == < . - 2 > .IF EQ N .WORD < -2 > .IFF .WORD < N * 40 >, PS .ENDC .ENDM SPL ;+ ; .MACRO GETPSW ; ; Push the PSW on the Stack, Fast ;- .MACRO GETPSW .IIF NDF PSWMTI, PSW1ST: .IF NE < . - PSW1ST > .WORD PSWMTI .IFF .WORD PSWLST .ENDC .WORD < -4 > PSWMTI == < . - 4 > .ENDM GETPSW ;+ ; (Unused, kept for future use. Coded to work with RMON's PSW patch list.) ; ; .MACRO PUTPSW ; ; Pop a Stack Word to the PSW, Fast ;- .MACRO PUTPSW .IIF NDF PSWMTI, PSW1ST: .IF NE < . - PSW1ST > .WORD PSWMTI .IFF .WORD PSWLST .ENDC .WORD < -6 > PSWMTI == < . - 4 > .ENDM PUTPSW .SBTTL Definition Of Symbols UNIMSK ==: 17 ;DL/DZ/DH unit # mask in PSW .SBTTL DL Interface Definitions ; Definition of offsets from (DL11) receiver CSR T.CNFG ==: 000000 ;offset for TCB config word 1 ;>>> ;use .TCBDf later T.TKS ==: 0 ;Receiver CSR T.TKB ==: 2 ;Receiver data buffer T.TPS ==: 4 ;Transmitter CSR T.TPB ==: 6 ;Transmitter data buffer ; DL11E/DLV11E modem status bits: DLDSI$ ==: 100000 ;Data set interrupt DLRI$ ==: 040000 ;Ring Indicator DLCTS$ ==: 020000 ;Clear To Send DLDCD$ ==: 010000 ;Data Carrier Detect DLRA$ ==: 004000 ;Receiver Active DLSRD$ ==: 002000 ;Secondary Received Data ; 001000 ;reserved ; 000400 ;reserved DLRD$ ==: 000200 ;Receiver Done DLRIE$ ==: 000100 ;Receiver Interrupt Enable DLDIE$ ==: 000040 ;Dataset Interrupt Enable ; 000020 ;Reserved DLSTD$ ==: 000010 ;Secondary Transmit Data DLRTS$ ==: 000004 ;Request To Send DLDTR$ ==: 000002 ;Data Terminal Ready ; Receiver buffer register DLERR$ ==: 100000 ;Error (OR of the following) DLOE$ ==: 040000 ;Overrun Error DLFE$ ==: 020000 ;Framing Error DLPE$ ==: 010000 ;Parity Error DLRCM$ ==: 000377 ;Received Character Mask ; Transmitter status register DLTIE$ ==: 000100 ;Transmitter Interrupt Enable DLBRK$ ==: 000001 ;Break .IF NE DZ11$N .SBTTL DZ Multiplexor Interface Definitions ; Control and Status Register (RW) DZ.CSR ==: 0 DZTRD$ ==: 100000 ;Transmit ready (R) DZTIE$ ==: 040000 ;Transmit interrupt enable (RW) DZSAL$ ==: 020000 ;Silo alarm (R) - silo has 16 characters in it DZSAE$ ==: 010000 ;Silo alarm enable (RW) - interrupt only if 16 chars DZTRL$ ==: 003400 ;Transmitter line number (R) - valid if tr. ready DZRDN$ ==: 000200 ;Receiver done (R) - character in silo DZRCV$ ==: 000100 ;Receiver interrupt enable (RW) DZMSE$ ==: 000040 ;Master scan enable (RW) - enable line scanning DZCLR$ ==: 000020 ;Master clear (RC) - initialize DZ-11 (self clearing) DZMNT$ ==: 000010 ;Maintenance mode (RW) - connect output to input ; Receiver buffer (R) ; Each DATAI removes a character from the silo ; Access only with MOV's, do not write DZ.RBUF ==: 2 DZDVD$ ==: 100000 ;Data valid - bits 0-14 valid, character is in silo DZOVR$ ==: 040000 ;Overrun - character lost DZFRM$ ==: 020000 ;Framing error - break detection DZPAR$ ==: 010000 ;Parity error DZRCL$ ==: 003400 ;Mask for line number of character DZICH$ ==: 000377 ;Mask for input character ; Line parameter register (W) ; Access only with MOV's DZ.LPR ==: 2 DZRCO$ ==: 010000 ;Receiver enable DZSPD$ ==: 007400 ;Mask for receive and transmit speeds: ; 0000 - 50 baud 0400 - 75 baud ; 1000 - 110 baud 1400 - 134.5 baud ; 2000 - 150 baud 2400 - 300 baud ; 3000 - 600 baud 3400 - 1200 baud ; 4000 - 1800 baud 4400 - 2000 baud ; 5000 - 2400 baud 5400 - 3600 baud ; 6000 - 4800 baud 6400 - 7200 baud ; 7000 - 9600 baud 7400 - Unused DZEPR$ ==: 000200 ;Odd parity (0 => even), valid only if parity enabled DZNPR$ ==: 000100 ;Parity enable (receive and transmit) DZSTP$ ==: 000040 ;Stop code length: ; 00 - 1 unit stop ; 40 - 2 unit stop (1.5 where 5 bit characters) DZLEN$ ==: 000030 ;Character length (receive and transmit): ; 00 - 5 Bit 20 - 7 Bit ; 10 - 6 Bit 30 - 8 Bit DZLIN$ ==: 000007 ;Parameter line number - line to set parameters for ; Note: do not use lines > 4 on DZV11 DZANS$ =: ;Initial line characteristics ; Transmitter control register (RW, byte) ; One bit per line (1 = line 0, ...) ; Set enables transmit on line DZ.TCR ==: 4 ; Data Terminal Ready (RW, byte) ; One bit per line ; Set turns on DTR on modem DZ.DTR ==: 5 ; Ring Detected (R, byte) ; Do not write, Use only MOVB's to read ; One bit per line ; Set indicates line is ringing ; Does not cause an interrupt DZ.RNG ==: 6 ; Transmit Data Register (W, byte) ; Use only MOVB's to set ; Sends a character to the line selected in DZTRL$ DZ.TDR ==: 6 ; Carrier Detect (R, byte) ; Do not write, Use only MOVB's to read ; One bit per line ; Set indicates carrier present on line DZ.CAR ==: 7 ; Break enable (W, byte) ; Do not read, Use only MOVB's to set ; One bit per line ; Set to enable break on the line DZ.BRK ==: 7 .ENDC ;NE DZ11$N .IF NE DH11$N .SBTTL DH Multiplexor Interface Definitions ; Device Lines Mode Modem Interface ; DHF11 32 DHU, DHV No Fiber Optic ; DHQ11 8 DHV Yes EIA-232-D, RS-423-A ; DHU11 16 DHU Yes RS-423-A, RS-232-C ; DHV11 8 DHV Yes RS-423-A, RS-232-C ; CXA16 16 DHU, DHV No RS-423-A ; CXB16 16 DHU, DHV No RS-422-A ; CXY08 8 DHV, DHU Yes EIA-232-D ; CXF32 32 DHU, DHV No Fiber Optic ; DHV-mode register definitions DH.CSR ==: 0 ;Control and Status Register (RW) DH.RBF ==: 2 ;Receive Buffer (R) DH.TXC ==: 2 ;Transmit character (W)(I) DH.LPR ==: 4 ;Line parameter register (RW)(I) DH.LSR ==: 6 ;Line status register (R)(I) DH.LCR ==: 10 ;Line control register (RW)(I) DH.BAL ==: 12 ;Transmit buffer address lo (RW)(I) DH.BAH ==: 14 ;Transmit buffer address hi (RW)(I) DH.TBC ==: 16 ;Transmit buffer count (RW)(I) ; DHU-mode register definitions DH.RXT ==: 2 ;Receive timer (WB) DH.FDA ==: 6 ;Fifo data (W[B])(I) DH.FSZ ==: 6 ;Fifo size (RB)(I) ; Control and status register bit definitions DHTAC$ ==: 100000 ;Transmitter action (R) DHTIE$ ==: 040000 ;Transmit interrupt enable (RW) DHDF$ ==: 020000 ;Diagnostic fail (R) DHTDE$ ==: 010000 ;Transmit DMA error (R) DHTLM$ ==: 007400 ;Transmit line mask (R) DHRDA$ ==: 000200 ;Received data available (R) DHRIE$ ==: 000100 ;Receiver interrupt enable (RW) DHMR$ ==: 000040 ;Master reset (RW) DHSST$ ==: 000020 ;Skip self-test (RW) DHIRM$ ==: 000017 ;Indirect address register mask (RW) ; Receive buffer bit definitions DHDV$ ==: 100000 ;Data valid (R) DHOE$ ==: 040000 ;Overrun error (R) DHFE$ ==: 020000 ;Framing error (R) DHPE$ ==: 010000 ;Parity error (R) DHRLM$ ==: 007400 ;Receive line mask (R) DHRCM$ ==: 000377 ;Received character mask (R) ; Transmit character register bit definitions [DHV-mode] DHTDV$ ==: 100000 ;Transmit data valid (W) DHTCM$ ==: 000377 ;Transmit character mask (W) ; Receive timer register [DHU-mode] DHRTM$ ==: 000377 ;Receive timer mask (W) ; Line parameter register bit definitions DHTSM$ ==: 170000 ;Transmit speed mask (RW) DHRSM$ ==: 007400 ;Receive speed mask (RW) DHSC$ ==: 000200 ;Stop code (RW) ; 0 = 1 unit stop ; 1 = 1.5 or 2 unit stop DHEP$ ==: 000100 ;Even parity (RW) DHPEN$ ==: 000040 ;Parity enable (RW) DHCLM$ ==: 000030 ;Character length mask (RW) ; 00 = 5 bits 01 = 6 bits ; 10 = 7 bits 11 = 8 bits DHDCM$ ==: 000006 ;Diagnostic code mask (RW) ; 00 = Normal operation ; 01 = Report status DHDXR$ ==: 000001 ;Disable XON/XOFF reporting (RW) ; Line status register bit definitions DHDSR$ ==: 100000 ;Data set ready (R) DHRI$ ==: 020000 ;Ring indicator (R) DHDCD$ ==: 010000 ;Data carrier detect (R) DHCTS$ ==: 004000 ;Clear to send (R) DHMDL$ ==: 001000 ;Modem support low (R) DHUID$ ==: 000400 ;DHU ID (R) DHFSZ$ ==: 000377 ;DHU-mode: Fifo size (R) ; Fifo data register [DHU-mode] DHC2M$ ==: 177400 ;2nd of two characters for transmit (W) DHC1M$ ==: 000377 ;1st or only character for transmit (WB) ; Line control register bit definitions DHRTS$ ==: 010000 ;Request to send (RW) DHDTR$ ==: 001000 ;Data terminal ready (RW) DHLT$ ==: 000400 ;Link type (RW) ; 0 = data leads only ; 1 = modem control DHMMM$ ==: 000300 ;Maintenance mode mask (RW) ; 00 = Normal 01 = Auto echo ; 10 = Local loopback 11 = Remote loopback DHFXO$ ==: 000040 ;Force XOFF (RW) DHOAF$ ==: 000020 ;Outgoing auto flow (RW) DHBRK$ ==: 000010 ;Break control (RW) DHREN$ ==: 000004 ;Receiver enable (RW) DHIAF$ ==: 000002 ;Incoming auto flow (RW) DHTAB$ ==: 000001 ;Transmit abort (RW) ; Transmit buffer address 1 bit definitions ; Bits <15:00> of address ; Transmit buffer address 2 bit definitions DHTEN$ ==: 100000 ;Transmitter enable (RW) DHTDS$ ==: 000200 ;Transmit DMA start (RW) DHBAH$ ==: 000077 ;Buffer address (hi-order) (RW) ; Transmit buffer count register ; Bits <15:00> of unsigned character count ; DH Controller information table offsets DHI.CA =: 0 ;Controller base CSR DHI.TP =: 2 ;Pointer to first TCB for controller DHI.MX =: 4 ;Pointer beyond last TCB for same DHI.NL =: 6 ;Number of lines used this controller ; =: 7 ;reserved DHI.SZ ==: 10 ;Size of controller information table entry ; Miscellaneous DH definitions DHPRI =: PR4 ;DH interrupt priority DHSPSK ==: 5400 ;DZ -> DH Speed code skew (3600 baud on DZ) .ENDC ;NE DH11$N .SBTTL DLIINT - DL11 Input Interrupt Service .PSECT MTINT$ ;+ ; DLIINT - DL11 Input Interrupt ; ; Common code services input interrupts for all DL11's on the system ; DLIINT is entered once per character ; It calls INCHAR to process it and insert it in the ring buffer ;- ;+ ; TTIINT (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap code hooks this location with: ; ; NOP ; NOP ; ; This allows for the fact that the RTEM-11 terminal ; service will have the condition codes stacked when ; it fakes a input interrupt. ;- ;+ ; TTIINT (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALLR TTIIN1 ; ; TTIIN1 gets the keyboard matrix code from the PRO300 series processor ; keyboard and converts it to ASCII and stores this character in the ; pseudo-keyboard receiver buffer KBDBUF in PI. ; ; TTIIN1 will call us back at TTIIN2. ;- .ENABL LSB DLIINT:: TTIINT:: ;(*** PRO300 HOOK ***) .IF GT GETPSW ;Fetch condition code bits MOV (SP)+,DLTMP ;Save them to get the line number later .ENDC ;GT ;+ ; DLIHOK (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap code hooks this location with: ; ; JSR R5,$INTN ; ; The routine $INTN is located in the RTEM-11 linkage ; routines. This allows input inturrupts to be serviced ; correctly under RTEM-11. ;- DLIHOK:: ;(*** RTEM-11 HOOK ***) JSR R5,$INTEN ;Declare an interrupt .WORD < ^c & PR7 > ;Run at priority 4 TTIIN2:: .IF EQ HSR$B JSR R3,SAVE30 ;Save R3-R0 .IF GT MOV DLTMP,R4 ;Get the interrupt PSW BIC #^c,R4 ;Isolate the DL unit number ASL R4 ;Double it for word index PDLTB0 ==: < . + 2 > ;**BOOT** Relocate address of DL TCB pointers table MOV DLTBL(R4),R3 ;Get pointer to this unit's TCB .IFF ;GT MOV DLTBL,R3 ;Get pointer to console TCB .ENDC ;GT MOV T.CSR(R3),R4 ;Get pointer to receive CSR .IF NE DLMD$M .Assume T.CNFG EQ 0 BIT #,@R3 ;Remote terminal? (Depends on T.CNFG = 0) BEQ 10$ ;No, it's local .Assume T.TKS EQ 0 MOV @R4,R0 ;Get the status word from the CSR .Assume DLDSI$ EQ 100000 BMI DLMCTL ;Modem status changed, go determine cause 10$: .ENDC ;NE DLMD$M ;+ ; HKPC08 (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; MOV @#KBDBUF,R0 ; ; This gets the character in the pseudo keyboard buffer and puts it in R0 ; when running on a PRO300 series processor. ;- HKPC08:: ;(*** PRO300 HOOK ***) MOV T.TKB(R4),R0 ;Get the character .Assume <.-HKPC08> EQ 4 TSTB T.CNF2(R3) ;Read pass all bit set? .Assume RPALL$ EQ 200 BMI 80$ ;Yes, don't parse TST R0 ;Character in error? .Assume DLERR$ EQ 100000 BPL 20$ ;No, character received is ok BIT #,R0 ;Parity or frame error? BNE SCNOP ;Yes, just return 20$: BIC #,R0 ;No, clear parity, etc. BEQ SCNOP ;If null ignore, Just return .BR 80$ ............ .IFF ;EQ HSR$B .IF GT MOV DLTMP,R4 ;R4 = interrupt line number BIC #^c,R4 ;Extract the unit number ASL R4 ;Make it an offset PHSRRB ==: < . + 2 > ;**BOOT** Relocate address of DL TCB pointers table MOV DLTBL(R4),R4 ;Get pointer to TCB .IFF ;GT MOV DLTBL,R4 ;R4 points to the TCB .ENDC ;GT .IF NE DLMD$M .Assume T.CNFG EQ 0 BIT #,@R4 ;Remote terminal? (Depends on T.CNFG = 0) BEQ 30$ ;No, local MOV @T.CSR(R4),R5 ;Get the status word .Assume DLDSI$ EQ 100000 BPL 30$ ;If positive, no modem status change JSR R3,SAVE30 ;Else, save R3-R0 MOV R4,R3 ;Point to the TCB MOV R5,R0 ;Get the contents of the receiver CSR MOV T.CSR(R3),R4 ;R4 points to the CSR BR DLMCTL ;Go process the modem changes ............ 30$: .ENDC ;NE DLMD$M MOV T.CSR(R4),R5 ;R5 points to the receiver CSR ;+ ; HKPC09 (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; MOV @#KBDBUF,-(SP) ; ; This gets the character in the pseudo keyboard buffer and pushes it on ; the stack when running on a PRO300 series processor. ;- HKPC09:: ;(*** PRO300 HOOK ***) MOV T.TKB(R5),-(SP) ;Get the input character and receiver flags .ASSUME <.-HKPC09> EQ 4 MOV HSRB,R5 ;Get the ring buffer put pointer MOV R4,(R5)+ ;Store the TCB address MOV (SP)+,(R5)+ ; and the character in the ring PHSRRT ==: < . + 2 > ;**BOOT** Relocate address of high speed ring bfr. top CMP R5,# ;Are we at the top of the ring? BLO 40$ ;Not yet MOV HSRBRP,R5 ;Reset to start of ring 40$: MOV R5,HSRB ;Save the updated put pointer INC HSRBCC ;Increment the character count BNE SCNOP ;Return if more than one character in buffer ;+ ; FRQHOK (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap code hooks this location with: ; ; JSR R5,$FORQ ; ; The routine $FORQ is located in the RTEM-11 linkage ; routines. This allows input inturrupts to fork correctly ; under RTEM-11. ;- FRQHOK:: ;(*** RTEM-11 HOOK ***) JSR R5,$FORK ;Drop to fork level to empty the buffer .WORD < TIFBLK - . > 50$: MOV HSRBGP,R1 ;Get HSR buffer get pointer MOV (R1)+,R3 ;Get from the ring the TCB address MOV (R1)+,R0 ; and the character CMP R1,HSRBEP ;Is the pointer up to the end pointer yet? BLO 60$ ;Nope MOV HSRBRP,R1 ;Yes, reset to top of ring 60$: MOV R1,HSRBGP ;Save the updated get pointer MOV T.CSR(R3),R4 ;Get the line's CSR TSTB T.CNF2(R3) ;Read pass all bit set? .Assume RPALL$ EQ 200 BMI 80$ ;Yes, don't parse TST R0 ;Character in error? .Assume DLERR$ EQ 100000 BPL 70$ ;No, character received is ok BIT #,R0 ;Parity or frame error? BNE 110$ ;Yes, just return 70$: BIC #,R0 ;Clear parity, etc. BEQ 110$ ;If null ignore. Just return .BR 80$ .ENDC ;EQ HSR$B 80$: CALL INPTR ;R1->ring buffrs; R5->input owners impure area BEQ 100$ ;If equal, terminal is unowned INTCOM: ;DL11/DZ11/DH11 common interrupt code .Assume T.CNFG EQ 0 MOV @R3,-(SP) ;Save the current configuration word .IF EQ SB BIT #,T.STAT(R3) ;Shared console? BEQ 90$ ;No, branch .IFF ;EQ SB TST T.STAT(R3) ;Console? .Assume CONSL$ EQ 100000 BPL 90$ ;No, branch .ENDC ;EQ SB .Assume T.CNFG EQ 0 MOV I.TERM(R5),@R3 ;Yes, copy configuration word from impure area 90$: CALL INCHAR ;Process the character .Assume T.CNFG EQ 0 MOV (SP)+,@R3 ;Restore the configuration word 100$: .IF NE HSR$B .IF NE BIT #,T.STAT(R3) ;DZ11 or DH11 unit? BNE SCNOP ;Yes, then no high speed ring buffers .ENDC ;NE 110$: DEC HSRBCC ;Decrement the character count BPL 50$ ;If positive, there's more to do .ENDC ;NE HSR$B SCNOP:: RETURN .DSABL LSB .IF NE .ENABL LSB .IF NE DLMD$M .SBTTL DLMCTL - DL11E Modem Control Routine ;+ ; DLMCTL - DL11E modem control routine to process data set status change ; ; R0 = Contents of T.TKS ; R3 -> TCB ; R4 -> CSR ;- DLMCTL:: .IF NE MTY$HK CALL HHMCHK ;Modem control disabled on this line? BNE 40$ ;Yes... .ENDC ;NE MTY$HK BIT #,R0 ;Was it a ring? BNE DLRNG ;Yes, go answer it BIT #,R0 ;No, is the carrier present? BNE DLCAR ;Yes, carrier came on BIT #,T.STAT(R3) ;Carrier dropped. Is it already inactive? BNE 40$ ;Yes, ignore loss of carrier BIT #,R0 ;No, is clear to send of sec. rcv. set? BNE 40$ ;Yes, ignore carrier loss .IF NE DHMD$M BR 5$ .IFF ;NE DHMD$M .BR 5$ .ENDC ;NE DHMD$M .ENDC ;NE DLMD$M .IF NE DHMD$M .SBTTL DHMCTL - DH Series modem control ;+ ; ; DHMCTL ; DH series modem control routine to process modem status ; changes. ; ; Call: ; R0 = Contents of DH.RBU, byte-swapped, so that high byte ; appears as DH.LSR ; R3 -> TCB ; R4 -> CSR ; ;- DHMCTL:: .IF NE MTY$HK CALL HHMCHK ;Modem control disabled on this line? BNE 40$ ;Yes... .ENDC ;NE MTY$HK BIT #,R0 ;Is line ringing? BNE DLRNG ;Yes, go answer it BIT #,R0 ;No, is carrier present? BNE DLCAR ;Yes, carrier came on BIT #,T.STAT(R3) ;Carrier dropped, was it already off? BNE 40$ ;Yes, ignore loss of carrier BIT #,R0 ;No, is Clear_To_Send asserted? BNE 40$ ;Yes, ignore carrier loss .BR 5$ .ENDC ;NE DHMD$M ;+ ; Loss of carrier may be temporary due to a glitch in the line. Wait 2 ; seconds to see if it comes back before dropping that line. ;- 5$: .IF NE U.K. ..UKDL:: ;**PATCH** NOP to disable immediate hangup BR DLWCR1 ;Turn unit off immediately if U.K. ............ .ENDC ;NE U.K. JSR R1,QTIMR ;Queue up a mark time ... .WORD < 2 * CLOCK > ; ... for 2 seconds DLCRP1:: .WORD DLWCAR ;**BOOT** Relocate completion routine address BR 40$ ;Exit from the interrupt .SBTTL DLCAR - Carrier is present on DL or DH ;+ ; Carrier is present. The line may be responding to data set ready or ; recovering from a line glitch. In any case go cancel any outstanding ; mark times and flag the line as up. ;- DLCAR: BIT #,T.STAT(R3) ;Shared console? BNE 10$ ;Yes, bypass ownership check TST T.OWNR(R3) ;Is the unit attached (in use)? BEQ 40$ ;No, just return 10$: CALL CTIMR ;Cancel any outstanding mark times 20$: BIC #,T.STAT(R3) ;Indicate carrier present .IF NE MAT$S CALL CARON ;Set modem present and turn off terminal hung .ENDC ;NE MAT$S BR 40$ ;Exit from the interrupt .SBTTL DLWCAR - Timeout waiting for carrier on DL or DH ;+ ; DLWCAR - Time out waiting for carrier ; ; Entered 2 seconds after loss of carrier (immediately if U.K. support), ; or 30 seconds after answering a ring interrupt ; Hangs up the line and indicate that it is down ; ; NOTE: This is a completion routine, not an interrupt routine ; ; R0 = sequence number of the mark time: ; Low byte = LUN ;- DLWCAR:: JSR R5,SAVE52 ;Save R5-R2 MOVB R0,R3 ;Copy the LUN ADD PC,R3 ;R3 -> This LUN's TCB MOV (R3),R3 ; ... DLWCR1: MOV T.CSR(R3),R4 ;R4 -> Device base CSR BIS #,T.STAT(R3) ;Line has lost carrier .IF NE BIT #,T.STAT(R3) ;Is this TCB for a DH? BNE 990$ ;Yep... .ENDC ;NE .IF NE DLMD$M .Assume T.TKS EQ 0 BIC #,@R4 ;Clear DTR to hang up phone .IF NE DHMD$M BR 991$ .ENDC ;NE DHMD$M .ENDC ;NE DLMD$M .IF NE DHMD$M 990$: CALL DHSELL ;Select the DH line BIC #,DH.LCR(R4) ;Clear DTR to hang up phone 991$: .ENDC ;NE DHMD$M .IF NE MAT$S CALL HNGON ;Set terminal hung up, clear carrier present .ENDC ;NE MAT$S BR 40$ ;Exit from the interrupt .SBTTL DLRNG - DH or DL line is ringing ;+ ; The line is ringing. Answer it with the data terminal ready bit and ; wait 30 seconds for the line to respond with carrier. If carrier is ; not up within 30 seconds, hang up the line. ;- DLRNG: BIT #,T.STAT(R3) ;Shared console? BNE 30$ ;Yes, bypass ownership check TST T.OWNR(R3) ;Is the unit attached (in use)? BEQ 40$ ;No, don't answer 30$: CALL CTIMR ;Yes, turn off any outstanding MRKT's .IF NE BIT #,T.STAT(R3) ;Is this TCB for a DH? BNE 992$ ;Yep... .ENDC ;NE .IF NE DLMD$M .Assume T.TKS EQ 0 BIS #,@R4 ;Set DTR and RTS to answer phone .Assume T.TKS EQ 0 BIT #,@R4 ;Is carrier already present? .IF NE DHMD$M BR 993$ .ENDC ;NE DHMD$M .ENDC ;NE DLMD$M .IF NE DHMD$M 992$: CALL DHSELL ;Select the DH line BIS #,DH.LCR(R4) ;Answer the phone BIT #,DH.LSR(R4) ;Is carrier already present? 993$: .ENDC ;NE DHMD$M BNE 10$ ;Yes, cancel outstanding MRKT's JSR R1,QTIMR ;Queue up a mark-time .WORD < 30. * CLOCK > ; to wait 30 seconds DLCRP2:: .WORD DLWCAR ;**BOOT** Relocate completion routine address 40$: RETURN .DSABL LSB .ENDC ;NE .IF NE .SBTTL Q/CTIMR - Queue Mark Time And Cancel Mark Time Routines ;+ ; QTIMR - Queue up a mark time for this logical unit number ; ; R3 -> TCB ; ; JSR R1,QTIMR ; .WORD Low order delta time ; .WORD Completion routine absolute address ; ; R0 = Undefined ; R1 = Undefined ;- QTIMR: JSR R5,SAVE52 ;Save R5-R2 .IF EQ SB MOVB T.JOB(R3),(R3) ;Use job number of attacher .IFF ;EQ SB CLRB (R3) ;Clear job number .ENDC ;EQ SB ADD #,R3 ;Point to the timer block in the TCB CLR (R3)+ ;Zero the high order time MOV (R1)+,(R3)+ ;Copy the low order time MOV (R1)+,(R3) ;Copy the completion address MOV R1,12(SP) ;Put the return address on the stack CALLR TIMIO ;Queue up the request and return from there ............ ;+ ; CTIMR - Cancel any mark times associated with the unit. ; ; R3 -> TCB ; ; CALL CTIMR ; ; R0 = Undefined ; R1 = Undefined ;- CTIMR: JSR R5,SAVE52 ;Save R5-R2 MOV (R3),R0 ;Get the terminal sequence number .IF EQ SB MOVB T.JOB(R3),R2 ;Get the job number .ENDC ;EQ SB MOV #,R1 ;Set the system limit CLR R5 ;Don't return unexpired time CALLR CMARKT ;Call to cancel and return from there ............ .ENDC ;NE .IF NE MTI$M .SBTTL DLMPOL - Routine To Poll Each DL11 ;+ ; DLMPOL - Poll each DL11 to ensure that Input Interrupt Enable is set ; Runs as a completion routine every 1/2 second ;- .ENABL LSB DLMPOL:: JSR R5,SAVE52 ;Save registers CLR R2 ;Initialize DL11 index PDLCS1 ==: < . + 2 > ;**BOOT** Relocate address of DL TCB pointers table 10$: MOV DLTBL(R2),R3 ;R3 -> TCB of this DL11 MOV T.CSR(R3),R4 ;Point to unit's CSR BEQ 30$ ;Skip it if no hardware present .Assume T.CNFG EQ 0 BIT #,@R3 ;Remote terminal? (Depends on T.CNFG = 0) BEQ 20$ ;No .Assume T.TKS EQ 0 BIS #,@R4 ;Set data set interrupt enable 20$: ;+ ; HKPC01 (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALL PIHK01 ; ; PIHK01 enables the keyboard receiver interrupts on a PRO300 series ; processor. ;- HKPC01:: ;(*** PRO300 HOOK***) .Assume T.TKS EQ 0 BIS #,@R4 ;Set input interrupt enable .Assume <.-HKPC01> EQ 4 BIT #,T.STAT(R3) ;Are we expecting output interrupt here? BEQ 30$ ;No INC T.RTRY(R3) ;Yes, count number of times we waited CMP #<4>,T.RTRY(R3) ;Have waited 1.5 to 2 seconds yet? BNE 30$ ;No, it may yet interrupt CLR T.RTRY(R3) ;Yes, reset output wait count CMP @T.VEC(R3),@#$SYPTR ;Does it vector into the RMON? BLO 30$ ;No, he stole the vector, don't modify IE .BR HKPC02 ............ ;+ ; HKPC02 (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALL PIHK02 ; ; PIHK02 enables and generates an output interrupt on a PRO300 series ; processor. ;- HKPC02:: ;(*** PRO300 HOOK ***) BIC #,T.TPS(R4) ;Turn off the output interrupt enable CALL @$XTTPS ;T.TPS may have changed BIS #,T.TPS(R4) ;Turn it back on (really should interrupt) .Assume <.-HKPC02> EQ 20 CALL @$XTTPS ;T.TPS may have changed 30$: TST (R2)+ ;Bump DL11 index CMP R2,# ;Is there another one? BLO 10$ ;Yes, do it ;+ ; Queue up another timer request for 1/2 second from now ;- DLTIMR: MOV DLTMCP,DLTCOM ;Set up completion address JSR R5,$TIMIO ;Set up a timer request .WORD < DLTMBK - . > ;Offset to timer block .WORD 0 ;Mark time, not cancel timer .WORD 0 ;High order time .WORD < CLOCK / 2 > ;Low order time = 1/2 second RETURN ............ .DSABL LSB ;+ ; DL11 Timer Control Block ;- DLTMBK: .WORD 0, 0 ;Time (high order, low order) .WORD 0, 0 ; .WORD 177444 ;Sequence number .WORD -1 ;System timer element DLTCOM: .WORD 0 ;Completion routine DLTMCP::.WORD DLMPOL ;**BOOT** Relocate completion routine address .ENDC ;NE MTI$M .SBTTL INPTR, OUTPTR - Ring Pointer Set Up Subroutines ;+ ; INPTR - Input ring pointer set up subroutine ; OUTPTR - Output ring pointer set up subroutine ; ; Point to input buffer ring count and test for ownership. If the terminal ; is the console, the ring buffers in the impure area are used. If not the ; console the buffers in the TCB are used. ; ; R3 -> TCB ; ; CALL INPTR ;(input interrupt) ; or ; CALL OUTPTR ;(output interrupt) ; ; R1 -> Input ring character count ; R5 -> Impure area ; Z=1 if no owner (R5 = 0) ;- .ENABL LSB INPTR: MOV TTIUSR,R5 ;Get the address of impure area of owning job BIT #,T.STAT(R3) ;Detach in progress? BEQ 10$ ;No, continue SEZ ;Yes, signal no owner and return RETURN ............ OUTPTR: MOV TTOUSR,R5 ;Get impure area of job w/ output of console 10$: .IF NE MTY$HK CALL HHCHK ;Line owned by handler? BNE 40$ ;Yes, no further processing here... .ENDC ;NE MTY$HK .IF EQ SB BIT #,T.STAT(R3) ;Is this the shared console? BNE 20$ ;Yes, use the ring buffer in job's impure area .IFF ;EQ SB TST T.STAT(R3) ;Is this the console? .Assume CONSL$ EQ 100000 BMI 20$ ;Yes, use the ring buffer in job's impure area .ENDC ;EQ SB MOV T.OWNR(R3),R5 ;No, point to owner's impure area BEQ 40$ ;No one owns unshared console, ignore it .IF EQ SB TST T.STAT(R3) ;Console? .Assume CONSL$ EQ 100000 BPL 30$ ;No, use the ring buffer in the TCB .IFF ;EQ SB BR 30$ ;Use the ring buffer in the TCB ............ .ENDC ;EQ SB 20$: MOV R5,R1 ;Get the impure area pointer ADD #,R1 ;R1 points to the input ring count BR 40$ 30$: MOV R3,R1 ;No, the pointer to the ring buffer is in TCB ADD #,R1 ;R1 points to the input ring count 40$: RETURN ............ .DSABL LSB .SBTTL Control Character Input Dispatch Table .MACRO CTLCHI C .NCHR ..., .IF GT < ... - 1 > INP'C:: . = < C * 2 > + TTITBL .WORD < INP'C - TTIBAS > . = INP'C .SBTTL Process C input .IFF CTRL.'C:: . = < < ''C - 100 > * 2 > + TTITBL .WORD < CTRL.'C - TTIBAS > . = CTRL.'C .SBTTL CTRL.'C - Process CTRL/'C Input .ENDC .ENDM CTLCHI ;+ ; Initialize the dispatch table ;- .WORD < ALT - TTIBAS > ;175 RIGHT BRACE (or ALTMODE) .WORD < ALT - TTIBAS > ;176 TILDE (or ALTMODE) .WORD < RUB - TTIBAS > ;RUBOUT TTITBL: .REPT < 'Z + 1 - 100 > .WORD < TTINCC - TTIBAS > ;Init table to NO special characters .ENDR .SBTTL INCHAR - Input Character Processing ;+ ; INCHAR - Process input character. ; ; R0 = Character ; R1 -> Input ring buffer pointers ; R3 -> TCB of the terminal ; R4 -> Receive CSR ; R5 -> Impure area if FB ; ; CALL INCHAR ; ; Note: If TCB is owned by a handler, the handler hook routine ; is called to pass the received character directly to the ; handler. ; ;- .ENABL LSB INCHAR:: .IF NE MTY$HK CALL HHCHK ;Line owned by handler? BEQ 5$ ;Nope... MOV R5,-(SP) ;Save pointer for awhile MOV R0,R5 ;R5 = Received character MOV #TH.PIC,R0 ;R0 = 'Put input character' code .IF EQ MMG$T CALL @T.OWNR(R3) ;Call handler hook routine .IFF ;EQ MMG$T CALL HHHOOK ;Call handler hook routine .ENDC ;EQ MMG$T MOV (SP)+,R5 ;Restore previously saved register RETURN 5$: .ENDC ;NE MTY$HK .IF NE SCCA$G ;>>>shouldn't this be done in CTLCHI C? CMPB R0,# ;Is this character a control C? BNE 10$ ;No, then continue. BITB #,INDSTA ;Is global .SCCA enabled? BEQ 10$ ;No, then continue. .IF EQ SB .ADDR #,-(SP) ;Push background impure area address. CMP R5,(SP)+ ;Is this destined for the background? BNE 10$ ;No, then continue. .ENDC ;EQ SB RETURN ;Return, ignoring the character. ............ 10$: .ENDC ;NE SCCA$G TSTB T.CNF2(R3) ;Read pass all? .Assume RPALL$ EQ 200 BMI TTINC3 ;Yes, don't change the character .Assume T.CNFG EQ 0 BIT #,@R3 ;Pass lower case? BNE 20$ ;Yes, leave character alone... CALL UCASE ;Nope, uppercase it... 20$: CMPB R0,# ;Could this be a special character? BLOS 30$ ;Yes, it could ..ALT ==: < . + 2 > ;**PATCH** Change to 175 to enable (175,176) -> ESC CMPB R0,# ;Could it be (special altmode or) rubout? BLO TTINCC ;No, ordinary character SUB #,R0 ;Special char, put it in range -3 to -1 30$: ASL R0 ;Double for word index TTITPT ==: < . + 2 > ;**BOOT** Relocate address of special dispatch table MOV TTITBL(R0),-(SP) ;Get routine address ADD PC,@SP ;Relocate it TTIBAS: ;Reference tag ASR R0 ;Fix the character MOV R3,R2 ;Copy the TCB pointer ADD #,R2 ; and point to status word ;CLC ;C=0 from 'ADD' above CALLR @(SP)+ ;Dispatch to routine ............ CTLCHI CR .IF NE SYT$K TSTB T.XFLG(R3) ;Are we in a ^X sequence? BNE 40$ ;Yes, go end it .ENDC ;NE SYT$K CALL TTINCC ;Process the return like any other character MOV #,R0 ;Force a line feed BR TTINC3 ;Process that, too ............ ;+ ; Process non-special character ;- TTINCC: .IF NE SYT$K TSTB T.XFLG(R3) ;Are we in CTRL/X sequence? BEQ 50$ ;Branch if not 40$: CALLR XPROC ;Yes, do it ............ 50$: .ENDC ;NE SYT$K .Assume T.CNFG EQ 0 BIT #,@R3 ;Are we in special mode? BNE TTINC3 ;No, no backslashes to type CMPB T.PTTI(R3),# ;Was previous character a rubout? BNE TTINC3 ;Branch if not JSR R5,ECHO ;Type a backslash ... .ASCII "\" ; ... to close out the rubout sequence ;+ ; Enter here if no RUBOUT sequence to close ;- TTINC3: CMP @R1,# ;Is input ring buffer full? BGE 100$ ;Yes, no room, ignore character and type bell INC @R1 ;Increment character count INC -(R1) ;Advance the input pointer CMP @R1,6(R1) ;Time to wrap the pointer? BNE 60$ ;Nope SUB #,@R1 ;Yes, wrap the pointer 60$: MOVB R0,@(R1)+ ;Put the character into the input ring CALL EOLTST ;End of line? BNE 70$ ;No INC (R1) ;Yes, bump the line counter CMP TTHIUS,R5 ;Is he using the terminal handler? BNE 70$ ;No TST T.STAT(R3) ;Console terminal? .Assume CONSL$ EQ 100000 BPL 70$ ;No, certainly not using TT: CALL TTHIN ;Process the line through the handler MOV T.CSR(R3),R4 ;Restore CSR pointer clobbered by TTHIN 70$: MOVB R0,T.PTTI(R3) ;Save previous character TSTB T.CNF2(R3) ;Read pass all? .Assume RPALL$ EQ 200 BMI 80$ ;Yes, set status and exit .Assume T.CNFG EQ 0 BIT #,@R3 ;Are we in special mode? BNE 80$ ;If so, don't echo the character CALL TTOPT3 ;Echo the character TST T.TTLC-T.ICTR(R1) ;Any lines ready? .IF EQ MAT$S BEQ 90$ ;No .IFF ;EQ MAT$S BNE 80$ ;Yes, tell user input is ready CALLR CLRIN ;No, report no input ready ............ .ENDC ;EQ MAT$S 80$: .IF NE MAT$S CALL SETIN ;Yes, report input is available .ENDC ;NE MAT$S JSR R4,UNBLOK ;Unblock the job if waiting terminal input .WORD TTIWT$ 90$: RETURN ;No, all done, return ............ 100$: CALL @$XTTNR ;Tell hook code that there is no room for char TSTB T.CNF2(R3) ;Read pass all? .Assume RPALL$ EQ 200 BMI 90$ ;Yes, just return MOVB R0,T.PTTI(R3) ;Save previous terminal input character DING: MOV #,R0 ;Ring a BELL CALLR TTOPT4 ;Put out the BELL ............ .DSABL LSB .SBTTL Input Control Character Processing .ENABL LSB .IF EQ SB CTLCHI B CALL SWICTX ;Prepare to switch input context MOV BCNTXT,R2 ;Point at BG job header XCOM: MOV R2,TTIUSR ;Job now owns console for input .IF NE SYT$K TSTB XFLG ;Must we force the ID out? BNE TTOSET ;Yes, print the ID in any case .ENDC ;NE SYT$K CMP R2,TTOUSR ;Does it also own output? BEQ 20$ ;Yes, no need for ID TTOSET::MOV R2,TTOUSR ;Give him ownership MOV I.TID(R2),T.TID(R3) ;Print ID CALLR TTOENB ;Go enable output interrupt to print ID ............ CTLCHI F CALL SWICTX ;Prepare to switch input context MOV FCNTXT,R2 ;R2 -> FG job header BEQ 10$ ;No FG job, give an error .IF NE SYT$K CMP I.CNSL(R2),R3 ;Is this FG console? BNE 10$ ;No, FG isn't sharing this, give error .ENDC ;NE SYT$K BIT #,I.BLOK(R2) ;It's there, is it running? BEQ XCOM ;Yes 10$: JSR R5,ECHO ;Echo 'F?' error message .ASCII "F?" CALLR ECHOCL ;New line, then exit ............ .ENDC ;EQ SB ALT: MOV #,R0 ;Replace with escape code BTINC3: BR TTINC3 ;and process normally ............ ; BTINC3 is ref label for branch chain CTLCHI O MOV R1,R2 ;Copy ring pointer ADD #,R2 ;Point to output character counter CLRB (R2)+ ;Clear count, nothing is in output ring MOVB @R2,-(SP) ;Get previous CTRL/O state CLRB (R2)+ ;Enable printing temporarily MOV @R2,-4(R2) ;Set output pointers equal to empty the ring JSR R5,ECHO0C ;Echo ^O .ASCII COMB @SP ;Invert CTRL/O state MOVB (SP)+,(R1) ;Set the new CTRL/O state BEQ 20$ ;Enabling output, so done JSR R4,UNBLOK ;Unblock job if waiting for TT output room .WORD ;Either waiting room OR waiting empty 20$: RETURN ............ .DSABL LSB .ENABL LSB CTLCHI C .IF NE SYT$K TSTB T.XFLG(R3) ;^X sequence in progress BEQ 20$ ;No 10$: JSR R5,ECHO0C ;Yes, simply echo ^C .ASCII CLR T.XFLG(R3) ; and end the ^X sequence (clear flag, count) RETURN ............ 20$: .ENDC ;NE SYT$K .Assume T.CNFG EQ 0 TST @R2 ;Is this a console? .Assume CONSL$ EQ 100000 BPL 30$ ;No, echo ^C iff not special mode TST I.SCCA(R5) ;Yes, is console CTRL/C intercept set? BEQ 40$ ;No, echo ^C on console even if special mode .Assume T.CNFG EQ 0 30$: BIT #,@R3 ;Special input mode? BNE 50$ ;Don't echo ^C if special 40$: JSR R5,ECHO0C ;Echo ^C .ASCII 50$: CMPB R0,T.PTTI(R3) ;Is it second CTRL/C? BNE BTINC3 ;No, treat it like any other character ;>>>is @R2 still pointing to T.STAT here? If so, use TST @R2 ; not after the call to ECHO0C, it calls ECHOR0, which ; states that R2 contents are undefined on return TST T.STAT(R3) ;Console? .Assume CONSL$ EQ 100000 BPL 70$ ;No MOV I.SCCA(R5),R2 ;Point to user's .SCCA intercept word BNE 80$ ;If present, simply set his status flag .IF EQ SB TST I.JNUM(R5) ;Abort the job. Is this the background? BNE 60$ ;If not BG, don't change indirect file data .ENDC ;EQ SB BIS #,STATWD ;Abort any indirect file BICB #,INDSTA ;Clear IND status bits TST EXTFLG ;Exit already in progress? BNE BTINC3 ;Yes, buffer this ^C for later .IF NE BATC$H MOV $ENTRY+BA.NUM,R2 ;Point to the batch handler BEQ 60$ ;No problem if not loaded CLR BATSW$(R2) ;Clear batch state word to stop it .ENDC ;NE BATC$H 60$: CALLR $RQABT ;Request an abort of the job ............ 70$: BIS #,T.STAT(R3) ;Non-console, set ^C^C flag in TCB BR 90$ ; and MTTY ATS word, then buffer it ............ 80$: ;^C^C on console with .SCCA set .IF NE MMG$T MOV @#KISAR1,-(SP) ;Save current PAR1 value MOV I.SCC1(R5),@#KISAR1 ;Set up PAR1 for user's word .IFTF ;NE MMG$T BIS #,@R2 ;Set ^C^C flag in user's .SCCA word .IFT ;NE MMG$T MOV (SP)+,@#KISAR1 ;Restore PAR1 .ENDC ;NE MMG$T 90$: .IF NE MAT$S CALL CTCON ;Set ^C^C bit in MTTY status (if attached) .ENDC ;NE MAT$S BTIN3A: BR BTINC3 ;Now go buffer the CTRL/C ............ .DSABL LSB .SBTTL Rubout and CTRL/U Processing .ENABL LSB RUB: ADD #<200>,R0 ;Fix RUBOUT in case special mode ;SEC ;C=1 from ADD of 200 to <177-200> CTLCHI U .IF EQ SYT$K .Assume T.CNFG EQ 0 BIT #,@R3 ;*C*Are we in special mode? BNE BTIN3A ;*C*If so, ordinary character .IFTF ;EQ SYT$K ROR -(SP) ;Save RUBOUT vs. CTRL-U flag .IFF ;EQ SYT$K TSTB T.XFLG(R3) ;CTRL/X sequence in progress? BNE 111$ ;Yes, force processing, regardless of TTSPC$ .Assume T.CNFG EQ 0 BIT #,@R3 ;Are we in special mode? BEQ 30$ ;No. Go process RUBOUT or CTRL/U TST (SP)+ ;purge RUBOUT flag BR BTIN3A ; and treat as regular character 111$: ADD #,R2 ;Point to ^X count, etc ;+ ; Process ^X version of RUBOUT, CTRL/U ;- TST (SP)+ ;Is this a CTRL/U? BMI 10$ ;No, it's a RUBOUT CLRB (R2)+ ;Clear count CLR (R2)+ ;Clear previous CLR (R2)+ ;Clear the CLR (R2)+ ; job name CLR (R2)+ ; buffer BR 130$ ;Go echo ^U ............ 10$: MOVB (R2)+,R5 ;Get count. Any characters to delete? BEQ 20$ ;No ADD R2,R5 ;Point to character to delete - 1 INC R5 ;Point to the character MOVB @R5,R0 ;Get it CLRB @R5 ;Erase the character from the buffer DECB -1(R2) ;Decrease count .Assume T.CNFG EQ 0 TST @R3 ;Scope terminal? .Assume BKSP$ EQ 100000 BMI 70$ ;Yes, go do a backspace type rubout CMPB T.XPRE(R3),# ;Was last character a rubout? BEQ 100$ ;Yes, just echo the character MOVB #,T.XPRE(R3) ;Indicate that we are in RUBOUT sequence BR 90$ ;Echo a backslash, then the character ............ 20$: CLRB T.XPRE(R3) ;Not in RUBOUT sequence now BR ECHOCL ;Echo CR/LF and exit RETURN ............ .ENDC ;EQ SYT$K 30$: ADD #,R2 ;Point at previous input character 40$: TST @R1 ;Any characters to delete? BEQ 120$ ;No, done MOVB @-(R1),R0 ;Get the character to delete CALL EOLTST ;Is it a line terminator? BEQ 110$ ;Yes, don't delete it CMP @R1,-2(R1) ;Need to wrap pointers? BNE 50$ ;No ADD #,@R1 ;Yes, wrap pointer 50$: DEC (R1)+ ;Back up pointer DEC @R1 ;Decrement character count 60$: TST @SP ;Doing CTRL/U? BPL 40$ ;If so, go delete more .Assume T.CNFG EQ 0 MOV @R3,(SP)+ ;Dump flag. Does the terminal have backspace? .Assume BKSP$ EQ 100000 BPL 80$ ;No, normal deletion inside backslashes 70$: JSR R5,ECHO ;Echo on scope as Backspace Space Backspace .ASCII " " MOV #,R0 ;Get the final Backspace CALLR TTOPT4 ;Echo it and return 80$: CMPB @R2,# ;Are we already in a RUBOUT sequence? .IF EQ SYT$K BEQ TTOPT3 ;Yes, no other backslash needed .IFF ;EQ SYT$K BEQ 100$ ;Yes, no other backslash needed .ENDC ;EQ SYT$K MOVB #,@R2 ;Save RUBOUT as previous character 90$: JSR R5,ECHO ;Print a backslash to start RUBOUTs .ASCII "\" .IF EQ SYT$K BR TTOPT3 ;Output deleted character and exit ............ .IFF ;EQ SYT$K 100$: CALLR TTOPT3 ;Output deleted character and exit ............ .ENDC ;EQ SYT$K 110$: TST (R1)+ ;Adjust buffer pointer to point to count 120$: CLRB @R2 ;No previous character now TST (SP)+ ;Dump flag. Doing RUBOUT or CTRL/U? BPL 130$ ;CTRL/U, go echo it .Assume T.CNFG EQ 0 TST @R3 ;RUBOUT of no characters, is it a scope? .Assume BKSP$ EQ 100000 BPL ECHOCL ;No, go to a new line RETURN ;Yes, just quit ............ 130$: JSR R5,ECHO ;Echo the CTRL/U .ASCII "^U" ECHOCL: JSR R5,ECHO ;Echo CR/LF .ASCII RETURN ............ .DSABL LSB .ENABL LSB CTLCHI S .Assume T.CNFG EQ 0 TSTB @R3 ;XON/XOFF enabled? .Assume PAGE$ EQ 200 BPL JTINCC ;No, process as normal character BIS #,@R2 ;Turn off terminal RETURN ;Done ............ CTLCHI Q BIC #,T.STAT(R3) ;Turn terminal on .Assume T.CNFG EQ 0 TSTB @R3 ;XON/XOFF enabled? (Depends on T.CNFG = 0) .Assume PAGE$ EQ 200 BPL JTINCC ;No, treat it like a normal character .IF NE BIT #,T.STAT(R3) ;Is line a DZ or DH? BEQ 20$ ;Nope... .IF NE DZ11$N .IF NE DH11$N BIT #,T.STAT(R3) ;Is line a DZ? BEQ 10$ ;Nope, must be a DH .ENDC ;NE DH11$N MOVB T.PUN(R3),R2 ;R2 = Line number of DZ controller PBMSK1 ==: < . + 2 > ;**BOOT** Relocate address of bit masks table BICB BITMSK(R2),DZ.TCR(R4) ;Disable output for this unit BR DZOENB ;Enable output to cause an interrupt .ENDC ;NE DZ11$N .IF NE DH11$N 10$: BR DHOENB .ENDC ;NE DH11$N 20$: .ENDC ;NE .DSABL LSB ;+ ; HKPC03 (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALL PIHK03 ; ; PIHK03 disables video output interrupt on a PRO300 series ; processor. ;- HKPC03:: ;(*** PRO300 HOOK ***) CLR T.TPS(R4) ;Turn off output interrupts .Assume <.-HKPC03> EQ 4 CALL @$XTTPS ;"T.TPS" may have changed BR DLOENB ;Enable output to cause an interrupt ............ .ENABL LSB .IF EQ SB SWICTX: BIT #,T.STAT(R3) ;Shared console? BEQ 10$ ;No, pass character along .Assume T.CNFG EQ 0 BIT #,@R3 ;Processing enabled? BEQ 10$ ;No, normal character .IF NE SYT$K MOV T.XFLG(R3),(PC)+ ;Get flag to force ID print if ^X XFLG: .WORD 0 ;^X flag status for later CLR T.XFLG(R3) ;Kill any pending ^X sequence .ENDC ;NE SYT$K RETURN ............ 10$: TST (SP)+ ;Purge return address .ENDC ;EQ SB JTINCC: CALLR TTINCC ;Treat it like a normal character ............ .DSABL LSB .IF NE SYT$K CTLCHI X CALL SWICTX ;Prepare to switch input context ADD #,R2 ;Point to XFLAG MOV #<201>,(R2)+ ;Start ^X sequence, clear count ;(output interrupt service ;will print ID after terminal I/O quiesces) CLR (R2)+ ;Clear previous, R2 -> buffer CLR (R2)+ ;Clear the CLR (R2)+ ; job name CLR (R2)+ ; buffer MOV TTIUSR,TTOUSR ;Grab terminal for output BR TTOENB ;Enable interrupts, exit this one ............ .SBTTL XPROC - Process Characters In ^X Sequence ;+ ; XPROC - Process characters in ^X sequence ; ; Typing ^X changes the job that a shared console is talking to. ; The monitor prompts with "Job? ", and accepts a 1-6 character job name; ; the shared console is switched to that job, ; In a ^X sequence, RUBOUT and ^U work. ; A ^X sequence is terminated by CR, LF, or ^Z. ; A ^X sequence is aborted by ^C or by typing a null name. ;- .ENABL LSB XPROC:: MOV R3,R5 ;Copy TCB pointer ADD #,R5 ; and point to previous ^X character CMPB #,@R5 ;Was it a RUBOUT? BNE 10$ ;No, no special work .Assume T.CNFG EQ 0 TST @R3 ;Is it a scope? .Assume BKSP$ EQ 100000 BMI 10$ ;Yes, no backslashes JSR R5,ECHO ;Close the RUBOUT sequence .ASCII "\" 10$: CMPB #,R0 ;Carriage return? BEQ 40$ ;Yes, end of ^X sequence CALL EOLTST ;Is it some other line delimiter? BEQ 40$ ;Yes, done with ^X sequence MOVB -(R5),R2 ;Get the ^X buffer character count CMP #,R2 ;Is there room in buffer? BGT 20$ ;No, 6 characters already, ding him CALLR DING ............ 20$: CALL UCASE ;Uppercase it INC R2 ;Bump the character count MOVB R2,(R5)+ ;Save the new count MOVB R0,(R5)+ ;Save character as previous typed ADD R5,R2 ;Point into ^X buffer MOVB R0,@R2 ;Save the character CALLR TTOPT4 ;Echo it and exit ............ 40$: TST (R5)+ ;All done. Point to the name buffer MOV R5,R0 ;Copy the pointer for FNDJOB CALL FNDJOB ;Find the named job's impure area pointer BEQ 50$ ;Error, no such job CMP I.CNSL(R2),R3 ;Is this a valid console for the named job? BNE 50$ ;No, error BIT #,I.BLOK(R2) ;Is the job running? BNE 50$ ;No, can't type to it CLR T.XFLG(R3) ;Got it! Say we're done with ^X sequence ;>>>following does NOT force ID, to force ID change to MOV #1,XFLG ;>>>else just delete, What's to do? MOV #<1>,R0 ;Set flag to ensure we print the new ID CALLR XCOM ;Merge with common ^F, ^B code ............ 50$: JSR R5,ECHO ;Can't type to job. Echo '?' .ASCII "?" CALL ECHOCL ;Echo a new line (T.XFLG still set, so output ; appears even if terminal is in CTRL/O state) CLR T.XFLG(R3) ;Done with ^X sequence RETURN ;Exit from character ............ .DSABL LSB .ENDC ;NE SYT$K .SBTTL TTOENB - Enable Output Interrupt ;+ ; TTOENB - Enable interrupts on output side of DL, DZ or DH line ; ; R3 -> TCB ; R4 -> CSR ; ; CALL TTOENB ; ; R2 = Undefined ; C=0 ;- ;+ ; TTOENB (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap code hooks this location with: ; ; CALL $RSTT ; NOP ; ; The routine $RSTT is located in the RTEM-11 linkage ; routines. This allows terminal output inturrupts to ; be enabled correctly under RTEM-11. ;- .ENABL LSB TTOENB:: ;(*** RTEM-11 HOOK ***) .IF NE BIT #,T.STAT(R3) ;Is line a DZ or DH? BEQ DLOENB ;Nope, a DL .IF NE DZ11$N .IF NE DH11$N BIT #,T.STAT(R3) ;Is line a DZ? BEQ DHOENB ;Nope, must be a DH... .ENDC ;NE DH11$N DZOENB: .IF NE MTY$HK MOV R2,-(SP) ;Save R2 in case called from handler .ENDC ;NE MTY$HK MOVB T.PUN(R3),R2 ;R2 = Line number of DZ controller PBMSK2 ==: < . + 2 > ;**BOOT** Relocate address of bit masks table BISB BITMSK(R2),DZ.TCR(R4) ;Set output enable bit .IF NE MTY$HK MOV (SP)+,R2 ;Restore previously saved R2 .ENDC ;NE MTY$HK BR 20$ ;Return .ENDC ;NE DZ11$N .IF NE DH11$N ;+ ; DHOENB: Unlike DL's and DZ's, which interrupt on the state of an ; empty output buffer when the output interrupt enable bit is set, DH's ; interrupt on the transition TO an empty buffer. So this routine, which ; simulates an interrupt so it can call the routine to get a character for ; output, 'primes' the DH output interrupt pump by sending a character. ;- DHOENB: GETPSW ;Push current PSW .ADDR #20$,-(SP) ; and return address MOV #PR7,-(SP) ;Raise priority PUTPSW JSR R5,$INTEN ;;;Declare an interrupt .WORD <^C & PR7> ;;; to be processed at DH device level BIT #,T.STAT(R3) ;;Output in progress? BNE 10$ ;;Yes, don't force another character JSR R3,SAVE30 ;;Save a few registers MOV 10(SP),R3 ;;R3 -> TCB CALL DHENB1 ;;Go force a character 10$: RETURN ;;From the faked interrupt .ENDC ;NE DH11$N .ENDC ;NE DLOENB: .IF NE MTI$M BIS #,T.STAT(R3) ;Set Interrupt_Expected .ENDC ;NE MTI$M ;+ ; HKPC04 (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALL PIHK04 ; ; PIHK04 enables and generates video output interrupt on a PRO300 series ; processor. ;- HKPC04:: ;(*** PRO300 HOOK ***) MOV #,T.TPS(R4) ;Set interrupt enable bit .ASSUME <.-HKPC04> EQ 6 CALL @$XTTPS ;"T.TPS" may have changed 20$: CLC RETURN ;Return ............ .DSABL LSB .IF NE SYT$K XPROMT: .ASCIZ "Job? " ;^X prompt string .EVEN .ENDC ;NE SYT$K .IF NE DZ11$N ;+ ; Table of Bit Masks for DZ11 Physical Units ;- BITMSK::.BYTE 1, 2, 4, 10, 20, 40, 100, 200 .EVEN .ENDC ;NE DZ11$N .SBTTL Character Output Subroutines .ENABL LSB .SBTTL ECHOR0 - Print A Control Character In "^x" Form ;+ ; ECHOR0 - Print a control character in "^x" form ; ; R0 = Character to print (normally 0 - 37) ; R1 -> Ring buffers @ T.ICTR ; R3 -> TCB ; R4 -> CSR ; ; CALL ECHOR0 ; ; R0 = Original character ! 100 ; R2 = Undefined ; C=0 if successful ; Character in ring ; Output interrupts enabled ; C=1 if no room in output ring ; The uparrow may be lost without warning ;- ECHOR0: MOV R0,-(SP) ;Save the character MOV #<'^>,R0 ;Get an '^' CALL TTOPT3 ;Send it out 10$: MOV (SP)+,R0 ;Restore the control character BIS #,R0 ;Make it printable .BR TTOPT3 ;Fall into TTOPT3 to echo ............ .SBTTL TTOPT3 - Print A Character, Check For Special Changes ;+ ; TTOPT3 - Print a character, check for special changes: ; CTRL/C not printed ; ESCAPE changed to $ ; 0-10, 16-37 printed as "^x" ; Other characters printed unchanged ; ; R0 = Character to print ; R1 -> Ring buffers @ T.ICTR ; R3 -> TCB ; R4 -> CSR ; ; CALL TTOPT3 ; ; R0 = (Last) character printed (different if changed as above) ; R2 = Undefined ; C=0 if successful ; Character in ring ; Output interrupts enabled ; C=1 if no room in output ring ; If "^x" form, the "^" is discarded without warning ;- TTOPT3::CMPB #,R0 ;Is this a CTRL/C? BEQ 80$ ;Yes, don't echo it CMPB #,R0 ;Is it an escape? BNE 20$ ;No, don't change it magically MOV #<'$>,R0 ;Convert to escape to '$' 20$: CMPB #<' >,R0 ;Is it a printable character? BLOS TTOPT4 ;Yes, echo it easily CMPB #,R0 ;Is it above a carriage return? BLO ECHOR0 ;No, echo as ordinary ^ control CMPB #,R0 ;Is it below a TAB? BHI ECHOR0 ;Not special, echo as uparrow .BR TTOPT4 ............ .SBTTL TTOPT4 - Print A Character, No Checking For Specials ;+ ; TTOPT4 - Print a character, no checking for specials ; ; R0 = Character to print ; R1 -> Ring buffers @ T.ICTR ; R3 -> TCB ; R4 -> CSR ; ; CALL TTOPT4 ; ; R2 = Undefined ; C=0 if successful ; Character in ring ; Output interrupts enabled ; C=1 if no room in output ring ;- TTOPT4::MOV R1,R2 ;Copy pointer to ring buffers .BR TTOPT2 ............ .SBTTL TTOPT2 - Print A Character, No Checking For Specials ;+ ; TTOPT2 - Print a character, no checking for specials ; ; R0 = Character to print ; R2 -> Ring buffers @ T.ICTR ; R3 -> TCB ; R4 -> CSR ; ; CALL TTOPT2 ; ; R2 = Undefined ; C=0 if successful ; Character in ring ; Output interrupts enabled ; C=1 if no room in output ring ;- TTOPT2::ADD #,R2 ;Point to count of output characters .IF NE SYT$K TSTB T.XFLG(R3) ;Is ^X sequence in effect? BNE 30$ ;Yes, ignore CTRL/O status .ENDC ;NE SYT$K TST @R2 ;Test CTRL/O state ;CLC ;C=0 from 'TST' above BMI 80$ ;CTRL/O in effect, don't print, return success 30$: TST T.CNF2(R3) ;Write pass all? .Assume WPALL$ EQ 100000 BMI 40$ ;Yes, don't strip high bit BICB #,R0 ;Clear high bit 40$: CMPB #,@R2 ;Will it fit in the output ring? BLO 80$ ;No room, return carry set (BLO=BCS) .IF NE MAT$S CALL RGFUL ;Report output ring not empty .ENDC ;NE MAT$S CMP 4(R2),-(R2) ;Time to wrap output buffer pointer? BHI 50$ ;No SUB #,@R2 ;Point back to beginning of buffer 50$: MOVB R0,@(R2)+ ;Insert character in output ring INC -(R2) ;Bump 'PUT' pointer INC 2(R2) ; then bump character count (order important!) BR TTOENB ;Enable output interrupts and return ............ .SBTTL ECHO0C - Print Control Character, Then 1 Or 2 Constant Characters ;+ ; ECHO0C - Print control character as "^x", then 1 or 2 constant characters ; ; R0 = Control character to print (normally 0 - 37) ; R1 -> Ring buffers @ T.ICTR ; R3 -> TCB ; R4 -> CSR ; ; JSR R5,ECHO0C ; .BYTE CHAR1,CHAR2 (If CHAR2 = 0, only one character is printed) ; OR ; .ASCII "xx" (Use "x" if only one character to print) ; ; R2 = Undefined ; C=0 if successful ; Characters in ring ; Output interrupts enabled ; C=1 if no room in output ring ; All but the last character may be lost without warning ;- ECHO0C: MOV R0,-(SP) ;Save the character CALL ECHOR0 ;Echo it as a control BR 60$ ;Go merge to print constants ............ .SBTTL ECHO - Print One Or Two Constant Characters ;+ ; ECHO - Print one or two constant characters ; ; R1 -> Ring buffers @ T.ICTR ; R3 -> TCB ; R4 -> CSR ; ; JSR R5,ECHO ; .BYTE CHAR1,CHAR2 (If CHAR2 = 0, only one character is printed) ; OR ; .ASCII "xx" (Use "x" if only one character to print) ; ; R2 = Undefined ; C=0 if successful ; Character in ring ; Output interrupts enabled ; C=1 if no room in output ring ;- ECHO: MOV R0,-(SP) ;Save R0 60$: MOVB (R5)+,R0 ;Get first character CALL TTOPT4 ;Echo it MOVB (R5)+,R0 ;Get second character BEQ 70$ ;Ignore nulls CALL TTOPT4 ;Print second character 70$: MOV (SP)+,R0 ;Restore R0 RTS R5 80$: RETURN .DSABL LSB .SBTTL EOLTST - Test For End Of Line ;+ ; EOLTST - Test for end of line ; ; R0 = Input character ; ; CALL EOLTST ; ; Z=1 if end of line ; Z=0 if not the end of line ;- .ENABL LSB EOLTST::CMPB #,R0 ;Is the character a ? BEQ 10$ ;Yes, return with Z-bit set CMPB #,R0 ;No, is it a CTRL/Z? BEQ 10$ ;Yes, return with Z-bit set CMPB #,R0 ;No, is it a CTRL/C? 10$: RETURN .DSABL LSB .SBTTL DLOINT - DL11 Output Interrupt Routine ;+ ; DLOINT - Services output interrupts for all DL11 interfaces installed in the ; system. DLOINT is entered once per interrupt, extracting the next character ; to be printed from the terminal's ring buffer. Also performs console ; terminal services such as console arbitration. ;- ;+ ; DLOINT (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap code hooks this location with: ; ; NOP ; NOP ; ; This allows for the fact that the RTEM-11 terminal ; service will have the condition codes stacked when ; it fakes a input interrupt. ;- .ENABL LSB TTOINT:: DLOINT:: .IF EQ HSR$O .IF GT GETPSW ;Fetch the condition code bits MOV (SP)+,DLTMP ;and save them for now .ENDC ;GT ;+ ; DLOHOK (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap code hooks this location with: ; ; BR .+12 ; ; This allows output interrupts to be handled ; correctly under RTEM-11 by avoiding a $INTEN ; and a SAVE30 ;- DLOHOK:: ;(*** RTEM-11 HOOK ***) JSR R5,$INTEN ;Declare an interrupt .WORD < ^c & PR7 > ;Run at priority 4 JSR R3,SAVE30 ;Save R3-R0 .IF GT MOV DLTMP,R4 ;Get the line number again .ENDC ;GT .IFF ;EQ HSR$O .IF GT GETPSW ;Get the PS with the unit bits MOVB (SP)+,@HSROPP ;Remember line number as next byte in the ring MOV R0,-(SP) ;Stack R0 PHSRBO ==: < . + 2 > ;**BOOT** Relocate address of HSRB output put pointer MOV #,R0 ;Point to high speed output ring put pointer INC @R0 ;Bump the pointer CMP (R0)+,(R0)+ ;Are we at the end of the ring? BLO 10$ ;Not yet MOV @R0,HSROPP ;Yes, wrap the pointer 10$: MOV (SP)+,R0 ;Restore the register .ENDC ;GT INC HSROCC ;Bump character count in ring BEQ 20$ ;First entry, fork and empty the ring RTI ;Exit, fork level already running ............ ;+ ; DLOHOK (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap code hooks this location with: ; ; BR .+14 ; ; This allows output inturrupts to be handled ; correctly under RTEM-11 by avoiding a $INTEN ; and a SAVE30 ;- DLOHOK:: ;(*** RTEM-11 HOOK ***) 20$: JSR R5,$INTEN ;Enter interrupt service .WORD < ^c & PR7 > ; at priority 4 JSR R5,$FORK ;Drop to fork level right away .WORD < TOFBLK - . > 30$: .IF GT MOV HSROGP,R5 ;Get the get pointer for ring MOVB (R5)+,R4 ;Get a byte of line number CMP R5,HSROEP ;Time to wrap pointer? BLO 40$ ;No MOV HSRORP,R5 ;Yes, reset pointer 40$: MOV R5,HSROGP ;Save the new pointer .ENDC ;GT CALL 50$ ;Stuff the character out DEC HSROCC ;Count down what's left in the ring BPL 30$ ;Do more, if any RETURN ;Done high speed ring ............ 50$: .ENDC ;EQ HSR$O .IF GT BIC #^c,R4 ;Isolate the DL unit number ASL R4 ;Double it for word index PDLTB1 ==: < . + 2 > ;**BOOT** Relocate address of DL TCB pointers table MOV DLTBL(R4),R3 ;Get pointer to this unit's TCB .IFF ;GT MOV DLTBL,R3 ;Get pointer to console TCB .ENDC ;GT MOV T.CSR(R3),R4 ; and address of CSR .IF NE MTI$M BIC #,T.STAT(R3) ;Interrupt received, so not expected CLR T.RTRY(R3) ;Clear the count .ENDC ;NE MTI$M CALL OUTPTR ;Get input ring buffer pointer BEQ 60$ ;Terminal is unowned. Report empty CALL OUTCHR ;Get the character to print BCS 60$ ;If C-bit set, there is nothing to print .IF NE MTI$M BIS #,T.STAT(R3) ;Indicate that we expect an ; output interrupt .ENDC ;NE MTI$M ;+ ; HKPC07 (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALL PIHK07 ; ; PIHK07 outputs the character in R0 to the video output on a PRO300 series ; processor. ;- HKPC07:: MOVB R0,T.TPB(R4) ;Print the character .Assume <.-HKPC07> EQ 4 CALLR @$XTTPB ;Process the output character ............ 60$: ;+ ; HKPC05 (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALL PIHK05 ; ; PIHK05 disables video output interrupt on a PRO300 series ; processor. ;- HKPC05:: MOV #<0>,T.TPS(R4) ;Disable interrupts (BIC #,T.TPS(R4)) .Assume <.-HKPC05> EQ 6 CALLR @$XTTPS ;T.TPS may have changed ............ .DSABL LSB .SBTTL Control Character Output Dispatch Table .MACRO CTLCHO C OUP'C:: . = < C + TTOTBL > .BYTE < OUP'C - TTOBAS > . = OUP'C .SBTTL Process C output .ENDM CTLCHO TTOTBL:: .REPT 40 .BYTE < OUPXXX - TTOBAS > .ENDR .SBTTL OUTCHR - Output Character Processing ;+ ; OUTCHR - Output next character. Called by terminal interrupt routines to ; process a single character. ; ; R1 -> Input ring buffer pointers (T.ICTR) ; R3 -> TCB ; R4 -> Terminal receive CSR ; R5 -> Job impure area ; ; CALL OUTCHR ; ; R0 = Character to print ; R1 = Undefined ; R2 = Undefined ; R5 -> New owner's impure area if ownership changed ; C=0 if character processed ; C=1 if no character to output (stack is empty) ;- .ENABL LSB OUTCHR: .IF NE MTY$HK CALL HHCHK ;Line owned by handler? BEQ 5$ ;Nope... MOV R5,-(SP) ;Save pointer for awhile MOV #TH.GOC,R0 ;R0 = 'Get output character' code .IF EQ MMG$T CALL @T.OWNR(R3) ;Call handler hook routine .IFF ;EQ MMG$T CALL HHHOOK ;Call handler hook routine .ENDC ;EQ MMG$T MOV R5,R0 ;*C* Move character to R0 MOV (SP)+,R5 ;*C* Restore previously saved register RETURN ;with character in R0 or carry set 5$: .ENDC ;NE MTY$HK TSTB T.STAT(R3) ;Is the terminal on (XOFF state)? .Assume PAGE$ EQ 200 BPL 20$ ;No, continue 10$: SEC ;Set C-bit to indicate nothing to print RETURN ;Return no-print indication ............ 20$: TST T.CNF2(R3) ;Write pass all mode? .Assume WPALL$ EQ 100000 BMI 40$ ;Yes, skip fill TSTB T.NFIL(R3) ;Are we doing null filling? BEQ 30$ ;No DECB T.NFIL(R3) ;Yes, one less filler now CLR R0 ;Give caller a null byte to print RETURN ;Done ............ 30$: TSTB T.TNFL(R3) ;Are we filling for TAB or FF? BEQ 40$ ;No INCB T.TNFL(R3) ;Increment special fill count MOVB T.TCTF(R3),R0 ;Get character to fill BR 190$ ;Send the filler ............ 40$: TSTB (R1) ;Is there output for this job? BNE 50$ ;Yes, don't unblock for output empty JSR R4,UNBLOK ;Unblock the job if waiting for output empty .WORD TTOEM$ 50$: .IF EQ SB MOV T.TID(R3),R2 ;Printing an ID? BEQ 80$ ;No, skip over ID code 60$: MOVB (R2)+,R0 ;Get a character from the ID BNE 70$ ;ID isn't done yet CLR R2 ;Else, end of ID, turn off printing of it 70$: MOV R2,T.TID(R3) ;Save the current ID pointer, 0 if end BNE 190$ ;Print the character if any CLRB T.OCHR(R3) ;Avoid another switch 80$: BIT #,T.STAT(R3) ;Shared console? BEQ 110$ ;No, put character into buffer .IF NE SYT$K TSTB T.XFLG(R3) ;Yes, is ^X sequence in progress? BNE 130$ ;Allow out buf. to empty before printing ^X ID .ENDC ;NE SYT$K .IFF ;EQ SB 80$: TST T.STAT(R3) ;Console? .Assume CONSL$ EQ 100000 BPL 110$ ;No, put character into buffer .ENDC ;EQ SB TST T.CNF2(R3) ;Write pass all? .Assume WPALL$ EQ 100000 BMI 110$ ;Yes, just put character in buffer .IF EQ SB CMPB #,T.OCHR(R3) ;Did we just print a LF here? BNE 120$ ;No, not yet time to arbitrate ownership MOV IMPLOC,R2 ;Point to table of impure pointers 90$: MOV -(R2),R5 ;Get a pointer BEQ 90$ ;No such job CMP #<-1>,R5 ;End of table? BEQ 10$ ;Yes, no job with output ready BIT #,I.BLOK(R5) ;Is the job dead? BNE 90$ ;Yes, get next pointer .IF NE SYT$K CMP I.CNSL(R5),R3 ;Is this the job's console? BNE 90$ ;No, get next pointer .ENDC ;NE SYT$K CMP TTHOUS,R5 ;Found a job with this as console. Using TT:? BEQ 100$ ;Yes, this job wins the terminal output TSTB I.OCTR(R5) ;No, is there .TTYOUT type output? BEQ 90$ ;No output, get next pointer 100$: CMP TTOUSR,R5 ;Is this job already printing here? BEQ 110$ ;Yes, no ID print since no owner change MOV R5,TTOUSR ;Change ownership of shared console output MOV I.TID(R5),T.TID(R3) ;Copy the ID pointer to print it MOV R5,R1 ;Point to the ADD #,R1 ; ring buffers BR 40$ ;Go print the new user's ID ............ .ENDC ;EQ SB 110$: TST T.STAT(R3) ;Console? .Assume CONSL$ EQ 100000 BPL 130$ ;No, job couldn't be using TT: here 120$: CMP TTHOUS,R5 ;Is this job using TT:? BEQ TTHOUT ;Yes, set up to process from it 130$: CMPB (R1),(PC)+ ;Job blocked? ..TTON:: .WORD TTBF$O ;**PATCH** Threshold to awaken output-blocked job BNE 140$ ;No, don't bother unblocking JSR R4,UNBLOK ;Unblock the job if waiting for output room .WORD TTOWT$ 140$: ADD #,R1 ;Point to the output ring pointers CMP @R1,-(R1) ;Time to wrap output pointer? BNE 150$ ;No SUB #,@R1 ;Yes, wrap it 150$: TSTB -2(R1) ;Anything to print? (T.OCTR) .IF EQ SYT$K BEQ 10$ .IFF ;EQ SYT$K BNE 160$ ;Yes, print it TSTB T.XFLG(R3) ;No, need ^X ID printed? BPL 10$ ;No, already printed ASLB T.XFLG(R3) ;Yes, clear high bit to indicate already done .ADDR #,R2 ;Point to ID to print MOV R2,T.TID(R3) ;Store the pointer BR 60$ ;Start printing ID ............ 160$: .ENDC ;EQ SYT$K MOVB @(R1)+,R0 ;Get the character 170$: TST T.CNF2(R3) ;Write pass all mode? .Assume WPALL$ EQ 100000 BMI OUPXXX ;Yes, don't check character BIC #,R0 ;No, make it 7 bit ASCII CMPB #<' >,R0 ;Is it a printing character? BHI SPCHAR ;No, check for special character CMP R0,# ;RUBOUT character? BEQ OUPXXX ;Yes INCB T.LPOS(R3) ;Bump the line position .Assume T.CNFG EQ 0 BIT #,@R3 ;Automatic CR/LF enabled? (T.CNFG = 0) BEQ OUPXXX ;No, just print it CMPB T.LPOS(R3),T.WID(R3) ;Yes, has carriage width been exceeded? BLOS OUPXXX ;No, don't print automatic CR/LF CLRB T.LPOS(R3) ;Yes, rest carriage position MOVB #,R0 ;Output a carriage return now MOV #<<-1*400>+LF>,T.TCTF(R3) ;Print a LF later 180$: MOVB R0,T.OCHR(R3) ;Remember the character to be printed 190$: CMPB R0,T.TFIL(R3) ;Does it need fillers? BNE 200$ ;No, return with C-bit clear TST T.CNF2(R3) ;Write pass all mode? .Assume WPALL$ EQ 100000 BMI 200$ ;Yes, don't check fillers MOVB T.FCNT(R3),T.NFIL(R3) ;Yes, set up the fillers 200$: CLC ;Return with C-bit clear RETURN ............ CTLCHO CR CLRB T.LPOS(R3) ;We're at the left margin, clear line position OUPXXX: INC -(R1) ;Bump the output ring pointer DEC -(R1) ;Decrement the character count .IF NE MAT$S TSTB @R1 ;More left to print? BNE 180$ ;Branch if yes. CALL RGEMP ;Indicate that output ring is empty .ENDC ;NE MAT$S BR 180$ ;Go print it ............ ;+ ; Process special output characters ;- TTOTPT ==: < . + 2 > ;**BOOT** Relocate address of special dispatch table SPCHAR: MOVB TTOTBL(R0),R2 ;Get special dispatch address ADD R2,PC ;Jump to dispatch TTOBAS:: ;+ ; Form feed processing ;- CTLCHO FF .Assume T.CNFG EQ 0 BIT #,@R3 ;Hardware FF? (T.CNFG = 0) BNE OUPXXX ;Yes, print FF MOV #<<-7*400>+LF>,T.TCTF(R3) ;No, simulate with 8 line feeds MOV #,R0 ;Print the first BR OUPXXX ;Merge ............ ;+ ; BACKSPACE processing ;- CTLCHO BS .Assume T.CNFG EQ 0 TST @R3 ;Does terminal have backspace? .Assume BKSP$ EQ 100000 BPL OUPXXX ;No DECB T.LPOS(R3) ;Yes, reduce line position BR OUPXXX ;Go print it ............ ;+ ; Horizontal TAB processing ;- CTLCHO TAB .Assume T.CNFG EQ 0 BIT #,@R3 ;Hardware tabs? BNE 210$ ;Yes, easy to print, just compute new pos MOV (R3),R0 ;Get current line position in high byte BIS (PC)+,R0 ;Convert to number of spaces in high byte, .BYTE <-1>,<370> ; put a -1 in the low byte ADD #<<' >+1>,R0 ;Put space in low byte, increment high byte MOV R0,T.TCTF(R3) ;Set fill count and space value MOVB R0,R0 ;Put a simple space as byte to print 210$: ADD #<8.*400>,(R3) ;Fix line position by rounding up BIC #<7*400>,(R3) ; to the next multiple of 8 BR OUPXXX ;Print it ............ ;+ ; TTHOUT - TT: output processing for console terminals ;- TTHOUT: MOV R1,R2 ;Copy pointer to T.ICTR in TCB TST (R1) ;Is CTRL/O in effect? BMI TTHOCM ;Yes, complete at once BEQ 220$ ;No, but output ring empty, start .WRITE BIT #,T.STAT(R3) ;Were chars there before .WRITE? BEQ 130$ ;Yes, let them be printed 220$: BIS #,T.STAT(R3) ;.WRITE starting, let .TTYOUT's wait MOV TTCQE,R1 ;Get pointer to Q.BLKN in queue element ADD #,R1 ;R1 -> byte count in Q.BUFF TTHOU1: TST (R1)+ ;Output done yet? BEQ TTHOCM ;Yes, go to COMPLT to end the request .IF NE MMG$T MOV @#KISAR1,-(SP) ;No, preserve PAR1 mapping BIT #,@R1 ;Did we cross the boundary into PAR2? BEQ 230$ ;No, address is OK SUB #,@R1 ;Yes, adjust the address back to PAR1 ADD #,(R1) ; and fix PAR1 value to map it 230$: MOV (R1),@#KISAR1 ;Map to the user buffer .ENDC ;NE MMG$T MOVB @(R1)+,R0 ;Get character to print .IF NE MMG$T MOV (SP)+,@#KISAR1 ;Restore mapping .ENDC ;NE MMG$T TST T.CNF2(R3) ;Write pass all? .Assume WPALL$ EQ 100000 BMI OUPXXX ;Yes,just print it TSTB R0 ;Was character a null? BNE 170$ ;No, print it 240$: INC -(R1) ;Bump buffer pointer to skip null DEC -(R1) ;Decrement count BR TTHOU1 ;Try next character ............ TTHOCM: MOV R5,-(SP) ;Save MOV R4,-(SP) ; registers CALL TTCMPL ;Go to completion MOV (SP)+,R4 ;Restore MOV (SP)+,R5 ; registers MOV R2,R1 ;Restore pointer to input count CALLR 20$ ;Go back to internal ring buffers ............ .DSABL LSB .IF NE DZ11$N .SBTTL DZIINT - DZ11 Input Interrupt Service ;+ ; DZIINT - Service input interrupts for all DZ11 multiplexors ; Remains at interrupt level until silo is emptied, ; calling INCHAR once per character. ;- .ENABL LSB DZIINT:: .IF GT GETPSW ;Fetch condition code bits MOV (SP)+,DZTMP ;Save them temporarily .ENDC ;GT JSR R5,$INTEN ;Declare an interrupt .WORD < ^c & PR7 > ; to run at priority 5 JSR R3,SAVE30 ;Save R3 - R0 10$: .IF GT MOV DZTMP,R4 ;Get interrupt PS BIC #^c,R4 ;Extract unit number from condition code bits ASL R4 ;Make them a word index PDZTB0 ==: < . + 2 > ;**BOOT** Relocate address of DZ TCB pointers table MOV DZTBL(R4),R3 ;R3 -> Table of TCB pointers PDZCS0 ==: < . + 2 > ;**BOOT** Relocate address of DZ CSR table MOV DZCSR(R4),R4 ;R4 -> Keyboard CSR .IFF ;GT MOV DZTBL,R3 ;R3 -> Table of TCB pointers MOV DZCSR,R4 ;R4 -> Keyboard CSR .ENDC ;GT MOV DZ.RBUF(R4),R0 ;Get a character from silo .Assume DZDVD$ EQ 100000 BPL 30$ ;Silo is empty, we can return MOV R0,R5 ;Copy character and flags SWAB R5 ;Get line number into low byte BIC #^c,R5 ;Isolate it ASL R5 ;Convert to table index ADD R3,R5 ;R5 -> TCB Pointer MOV @R5,R3 ;R3 -> TCB of this line BEQ 10$ ;Spurious interrupt, ignore it TSTB T.CNF2(R3) ;Read pass all mode? .Assume RPALL$ EQ 200 BMI 20$ ;Yes, pass nulls BIC #,R0 ;Clear extraneous bits BEQ 10$ ;Ignore nulls 20$: CALL INPTR ;Point at the owner's ring pointers BEQ 10$ ;Unit is unowned, ignore the input character CALL INTCOM ;Process the character BR 10$ ;Get next one from silo 30$: RETURN ;Return from interrupt .DSABL LSB .SBTTL DZOINT - DZ11 Output Interrupt Service ;+ ; DZOINT - DZ11 output interrupt service ; ; Service output interrupts for all DZ11/DZV11 multiplexors on the system. ; Sends one character per interrupt ;- .ENABL LSB DZOINT:: .IF GT GETPSW ;Get condition codes containing DZ number MOV (SP)+,DZTMP ;Save them .ENDC ;GT JSR R5,$INTEN ;Declare an interrupt .WORD < ^c & PR7 > ; and run at priority 5 JSR R3,SAVE30 ;Save the rest of the registers .IF GT MOV DZTMP,R4 ;Get interrupt PS BIC #^c,R4 ;Extract condition code bits ASL R4 ;Double them to get a table index PDZTB1 ==: < . + 2 > ;**BOOT** Relocate address of DZ TCB pointers table MOV DZTBL(R4),R3 ;Point to TCB pointers for this unit PDZCS1 ==: < . + 2 > ;**BOOT** Relocate address of DZ CSR table MOV DZCSR(R4),R4 ;Point to keyboard CSR for this unit .IFF ;GT MOV DZTBL,R3 ;Point to TCB pointers for the DZ MOV DZCSR,R4 ;Point to keyboard CSR for DZ .ENDC ;GT MOVB 1(R4),R5 ;Get line number of interrupting line BIC #^c,R5 ;Isolate it ASL R5 ;Make it index to TCB table ADD R3,R5 ;Point to TCB pointers for this DZ MOV @R5,R3 ;Get TCB pointer for this line CALL OUTPTR ;Point to ring buffers BEQ 10$ ;Unit is unowned, ignore it CALL OUTCHR ;Get an output character BCS 10$ ;Nothing to print, turn off output here MOVB R0,DZ.TDR(R4) ;Print the character RETURN ;Done 10$: MOVB T.PUN(R3),R0 ;Get line number again PBMSK3 ==: < . + 2 > ;**BOOT** Relocate address of bit masks table BICB BITMSK(R0),DZ.TCR(R4) ;Disable this unit for output RETURN ;Done .DSABL LSB .IF NE DZMD$M .SBTTL DZMCTL - Multi-terminal DZ11 Modem Control ;+ ; DZMCTL -- This is a completion routine which runs every half second ; as a result of a .MRKT. It polls each unit of each DZ11 for its modem ; status and notes any changes in status in the unit's TCB. Since there ; is NO RING INTERRUPT on the DZ11, the assumption is made that all modems ; operate in an auto-answer mode. ; ; Entered as a completion routine with R0 and R1 available. All others ; must be saved if used. ; ; Note: ; o Modification for V5.6, only those remote lines that are either ; attached by a job or hooked by a handler which has not disabled ; modem control will have DTR turned on. ; ;- .ENABL LSB DZMCTL:: JSR R5,SAVE52 ;Save some registers PDZTCT ==: < . + 2 > ;**BOOT** Relocate address of DZ TCB list MOV #DZTCTB,R1 ;R1 -> Table of pointers to DZ TCBs MOV #,R2 ;R2 = Number of DZ lines total 10$: MOV (R1)+,R3 ;R3 -> TCB for a DZ line BEQ 30$ ;In case entry is not filled... MOV T.CSR(R3),R4 ;R4 -> CSR for interface BEQ 30$ ;In case interface doesn't exist... TST T.OWNR(R3) ;Is line attached by job ; or hooked by handler? BEQ 30$ ;Nope, then don't touch it... .Assume T.CNFG EQ 0 BIT #,@R3 ;Is this a remote line? BEQ 30$ ;Nope, no need to check carrier .IF NE MTY$HK CALL HHMCHK ;Modem control disabled on this line? BNE 30$ ;Yes, handler will process modem .ENDC ;NE MTY$HK MOVB T.PUN(R3),R0 ;R0 = DZ physical unit number PBMSK4 ==: < . + 2 > ;**BOOT** Relocate address of bit masks table MOVB BITMSK(R0),-(SP) ;Get the bit mask for this line BISB @SP,DZ.DTR(R4) ;Assert DTR for this line BITB (SP)+,DZ.CAR(R4) ;Is a carrier present? BEQ 30$ ;Nope, on to next line BIT #,T.STAT(R3) ;Yes, is unit 'on-hook'? BEQ 20$ ;Nope, it's ready MOV #,-(SP) ;Get initial line characteristics BISB R0,@SP ;Set in unit # MOV (SP)+,DZ.LPR(R4) ;Set line parameters BIC #,T.STAT(R3) ;Init status .IF NE MAT$S CALL CARON ;Indicate modem off-hook and carrier .ENDC ;NE MAT$S BR 30$ ;Try next unit ; Carrier not present on this unit 20$: BIT #,T.STAT(R3) ;Already hung up (on-hook)? BNE 30$ ;Yes, on to next line PBMSK5 ==: < . + 2 > ;**BOOT** Relocate address of bit masks table BICB BITMSK(R0),DZ.DTR(R4) ;No, drop Data Terminal Ready BIS #,T.STAT(R3) ; and flag line is hung-up (on-hook) .IF NE MAT$S CALL HNGON ;Indicate modem on-hook and no carrier .ENDC ;NE MAT$S 30$: DEC R2 ;Any more DZ lines to check? BGT 10$ ;Yes... ; Post another timer for 1/2 second from now DZTIMR: MOV DZTMCP,DZTCOM ;Set up completion address JSR R5,$TIMIO ;Call TIMIO to Q a MARK TIME .WORD < DZTMBK - . > ;Offset to timer block .WORD 0 ;Mark Time .WORD 0 ;Hi order time .WORD < CLOCK / 2 > ;Lo order time - 1/2 second RETURN .DSABL LSB ; DZ11 Timer Control Block DZTMBK: .WORD 0, 0 ;Double-precision time .WORD 0, 0 .WORD 177442 ;Sequence number .WORD -1 ;System timer element DZTCOM: .WORD 0 ;Completion routine DZTMCP::.WORD DZMCTL ;Completion routine address ***BOOT*** .ENDC ;NE DZMD$M .ENDC ;NE DZ11$N .IF NE DH11$N .SBTTL DHIINT - DH series Input Interrupt Service ;+ ; ; DHIINT ; Services input interrupts for all DH11 (and variant) ; multiplexors. Remains at interrupt level until all ; received characters have been processed. ; ;- .ENABL LSB DHIINT:: .IF GT GETPSW ;Fetch condition code bits MOV (SP)+,DHTMP ;Save them temporarily .ENDC ;GT JSR R5,$INTEN ;Declare an interrupt .WORD < ^c & PR7 > ; to run at DH device priority JSR R3,SAVE30 ;Save registers R0-R3 10$: CALL DHSELC ;Select appropriate controller info MOV (R1)+,R4 ;R4 -> Controller base CSR MOV (R1)+,R3 ;R3 -> First TCB for this controller 20$: MOV DH.RBF(R4),R0 ;R0 = Character (and other info) .Assume DHDV$ EQ 100000 BPL 50$ ;Receive FIFO is empty... MOV R0,R5 ;Copy the character BIC #^C,R5 ;Mask to DH receive line number SWAB R5 ; which is then moved to low byte CMPB R5,(R1) ;Interrupt from a configured line? BHIS 20$ ;Nope, ignore it... ASL R5 ;Yes, shift for word offset ADD R3,R5 ; into TCB table for this controller MOV @R5,R3 ;R3 -> TCB BEQ 10$ ;Ignore character if no TCB MOV R0,R5 ;Copy the character again BIC #^C,R5 ;Strip to error bits .IF EQ DHMD$M BNE 10$ ;Invalid character, ignore it... .IFF ;EQ DHMD$M BEQ 30$ ;Valid character... CMPB R5,# ;Modem or diagnostic info? BNE 10$ ;Neither, ignore it BIT #1,R0 ;Yes, modem status? BNE 10$ ;No, diagnostic info, ignore it... SWAB R0 ;Yes, shift info to high byte CALL DHMCTL ;Process the modem status change BR 10$ ; and go process next receive event 30$: .ENDC ;EQ DHMD$M TSTB T.CNF2(R3) ;Doing Read_Pass_All? .Assume RPALL$ EQ 200 BMI 40$ ;Yes, don't touch character... BIC #^C<177>,R0 ;Nope, make it 7-bit ASCII BEQ 10$ ; ignoring s 40$: CALL INPTR ;Get proper pointers BEQ 10$ ;Unit is unowned, ignore interrupt CALL INTCOM ;Put character where it belongs BR 10$ ; then process another receive event 50$: RETURN .DSABL LSB .SBTTL DHOINT - DH series Output Interrupt Service ;+ ; ; DHOINT ; Responds to an output interrupt generated by a DH series ; interface. ; ;- .ENABL LSB DHOINT:: .IF GT GETPSW ;Get condition code bits MOV (SP)+,DHTMP ; and save them temporarily .ENDC ;GT JSR R5,$INTEN ;Declare an interrupt .WORD < ^c & PR7 > ; to run at DH device priority JSR R3,SAVE30 ;Save registers R0-R3 10$: CALL DHSELC ;Select appropriate controller info MOV (R1)+,R4 ;R4 -> Controller base CSR MOV (R1)+,R5 ;R5 -> First TCB for this controller 20$: MOV DH.CSR(R4),R3 ;R3 = Interrupting line number .Assume DHTAC$ EQ 100000 BPL 50$ ;No more transmit actions to process BIC #^C,R3 ;Strip to line number SWAB R3 ;Shift to low byte CMPB R3,(R1) ;Interrupt from a configured line? BHIS 20$ ;Nope, ignore it... ASL R3 ;Yes, shift for word offset ADD R3,R5 ; into TCB table for this controller MOV @R5,R3 ;R3 -> TCB BEQ 10$ ;Ignore if no TCB BIC #,T.STAT(R3) ;Reset Output_In_Progress CALL DHENB1 ;Output a character BR 10$ DHENB1: CALL OUTPTR ;Point to ring buffers BEQ 50$ ;Unit is unowned, ignore it... CALL OUTCHR ;Get an output character BCS 50$ ;Nothing to output... CALL DHSELL ;Select the DH line BIT #,DH.LSR(R4) ;DHU or DHV mode? BEQ 30$ ;DHV mode... MOVB R0,DH.FDA(R4) ;Write character to DHU fifo BR 40$ 30$: BIS #,R0 ;Mark as valid character to transmit MOV R0,DH.TXC(R4) ;Transmit the single character to DHV 40$: BIS #,T.STAT(R3) ;Set Output_In_Progress 50$: RETURN .DSABL LSB .SBTTL DHSELC - Select DH controller information block ;+ ; ; DHSELC ; Returns a pointer to the DH controller information block ; associated with the interrupting controller. ; ; Implicit input: ; DHTMP contains PSW from vector (low bits indicate controller #) ; ; Returns: ; R1 -> DH Controller information block ; ;- DHSELC: .IF GT MOV DHTMP,R1 ;R1 = Interrupt PS BIC #^C,R1 ;Strip to controller number BEQ 20$ ;If controller 0, use CIT entry 0 .IF GT CLR -(SP) ;Reset CIT offset 10$: ADD #DHI.SZ,@SP SOB R1,10$ MOV (SP)+,R1 ;R1 = Offset to CIT entry .IFF ;GT MOV #DHI.SZ,R1 ;Offset to CIT entry 1 .ENDC ;GT 20$: ADD #DHTBL,R1 ;R1 -> CIT entry DHIT00 == < . - 2 > ;** BOOT ** Relocate address of CIT entry 0 .IFF ;GT MOV #DHTBL,R1 ;R1 -> CIT entry DHIT00 == < . - 2 > ;** BOOT ** Relocate address of CIT entry 0 .ENDC ;GT RETURN .SBTTL DHSELL - Select DH line ;+ ; ; DHSELL ; Selects a particular DH line. ; ; Call: ; R3 -> TCB ; ; Return: ; R4 -> CSR of controller ; Line has been selected ; ;- DHSELL: CLR -(SP) ;Set to get DH line number MOVB T.PUN(R3),@SP ;Get it... MOV T.CSR(R3),R4 ;R4 -> DH Controller base CSR BIS #,@SP ;Ensure interrupts remain enabled MOV (SP)+,@R4 ;Select the DH line RETURN .ENDC ;NE DH11$N .IF NE .SBTTL SAVE52 - Save Registers R5-R2 ;+ ; SAVE52 - Save R5-R2 coroutine ; ; SP -> Return address ; ; JSR R5,SAVE52 ; ; R5 = Undefined ; R2-R5 Saved ; ; Restore registers and return via RETURN ;- SAVE52: MOV R4,-(SP) ;Save the registers MOV R3,-(SP) ; that weren't saved MOV R2,-(SP) ; by the JSR CALL @R5 ;Call our caller back MOV (SP)+,R2 ;Restore MOV (SP)+,R3 ; all MOV (SP)+,R4 ; four MOV (SP)+,R5 ; registers RETURN ;Return to caller's caller .ENDC ;NE .IF NE MAT$S .SBTTL Report Status Subroutines ;+ ; The following subroutines call TRMSTS to report status changes to the user. ; ; R3 -> TCB ; R5 -> Job impure area ; ; CALL function ;- ;+ ; CARON - Report modem carrier present ;- CARON:: JSR R1,TRMSTS ;Return terminal status to user .WORD AS.HNG ;Clear terminal hung up bit .WORD AS.CAR ;Set modem carrier present bit ............ ;+ ; HNGON - Report terminal hung up ;- HNGON:: JSR R1,TRMSTS ;Return terminal status to user .WORD AS.CAR ;Clear modem carrier present bit .WORD AS.HNG ;Set terminal hung up bit ............ ;+ ; CTCON - Report double CTRL/C. ;- CTCON:: JSR R1,TRMSTS ;Return terminal status to user .WORD 0 ;Don't clear any bits .WORD AS.CTC ;Set double CTRL/C bit ............ ;+ ; CLRIN - Report no input available ;- CLRIN:: JSR R1,TRMSTS ;Return terminal status to user .WORD AS.INP ;Clear input available bit .WORD 0 ;Don't set any bits ............ ;+ ; SETIN - Report input available ;- SETIN:: JSR R1,TRMSTS ;Return terminal status to user .WORD 0 ;Don't clear any bits .WORD AS.INP ;Set input available bit ............ ;+ ; RGFUL - Report output buffer not empty ;- RGFUL:: JSR R1,TRMSTS ;Return terminal status to user .WORD AS.OUT ;Clear output buffer empty bit .WORD 0 ;Don't set any bits ............ ;+ ; RGEMP - Report output buffer empty ;- RGEMP:: JSR R1,TRMSTS ;Return terminal status to user .WORD 0 ;Don't clear any bits .WORD AS.OUT ;Set output buffer empty bit ............ .SBTTL TRMSTS - Copy Terminal Status To User ;+ ; TRMSTS - Set terminal status information in user supplied status word ; (Information is returned asynchronously as it changes) ; ; R3 -> TCB ; R5 -> Job impure area ; SP -> Address to return to ; ; JSR R1,TRMSTS ; .WORD Bits to clear ; .WORD Bits to set ; ; Return to caller's caller ;- .ENABL LSB TRMSTS: TST T.OWNR(R3) ;Is this line attached? BEQ 10$ ;Nope, then AST can't be valid TST T.AST(R3) ;Is there an AST word set up? BEQ 10$ ;No, exit real fast .IF NE MMG$T MOV @#KISAR1,-(SP) ;Save kernel PAR1 MOV T.AST+2(R3),@#KISAR1 ;Set up PAR1 to map the user AST word .ENDC ;NE MMG$T BIC (R1)+,@T.AST(R3) ;Clear some bits BIS (R1)+,@T.AST(R3) ; and set some others .IF NE MMG$T MOV (SP)+,@#KISAR1 ;Restore PAR1 .ENDC ;NE MMG$T 10$: MOV (SP)+,R1 ;Restore caller's R1 RETURN ;Return to his caller .DSABL LSB .ENDC ;NE MAT$S .IF NE MTY$HK .IF NE MMG$T .SBTTL HHHOOK - Multi-terminal handler hooks for XM HHHOOK: MOV @#KISAR1,-(SP) ;Save current PAR1 mapping MOV #200,@#KISAR1 ;Map to kernel CALL @T.OWNR(R3) ;Call handler hook routine MOV (SP)+,@#KISAR1 ;*C* Restore PAR1 mapping RETURN .ENDC ;NE MMG$T .SBTTL HHCHK - Check for handler hooks in use .SBTTL HHMCHK - Check for handler hooks modem control use ;+ ; ; HHCHK ; This routine checks if the TCB is owned by a handler ; ; Call: ; R3 -> TCB ; ; Return: ; PSW = 0, line is not hooked by handler ; PSW = 1, line is hooked by handler ; ; Note: ; T.OWNR is checked after HANMT$ because there is a race dependent ; on which order a handler establishes the linkage information. If ; T.OWNR is set first and an interrupt occurs before HANMT$ is set, ; the interrupt service code could use the handler code as if it ; was a jobs impure area. Users should be advised to set the HANMT$ ; bit first, then load T.OWNR with the address of the hook routine ; in the handler. ; ; HHMCHK ; This routine checks if the TCB is owned by a handler and if ; the handler has disabled the multiterminal service from ; processing modem status changes. ; ; Call: ; R3 -> TCB ; ; Return: ; PSW = 0, line is not hooked by handler or ; handler has not disabled modem control ; PSW = 1, line is hooked by handler and ; handler has disabled modem control ; ; Note: ; o Uses HHCHK ; ;- HHCHK:: BIT #,T.STAT(R3) ;Is terminal line linked to handler? BEQ 10$ ;Nope... TST T.OWNR(R3) ;Yes, but is the link really set? 10$: RETURN ;Return PSW HHMCHK:: CALL HHCHK ;Is terminal line linked to handler? BEQ 10$ ;Nope... BIT #,T.STAT(R3) ;Yes, will handler process modem? 10$: RETURN ;Return PSW .SBTTL MTOENB - Output enable routine (Handler hooks) ;+ ; ; MTOENB ; Enables output interrupts on a specified line. ; ; Call (via THOOKS data structure, offset 04): ; R3 -> TCB ; ; Note: ; Saves R4 ; ;- MTOENB:: MOV R4,-(SP) ;Save R4 for awhile MOV T.CSR(R3),R4 ;R4 -> Base CSR of terminal interface CALL TTOENB ;Enable output interrupts MOV (SP)+,R4 ;Restore previously saved register RETURN ;to caller .SBTTL MTYBRK - Break control routine (Handler hooks) .SBTTL MTYCTL - Line control routine (Handler hooks) ;+ ; ; MTYBRK ; Sets or resets the status of the BREAK signal on a ; specified line. ; ; Call (via THOOKS data structure, offset 10): ; R0<00> indicates desired state of BREAK signal ; R3 -> TCB ; ; Return: ; R0 = Current modem status (DL-compatible bits) ; ;- .ENABL LSB MTYBRK:: BIC #^C,R0 ;Only this bit is altered MOV R0,-(SP) ;Save it CALL MTYSTA ;Get current status BIC #,R0 ; and dump Break BIS (SP)+,R0 ;Merge new setting... BR 10$ ; and join common code ;+ ; ; MTYCTL ; Sets or resets the status of modem control signals on a ; specified line. ; ; Call (via THOOKS data structure, offset 12): ; R0<00> = desired status of ; R3 -> TCB ; ; Return: ; R0 = Current modem status (DL-compatible bits) ; ; Note: ; On DL and DH, DTR and RTS may be set/reset ; On DZ, only DTR may be set/reset ; ; Entry via this routine will not allow setting/resetting of ; Break bit on any interface, you must use the MTYBRK routine ; to do that. ; ; The reason the priority is raised during the DH code is ; to prevent a race between the selection of a line from ; this code (and subsequent reference) and selection of a ; possibly different line from interrupt code. ; ;- MTYCTL:: BIC #^C,R0 ;Only these bits may be set/reset 10$: MOV R4,-(SP) ;Save R4 for awhile MOV T.CSR(R3),R4 ;R4 -> Base CSR for interface .IF NE BIT #,T.STAT(R3) ;Is line a DZ or DH? BEQ 50$ ;Nope, it's a DL... .IF NE DZ11$N .IF NE DH11$N BIT #,T.STAT(R3) ;Is line a DZ? BEQ 40$ ;Nope, it's a DH... .ENDC ;NE DH11$N MOV R2,-(SP) ;Save R2 for awhile MOVB T.PUN(R3),R2 ;R2 = Physical Unit Number PBMSK6 ==: < . + 2 > ;** BOOT ** Relocate address of bit masks table MOVB BITMSK(R2),R2 ;R2 = Bit to touch MOVB DZ.BRK(R4),-(SP) ;Get current state of BRK BICB R2,@SP ; and dump it BIT #,R0 ;Should it be on? BEQ 20$ ;Nope... BISB R2,@SP ;Yes, set it 20$: MOVB (SP)+,DZ.BRK(R4) ; and update the BRK register MOVB DZ.DTR(R4),-(SP) ;Get current state of DTR BICB R2,@SP ; and dump it BIT #,R0 ;Is DTR supposed to be on? BEQ 30$ ;Nope... BISB R2,@SP ;Yes, set it... 30$: MOVB (SP)+,DZ.DTR(R4) ; and update the DTR register MOV (SP)+,R2 ;Restore previously saved R2 BR 70$ .ENDC ;NE DZ11$N .IF NE DH11$N 40$: CALL DL2DH ;Convert DL to DH format GETPSW ;Get current priority SPL 7 ;Enter critical section CALL DHSELL ;;;Select the DH line MOV DH.LCR(R4),-(SP) ;;;Get the current modem status BIC #,@SP ;;;Strip the old control bits BIS R0,@SP ;;;Merge the new control bits MOV (SP)+,DH.LCR(R4) ;;;Set the line control register PUTPSW ;;;Restore previous priority BR 70$ .ENDC ;NE DH11$N .ENDC ;NE 50$: MOV T.TPS(R4),-(SP) ;Get current transmitter status BIC #,@SP ; and dump Break BIT #,R0 ;Should it be on? BEQ 60$ ;Nope... BIS #,@SP ;Yes, set it 60$: MOV (SP)+,T.TPS(R4) ; and update the register BIC #,R0 ;Discard it now that we've used it .Assume T.TKS EQ 0 MOV @R4,-(SP) ;Get the current modem status BIC #,@SP ;Strip the old control bits BIS R0,@SP ;Merge the new control bits .Assume T.TKS EQ 0 MOV (SP)+,@R4 ;Set the new status 70$: MOV (SP)+,R4 ;Restore previously saved registers .BR MTYSTA ;Return new status .DSABL LSB .SBTTL MTYSTA - Line status routine (Handler hooks) ;+ ; ; MTYSTA ; Returns the status of the modem control signals which ; are applicable for the line in a DL-compatible format. ; ; Call (via THOOKS data structure, offset 14): ; R3 -> TCB of line ; ; Return: ; R0 = DL-Compatible modem control bits ; ; Note: ; The reason the priority is raised during the DH code is ; to prevent a race between the selection of a line from ; this code (and subsequent reference) and selection of a ; possibly different line from interrupt code. ; ;- .ENABL LSB MTYSTA:: CLR R0 ;Reset returned status MOV R4,-(SP) ;Save R4 for awhile MOV T.CSR(R3),R4 ;R4 -> Base CSR for interface .IF NE BIT #,T.STAT(R3) ;Is line a DZ or DH? BEQ 50$ ;Nope, it's a DL... .IF NE DZ11$N .IF NE DH11$N BIT #,T.STAT(R3) ;Is line a DZ? BEQ 40$ ;Nope, it's a DH... .ENDC ;NE DH11$N MOV R2,-(SP) ;Save R3 for awhile MOVB T.PUN(R3),R2 ;R2 = Physical Unit Number PBMSK7 ==: < . + 2 > ;** BOOT ** Relocate address of bit masks table MOVB BITMSK(R2),R2 ;R2 = Bit to touch BITB R2,DZ.DTR(R4) ;Is DTR on? BEQ 10$ ;Nope... BIS #,R0 ;Yes, return it 10$: BITB R2,DZ.BRK(R4) ;Is Break on? BEQ 9$ ;Nope... BIS #,R0 ;Yes, return it 9$: BITB R2,DZ.RNG(R4) ;Is the line ringing? BEQ 20$ ;Nope... BIS #,R0 ;Yes, return it 20$: BITB R2,DZ.CAR(R4) ;Is carrier up on the line? BEQ 30$ ;Nope... BIS #,R0 ;Yes, return it 30$: MOV (SP)+,R2 ;Restore previously saved register BR 60$ .ENDC ;NE DZ11$N .IF NE DH11$N 40$: MOV R1,-(SP) ;Save a few registers for awhile MOV R2,-(SP) ; ... GETPSW ;Save current priority SPL 7 ;Enter critical section CALL DHSELL ;;;Select the DH line MOV DH.LCR(R4),R2 ;;;R2 = Current line control MOV DH.LSR(R4),R0 ;;;R0 = Current line status PUTPSW ;;;Exit critical section CALL DHS2DL ;Perform translation of line status MOV R0,R1 ; and save the result MOV R2,R0 ;R0 = Line control CALL DHC2DL ;Perform translation of line control BIS R1,R0 ; and merge line status with it MOV (SP)+,R2 ;Restore previously saved registers MOV (SP)+,R1 ; ... BR 60$ .ENDC ;NE DH11$N .ENDC ;NE 50$: .Assume T.TKS EQ 0 MOV @R4,R0 ;R0 = Modem status BIC #^C,R0 ;Strip to ; DL significant bits MOV T.TPS(R4),-(SP) ;Get transmitter status BIC #^C,@SP ;Discard all but Break BIS (SP)+,R0 ;Merge into result 60$: MOV (SP)+,R4 ;Restore previously saved register RETURN .DSABL LSB .IF NE DH11$N .SBTTL DL2DH - DL modem control to DH line control translation .SBTTL DHC2DL - DH line control to DL modem control translation .SBTTL DHS2DL - DH line status to DL modem control translation ;+ ; ; DL2DH ; Performs a translation of DL modem control bits to their ; equivalent DH line control register bit positions. ; ; Call: ; R0 = DL-compatible modem control bits ; ; Return: ; R0 = DH-compatible line control bits ; ;- .ENABL LSB DL2DH: MOV R1,-(SP) ;Save R1 for awhile... MTYHK1 == <. + 2> ;** BOOT ** Relocate address of table MOV #DLDHTB,R1 ;R1 -> Translation table BR 10$ ;+ ; ; DHC2DL ; Performs a translation of the DH line control bits to their ; equivalent DL modem control register bit positions ; ; Call: ; R0 = DH-compatible line control bits ; ; Return: ; R0 = DL-compatible modem control bits ; ;- DHC2DL: MOV R1,-(SP) ;Save R1 for awhile... MTYHK2 == <. + 2> ;** BOOT ** Relocate address of table MOV #DHCDLT,R1 ;R1 -> Translation table BR 10$ ;+ ; ; DHS2DL ; Performs a translation of the DH line status bits to their ; equivalent DL modem control register bit positions ; ; Call: ; R0 = DH-compatible line status bits ; ; Return: ; R0 = DL-compatible modem control bits ; ;- DHS2DL: MOV R1,-(SP) ;Save R1 for awhile... MTYHK3 == <. + 2> ;** BOOT ** Relocate address of table MOV #DHSDLT,R1 ;R1 -> Translation table 10$: MOV R0,-(SP) ;Make a copy of the original bits CLR R0 ;Reset the translated bits 20$: TST @R1 ;End of table? BEQ 40$ ;Yep, translation is complete... BIT @R1,@SP ;Is this bit on? BEQ 30$ ;Nope... BIS 2(R1),R0 ;Yes, translate it... 30$: ADD #4,R1 ;On to next entry BR 20$ 40$: TST (SP)+ ;Discard original bits MOV (SP)+,R1 ;Restore previously saved register RETURN .DSABL LSB ; DL modem control to DH line control translation table DLDHTB:: .WORD DLRTS$, DHRTS$ ;Line control, Request To Send .WORD DLDTR$, DHDTR$ ;Line control, Data Terminal Ready .WORD DLBRK$, DHBRK$ ;Line control, Break .WORD 0 ; DH modem status to DL modem control translation table DHSDLT:: .WORD DHRI$, DLRI$ ;Modem status, Ring Indicator .WORD DHCTS$, DLCTS$ ;Modem status, Clear To Send .WORD DHDCD$, DLDCD$ ;Modem status, Data Carrier Detect .WORD 0 ; DH line control to DL modem control translation table DHCDLT:: .WORD DHRTS$, DLRTS$ ;Line control, Request To Send .WORD DHDTR$, DLDTR$ ;Line control, Data Terminal Ready .WORD DHBRK$, DLBRK$ ;Line control, Break .WORD 0 .ENDC ;NE DH11$N .ENDC ;NE MTY$HK .SBTTL Data Areas ;+ ; The following four words must be contiguous and ordered. ;- TTOUSR::.WORD BKGND ;Owner of console for output TTIUSR::.WORD BKGND ;Owner of console for input TTHOUS::.WORD 0 ;Owner of TT: for output TTHIUS::.WORD 0 ;Owner of TT: for input .IF NE HSR$B ;+ ; High Speed Ring Buffer Table ;- HSRB:: .WORD HSRBUF ;-> Input side of ring buffer (PUT pointer) HSRBEP::.WORD HSRBUE ;-> End of ring buffer HSRBRP::.WORD HSRBUF ;-> Beginning of ring buffer HSRBCC::.WORD -1 ;Character count HSRBGP::.WORD HSRBUF ;-> Output side of ring buffer (GET pointer) HSRBUF::.BLKW < HSRBSZ * 2 > ;Pairs of TCB pointers and chars HSRBUE:: ;End of high speed ring TIFBLK::BSS < F.BSIZ / 2 > ;FORK block .ENDC ;NE HSR$B .IF NE HSR$O .IF NE HSROPP::.WORD HSROBF ;-> Input side of ring (PUT pointer) HSROEP::.WORD HSROBE ;-> End of ring HSRORP::.WORD HSROBF ;-> Start of ring .ENDC ;NE HSROCC::.WORD -1 ;Character count .IF NE HSROGP::.WORD HSROBF ;-> Output side of ring (GET pointer) HSROBF::.BLKB DL11$N HSROBE:: .EVEN .ENDC ;NE TOFBLK::BSS < F.BSIZ / 2 > ;Output FORK block .ENDC ;NE HSR$O .END