Trailing-Edge
-
PDP-10 Archives
-
klad_sources
-
klad.sources/gkbd.mac
There is 1 other file named gkbd.mac in the archive. Click here to see a list.
SUBTTL KEYBOARD INTERFACE
;This module provides a timesharing terminal interface for the
;DIAGNOSTIC library. The interface itself attempts to emulate as
;far as possible the TEXTI JSYS implemented in the TOPS20 monitor.
SUBTTL Table of Contents
; TABLE OF CONTENTS FOR GLXKBD
;
;
; SECTION PAGE
; 1. Table of Contents......................................... 2
; 2. Revision History.......................................... 3
; 3. Local Definitions......................................... 5
; 4. Module Storage............................................ 6
; 5. K%INIT -- Initialization of the Scanning Module......... 7
; 6. K%RCOC -- Read Character Output Control Table........... 8
; 7. K%WCOC -- Write Character Output Control table......... 9
; 8. K%SUET -- Set User Escape Table......................... 10
; 9. K%STYP -- Set terminal type............................. 11
; 10. K%TXTI -- Handle Terminal Input......................... 13
; 11. TXTL -- Loop for inputting text......................... 14
; 12. TTYCHR -- Here to receive 1 character from the TTY...... 16
; 13. Utilities for text handling............................... 17
; 14. SPCHK -- Check for special characters................... 22
; 15. CCU -- Handle ^U (Rubout entire line)................... 23
; 16. CCR -- Handle ^R (Re-type the line)..................... 24
; 17. CCDEL -- Handle Rubout (Delete one character)........... 25
; 18. CCW -- Handle ^W (Delete back to punctuation character). 26
; 19. BEGBUF -- Handle rubouts to beginning of buffer......... 27
; 20. TYPEBP -- Type a string according to a byte-pointer..... 27
SUBTTL Revision History
COMMENT \
Edit GCO Reason
---- --- -------------------------------------------
0001 Create GLXKBD module
0002 Fix a number of interrupt race problems and
start adding ESCape sequence code
0003 009 Implement a new TEXTI flag to causes 'nothing' to echo.
0004 010 Make K%STYP set some additional characteristic like LC..
0005 Allow the source word (.RDIOJ) contain a byte-pointer to
an ASCIZ string if RD%JFN is off in the flag word (this
is additional compatibility with the TEXTI JSYS).
006 TOTALLY HACKED UP FOR DIAGNOSTICS
\ ;END OF REVISION HISTORY
; Entry Points found in this module
ENTRY K%INIT ;INITIALIZATION POINT
ENTRY K%TXTI ;TEXT INPUT ROUTINE
ENTRY K%RCOC ;READ COC TABLE
ENTRY K%WCOC ;WRITE COC TABLE
ENTRY K%STYP ;SET TERMINAL TYPE
ENTRY K%SUET ;SETUP USER ESCAPE TABLE
SUBTTL Local Definitions
; Special Accumulator definitions
C==16 ;GLOBAL CHARACTER REGISTER
; Special characters
.CHBSL=="\" ;BACKSLASH
; Control character former
DEFINE $C(A)<"A"-100> ;JUST ASCII MINUS LEAD BIT
SUBTTL Module Storage
$$DATA TTYFLG ;FLAGS FROM INITIALIZATION BLOCK
; $$DATA RD,.RDSIZ ;INTERNAL ARGUMENT BLOCK
$$DATA COCTAB,2 ;CHARACTER OUTPUT CONTROL TABLE
$$DATA TRMPTR ;POINTER TO TERMINAL CONTROL
$$DATA RUBFLG ;-1 WHEN LAST CHAR WAS RUBOUT
$$DATA ARGLOC ;LOCATION OF CALLER'S ARGUMENT BLOCK
$$DATA BCKFLG ;-1 WHEN BACKUP LIMIT HAS BEEN PASSED
$$DATA UESCTB ;ADDRESS OF USER ESCAPE TABLE
$$DATA CURESC ;CURRENT STATE OF ESCAPE SEQ PROCESSOR
$$DATA TRMTYP ;TERMINAL TYPE
; $$DATA TRMUDX ;UDX FOR TERMINAL
$$DATA BGLINE ;POINTER TO BEGINNING OF CURRENT LINE
$$DATA BGBUFR ;MY POINTER TO BEGINNING OF BUFFER
I%ION: POPJ P,
I%IOFF: POPJ P,
SUBTTL K%INIT -- Initialization of the Scanning Module
;K%INIT is called during the intialization phase of the host program via the
; I%INIT call. If command scanning is desired, the controlling terminal
; is taken over, etc...
;CALL IS: S1/ Length of the Initialization Block
; S2/ Address of the Initialization Block
;
;TRUE RETURN: No arguments are returned
K%INIT:
IFN FTJSYS,<
DMOVE S1,[BYTE (2) 0,1,1,1,1,1,1,2,3,2,2,1,1,2,1,1,1,1
BYTE (2) 0,0,0,0,0,0,1,1,1,3,2,2,2,2,0,0,0,0] ;LOAD COCTAB
PJRST K%WCOC ;WRITE THE COC AND RETURN
> ;END IFN FTJSYS
IFN FTUUOS,<
; MOVEI S1,16 ;USE CHANNEL 16
; IOR S1,[OPEN [IO.LEM+IO.SUP+IO.TEC+.IOASC ;SET ALL THE FUNNY MODES
; SIXBIT /TTY/ ;ON THE CONTROLLING TERMINAL
; XWD 0,0 ]] ;ALLOCATING NO BUFFERS
; XCT S1 ;OPEN UP THE TERMINAL FOR SCANNING
OPEN 16,[IO.LEM+IO.SUP+IO.TEC+.IOASC
SIXBIT/TTY/
0]
$STOP(COT,Cannot OPEN terminal)
DMOVE S1,[BYTE (2) 0,1,1,1,1,1,1,2,3,2,2,1,1,2,1,1,1,1
BYTE (2) 0,0,0,0,0,0,1,1,1,3,2,2,2,2,0,0,0,0] ;LOAD COCTAB
PUSHJ P,K%WCOC ;WRITE THE TABLE
MOVSI S1,'TTY' ;LOAD TTY NAME
IONDX. S1, ;GET IO INDEX
JFCL ;IGNORE ERROR
MOVEM S1,TRMUDX ;STORE FOR VARIOUS TRMOPS
SETZM UESCTB ;NO ESCAPE SEQUENCES
SETZM CURESC ;CLEAR ESCAPE MACHINE
MOVX S1,.TT33 ;ASSUME THIS IS A 33
SETOM TTYFLG ;SET TTY OPENED
PJRST K%STYP ;SET TYPE AND RETURN
> ;END IFN FTUUOS
SUBTTL K%RCOC -- Read Character Output Control Table
;K%RCOC and K%WCOC are used to read/write the control character output
; table. For each character 0-37, there is a 2 bit field indicating
; how this character should be echoed. This two word table then
; consists of bit pairs code as:
; 00 - Do not echo at all
; 01 - Indicate by ^X
; 10 - Send the actual ASCII code (I.E. 7 for ^G)
; 11 - Simulate the character
;CALL IS: No arguments
;
;TRUE RETURN: S1/ First word of COC table
; S2/ Second word of COC table
IFN FTUUOS,<
K%RCOC: DMOVE S1,COCTAB ;GET TABLE
$RETT ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
K%RCOC: PUSH P,S2+1 ;SAVE A 3RD AC
MOVX S1,.PRIIN ;LOAD PRINCIPLE INPUT JFN
RFCOC ;READ THE COC TABLE
MOVE S1,S2 ;GET FIRST WORD INTO S1
MOVE S2,S2+1 ;GET SECOND WORD INTO S2
POP P,S2+1 ;RESTORE THE SAVED AC
$RETT ;AND RETURN
> ;END IFN FTJSYS
SUBTTL K%WCOC -- Write Character Output Control table
;See explanation above
;CALL IS: S1/ First word of COC table
; S2/ Second word of COC table
;
;TRUE RETURN: Always
IFN FTUUOS,<
K%WCOC: DMOVEM S1,COCTAB ;STORE THE TABLE
$RETT ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
K%WCOC: PUSH P,S2+1 ;SAVE A 3RD JSYS AC
MOVE S2+1,S2 ;PUT SECOND WORD IN T1
MOVE S2,S1 ;PUT FIRST WORD IN S2
MOVEI S1,.PRIIN ;GET PRINCIPLE INPUT JFN
SFCOC ;SET COC TABLE
POP P,S2+1 ;RESTORE S2+1
$RETT ;AND RETURN
> ;END IFN FTJSYS
SUBTTL K%SUET -- Set User Escape Table
;K%SUET is called to setup the address of the user escape table if the
; program wants special action on ESCape sequences.
;
;Call: S1/ address of User Escape Table
; or 0 to clear the UET entry
;
;T Ret: always
IFN FTUUOS,<
K%SUET: MOVEM S1,UESCTB ;SAVE THE ESCAPE TABLE ADDRESS
SETZM CURESC ;CLEAR CURRENT STATE
MOVE S1,TRMTYP ;GET TERMINAL TYPE
CAXE S1,.TTV50 ;IS IT A VT50?
CAXN S1,.TTV52 ;OR A VT52?
SKIPA ;YES, SET IT UP
$RETT ;RETURN
OUTCHR [.CHESC] ;OUTPUT AN ESCAPE
MOVEI S1,"=" ;THIS SETS THE MODE
SKIPN UESCTB ;PROGRAM IS CLEARING IT
MOVEI S1,76 ;CLEAR IT
OUTCHR S1 ;PUT OUT THE CHARACTER
$RETT ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
K%SUET: HALT . ;NOT IMPLEMENT
> ;END IFN FTJSYS
SUBTTL K%STYP -- Set terminal type
;K%STYP is used to give the scanning module knowledge of the terminal type
; in use as the command terminal.
;CALL IS: S1/ Terminal type code (See GLXMAC)
;
;TRUE RETURN: Terminal is a known type
;FALSE RETURN: The terminal code does not appear in SCN's tables
IFN FTJSYS,<
K%STYP: MOVE S2,S1 ;PUT TYPE IN S2
MOVX S1,.PRIIN ;LOAD PRINCIPLE INPUT JFN
STTYP ;SET TERMINAL TYPE
ERJMP .RETF ;LOSE IF JSYS DID
$RETT ;ELSE WIN.
> ;END IFN FTJSYS
IFN FTUUOS,<
K%STYP: PUSHJ P,.SAVE4 ;SAVE SOME PERM ACS
MOVE P1,S1 ;AND COPY INPUT ARGUMENT
MOVSI S1,-TTTABL ;LENGTH OF TABLE
STYP.2: HLRZ S2,TTTAB(S1) ;GET A TERMINAL TYPE CODE
CAME P1,S2 ;A MATCH?
AOBJN S1,STYP.2 ;NO, TRY ALL THE ENTRIES
JUMPGE S1,.RETF ;TAKE FAILURE IF NOT FOUND
MOVE S2,TTSET(S1) ;GET ADDRESS OF SETUP ROUTINE
ADDI S1,TTTAB ;ADD TABLE ADDRESS TO OFFSET
HRRZM S1,TRMPTR ;STORE POINTER FOR LATER USE
MOVEM P1,TRMTYP ;AND SAVE THE TERMINAL TYPE
TLNN S2,-1 ;IS THERE A WIDTH THERE?
PJRST 0(S2) ;NO, JUST SET TERMINAL SPECIFIC STUFF
MOVE S1,[3,,P1] ;SETUP AN ARG BLOCK
MOVX P1,.TOWID+.TOSET ;SET WIDTH FUNCTION
MOVE P2,TRMUDX ;GET THE UDX
HLRZ P3,S2 ;GET THE WIDTH
TRMOP. S1, ;SET THE WIDTH
JFCL ;IGNORE THE ERROR
PJRST 0(S2) ;AND DO TERMINAL SPECIFIC STUFF
;TABLES ARE ON THE FOLLOWING PAGE
;
;STILL IN IFN FTUUOS
;FORMAT OF THE TTTAB TABLE IS:
; XWD TERMINAL-TYPE,ADDRESS-OF-CONTROL-TABLE
;
;EACH ENTRY IN THE CONTROL TABLE IS THE ADDRESS OF A PARTICULAR
; CONTROL SEQUENCE FOR THE TERMINAL.
;
;THE SEQUENCES ARE:
.TCEOL==0 ;ERASE TO END-OF-LINE
TTTAB: .TT33,,0 ;MODEL 33 TTY
.TT35,,0 ;MODEL 35 TTY
.TT37,,0 ;MODEL 37 TTY
.TTEXE,,0 ;EXECUPORT
.TTV05,,[[BYTE (7)37,177,177,177]];VT05
.TTV50,,[[BYTE (7).CHESC,"J"]] ;VT50
.TTL30,,0 ;LA30
.TTL36,,0 ;LA36
.TTV52,,[[BYTE (7) .CHESC,"J"]] ;VT52
.TTV52,,[[BYTE (7) .CHESC,"J"]] ;AND ONE FOR PATCHING
TTTABL==.-TTTAB
;FORMAT OF TABLE IS WIDTH,,ADR OF SETUP ROUTINE
; IF WIDTH IS 0, IT ISN'T SET
; ***MUST BE PARALLEL TO TTTAB***
TTSET: XWD ^D72,.RETT ;MODEL 33 TTY
XWD ^D72,.RETT ;MODEL 35 TTY
XWD ^D72,.RETT ;MODEL 37 TTY
XWD ^D72,.RETT ;EXECUPORT
XWD ^D72,.RETT ;VT05
XWD ^D80,SETVT5 ;VT50
XWD ^D72,.RETT ;LA30
XWD ^D00,.RETT ;LA36
XWD ^D80,SETVT5 ;VT52
XWD ^D80,SETVT5 ;PATCH SPACE
;TERMINAL SETUP ROUTINES
SETVT5: OUTCHR [.CHESC] ;PUT OUT AN ESCAPE
MOVEI S1,"=" ;TO SET ALTERNATE MODE
SKIPN UESCTB ;DID PROGRAM SET IT
MOVEI S1,76 ;NOPE.
OUTCHR S1 ;PUT IT OUT
MOVE S1,[3,,P1] ;GET TRMOP ARG POINTER
MOVX P1,.TOLCT+.TOSET ;SET TT LC
MOVE P2,TRMUDX ;GET THE UDX
SETZ P3, ;SET A FLAG?
TRMOP. S1, ;DO THE TRMOP
JFCL ;IGNORE ERROR
$RETT ;AND RETURN
> ;END IFN FTUUOS
SUBTTL K%TXTI -- Handle Terminal Input
;This routine is used to do input from the controlling terminal. It
; acts much like the TOPS-20 JSYS TEXTI.
;CALL IS: S1/ Address of a TEXTI format argument block
;
;TRUE RETURN: Always, with an updated argument block
IFN FTJSYS,<
K%TXTI: TEXTI ;DO THE TEXTI JSYS
ERJMP .RETF ;LOSE IF HE DID
$RETT ;AND RETURN
> ;END IFN FTJSYS
IFN FTUUOS,<
K%TXTI: SKIPN TTYFLG ;WAS TERMINAL EVER OPENED?
$STOP(TNO,Terminal never opened) ;APPARENTLY NOT
MOVEM S1,ARGLOC ;REMEMBER ARGUMENT BLOCK LOCATION
SAVE C ;SAVE CHARACTER AC
PUSHJ P,.SAVET ;MAKE T REGS AVAILABLE FOR SCRATCH
MOVEI S1,.RDSIZ ;GET SIZE OF BLOCK
MOVEI S2,RD ;AND ITS LOCATION
PUSHJ P,.ZCHNK ;AND NOW ZERO THE BLOCK OUT
HRL S2,ARGLOC ;FORM A XFER POINTER
MOVE S1,ARGLOC ;GET LOCATION OF BLOCK
MOVE S1,.RDCWB(S1) ;LENGTH OF BLOCK TO MOVE
ADDI S1,0(S2) ;NOW HAVE LAST WORD TO MOVE
BLT S2,0(S1) ;MOVE USER BLOCK
PUSHJ P,CONVBP ;CONVERT ALL BYTE POINTERS ETC..
SETZM RUBFLG ;CLEAR RUBOUT IN PROGRESS FLAG
SETZM BCKFLG ;CLEAR BACKUP LIMIT FLAG
JRST TXTL ;YES, DON'T SLEEP
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
; HERE WHEN ALL IS DONE, S1 CONTAINS FLAGS TO STORE
FINTXT: SKIPE BCKFLG ;WAS BACKUP LIMIT REACHED?
IORX S1,RD%BLR ;YES, TURN ON THE INDICATOR
IORM S1,RD+.RDFLG ;STORE FLAGS
SKIPN RD+.RDDBC ;ANY ROOM FOR A TERMINATING NULL?
JRST FINT.1 ;NO, SO CANNOT DEPOSIT NULL
SETZ S1, ;GET A NULL
MOVE S2,RD+.RDDBP ;GET THE BYTE POINTER
IDPB S1,S2 ;AND STORE IT
FINT.1: MOVE S1,ARGLOC ;GET LOCATION OF ARG BLOCK
MOVE S2,.RDCWB(S1) ;AND SIZE OF IT-1
ADD S2,S1 ;GET LAST WORD TO MOVE
HRLI S1,RD ;TRANSFER FROM OUR FULL ARG BLOCK
BLT S1,0(S2) ;TO THE USER'S POSSIBLY PARTIAL
PUSHJ P,I%ION ;RE-ENABLE INTERRUPTS JUST IN CASE
$RETT
;STILL IN IFN FTUUOS FOR A LONG TIME
SUBTTL TXTL -- Loop for inputting text
;TXTL is a lower level routine which loops for each character, calling
; all the worker routines. It exits when the appropriate condition
; (ie, break or full) occurs.
;CALL IS: No arguments
;
;TRUE RETURN: Always
TXTL: PUSHJ P,I%ION ;TURN ON INTERRUPTS IF OFF
SKIPL BCKFLG ;WAS BACKUP LIMIT REACHED?
SKIPG S1,RD+.RDDBC ;ANY ROOM FOR ANOTHER CHARACTER?
JRST FINTXT ;NO, RETURN WITH NO FLAGS SET
MOVX S1,RD%JFN ;GET THE "JFN PRESENT" BIT
TDNN S1,RD+.RDFLG ;SKIP IF SET
JRST [ILDB C,RD+.RDFLG ;ELSE, GET A CHARACTER
JUMPN C,TXTL.2 ;AND CONTINUE IF NOT NULL
MOVX S1,RD%BTM ;LOAD "BREAK TERMINATOR" FLAG
JRST FINTXT] ;AND RETURN
HLRZ S1,RD+.RDIOJ ;GET PRIMARY INPUT JFN
CAXE S1,.PRIIN ;TERMINAL?
JRST TXTL.4 ;NO
SKIPE CURESC ;ARE WE IN AN ESCAPE SEQUENCE?
JRST TXTL.5 ;YES, GET NEXT CHARACTER
PUSHJ P,TTYCHR ;NO,GET A CHARACTER
CAIN C,.CHESC ;IS IT AN ESCAPE?
SKIPN S1,UESCTB ;YES, HAS USER SETUP A TABLE?
JRST TXTL.2 ;NO, CONTINUE ON
MOVEM S1,CURESC ;SAVE AS CURRENT STATE
TXTL.1: PUSHJ P,TTYCHR ;GET THE NEXT CHARACTER
ADD C,CURESC ;GET ADR OF TABLE ENTRY
MOVE S1,0(C) ;AND GET THE WORD
MOVEM S1,CURESC ;STORE AS CURRENT STATE
JUMPE S1,[OUTCHR [.CHBEL] ;TYPE A BELL
JRST TXTL] ;AND LOOP AROUND
TLNN S1,-1 ;IS IT 0,,ADR?
JRST TXTL.1 ;YES, LOOP
JRST TXTL ;NO, A BP FINALLY
;TXTL IS CONTINUED ON THE FOLLOWING PAGE
;CONTINUED FROM THE PREVIOUS PAGE
TXTL.2: JUMPE C,TXTL ;IGNORE NULLS
PUSHJ P,CONVRT ;CONVERT LOWER TO UPPER, ETC.
PUSHJ P,SPCHK ;SEE IF ITS A SPECIAL FUNCTION
JUMPT 0(S1) ;IF ITS SPECIAL, GO HANDLE IT
PUSHJ P,STOC ;STORE THE CHARACTER
PUSHJ P,I%ION ;OK, SAFE TO BE INTERRUPTED
AOSN RUBFLG ;CLEAR RUBFLG, WAS IT UP?
OUTCHR [.CHBSL] ;YES, CLOSE THE RUBOUT SET
PUSHJ P,ECHO ;AND ECHO IT
TXTL.3: PUSHJ P,CBRK ;CHECK FOR A BREAK
JUMPF TXTL ;IF NOT, GET NEXT CHARACTER
MOVX S1,RD%BTM ;FLAG THAT BREAK ENDED INPUT
JRST FINTXT ;AND RETURN
TXTL.4: PUSHJ P,F%IBYT ;GET NEXT CHARACTER FROM FILE
JUMPF [CAXE S1,EREOF$
JRST TXTL.6
$RETF]
SKIPN C,S2 ;NULL?
JRST TXTL.4 ;YES
HRRZ S1,RD+.RDIOJ
CAIN S1,.PRIOU ;OUTPUT TO TERMINAL ?
PUSHJ P,ECHO ;YES
PUSHJ P,CONVRT ;CONVERT CASING
PUSHJ P,STOC ;STORE
JRST TXTL.3 ;LOOP
TXTL.5: ILDB C,CURESC ;GET THE CHARACTER
SKIPN C ;FINALLY HIT A NULL?
SETZM CURESC ;YES, CLEAR THE POINTER
CAIGE C,200 ;SPECIAL CHARACTER?
JRST TXTL.2 ;NO, HANDLE NORMALLY
SUBI C,200 ;MAKE SOMETHING OF IT
OUTCHR C ;OUTPUT IT
JRST TXTL.5 ;AND LOOP
TXTL.6: $STOP(FSE,File System Error)
SUBTTL TTYCHR -- Here to receive 1 character from the TTY
;TTYCHR is written to be interruptable until a character is typed.
; When a character is available, TTYCHR goes IOFF and returns
; the character in C WITH INTERRUPTS OFF so that input is not
; lost.
TTYCHR: SKPINC ;SKIP IF A CHARACTER IS THERE
SKIPA ;NONE THERE YET, SLEEP
JRST TTYC.1 ;READY!!
MOVX S1,HB.RTC ;LOAD SOME HIBER BITS
HIBER S1, ;SLEEP
JFCL ;IGNORE IT
JRST TTYCHR ;AND LOOP FOR A CHARACTER
TTYC.1: PUSHJ P,I%IOFF ;NEED NOT TO BE INTERRUPTED HERE
INCHRW C ;ASK FOR A CHARACTER
$RETT ;AND RETURN """IOFF"""
SUBTTL Utilities for text handling
; STOC - Store an input character
STOC: CAIE C,.CHCRT ;IS THIS A CARRIAGE-RETURN?
JRST STOC.1 ;NO
LOAD S1,RD+.RDFLG,RD%CRF ;DO WE WANT TO SUPRESS IT?
JUMPN S1,.RETT ;YES,GIVE UP NOW
STOC.1: IDPB C,RD+.RDDBP ;STORE FOR POINTER
SOS RD+.RDDBC ;AND DECREMENT COUNT
$RETT ;THEN RETURN
; USTOC - Unstore a character
USTOC: SKIPN S1,RD+.RDBKL ;IS BACKUP LIMIT GIVEN?
JRST USTO.1 ;NO
CAMN S1,RD+.RDDBP ;AND ARE WE AT THE LIMIT?
SETOM BCKFLG ;REMEMBER THIS FOR LATER
USTO.1: SOS S1,RD+.RDDBP ;BACK OFF 5 BYTES
MOVEI S2,4 ;AND THEN GO FORWARD
IBP S1 ;BY INCREMENTING
SOJG S2,.-1 ;FOUR TIMES
PUSHJ P,MAKBP ;CONVERT IT
MOVEM S1,RD+.RDDBP ;AND RE-STORE IT
AOS RD+.RDDBC ;ONE MORE BYTE AVAILABLE
$RETT ;THEN RETURN
; CONVRT - Do case conversion as necessary
CONVRT: LOAD S1,RD+.RDFLG,RD%RAI ;DOES CALLER WANT INPUT RAISED?
CAXE C,$C(H) ;OR IS THIS ^H?
JUMPE S1,.RETT ;IF NOT, RETURN NOW
CAIL C,"a" ;IS IT IN RANGE OF LC A
CAILE C,"z" ; TO LC Z?
SKIPA ;NO, DON'T CONVERT IT
SUBI C,"a"-"A" ;ELSE DO THE CONVERSION
CAXE C,$C(H) ;IF NOT ^H, THEN
$RETT ;RETURN
PUSHJ P,GETCOC ;GET CONTROL CODE
CAXN S1,3 ;IS "SIMULATE" ON?
MOVEI C,.CHDEL ;YES, CONVERT TO RUBOUT
$RETT ;THEN RETURN
; CONVBP - Convert default byte pointers
CONVBP: SKIPN S1,RD+.RDDBP ;GET REQUIRED POINTER
$STOP(IBP,Illegal byte pointer in K%TXTI)
PUSHJ P,MAKBP ;CONVERT TO NORMAL
MOVEM S1,RD+.RDDBP ;STORE IT BACK
SKIPN S1,RD+.RDBFP ;GET INITIAL POINTER IF GIVEN
MOVE S1,RD+.RDDBP ;IF NOT, SET TO DESTINATION
PUSHJ P,MAKBP ;CONVERT
MOVEM S1,BGLINE ;STORE AS BEGINNING OF LINE
MOVEM S1,BGBUFR ;STORE AS BEGINNING OF BUFFER
SKIPN S1,RD+.RDBKL ;GET BACKUP LIMIT IF GIVEN
JRST COBP.1 ;NOT GIVEN, SKIP THIS
PUSHJ P,MAKBP ;CONVERT IT
MOVEM S1,RD+.RDBKL ;AND STORE IT BACK
COBP.1: SKIPN S1,RD+.RDRTY ;IS RE-TYPE PROMPT GIVEN?
$RETT ;NO
PUSHJ P,MAKBP ;CONVERT IT
MOVEM S1,RD+.RDRTY ;STORE IT BACK
MOVX S1,RD%JFN ;GET THE "JFN PRESENT" BIT
TDNE S1,RD+.RDFLG ;SKIP IF NOT SET
$RETT ;SET...NO BYTE-POINTER
SKIPN S1,RD+.RDIOJ ;GET THE BYTE POINTER
$STOP(IIP,Illegal Input Pointer)
PUSHJ P,MAKBP ;CONVERT THE BYTE POINTER
MOVEM S1,RD+.RDIOJ ;AND RE-STORE IT
$RETT ;RETURN
; MAKBP - Un-default a byte pointer
MAKBP: TLC S1,-1 ;COMPLEMENT LH (BYTE POINTER PART)
TLCN S1,-1 ;CHANGE BACK , TEST FOR -1
HRLI S1,(POINT 7) ;IF DEFAULTED,CONVERT TO ASCII
LOAD S2,S1,BP.POS ;GET POSITION (BITS TO RIGHT)
CAIGE S2,7 ;ENOUGH FOR ANOTHER BYTE?
JRST [ MOVEI S2,^D36 ;NO, MAKE IT ^D36 BITS TO
STORE S2,S1,BP.POS ;THE RIGHT IN NEXT WORD
AOJA S1,.RETT] ;AND RETURN
$RETT ;THEN RETURN
; IMGSTR - Output a string as it was echoed
IMGSTR: SAVE C ;SAVE CHARACTER REGISTER
PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,MAKBP ;MAKE A BYTE POINTER
MOVE P1,S1 ;GET THE POINTER IN P1
IMGS.1: ILDB C,P1 ;GET A CHARACTER
JUMPE C,.POPJ ;RETURN ON NULL
PUSHJ P,ECHO ;RE-ECHO IT
JRST IMGS.1 ;LOOP FOR MORE
; CLINE - Clear current video line
CLINE: OUTCHR [.CHCRT] ;OUTPUT A CARRAIGE RETURN
HRRZ S1,@TRMPTR ;GET CONTROL CODE FOR ERASE
OUTSTR @.TCEOL(S1) ;TO END OF LINE
$RETT ;AND RETURN
; GETCOC - Fetch COC for a given character
GETCOC: MOVE S1,C ;GET CHARACTER
IDIVI S1,^D18 ;2 BITS PER CHAR = 18 CHARS PER WORD
MOVE S1,COCTAB(S1) ;GET RIGHT WORD OF COC
ASH S2,1 ;TWO BITS NEEDED FOR ONE CHARACTER
ROTC S1,2(S2) ;POSITION COC AS BITS 34&5 OF S2
LDB S1,[POINT 2,S2,35] ;GET INTO S1 FOR RETURN
$RETT ;AND RETURN
; ECHO - HANDLE CHARACTER ECHOING
ECHO: MOVX S1,RD%NEC ;GET NO ECHO BIT
TDNE S1,RD+.RDFLG ;TEST IT
$RETT ;RETURN IF SET
CAIL C," " ;IS THIS A PRINTABLE CHARACTER?
JRST ECHO.2 ;YES, JUST OUTPUT IT
PUSHJ P,GETCOC ;GET COC CODE FOR CHARACTER
JRST @[EXP .RETT,ECHO.1,ECHO.2,ECHO.3](S1) ;DISPATCH FOR HANDLING
; SEND ^ (UP-ARROW) FOLLOWED BY PRINTABLE FORM OF CHARACTER
ECHO.1: MOVEI S1,100(C) ;GET PRINTABLE FORM OF CHARACTER
OUTCHR ["^"] ;PRINT UP-ARROW
OUTCHR S1 ;AND THE CHARACTER
$RETT ;AND RETURN
; SEND ACTUAL CODE FOR THIS CHARACTER (TRUE ECHO)
ECHO.2: OUTCHR C ;PRINT IT
$RETT ;AND RETURN
; SIMULATE ACTION FOR CHARACTER
ECHO.3: CAXE C,.CHESC ;ONLY KNOW HOW TO SIMULATE ESCAPE (33)
JRST ECHO.2 ;SO IF NOT THAT, SEND ACTUAL CODE
OUTCHR ["$"] ;SIMULATE ESC WITH "$" (DOLLAR SIGN)
$RETT ;AND RETURN
; CBRK - Check to see if character is a break
CBRK: SKIPN RD+.RDBRK ;IS A USER SUPPLIED BREAK TABLE PRESENT?
JRST CBRK.1 ;NO, GO TO NEXT SECTION
MOVE S1,C ;GET CODE FOR CHARACTER
IDIVI S1,^D32 ;32 CODES PER WORD
ADD S1,RD+.RDBRK ;GET RIGHT WORD OF TABLE
MOVE S1,0(S1) ;IE WORD 0-3
LSH S1,0(S2) ;POSITION RIGHT BIT TO SIGN BIT
JUMPL S1,.RETT ;TAKE THIS BREAK IF WANTED
CBRK.1: MOVSI S1,-BTBLL ;GET BREAK TABLE LENGTH
CBRK.2: HLLZ S2,BTBL(S1) ;GET ONLY FLAG PORTION
TDNN S2,RD+.RDFLG ;IS THIS BREAK SET FLAG ON?
JRST CBRK.4 ;NO, SKIP THIS TEST
HRRZ S2,BTBL(S1) ;NOW GET ADDRESS PORTION
HRLI S2,(POINT 7) ;FORM A BYTE POINTER
CBRK.3: ILDB T1,S2 ;GET BYTE
JUMPE T1,CBRK.4 ;IF NULL, WE HAVE A NO MATCH
CAMN T1,C ;DOES THIS MATCH A BREAK CHARACTER?
$RETT ;YES, TAKE TRUE RETURN
JRST CBRK.3 ;LOOP FOR ALL
CBRK.4: AOBJN S1,CBRK.2 ;STEP THROUGH ENTIRE TABLE
$RETF ;FINALLY, ITS NOT A BREAK
; FORMAT OF TABLE IS: FLGS,,[BYTE (7) CHR,CHR, WHICH ARE BREAK IF FLG IS SET]
BTBL: RD%BRK+[BYTE(7) $C(Z),.CHESC] ;^Z,$
RD%TOP+[BYTE(7) $C(G),$C(L),$C(Z),.CHESC,.CHLFD,.CHCRT,0]
RD%PUN+PUNTAB
RD%BEL+[BYTE(7) .CHLFD,0]
BTBLL==.-BTBL
PUNTAB: ;TABLE OF PUNCTUATION CHARACTERS
BYTE (7) 40,41,42,43,44,45,46,47,50,51,52,53,54,55,56,57,34,35,36,37
BYTE (7) 72,73,74,75,76,77,100,133,134,135,136,137,140,173,174
BYTE(7) $C(A),$C(B),$C(C),$C(D),$C(E),$C(F),$C(H),$C(I),$C(K),$C(N)
BYTE(7) $C(O),$C(P),$C(Q),$C(S),$C(T),175,176,$C(X),$C(Y),0
SUBTTL SPCHK -- Check for special characters
;SPCHK is called to detect special formatting and edit characters as they
; come in.
;
;CALL IS: C/ Character
;
;TRUE RETURN: S1/ Address of routine to call
;FALSE RETURN: Character was not special
SPCHK: MOVSI S1,-SCTBLL ;GET LENGTH OF TABLE
SPCH.1: HLRZ S2,SCTBL(S1) ;GET CHARACTER
CAME S2,C ;A MATCH?
AOBJN S1,SPCH.1 ;LOOP LOOKING FOR MATCH
JUMPGE S1,.RETF ;IF NO MATCH, RETURN FALSE
HRRZ S1,SCTBL(S1) ;GET PROCESSOR ADDRESS
LOAD S2,RD+.RDFLG,RD%SUI ;GET ^U SUPRESS BIT
CAIN S1,$C(U) ;IF NOT CONTROL-U,
PJUMPN S2,.RETF ;IF A SUPPRESS ^U, RETURN FALSE
$RETT ;RETURN TRUE
SCTBL: .CHDEL,,CCDEL ;DELETE (177)
$C(U),,CCU ;^U
$C(R),,CCR ;^R
$C(W),,CCW ;^W
SCTBLL==.-SCTBL
SUBTTL CCU -- Handle ^U (Rubout entire line)
;HERE TO PROCESS ^U (RESTART INPUT)
CCU: SETZM RUBFLG ;CLEAR RUBOUT FLAG
MOVE S1,BGLINE ;GET BEGINNING POINTER
CAMN S1,RD+.RDDBP ;DOES CURRENT MATCH FIRST?
JRST CCU.1 ;YES, SO WE ARE AT FRONT
PUSHJ P,USTOC ;UNSTORE 1 CHARACTER
JRST CCU ;TRY AGAIN
CCU.1: HRRZ S1,@TRMPTR ;GET CONTROL CODE PART
JUMPN S1,CCU.2 ;IF VIDEO, HANDLE IT THAT WAY
OUTSTR [ASCIZ/
/] ;GIVE A NEW LINE
JRST CCU.3 ;AND CONTINUE
CCU.2: PUSHJ P,CLINE ;CLEAR THE LINE
CCU.3: PUSH P,T1 ;SAVE T1
SKIPE T1,RD+.RDRTY ;IF A PROMPT WAS GIVEN,
PUSHJ P,TYPEBP ;RESEND THE PROMPT
POP P,T1 ;RESTORE T1
LOAD S1,RD+.RDFLG,RD%RND ;DOES USER WANT RETURN ON EMPTY?
JUMPE S1,TXTL ;NO, GO FOR MORE INPUT
MOVX S1,RD%BFE ;INDICATE BUFFER EMPTY
JRST FINTXT ;AND FINISH UP
SUBTTL CCR -- Handle ^R (Re-type the line)
CCR: SETZM RUBFLG ;CLEAR RUBOUT FLAG
HRRZ S1,@TRMPTR ;GET TERMINAL POINTER
JUMPE S1,CCR.1 ;IF NULL, ITS HARD COPY
PUSHJ P,CLINE ;CLEAR THE LINE
SKIPA ;AND DON'T GO TO NEXT ONE
CCR.1: OUTSTR [ASCIZ/
/] ;GET TO NEXT LINE
PUSH P,T1 ;SAVE T1
SKIPE T1,RD+.RDRTY ;IS RE-PROMPT GIVEN?
PUSHJ P,TYPEBP ;YES, OUTPUT IT
MOVE S1,RD+.RDDBP ;GET CURRENT BYTE POINTER
MOVEI S2,0 ;AND A NULL TO DEPOSIT
IDPB S2,S1 ;STORE AS ASCIZ TERMINATOR
MOVE S1,BGLINE ;GET POINTER TO LINE
PUSHJ P,IMGSTR ;OUTPUT AN STRING AS ECHOED
POP P,T1 ;RESTORE T1
JRST TXTL ;WHEN DONE, GET NEXT CHARACTER
SUBTTL CCDEL -- Handle Rubout (Delete one character)
CCDEL: MOVE S1,RD+.RDDBP ;GET CURRENT POINTER
CAMN S1,BGBUFR ;ARE WE BACK UP TO BEGINNING?
JRST BEGBUF ;YES, AT BEGINNING OF BUFFER
PUSHJ P,USTOC ;UN-STORE A CHARACTER
MOVE S1,RD+.RDDBP ;GET CORRECTED POINTER
ILDB C,S1 ;THEN GET DELETED CHARACTER
HRRZ S1,@TRMPTR ;GET POINTER TO CONTROL CODE
JUMPN S1,CCDL.1 ;IF THERE IS CODE,DO IT
SKIPL RUBFLG ;WAS PREVIOUS CHAR A RUBOUT?
OUTCHR [.CHBSL] ;START RUBOUT SET WITH BACKSLASH
SETOM RUBFLG ;AND SET FLAG TO REMEMBER IT
PUSHJ P,ECHO ;ECHO THE CHARACTER
JRST TXTL ;THEN RETURN FOR NEXT CHARACTER
CCDL.1: CAIGE C," " ;WAS DELETED CHARACTER PRINTING?
JRST CCDL.2 ;NO, NEED FURTHER ANALYSIS
OUTSTR [BYTE (7)10,40,10] ;OUTPUT BACKSPACE,SPACE,BACKSPACE
JRST TXTL ;THEN CONTINUE
CCDL.2: PUSHJ P,GETCOC ;GET COC FOR THIS CHARACTER
JUMPE S1,TXTL ;IF CODE 0 , NOTHING THERE AT ALL
CAXE S1,1 ;IF ITS A ONE, JUST RUBOUT 2 CHARACTERS
JRST CCR ;ELSE FORCE A RETYPE OF THE LINE
OUTSTR [BYTE (7)10,10,40,40,10,10] ;OUTPUT BACK,BACK,SPACE,SPACE,BACK,BACK
JRST TXTL ;THEN GET NEXT INPUT
SUBTTL CCW -- Handle ^W (Delete back to punctuation character)
CCW: SETZM RUBFLG ;CLEAR RUBOUT FLAG
MOVE S1,RD+.RDDBP ;GET BYTE POINTER
CAMN S1,BGLINE ;IF AT THE BEGINNING, GO HANDLE IT
JRST BEGBUF ;BY RINGING OR RETURNING
CCW.1: PUSHJ P,USTOC ;UN-STORE ONE CHARACTER
MOVE S1,RD+.RDDBP ;GET CORRECTED POINTER
CAMN S1,BGLINE ;ARE WE AT BEGINNING NOW?
JRST CCW.3 ;YES, THATS A PUNCTUATION ALL RIGHT
SUBI S1,1 ;GET CHAR PRECEDING THIS ONE
MOVEI S2,5 ;BY BACKING OFF AND INCREMENTING
ILDB C,S1 ;THE RIGHT NUMBER OF TIMES
SOJG S2,.-1 ;
MOVE S1,[POINT 7,PUNTAB] ;POINT TO PUNCTUATION TABLE
CCW.2: ILDB S2,S1 ;GET A PUNCTUATION CHARACTER
JUMPE S2,CCW.1 ;IF AT END, DELETE ANOTHER CHARACTER
CAME S2,C ;IS NEXT CHAR A PUNCTUATION CHAR?
JRST CCW.2 ;NO, TRY NEXT IN LIST
CCW.3: JRST CCR ;HAVE DELETED FAR ENOUGH, RETYPE LINE
SUBTTL BEGBUF -- Handle rubouts to beginning of buffer
;Here to handle deletion of characters till beginning of buffer.
; Either ring bell and wait, or return to caller.
BEGBUF: LOAD S1,RD+.RDFLG,RD%RND ;GET FLAG FOR RETURN HERE
JUMPN S1,[ MOVX S1,RD%BFE ;FLAG IS LIT, RETURN BUFFER EMPTRY NOW
JRST FINTXT ] ;TO CALLER
OUTCHR [.CHBEL] ;SEND "BELL" AND
JRST TXTL ;THEN RETURN FOR NEXT CHARACTER
SUBTTL TYPEBP -- Type a string according to a byte-pointer
;Call with a byte-pointer in T1
TYPEBP: HLRZ S1,T1 ;GET LEFT HALF OF POINTER
CAIN S1,-1 ;IS IT -1
MOVEI S1,(POINT 7,0) ;YES, MAKE IT STANDARD
CAIN S1,(POINT 7,0) ;WORD ALIGNED?
JRST TYPE.2 ;YES, DO AN OUTSTR
TYPE.1: ILDB S1,T1 ;GET A CHARACTER
JUMPE S1,.RETT ;DONE ON A NULL
OUTCHR S1 ;TYPE IT
JRST TYPE.1 ;AND LOOP
TYPE.2: OUTSTR 0(T1) ;TYPE THE STRING
$RETT ;AND RETURN
> ;END IFN FTUUOS FROM K%TXTI
KBD%L: ;LABEL THE LITERAL POOL