.MCALL .MODULE .MODULE KBOARD,VERSION=37,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 Input Keyboard Processing ;+ ; This routine controls input from the PC keyboard. ; KB input is in the form of keycodes that correspond to the position ; of the key on the keyboard. The keycodes are NOT ASCII characters. The ; purpose of this routine is to translate the keycodes into ASCII characters ; and deliver them to the monitor console input routine. ; ; The keyboard uses a ring buffer to store input. Interrupts come in at ; priority 4 and are placed into the ring buffer. The buffer is emptied ; by using a .FORK to lower the priority to 0. This way interrupts keep ; coming in and the buffer is emptied in between. ; ; Keyboard Mapping ; ; In XM most of the keyboard is mapped into high memory. PSECT PIK contains ; the code that is mapped. Use the $REL macro to communciate with anything ; in low memory (PSECT PIDRV) and the video high memory (PSECT PIV) and ; any addresses in PIK. ; ; In To talk to Use ; ; PIK Root (PIDRV) PIRK ; PIK Video (PIV) PIVK ; PIK Address in PIK PIK ;- .PSECT PIDVR .ENABL LSB TTIIN1::JSR R5,@#$INTEN ;Lower processor priority $REL .-2 $INTEN RMON .WORD ^C&PR7 ; to priority 4 JSR R3,SAVE30 ;Save the registers .IF NE MMG$T CALL MAPKBD ;Map to KB interrupt service code .ENDC ;NE MMG$T CALL @#KB ;Go to KB interrupt service code $REL .-2 KB PIK TST (PC)+ ;Do we need to FORK? KBFORK: .WORD 0 ;Non-zero means that we need to FORK BNE 2$ ;If yes, branch to start one. 1$: RETURN ;Unmap KB kernel PAR1, restore registers, ; and return from interrupt FRKBLK: .WORD 0,0,0,0 2$: CLR KBFORK ;Say we don't need to FORK TST FRKBLK ;Do we already have a FORK request pending? BNE 1$ ;Branch if we do; we don't need/want another .FORK FRKBLK ;Do the FORK. This will unmap KB kernel PAR1, ; restore registers, and return from interrupt .IF NE MMG$T CALL MAPKBD ;Map to KB interrupt service code .ENDC ;NE MMG$T JMP @#KB1 ;Go to KB interrupt service code $REL .-2 KB1 PIK .DSABL LSB KB$COM::.WORD 0 ;Video keyboard communication buffer address KBDBUF::.WORD 0 ;Pseudo receiver buffer TTIIN2 = 0 CTTIIN::.WORD TTIIN2 ;Pointer to console receiver interrupt routine ; CTTIIN is hooked with TTIIN2 from RMON ; or MTTINT as the case may be .PSECT PIK,I,RW ;KB interrupt service code section .ENABL LSB KB:: MOV #MAXCYC,@#BYESCR ;Reset screen black-out counter $REL .-2 BYESCR PIRK CALL ARPT ;Test for autorepeat MOV @#KB$COM,R0 ;Is there an ASCII string from VIDEO? $REL .-2 KB$COM PIRK BNE 5$ ;Branch if yes (R0 -> ASCII string) ;CLR R0 ;R0 = 0 because BNE failed! BISB @KB$SLT,R0 ;Get keycode from data buffer register ;+ ; The following code is to get around a hardware race where the receiver ; done bit can be cleared by the above BISB and set again by another ; incoming keycode so fast that the interrupt controller doesn't see ; a transition and therefore doesn't request an interrupt. ;- BITB #2,@#KBSTAT ;Is receiver done set? BEQ 1$ ;If not, do nothing MOV #131,@#CNTRL0 ;Set the interrupt request bit 1$: .BR QUEKCD ;Put keycode in input ring buffer and return QUEKCD: MOV KBIPUT,R5 ;Point to next slot in KB input buffer TST KBICNT ;Ring buffer in use? BNE 2$ ;If yes, branch MOV SP,@#KBFORK ;Indicate that we need to start a FORK $REL .-2 KBFORK PIRK 2$: CMP #KBISIZ,KBICNT ;Is the ring buffer full? BEQ 4$ ;Branch if yes MOVB R0,(R5)+ ;Store key code or ASCII code in ring buffer INC KBICNT ;Bump buffer count CMP #KBIBFE,R5 ;Time to wrap KBIPUT around? $REL .-2 KBIBFE PIK BHI 3$ ;Branch if not SUB #KBISIZ,R5 ;Get the slot address 3$: MOV R5,KBIPUT ;Point to the next available slot 4$: RETURN 5$: MOV R0,R1 ;Get pointer in R1 MOV #85.,R0 ;Load a "start ASCII string" code in R0 CMP R1,#C.ANSR ;Is this ANSWERBACK? $REL .-2 C.ANSR PIK BNE 9$ ;If not, branch CLR R2 BISB (R1)+,R2 ;Get length of answerback message ;R1 = address of string start BEQ 8$ ;Branch if null string CALL QUEKCD ;Put "start ASCII string" code in ring buffer 6$: MOVB (R1)+,R0 ;Save character CALL QUEKCD ; in input ring buffer SOB R2,6$ ;Loop to get the entire string 7$: MOV #377,R0 ;Put an "end ASCII string" CALL QUEKCD ; code in ring buffer 8$: CLR @#KB$COM ;Say we're done with the VIDEO ASCII string $REL .-2 KB$COM PIRK RETURN 9$: CALL QUEKCD ;Save character in input ring buffer MOVB (R1)+,R0 ;Get next character in string BNE 9$ ; and go put it in ring buffer BR 7$ ;No more characters in this string .DSABL LSB .ENABL LSB 1$: COM (PC)+ ;Flip the ASCII sequence indicator flag ASCSEQ: .WORD 0 ;0 = Not ASCII seq; -1 = ASCII seq KB1: TST KBICNT ;Anything to process? BEQ 6$ ;If not, branch BIS #PR4,@#PS ;Don't allow interrupts while dequeuing MOV KBIGET,R5 ;Point to next ASCII character to send CLR R0 ;Guarantee sign extension is 0 BISB (R5)+,R0 ;Get keycode or ASCII char in R0 DEC KBICNT ;Decrement buffer count CMP #KBIBFE,R5 ;Time to wrap KBIGET around? $REL .-2 KBIBFE PIK BHI 2$ ;If not, continue SUB #KBISIZ,R5 ;Reset KBIGET to the buffer start 2$: MOV R5,KBIGET ;Save new value of KBIGET BIC #PR4,@#PS ;Allow interrupts again TST ASCSEQ ;Are we in an ASCII sequence? BNE 4$ ;Branch if yes CMPB R0,#85. ;Is this a "start ASCII string" code? BEQ 1$ ;Branch if yes SUB #KBFRSK,R0 ;Convert code to offset from first keycode BLO KB1 ;Branch if before first -- ignore it CALL XLATE ;Translate the keycode into an ASCII char BCS KB1 ;Get next keycode if no ASCII char returned CALL XONTST ;Test for XON/XOFF BNE KB1 ;If XOFF, eat character MOV R0,R4 ;Multi-terminal needs character in R4!!! CALL KEYKLK ;Sound the keyclick MOV R4,ASCODE ;Save ASCII code for metronome (autorepeat) TSTB ASCODE+1 ;Is this a single ASCII character? BEQ 5$ ;Branch if yes MOV R4,(PC)+ ;Get ASCII sequence pointer in ESEQNP ESEQNP: .WORD 0 ;Pointer to remainder of ASCII sequence 3$: CLR R4 ;Guarantee no sign extension BISB @ESEQNP,R4 ;Get next ASCII character from sequence BEQ KB1 ;Branch if there aren't any more INC ESEQNP ;Bump pointer to next char in ASCII sequence CALL SNDCHR ;Send the character to monitor's input service BR 3$ ;Continue processing sequence 4$: CMPB R0,#377 ;Is this an ASCII sequence terminator? BEQ 1$ ;Branch if yes MOV R0,R4 ;Multi-terminal needs character in R4!!! 5$: CALL SNDCHR ;Send the character to monitor's input service BR KB1 ;Go process next keycode from ring buffer 6$: RETURN ;Unmap kernel PAR1 and return .DSABL LSB SNDCHR: MOV R4,@#KBDBUF ;Get ASCII character in pseudo-receiver $REL .-2 KBDBUF PIRK ; buffer .IF EQ MMG$T ;If not XM CALLR @CTTIIN ;Call console receiver interrupt routine .IFF ;EQ MMG$T CALLR @CTTIIN+PIKBAS-P1ADDR ;Call console receiver interrupt routine ....PC = . $REL .-2 CTTIIN+PIKBAS-P1ADDR-....PC PIRK .ENDC ;EQ MMG$T KBISIZ =: 134. ;Size of input ring buffer KBIBUF: .BLKB KBISIZ ;KB input request ring buffer KBIBFE: ;End of ring buffer .EVEN KBICNT: .WORD 0 ;Count of current entries in input ring buffer KBIGET: .WORD KBIBUF ;Pointer to next character to process $REL .-2 KBIBUF PIK KBIPUT: .WORD KBIBUF ;Pointer to next empty slot in input ring buffer $REL .-2 KBIBUF PIK .SBTTL ARPT - Autorepeat enable/disable ;+ ; SETUP will allow you to enable/disable autorepeat across the board. ; The default is autorepeat on. ; ; Peat and Repeat were on the fence ; Peat fell off and who was left? ; Repeat ; ; Peat and Repeat were on the fence ; Peat fell off and who was left? ; Repeat ; ; ... (Ad nauseam) ;- .ENABL LSB ARPT:: CMPB @#D$ARM,(PC)+ ;Are we in synch with video? ARFLAG: .WORD 1 ;Autorepeat flag: 1 if on, 0 if off $REL .-4 D$ARM PIRK BEQ 2$ ;Branch if yes MOV #KARDSB,R0 ;Disable autorepeat code MOVB @#D$ARM,ARFLAG ;Say we are in synch $REL .-4 D$ARM PIRK BEQ 1$ ;Disable autorepeat ADD #KARENB-KARDSB,R0 ;Enable autorepeat code 1$: CALLR QKBOUX ;Send the code 2$: RETURN .DSABL LSB .SBTTL XLATE - Translate a keycode ;+ ; XLATE will translate a keycode into an ASCII character or get the ; address of an escape sequence to return to the monitor ; ; OUTPUT: ; R0 = ASCII character or address of escape sequence ;- XLATE: CLR R1 ;Guarantee there is no sign extension BISB KEYGRP(R0),R1 ;Get keycode table start in PIC form $REL .-2 KEYGRP PIK ROR R1 ;Get parity of R1 to carry BCC 1$ ;If even we have a routine to dispatch to RETURN ;If odd, we return with carry set 1$: ROL R1 ;Restore carry and R1 to dispatch offset CALLR @GRDSPT(R1) ;Go to routine for this key group $REL .-2 GRDSPT PIK .SBTTL XONTST - Test for XON/XOFF ;+ ; XONTST will light the WAIT LED when XOFF is sent and turn it off ; when XON is sent. ; ; Global variable KB$OFF is the XON/XOFF flag. The processing algorithm is ; ; KB$OFF = 0 -> keyboard is XON'd (make sure WAIT LED is out) ; 1 -> keyboard is XOFF'd (make sure WAIT LED is lit) ; ; The local variable KEYLOK will tell if the transition is from XOFF to XON. ; ; KEYLOK = 0 -> WAIT LED is out ; 1 -> WAIT LED is lit ;- .ENABL LSB XONTST: CMPB @#KB$OFF,(PC)+ ;Is XON/XOFF flag in synch with WAIT LED? KEYLOK: .WORD 0 ;0 -> WAIT LED is out; 1 -> WAIT LED is lit $REL .-4 KB$OFF PIRK BEQ 20$ ;If yes, branch MOV R0,-(SP) ;Save the ASCII char MOV #WAITON,R0 ;Assume XOFF/WAIT LED to be turned on $REL .-2 WAITON PIK MOVB @#KB$OFF,KEYLOK ;Say we are now in synch BNE 10$ ;Branch if we're doing an XOFF ADD #WAITOF-WAITON,R0 ;XON/WAIT LED to be turned off 10$: CALL QKBOUX ;Queue it MOV (SP)+,R0 ;Restore the ASCII char 20$: TST KEYLOK ;Are we XON or XOFF? RETURN .DSABL LSB .SBTTL HANHSC - Process hold screen ;+ ; The HOLD SCREEN key will operate as the VT100 NO SCROLL key. The LED ; will turn on when HOLD SCREEN is pressed the first time, and turn off ; when it is pressed the second time. ; ; INPUT: ; R0 = F1 keycode ; ; OUTPUT: ; C = 0 R0 = XON or XOFF to the monitor ;- .ENABL LSB HANHSC::CALL VT220 ;Do we do VT220 esc seq processing? MOV #XOFF,R0 ;Assume XOFF CMPB HSCRFL,R0 ;Did that last time? BNE 15$ ;If not, branch MOV #XON,R0 ;Send an XON 15$: CALL CHKXOF ;Set/Clear the LED CLC RETURN ;Return .DSABL LSB .SBTTL HANPSC - Process print screen ;+ ; Under XM in normal mode when the spooler is running, the PRINT SCREEN ; key will send a command to the spooler to print the contents of the ; screen. Under applications mode PRINT SCREEN will deliver a VT220 ; escape sequence to the monitor. ; ; INPUT: ; R0 = F2 keycode ; ; OUTPUTS: ; C = 1 PRINT SCREEN, return no code to the monitor ; C = 0 R0 = address of VT220 escape sequence ;- .ENABL LSB HANPSC::CALL VT220 ;Do we do VT220 esc seq processing? .IF NE MMG$T BIT #SP.ON,@#SPSTAT ;Is the spooler running? $REL .-2 SPSTAT RMONK BEQ 20$ ;If not, branch BIS #PRTSCR,@#SPSTAT ;Set PRINT SCREEN bit in SPSTAT $REL .-2 SPSTAT RMONK CALL KEYKLK ;We want a keyclick 20$: .ENDC; NE MMG$T SEC ;No keycode to the monitor RETURN .DSABL LSB .SBTTL HANSET - Process SETUP key ;+ ; If the keyboard is locked (the WAIT LED is on), pressing the SETUP ; key (F3) will unlock the keyboard and turn off the WAIT LED. This ; will always occur. If you are in applications mode, the SETUP key will ; also transmit the VT220 escape sequence for F3. ; ; If the keyboard is not locked, the SETUP key will be dead in normal ; mode, or transmit a VT220 escape sequence in applications mode. ; ; INPUT: ; R0 = F3 keycode ; ; OUTPUTS: ; C = 1 return no code to the monitor ; C = 0 R0 = address of VT220 escape sequence ;- .ENABL LSB HANSET::TSTB KEYLOK ;Is the keyboard locked? BEQ 20$ ;If not, branch MOV R0,-(SP) ;Save the keycode in case we need it later MOV #WAITOF,R0 ;Turn off WAIT LED $REL .-2 WAITOF PIK CALL QKBOUX ;Queue it CLRB @#KB$OFF ;Say we have XON $REL .-2 KB$OFF PIRK CLRB KEYLOK ;Say WAIT LED is out MOV (SP)+,R0 ;Restore R0 for VT220 esc seq test 20$: CALL VT220 ;Do we have a VT220 escape sequence? SEC ;No keycode to the monitor RETURN .DSABL LSB .SBTTL HANEBL - ESC, BS, LF ;+ ; ; INPUT: ; R0 = F11, F12, or F13 keycode ; ; OUTPUTS: ; Normal mode R0 = Code for ES, BS or LF ; Appl mode R0 = address of VT220 escape sequence ; ;- .ENABL LSB HANEBL::CALL VT220 ;Do we do VT220 esc seq processing? CALL COMPOF ;These are all control chars, so cancel MOVB EBLFAS-FKOEBL(R0),R0 ;Point to table in PIC form $REL .-2 EBLFAS-FKOEBL PIK RETURN .DSABL LSB .SBTTL HANCUR - Cursor Keys ;+ ; Send an escape sequence for the cursor keys. ; ; The cursor key escape sequence is in the 7 bit ASCII form ; ; ESC [ n ; ; where n = A, B, C, or D (capital letters) ; ; The cursor key application flag (D$CKM) determines if the second ; character is a [ or an O (capital O) ; ; If D$CKM = 0, use [ in the esc seq ; If D$CKM = 1, use O ; ; D$CKM is set by the video ; ; INPUT: ; R0 = cursor key keycode ; ; OUTPUT: ; R0 = address of cursor key escape sequence ;- .ENABL LSB HANCUR:: ;Cursor key CALL COMPOF ;Force Compose off if active MOV #CURESC+2,R1 ;Point to final character in cursor sequence $REL .-2 CURESC+2 PIK MOVB CDIRIN-FKOCUR(R0),@R1 ;Store last character of escape sequence $REL .-2 CDIRIN-FKOCUR PIK MOVB @#D$CKM,R0 ;Load cursor application mode flag (0 or 1) $REL .-2 D$CKM PIRK MOVB CSIOH(R0),-(R1) ;Load introducer character in cursor sequence $REL .-2 CSIOH PIK DEC R1 ;Point to start of sequence MOV R1,R0 ; and return pointer in R0 RETURN .DSABL LSB .SBTTL HANKPD, HANKPF - Numeric Keypad ;+ ; The numeric keypad sends out different codes depending on whether ; it is in numeric mode or application mode. HANKPD controls the ; numeric mode, and HANKPF controls the application mode. ; ; INPUT: ; R0 = numeric keypad keycode ; ; OUTPUTS: ; HANKPD - R0 = ASCII character code ; HANKPF - R0 = address of numeric keypad escape sequence ;- HANKPD::TSTB @#D$KPD ;Not PF key, are we in application mode? $REL .-2 D$KPD PIRK BNE HANKPF ;Branch if yes MOVB KEYPAS-FKOKPD(R0),R0 ;Get the ASCII character $REL .-2 KEYPAS-FKOKPD PIK ;>>> check this re: compose cancelling CALLR HANXXX ;Do character processing as in main array HANKPF:: ;PF key and/or keypad application mode CALL COMPOF ;Cancel any Compose sequence MOVB KPESAS-FKOKPD(R0),@#KEYPES+2 ;Store final character in esc seq $REL .-4 KPESAS-FKOKPD PIK $REL .-2 KEYPES+2 PIK MOV #KEYPES,R0 ;Point to start of escape sequence $REL .-2 KEYPES PIK RETURN ;Return .SBTTL HANLOC - Lock key ;+ ; The LOCK key lights the LOCK LED on the keyboard and sounds ; a keyclick. It does not send an ASCII value to the monitor. ; ; ; INPUT: ; R0 = lock key keycode ; ; OUTPUTS: ; LOCK LED turned on or off ; SCLKFL set on or off ;- .ENABL LSB HANLOC::MOV #LOKON,R0 ;Turn on LOCK LED $REL .-2 LOKON PIK COMB SCLKFL ;Complement state - to on or off? BNE 10$ ;Branch if to on - function correct MOV #LOKOFF,R0 ;Turn off LOCK LED $REL .-2 LOKOFF PIK 10$: CALL QKBOUX ;Queue it CALL KEYKLK ;We want a keyclick, SEC ;But no code being returned RETURN .DSABL LSB .SBTTL HANMET - Autorepeat - send metronome code ;+ ; When an autorepeating key is held down, it will continue to send ; the last ASCII code to the monitor and keyclicks to the output ; keyboard. ; ; Keys held down with the control key do not autorepeat. ; ; INPUT: ; R0 = metronome keycode ; ; OUTPUT: ; ASCII code to be repeated ;- .ENABL LSB HANMET::TSTB @#D$ARM ;Autorepeat off? $REL .-2 D$ARM PIRK BEQ 1$ ;If yes, branch TST COMFLG ;In a compose sequence? BNE 1$ ;Yes, then no repeating BITB #SHCTRL,SHCTFL ;Is control held down? BNE 1$ ;Yes, return nothing MOV (PC)+,R0 ;Autorepeat -- get last ASCII char ASCODE: .WORD 0 ;Last ASCII character (not from VIDEO!) BEQ 1$ TST (PC)+ ;Clear carry, Skip SEC 1$: SEC ;Return nothing RETURN .DSABL LSB ;>>> NOTE: Autorepeat stays off until [all keys up] occurs, so ; that a a[held down] will not produce @aaaaaa ; This may require some more work in HANMET. .SBTTL HANMAR - Main Array ;+ ; HANMAR uses four tables to translate a keycode into a character. ; ; The tables are ; ; 1. Unshifted - neither shift key nor control key down, lock off ; 2. Shifted - Shift key held down, control up, lock irrelevant ; 3. Control - CTRL key held down, lock and shift irrelevant ; 4. Caps lock - lock on, letters capitalized (if the national ; array supports it), all else unshifted. The shift and ; CTRL keys supersede caps lock. ; 5. Shift lock - VT220 only - all main array keys shifted. ; Shift lock uses the same table as shift. ; ; ; INPUTS: ; R0 = offset within a table to the correct ASCII code ; ; OUTPUTS: ; R0 = ASCII value ; C set if invalid character ;- .ENABL LSB HANMAR::CLR R4 ;assume no "LOCK" and no "CAPS" TSTB SCLKFL ;is "LOCK" set? BEQ 1$ ;no BIS #SHLOCK,R4 ;yes TSTB @#S$LOCK ;is "CAPS" chosen? $REL .-2 S$LOCK PIRK BNE 1$ ;no BIS #SHCAPS,R4 ;yes 1$: BISB SHCTFL,R4 ;or in "CTRL" and "SHIFT" MOVB STABLE(R4),R4 ;load proper type from combination $REL .-2 STABLE PIK ;of LOCK, SHIFT, CTRL, and CAPS/SHIFT ADD MNAAPT(R4),R0 ;point to char $REL .-2 MNAAPT PIK MOVB MNARAS-FKOMAR(R0),R0 ;Get ASCII character $REL .-2 MNARAS-FKOMAR PIK BIC #177400,R0 ;Take care of sign extension CMPB #INV,R0 ;INV=377 (invalid in 7-bit and 8-bit) BEQ 50$ ;invalid character TSTB R0 ;Normal Char? BPL 60$ ;Yes CMPB R0,#MAXDIA ;Dead diacritical? BHI 50$ ;No, invalid MOVB NOSPXL-200(R0),R0 ;Yes, get real char $REL .-2 NOSPXL-200 PIK MOV R0,-(SP) ;save it from the subr CALL COMPON ;Turn on compose LED MOV (SP)+,R0 ;and back BR 40$ ;Join compose code 60$: HANXXX: ;Common character processing for compose CMPB #40,R0 ;Control char? BGT 33$ ;yes CMPB #177,R0 ;Delete? BNE 65$ ;no, normal char TST COMFLG ;COMPOSing? BEQ 90$ ;No, then just send a DELETE CALL COMPQF ;Turn Compose off (quietly) CALL KEYKLK ;But click the key BR 50$ ;But don't send DELETE 33$: CALL COMPOF ;Turn Compose off (with bells) BR 90$ ;And send control char 65$: TST #.-. ;Composing? COMFLG =: .-2 BEQ 90$ ;No, do normal processing 40$: TSTB COMFLG ;First or second char in sequence? BNE 80$ ;Second MOVB R0,COMFLG ;First, save the char CALL KEYKLK ;Click BR 50$ ;But return no char 80$: MOVB R0,COMFLG+1 ;Second, save the char CMPB COMFLG,COMFLG+1 ;Sort them BLE 70$ ;right order SWAB COMFLG ;Exchange them 70$: ;NOTE: the following is a linear search ;something faster may be required for ;the full Multi-National composes. MOV #KB$CMP,R4 ;Point to compose triplets $REL .-2 KB$CMP PIK MOV COMFLG,R0 ;load copose input pair 114$: CMPB (R4)+,R0 ;First chars match? BNE 112$ ;no, try next triplet SWAB R0 ;Check the second chars CMPB (R4)+,R0 ;Second chars match? BEQ 111$ ;YES, send resultant char SWAB R0 ;no, restore pair order TSTB (R4)+ ;Skip resultant char BR 113$ ;Try next triplet 112$: CMPB (R4)+,(R4)+ ;Skip second and resulting chars TSTB @R4 ;End of triplets? 113$: BNE 114$ ;Try next triplet 34$: CALL COMPOF ;Turn off COMPOSE and ring bell 50$: SEC ;Illegal, set C bit RETURN 111$: MOVB @R4,R0 ;Send composed char CALL COMPQF ;Turn off COMPOSE quietly ;;;>>> BIC #^c377,R0 ;clear junk for 8 bit chars 90$: CALL CHKXOF ; Check for XON and XOFF .BR CRTST ;Test for a C/R .DSABL LSB .SBTTL CRTST - Test for CR ;+ ; When New Line Mode (A$LNM) is set, the RETURN and ENTER keys will return ; CRLF to the monitor. When New Line Mode is reset, they will return ; only CR to the monitor. ; ; A$LNM = 0 -> send CR ; A$LNM = 1 -> send CRLF ; ; A$LNM is set by the video. ; ; INPUT: ; R0 = ASCII code ;- .ENABL LSB CRTST: CMPB #CR,R0 ;Is the character a CR? BNE 90$ ;If not, branch TSTB @#A$LNM ;New Line Mode = 1? $REL .-2 A$LNM PIRK BEQ 100$ ;If not, branch MOV #CRLF,R0 ;Get sequence to send to the monitor $REL .-2 CRLF PIK 90$: CLC ;Clear C for return 100$: RETURN .DSABL LSB .SBTTL CHKXOF - Test for XON or XOFF ;+ ; Test the character in R0 for XON or XOFF. If so, output the ; appropriate code to turn ON or OFF the HOLD_SCREEN LED. ;- .ENABL LSB CHKXOF: MOV R0,-(SP) ; save the character CMPB #XOFF,R0 ; XOFF? BNE 10$ MOV #HSCON,R0 ; Point to ON HOLD SCREEN LED code $REL .-2 HSCON PIK BR 20$ 10$: CMPB #XON,R0 ; XON? BNE 30$ ; return if not. MOV #HSCOFF,R0 ; Point to OFF HOLD SCREEN LED code $REL .-2 HSCOFF PIK 20$: MOVB @SP,HSCRFL ; keep copy of XON or XOFF for flag CALL QKBOUX ; dictate LED status 30$: MOV (SP)+,R0 ; get the character again RETURN .DSABL LSB .SBTTL HANSHC, HANAUP - Shift and control keys, all up code ;+ ; HANSHC controls the shift and control keys. These keys change the ; shift/control flag (SHCTFL), but return no code to the monitor. ; SHCTFL selects the correct table for the main array translation. ; The next key pressed will be a main array key, translated by HANMAR. ; ; When the shift or control key is released, the keyboard sends an ; ALL-UP code. This code will vector into HANAUP and clear SHCTFL. ; .ENABL LSB HANSHC::MOVB SHCFLB-FKOSHC(R0),R0 ;Get shift or control flag bit $REL .-2 SHCFLB-FKOSHC PIK XOR R0,SHCTFL ;Complement bit in flag BR SCEX ;Return 'no code" HANAUP::CLRB SHCTFL ;All up -- clear shift control flag SCEX: SEC ;Indicate no code being returned RETURN ;Return to main routine .DSABL LSB .SBTTL Invalid keys ;+ ; In normal mode, the F4-F10, the F14-F20 keys, and the editing keypad ; (FIND,etc.) are invalid keys. They do not keyclick, and they do ; not send any characters to the monitor. In application mode ; all of these plus F1, F2, and F11, F12, and F13 will keyclick and ; send a VT220 escape sequence to the monitor. ; ; INPUTS: ; R0 = F4-F10,F1-F20 keycodes ; ; OUTPUTS: ; Normal mode No ASCII code, no keyclick ; Applications mode R0 = Address of VT220 escape sequence ;- .ENABLE LSB HANINV::CALL VT220 ;Do we do VT220 esc seq processing? SEC ;Say no ASCII character returned RETURN COMPOF: MOV R0,-(SP) ;Save Char MOV #KBELL,R0 ;Ring the bell BR 10$ ;join common code COMPQF: MOV R0,-(SP) ;Save Char CLR R0 ;Indicate no bell to toll 10$: TST COMFLG ;In a compose sequence? BEQ 100$ ;No, then cancelling is easy (done) TST R0 ;Ring the bell? BEQ 20$ ; No CALL QKBOUX ;... 20$: CLR COMFLG ;Out of a compose sequence CLR ASCODE ;And nothing to autorepeat MOV #COMOFF,R0 ;Turn LED off $REL .-2 COMOFF PIK CALL QKBOUX ; 100$: MOV (SP)+,R0 ;Restore char RETURN ; done .DSABL LSB .ENABL LSB HANCOM:: TSTB @#S$COMP ;Test for COMPOSE enabled by SETUP $REL .-2 S$COMP PIRK BEQ 100$ ;Not doing Compose MOV #100000,COMFLG ;Set it CALL COMPON ;Turn on the LED 100$: SEC ;No char RETURN COMPON: MOV #COMON,R0 ;Turn the compose LED on $REL .-2 COMON PIK CALL QKBOUX ; CALLR KEYKLK ;Click .DSABL LSB .SBTTL VT220 - Give the VT220 escape sequence in application mode ;+ ; VT220 will generate a VT220 escape sequence in application mode for ; the keys unused in normal mode. The keys will also keyclick. ; ; A VT220 escape sequence is in the 7 bit ASCII form ; ; ESC [ n ~ ; ; Where n is an ASCII value defined below in the table KEYVAL. ; n may be one or two characters. ; ; INPUTS ; R0 = keycode offset from the first valid keycode ; ; OUTPUTS ; R0 = address of start of VT220 escape sequence ;- .ENABL LSB VT220: TSTB @#D$FKM ;Are we in application mode? $REL .-2 D$FKM PIRK BEQ 100$ ;If not, branch ..APHS::CMPB R0,# ; F1-F5? BLOS 100$ ; If so, it's a local function MOV #KEYVAL,R5 ;Get esc seq value table in PIC form $REL .-2 KEYVAL PIK ADD #KBFRSK,R0 ;Make the offset into a keycode again MOV #KEYKOD,R4 ;Point to keycode table in PIC form $REL .-2 KEYKOD PIK 10$: CMPB R0,@R4 ;Find the keycode? BEQ 20$ ;If yes, branch TST (R5)+ ;Increment the pointer TSTB (R4)+ ;At table end? BNE 10$ ;If no, keep looking SEC ;Invalid BR 90$ ;Go out 20$: MOV #ESC220+2,R3 ;Point to third slot in esc seq table in PIC form $REL .-2 ESC220+2 PIK MOVB (R5)+,(R3)+ ;Move the char in MOVB @R5,@R3 ;Move the character in BEQ 30$ ;If a null, replace it with tilde TSTB (R3)+ ; else leave it alone 30$: MOVB #TILDE,(R3)+ ;Put in the tilde CLRB @R3 ; and terminate the pattern MOV #ESC220,R0 ;*C*Point to esc seq pattern in PIC form $REL .-2 ESC220 PIK 90$: BIC (SP),(SP)+ ;*C*Return to caller's caller 100$: RETURN ;Go back .DSABL LSB .SBTTL QKBOUT - Queue Keyboard Output Requests ;+ ; QKBOUT queues the requests to the output keyboard. KB, the input ; keyboard interrupt routine, and the video call it. QKBOUT increments ; the pointer KBOPUT, and then forces an interrupt, if necessary, on the ; KB output device to enter KBOUT. ; ; INPUTS: ; R0 = Output keyboard function code or address of series of ; function codes ;- .PSECT PIDVR QKBOUT:: .IF NE MMG$T ;If XM CALL MAPKBD .ENDC ;NE MMG$T JMP @#QKBOUX $REL .-2 QKBOUX PIK .PSECT PIK,I,RW .ENABL LSB QKBOUX::MOV R1,-(SP) ;Save the registers MOV R5,-(SP) ; we use MOV @#PS,-(SP) ;Save our priority (PR0 or PR4 only!) BIS #PR4,@#PS ; and go to priority 4 MOV #72,@#CNTRL0 ;No xmit interrupts while enqueueing MOV #TESTIT,R1 ;Point to code or address $REL .-2 TESTIT PIK MOV R0,@R1 ;Get code or address TSTB TESTIT+1 ;Is it a single code? BEQ 1$ ;If yes, branch MOV R0,R1 ;Get address of multiple code sequence 1$: MOV R1,OUTSQP ;Save the pointer MOV KBOPUT,R5 ;Point to next slot in KB output buffer 2$: CMP #KBOSIZ,KBOCNT ;Is the output ring buffer full? BEQ 4$ ;Branch if yes MOVB @OUTSQP,(R5)+ ;Move the code in INC KBOCNT ;Bump the count INC OUTSQP ;Bump the pointer CMP #KBOBFE,R5 ;Time to wrap KBOPUT around? $REL .-2 KBOBFE PIK BHI 3$ ;If not, continue SUB #KBOSIZ,R5 ;Get the slot address 3$: TSTB @OUTSQP ;At the end? BNE 2$ ;If not, branch MOV R5,KBOPUT ;Point to the next available slot MOV #32,@#CNTRL0 ;No, so enable interrupts MOV #132,@#CNTRL0 ;Prime KB output with an interrupt 4$: MOV (SP)+,@#PS ;Restore our old priority MOV (SP)+,R5 ;Restore the MOV (SP)+,R1 ; registers RETURN .DSABL LSB .SBTTL KBOUT - Output queued KB requests ;+ ; KBOUT is the output keyboard interrupt routine. The output requests ; are located in the ring buffer KBOBUF. KB, the keyboard input interrupt ; routine, and the video put the requests into KBOBUF. ; ; KBOUT is entered from an interrupt enabled in QKBOUT. KBOUT will increment ; KBOGET, and process the next request in the KBOBUF ring buffer. If there ; are no more requests, the keyboard transmitter interrupt is disabled. ; ; INPUTS: ; KBOGET -> pointer to next output request ;- .PSECT PIDVR KBOUT:: BITB #KBTRD$,@#KBSTAT ;Is transmitter ready? BEQ 111$ ;Branch if it isn't CALL 1$ ;Output keyboard interrupt entry point 111$: RTI 1$: .IF NE MMG$T ;If XM CALL MAPKBD .ENDC ;NE MMG$T JMP @#KBOUTX $REL .-2 KBOUTX PIK .PSECT PIK,I,RW .ENABL LSB KBOUTX: TST KBOCNT ;Anything to process? BEQ 90$ ;If not, branch MOVB @KBOGET,@KB$SLT ;Move output code to data buffer INC KBOGET ;Bump KBOGET pointer DEC KBOCNT ;Decrement buffer count CMP #KBOBFE,KBOGET ;Time to wrap KBOGET around? $REL .-4 KBOBFE PIK BHI 40$ ;If not, continue SUB #KBOSIZ,KBOGET ;Reset KBOGET to the buffer start 40$: RETURN 90$: MOV #72,@#CNTRL0 ;Disable KB transmitter interrupts RETURN ;Return .DSABL LSB .SBTTL KEYKLK - Sound the keyclick ;+ ; KEYKLK will sound the keyclick when a valid key is pressed on the ; keyboard. ;- .ENABL LSB KEYKLK: TSTB @#S$CLIC ;Keyclick turned off? $REL .-2 S$CLIC PIRK BEQ 100$ ;If yes, branch MOV #KLKSND,R0 ;Send sound keyclick codes $REL .-2 KLKSND PIK CALL QKBOUX ;Queue it 100$: RETURN .DSABL LSB .SBTTL Keyboard variables KBDB = 173500 ;Keyboard data buffer register KBSTAT = KBDB+2 ;Keyboard status register KB$SLT::.WORD KBDB ;Keyboard data buffer register KBDCSR: .WORD 0 ;Pseudo receiver CSR HSCRFL: .BYTE 0 ;Hold Screen Flag ; = 0 to hold ; <> 0 to release SCLKFL: .BYTE 0 ;Lock flag -- 0 if up, 1 if down .EVEN ;+ ; There are four tables for the main array translation: ; ; 1) Unshifted ; 2) Shifted ; 3) Control ; 4) Caps locked ; ; Each table is 100 bytes long. To select a table, select an offset ; from table MNAAPT. ; ; To get the correct translation for a keycode, the algorithm is: ; ; correct ASCII code (byte) = address of MNARAS ; + offset into MNARAS (from MNAAPT) ; + (keycode-(value of first keycode we use)) ;- ;+ ; Shift and Control key values ;- MNAAPT: ;Table of offsets within main array translation table MNNORM =:.-MNAAPT .WORD GCSMAR * 0 ;unshifted MNSHIF =:.-MNAAPT .WORD GCSMAR * 1 ;shifted MNCTRL =:.-MNAAPT .WORD GCSMAR * 2 ;control MNCAPS =:.-MNAAPT .WORD GCSMAR * 3 ;Caps lock SHCFLB: .BYTE SHSHIF ;SHCTFL bit set if shift key down .BYTE SHCTRL ; " " " " control" " SHCTFL: .WORD 0 ;Shift control flag SHCAPS =: ^B0001 ; pattern for CAPS lock chosen SHSHIF =: ^B0010 ; pattern for SHIFT key down SHCTRL =: ^B0100 ; pattern for CTRL key down SHLOCK =: ^B1000 ; pattern for LOCK on .MACRO SHIFTS ACTION LOCK CTRL SHIF CAPS .ASSUME .-STABLE EQ <+++> .BYTE ACTION .ENDM STABLE: ;table of offsets derived from the ; combinations of CAPS/SHIFT, ; SHIFT, CTRL, and LOCK states. ; table to use LOCK CTRL SHIFT CAPS SHIFTS MNNORM 0 0 0 0 SHIFTS MNNORM 0 0 0 1 SHIFTS MNSHIF 0 0 1 0 SHIFTS MNSHIF 0 0 1 1 SHIFTS MNCTRL 0 1 0 0 SHIFTS MNCTRL 0 1 0 1 SHIFTS MNCTRL 0 1 1 0 SHIFTS MNCTRL 0 1 1 1 SHIFTS MNSHIF 1 0 0 0 SHIFTS MNCAPS 1 0 0 1 SHIFTS MNSHIF 1 0 1 0 SHIFTS MNSHIF 1 0 1 1 SHIFTS MNCTRL 1 1 0 0 SHIFTS MNCTRL 1 1 0 1 SHIFTS MNCTRL 1 1 1 0 SHIFTS MNCTRL 1 1 1 1 ;+ ; Output Keyboard values ;- ; LED codes KLKSND::.BYTE KCLON ;Enable keyclick .BYTE KCLVOL ;Set keyclick volume .BYTE KCLICK ;Send keyclick .BYTE KCLOFF ;Disable keyclick .BYTE 0 ;Table terminator WAITON::.BYTE KLEDON ;Turn LED on .BYTE KLEDWA ;WAIT LED .BYTE 0 ;Table terminator WAITOF::.BYTE KLEDOF ;Turn LED off .BYTE KLEDWA ;WAIT LED .BYTE 0 ;Table terminator HSCON:: .BYTE KLEDON ;Turn LED on .BYTE KLEDHS ;HOLD SCREEN LED .BYTE 0 ;Table terminator HSCOFF::.BYTE KLEDOF ;Turn LED off .BYTE KLEDHS ;HOLD SCREEN LED .BYTE 0 ;Table terminator LOKON:: .BYTE KLEDON ;Turn LED on .BYTE KLEDLO ;LOCK LED .BYTE 0 ;Table terminator LOKOFF::.BYTE KLEDOF ;Turn LED off .BYTE KLEDLO ;LOCK LED .BYTE 0 ;Table terminator COMON:: .BYTE KLEDON ;Turn LED on .BYTE KLEDCO ;COMPOSE LED .BYTE 0 ;Table terminator COMOFF::.BYTE KLEDOF ;Turn LED off .BYTE KLEDCO ;COMPOSE LED .BYTE 0 ;Table terminator .EVEN KBOSIZ =: 30. ;Size of output ring buffer KBOBUF: .BLKB KBOSIZ ;KB output request ring buffer KBOBFE: ;End of ring buffer .EVEN KBOCNT: .WORD 0 ;Count of current entries in output ring buffer KBOGET: .WORD KBOBUF ;Pointer to next character to process $REL .-2 KBOBUF PIK KBOPUT: .WORD KBOBUF ;Pointer to next empty slot in input ring buffer $REL .-2 KBOBUF PIK TESTIT: .WORD 0 ;Save area for output keycode code or address of keyboard codes OUTSQP: .WORD 0 ;Address of next output keyboard code ANSLEN: .BYTE 0 ;Length of answerback message .EVEN .END