github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-06 19:11:04 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/smfile/gkbd.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

843 lines
27 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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.
BATFLG: EXP -1 ;BATCH MODE FLAG
TTYCHR: SKIPL BATFLG ;DO WE KNOW YET?
JRST TTYC.0 ;YES
HRROI S1,.GTLIM ;GET THE LIMIT WORD
GETTAB S1, ;FROM MONITOR
SETO S1, ;ASSUME BATCH
TXNE S1,JB.LBT ;ARE WE?
AOS BATFLG ;YES
AOS BATFLG ;0 IF NOT, 1 IF YES
TTYC.0: SKPINC ;SKIP IF A CHAR IS THERE
SKIPE BATFLG ;NONE YET, ARE WE INTERACTIVE?
JRST TTYC.1 ;GOT A CHAR, OR BATCH
MOVX S1,HB.RTC ;LOAD SOME HIBER BITS
HIBER S1, ;SLEEP
JFCL ;IGNORE IT
JRST TTYC.0 ;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
Reference in New Issue View Git Blame Copy Permalink