Trailing-Edge
-
PDP-10 Archives
-
cuspbinsrc_2of2_bb-fp63b-sb
-
10,7/rms10/rmssrc/cpakbd.mac
There are 7 other files named cpakbd.mac in the archive. Click here to see a list.
TITLE CPAKBD -- Keyboard Interface for CMDPAR
SUBTTL AUTHOR: Irwin Goverman/ILG/LSS/MLB/WLH/DC 19-Sept-79
;
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979
; DIGITAL EQUIPMENT CORPORATION
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND 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. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH CPASYM ;OPEN SYMBOLS NEEDED
PROLOG(CPAKBD)
;This module provides the TEXTI JSYS implemented in the TOPS20 monitor.
SUBTTL Table of Contents
; TABLE OF CONTENTS FOR CPAKBD
;
;
; 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%BOUT -- Type one character on TTY..................... 13
; 11. K%SOUT -- Type an ASCIZ string on TTY................... 13
; 12. K%BIN -- Accept a character from TTY................... 14
; 13. K%BACK -- Back up terminal input by one character....... 14
; 14. K%TPOS -- GET THE HORIZONTAL TERMINAL POSITION.......... 15
; 15. K%TXTI -- Handle Terminal Input......................... 16
; 16. TXTL -- Loop for inputting text....................... 18
; 17. Utilities for text handling............................... 20
; 18. STOC -- Store an input character...................... 20
; 19. USTOC -- Unstore a character........................... 20
; 20. CONVRT -- Do case conversion as necessary............... 21
; 21. CONVBP -- Convert default byte pointers................. 21
; 22. MAKBP -- Un-default a byte pointer..................... 22
; 23. IMGSTR -- Output a string as it was echoed.............. 22
; 24. CLINE -- Clear current video line...................... 22
; 25. GETCOC -- Fetch COC for a given character............... 22
; 26. ECHO -- HANDLE CHARACTER ECHOING...................... 23
; 27. CBRK -- Check to see if character is a break.......... 24
; 28. SPCHK -- Check for special characters.................. 25
; 29. CCU -- Handle ^U (Rubout entire line)................ 26
; 30. CCR -- Handle ^R (Re-type the line).................. 27
; 31. FNDLIN -- Find beginning of current line................ 28
; 32. CCDEL -- Handle Rubout (Delete one character).......... 29
; 33. CCW -- Handle ^W (Delete back to punctuation character) 30
; 34. BEGBUF -- Handle rubouts to beginning of buffer......... 31
; 35. TYPEBP -- Type a string according to a byte-pointer..... 31
SUBTTL 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
ENTRY K%BIN ;READ ONE CHARACTER
ENTRY K%BOUT ;TYPE ONE CHARACTER
ENTRY K%SOUT ;TYPE AN ASCIZ STRING
ENTRY K%BACK ;BACK UP OVER LAST INPUT CHARACTER
ENTRY K%TPOS ;TERMINAL CURSOR POSITION ROUTINE
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
$IMPURE
$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 TRMTY ;TERMINAL TYPE
$DATA TRMUDX ;UDX FOR TERMINAL
$DATA BGLINE ;POINTER TO BEGINNING OF CURRENT LINE
$DATA BGBUFR ;MY POINTER TO BEGINNING OF BUFFER
$DATA LSTCHR ;LAST CHARACTER RETURNED BY K%BIN
$DATA BAKCHR ;-1 IF USER CALL K%BACK
$DATA TSTACK ;TEXT STACK POINTER
$PURE
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: No arguments
;
;TRUE RETURN: No arguments are returned
TOPS10 <
K%INIT: $SAVE <T1,T2,T3,T4> ;SAVE SOME REGS
MOVE T1,[EXP FO.ASC+.FORED] ;ASSIGN EXTENDED CHAN, READ ONLY
MOVE T2,[IO.LEM+IO.SUP+IO.TEC+.IOASC] ;SET ALL THE FUNNY MODES
MOVSI T3,'TTY' ;ON THE CONTROLLING TERMINAL
SETZ T4, ;NO BUFFERS
MOVE S1,[XWD 4,T1] ;LENGTH, ADR OF ARG BLOCK
FILOP. S1, ;OPEN UP THE TERMINAL FOR SCANNING
$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
SETZM UESCTB ;NO ESCAPE SEQUENCES
SETZM CURESC ;CLEAR ESCAPE MACHINE
MOVSI T2,'TTY' ;LOAD TTY NAME
IONDX. T2, ;GET IO INDEX
JFCL ;IGNORE ERROR
MOVEM T2,TRMUDX ;STORE FOR VARIOUS TRMOPS
MOVX T1,.TOTRM ;FUNCTION CODE TO GET TERMINAL TYPE
MOVE S1,[XWD 2,T1] ;ARG LIST FOR TRMOP.
TRMOP. S1, ;ASK FOR TERMINAL TYPE
JRST KINI.2 ;NO? ASSUME A DEFAULT
MOVSI T1,-<.TIMAX+1> ;IOWD PTR TO SIXBIT NAME TABLE
KINI.1: CAME S1,TSTAB(T1) ;MATCH THIS ENTRY?
AOBJN T1,KINI.1 ;NO, TRY AGAIN
SKIPL T1 ;HIT ONE?
KINI.2: MOVX T1,.TI33 ;NO, ASSUME THIS IS A 33
HRRZS S1,T1 ;GET ONLY ITS INDEX
PJRST STYP.3 ;SET TYPE AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
K%INIT: $RETT ;ASSUME ALL O.K.
>;END TOPS20 CONDITIONAL
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
TOPS10 <
K%RCOC: DMOVE S1,COCTAB ;GET TABLE
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
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 TOPS20 CONDITIONAL
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
TOPS10 <
K%WCOC: DMOVEM S1,COCTAB ;STORE THE TABLE
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
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 TOPS20 CONDITIONAL
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
TOPS10 <
K%SUET: MOVEM S1,UESCTB ;SAVE THE ESCAPE TABLE ADDRESS
SETZM CURESC ;CLEAR CURRENT STATE
MOVE S1,TRMTY ;GET TERMINAL TYPE
CAXN S1,.TT100 ;VT100
JRST SUET.1 ;SETUP THE TERMINAL
CAXE S1,.TTV50 ;IS IT A VT50?
CAXN S1,.TTV52 ;OR A VT52?
SKIPA ;YES, SET IT UP
$RETT ;RETURN
SUET.1: MOVX S1,.CHESC ;LOAD AN ESCAPE
PUSHJ P,K%BOUT ;AND TYPE IT
MOVEI S1,"=" ;THIS SETS THE MODE
SKIPN UESCTB ;PROGRAM IS CLEARING IT
MOVEI S1,76 ;CLEAR IT
PUSHJ P,K%BOUT ;PUT OUT THE CHARACTER
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
K%SUET: HALT . ;NOT IMPLEMENT
> ;END TOPS20 CONDITIONAL
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 CPASYM)
;
;TRUE RETURN: Terminal is a known type
;FALSE RETURN: The terminal code does not appear in SCN's tables
TOPS20 <
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 TOPS20 CONDITIONAL
TOPS10 <
K%STYP: PUSHJ P,.SAVE4 ;SAVE SOME PERM ACS
MOVE P1,S1 ;AND COPY INPUT ARGUMENT
MOVSI S1,-<.TIMAX+1> ;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
MOVX P2,.TOTRM+.TOSET ;CODE TO SET TERMINAL TYPE
MOVE P3,TRMUDX ;ON OUR UNIVERSAL DEVICE INDEX (TTY)
MOVE P4,TSTAB(S1) ;GET SIXBIT TTY NAME
MOVE S2,[XWD 3,P2] ;LENGTH, ADR OF ARG BLOCK
TRMOP. S2, ;TELL THE MONITOR
$RETF ;CAN'T... TELL CALLER
;Enter here with table index in S1 to just set our internal tables
;Can't use anything put the scratch acs in here.
STYP.3: HLRZ S2,TTTAB(S1) ;GET BACK TERMINAL TYPE CODE
MOVEM S2,TRMTY ;SAVE TYPE CODE FOR LATER
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
SKIPN S2 ;ANY SETUP NEEDED?
$RETT ;NONE NEEDED, ALL DONE HERE
PJRST 0(S2) ;SET TERMINAL SPECIFIC STUFF
;TABLES ARE ON THE FOLLOWING PAGE
;
;STILL IN TOPS10 CONDITIONAL
;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
;DEFINE THE EXPANDER MACRO
DEFINE X(PARNAM,SIXNAM,SUF,EOLSEQ),<
IFNB <EOLSEQ>,< $SET (.TI'SUF,,<.TT'SUF,,[[BYTE (7)'EOLSEQ']]>)>
IFB <EOLSEQ>,< $SET (.TI'SUF,,<.TT'SUF,,0>)>
>
TTTAB: $BUILD (.TIMAX+1)
TRMTYP
$EOB
; .TT33,,0 ;MODEL 33 TTY
; .TT35,,0 ;MODEL 35 TTY
; .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
;BUILD A TABLE OF SIXBIT NAMES TO MATCH AGAINST THE TRMOP. RETURNED CODES
DEFINE X(PARNAM,SIXNAM,SUF,EOLSEQ),<
$SET (.TI'SUF,,<SIXBIT/SIXNAM/>)
>;END DEFINE X
TSTAB: $BUILD (.TIMAX+1)
TRMTYP
$EOB
;FORMAT OF TABLE IS 0,,ADR OF SETUP ROUTINE
; OR 0,,0 TO ALWAYS RETURN TRUE
; ***MUST BE PARALLEL TO TTTAB***
TTSET: $BUILD (.TIMAX+1)
$SET (.TIV50,,SETVT5)
$SET (.TIV52,,SETVT5)
$EOB
; EXP .RETT ;MODEL 33 TTY
; EXP .RETT ;MODEL 35 TTY
; EXP .RETT ;VT05
; EXP SETVT5 ;VT50
; EXP .RETT ;LA30
; EXP .RETT ;LA36
; EXP SETVT5 ;VT52
; EXP SETVT5 ;PATCH SPACE
;TERMINAL SETUP ROUTINES
SETVT5: MOVX S1,.CHESC ;LOAD AN ESCAPE
PUSHJ P,K%BOUT ;AND TYPE IT
MOVEI S1,"=" ;TO SET ALTERNATE MODE
SKIPN UESCTB ;DID PROGRAM SET IT
MOVEI S1,76 ;NOPE.
PUSHJ P,K%BOUT ;AND 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 TOPS10 CONDITIONAL
SUBTTL K%BOUT -- Type one character on TTY
;Call: S1/ character, right justified
;
;True Return: always
TOPS10 <
K%BOUT: OUTCHR S1 ;TYPE THE CHARACTER
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
K%BOUT: PBOUT% ;TYPE THE CHARACTER
$RETT ;AND RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL K%SOUT -- Type an ASCIZ string on TTY
;Call: S1/ address of string (word-aligned)
;
;True Return: always
TOPS10 <
K%SOUT: OUTSTR 0(S1) ;TYPE THE STRING
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
K%SOUT: PSOUT% ;TYPE THE STRING
$RETT ;AND RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL K%BIN -- Accept a character from TTY
;Call: No arguments
;
;True Return: S1/ one character right justified
K%BIN: SKIPN BAKCHR ;HAVE WE BEEN BACKED UP?
JRST BIN.1 ;NO, GET A CHARACTER
SETZM BAKCHR ;YES, CLEAR THE FLAG
MOVE S1,LSTCHR ;GET THE LAST CHARACTER
$RETT ;AND RETURN
TOPS10 <
BIN.1: INCHRW LSTCHR ;GET A CHARACTER
MOVE S1,LSTCHR ;PUT IN AC
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
BIN.1: PBIN% ;GET A CHARACTER
MOVEM S1,LSTCHR ;PUT IN LOCATION FOR BACKSPACE
$RETT ;AND RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL K%BACK -- Back up terminal input by one character
;K%BACK is called to cause the next call to read a character from the
; terminal to re-read the last character read from the terminal.
; If K%BACK is called, it cannot be called again until K%BIN
; has been called at least once.
;Call: No arguments
;
;True Return: Always
K%BACK: SKIPE BAKCHR ;CALLED TWICE ALREADY?
$STOP(BTT,Backing up terminal twice)
SKIPE LSTCHR ;SKIP IF AT BEGINNING OF BUFFER
SETOM BAKCHR ;ELSE, BACK UP
$RETT ;AND RETURN
SUBTTL K%TPOS -- GET THE HORIZONTAL TERMINAL POSITION
;K%TPOS IS CALLED TO DETERMINE THE POSITION OF THE CURSOR
;
;CALL: NO ARGUMENTS
;
;TRUE RETURN: ALWAYS S1/ HORIZONTAL POSITION
TOPS10 <
K%TPOS: PUSHJ P,.SAVE1 ;SAVE AN AC
SETOM S2 ;SET S2 FOR THIS TERMINAL
TRMNO. S2, ;GET UDX FOR TERMINAL
$RETF ;ERROR..RETURN FALSE
MOVEI S1,.TOHPS ;TRMOP FUNCTION FOR POSITION
HRLI P1,2 ;NUMBER OF ARGUMENTS
HRRI P1,S1 ;ADDRESS OF ARGUMENTS
TRMOP. P1, ;DO THE TRMOP
$RETF ;RETURN FALSE
MOVE S1,P1 ;PLACE VALUE IN S1
$RETT ;RETURN..TRUE
>;END TOPS10 CONDITIONAL
TOPS20 <
K%TPOS: MOVX S1,.CTTRM ;CONTROLLING TERMINAL
RFPOS% ;GET THE POSITION
ERJMP .RETF ;ERROR..RETURN FALSE
HRRZ S1,S2 ;RETURN HORIZONTAL POSITION
$RETT
>;END TOPS20 CONDITIONAL
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
TOPS20 <
K%TXTI: TEXTI% ;DO THE TEXTI JSYS
ERJMP .RETF ;LOSE IF HE DID
$RETT ;AND RETURN
> ;END TOPS20 CONDITIONAL
TOPS10 <
K%TXTI: MOVEM S1,ARGLOC ;REMEMBER ARGUMENT BLOCK LOCATION
$SAVE C ;SAVE CHARACTER AC
PUSHJ P,.SAVET ;MAKE T REGS AVAILABLE FOR SCRATCH
MOVEM P,TSTACK ;SAVE THE STACK
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?
TXO 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
$RETT
;STILL IN TOPS10 CONDITIONAL 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: SETZ S1, ;CLEAR FLAGS IN CASE WE RETURN
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,K%BIN ;NO, GET A CHARACTER
MOVE C,S1 ;PUT THE CHARACTER IN C
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,K%BIN ;GET THE NEXT CHARACTER
MOVE C,S1 ;PUT THE CHARACTER IN C
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,[MOVX S1,.CHBEL ;LOAD A BELL
PUSHJ P,TXTOUT ;TYPE IT
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
MOVX S1,.CHBSL ;LOAD A BACKSLASH
AOSN RUBFLG ;CLEAR RUBFLG, WAS IT UP?
PUSHJ P,TXTOUT ;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,TXTINP ;DO THE TEXT INPUT
JUMPF .POPJ ;ERROR..RETURN
SKIPN C,S2 ;NULL?
JRST TXTL.4 ;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 ;SPECAIL CHARACTER?
JRST TXTL.2 ;NO, HANDLE NORMALLY
SUBI C,200 ;MAKE SOMETHING OF IT
MOVE S1,C ;PUT THE CHARACTER IN S1
PUSHJ P,TXTOUT ;TYPE IT
JRST TXTL.5 ;AND LOOP
SUBTTL TXTINP -- INPUT ROUTINE FOR NON TERMINAL INPUT
TXTINP: CAXN S1,.NULIO ;NULL INPUT
$RETE(EOF) ;GENERATE EOF ERROR
$CALL F%IBYT ;GET NEXT CHARACTER FROM FILE
JUMPT .POPJ ;O.K. RETURN
CAXN S1,EREOF$ ;EOF?
$RETF ;YES..RETURN FALSE
$STOP(FSE,File System Error)
SUBTTL TXTOUT -- CHARACTER OUTPUT FOR TERMINALS AND FILES
;THIS ROUTINE WILL DUMP A CHARACTER TO THE TERMINAL OR A FILE
;DEPENDING ON THE JFN IN THE TEXTI ARGUMENT BLOCK
TXTOUT: HRRZ S2,RD+.RDIOJ ;GET OUTPUT JFN
CAXN S2,.NULIO ;NULL?
$RETT ;JUST IGNORE IT
CAXN S2,.PRIOU ;PRIMARY OUTPUT TERMINAL?
PJRST K%BOUT ;OUTPUT IT
$RETF ;RETURN FALSE
SUBTTL STROUT -- STRING OUTPUT TO FILE AND TERMINAL
;This routine will check the output JFN and pass the data to
;the file, terminal or null
STROUT: HRRZ S2,RD+.RDIOJ ;GET OUTPUT JFN
CAXN S2,.NULIO ;NULL?
$RETT ;JUST RETURN
CAXN S2,.PRIOU ;PRIMARY OUTPUT?
PJRST K%SOUT ;YES.. DUMP THE STRING
MOVE T1,S1 ;GET THE STRING POINTER
STRO.1: ILDB S1,T1 ;GET A BYTE
JUMPE S1,.RETT ;RETURN TRUE
PUSHJ P,TXTOUT ;DUMP THE CHARACTER
JRST STRO.1 ;GET NEXT ONE
SUBTTL Utilities for text handling
SUBTTL 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
SUBTTL 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
SUBTTL 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
SUBTTL 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
SUBTTL 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
SUBTTL 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
SUBTTL CLINE -- Clear current video line
CLINE: MOVX S1,.CHCRT ;LOAD A CARRAIGE RETURN
PUSHJ P,TXTOUT ;TYPE IT
HRRZ S1,@TRMPTR ;GET CONTROL CODE FOR ERASE
MOVEI S1,@.TCEOL(S1) ; TO END OF LINE
PUSHJ P,STROUT ;TYPE IT
$RETT ;AND RETURN
SUBTTL 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
SUBTTL 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,"^" ;LOAD AN UP-ARROW
PUSHJ P,TXTOUT ;PRINT IT
MOVEI S1,100(C) ;GET PRINTABLE FORM OF CHARACTER
PUSHJ P,TXTOUT ;AND PRINT IT
$RETT ;AND RETURN
; SEND ACTUAL CODE FOR THIS CHARACTER (TRUE ECHO)
ECHO.2: MOVE S1,C ;PUT THE CHARACTER IN S1
PJRST TXTOUT ;TYPE IT 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
MOVEI S1,"$" ;LOAD A DOLLAR SIGN
PJRST TXTOUT ;TYPE IT AND RETURN
SUBTTL 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,
JUMPN 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: PUSHJ P,FNDLIN ;RESET BEGINNING OF LINE
CDX: SETZM RUBFLG ;CLEAR RUBOUT FLAG
MOVE T3,BGLINE ;COMPARE PTR'S
MOVE T4,RD+.RDDBP
PUSHJ P,CMPPTR ;ARE WE AT BEGINNING OF LINE?
JRST CCU.1 ;YES, SO WE ARE AT FRONT
PUSHJ P,USTOC ;UNSTORE 1 CHARACTER
JRST CDX ;TRY AGAIN
CCU.1: HRRZ S1,@TRMPTR ;GET CONTROL CODE PART
JUMPN S1,CCU.2 ;IF VIDEO, HANDLE IT THAT WAY
MOVEI S1,[BYTE(7).CHCRT,.CHLFD] ;GIVE A NEW LINE
PUSHJ P,STROUT ;TYPE IT
JRST CCU.3 ;AND CONTINUE
CCU.2: PUSHJ P,CLINE ;CLEAR THE LINE
CCU.3: MOVE T3,BGLINE ;COMPARE PTR'S
MOVE T4,BGBUFR ;..
PUSHJ P,CMPPTR ;SAME?
JRST CCU.4 ;YES, WE'RE AT THE TOP OF BUFFER
JRST TXTL
CCU.4: SKIPE T1,RD+.RDRTY ;IF THERE'S ANY PROMPT TEXT
PUSHJ P,TYPEBP ;TYPE IT
LOAD S2,RD+.RDFLG,RD%RND ;RETURN ON EMPTY BIT
MOVX S1,RD%BFE ;RETURN BIT
JUMPN S2,FINTXT ;FINISH UP IF HE WANTS RETURN
JRST TXTL ;GO BACK FOR MORE INPUT
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
JRST CCR.2 ;AND DON'T GO TO NEXT ONE
CCR.1: MOVEI S1,[BYTE(7).CHCRT,.CHLFD] ;GET TO NEXT LINE
PUSHJ P,STROUT ;TYPE IT
CCR.2: PUSH P,T1 ;SAVE T1
PUSHJ P,FNDLIN ;RESET BEGINNING OF LINE
MOVE T3,BGLINE ;COMPARE PTR'S
MOVE T4,BGBUFR ;..
PUSHJ P,CMPPTR ;SAME?
JRST [SKIPE T1,RD+.RDRTY ;YUP, PROMPT TEXT AVAILABLE?
PUSHJ P,TYPEBP ;YES, TYPE IT
JRST .+1]
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 FNDLIN -- Find beginning of current line
FNDLIN: MOVE T3,BGBUFR ;GET PTR TO BEGIN OF BUFFER
MOVE T4,RD+.RDDBP ;GET CURRENT PTR
PUSHJ P,CMPPTR ;AND COMPARE
JRST FNDL.2 ;THEY'RE THE SAME
MOVE T3,RD+.RDDBP ;GET CURRENT PTR IN T3
FNDL.1: LDB S1,T3 ;AND GET THAT BYTE
CAIN S1,.CHLFD ;LINEFEED?
JRST FNDL.2 ;YUP
PUSHJ P,DECBP ;NO, BACK PTR UP
MOVE T4,BGBUFR ;GET PTR TO BEGIN OF BUFFER
PUSHJ P,CMPPTR ;COMPARE BP'S
JRST FNDL.2 ;POINTERS ARE EQUAL
JRST FNDL.1 ;POINTERS ARE NOT EQUAL
FNDL.2: MOVEM T3,BGLINE ;SAVE AS BEGINNING OF LINE
$RETT ;RETURN TRUE
;ROUTINE TO DECREMENT ASCII BYTE POINTER IN T3
DECBP: LDB T2,[POINT 6,T3,5] ;GET POSITION
ADDI T2,7 ;INDICATE PREVIOUS BYTE
DECB.1: DPB T2,[POINT 6,T3,5] ;AND STORE IT
CAIG T2,^D35 ;IMPOSSIBLE POSITION?
POPJ P,0 ;NO, RIGHT ON
SUBI T3,1 ;MAKE SO LDB GETS PREVIOUS BYTE
MOVEI T2,1 ;..
JRST DECB.1 ;STORE CORRECT POSITION
;ROUTINE TO COMPARE ASCII BP'S ALLOWING FOR NORMALIZATION.
;BP'S ARE IN T3/T4 AND ROUTINE SKIP RETURNS IF BP'S NOT EQUAL
CMPPTR: PUSH P,T3 ;SAVE ARGUMENT REGISTERS
PUSH P,T4 ;..
IBP T4 ;INCREMENT AND NORMALIZE
IBP T3 ;..
CAME T3,T4 ;GOTTA MATCH?
AOS -2(P) ;NO, SETUP FOR SKIP RETURN ON POPJ
POP P,T4 ;RESTORE ORIGINAL ARGUMENTS
POP P,T3 ;..
POPJ P,0 ;RETURN AS INDICATED
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?
MOVX S1,.CHBSL ;START RUBOUT SET WITH BACKSLASH
PUSHJ P,TXTOUT ;TYPE IT
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
MOVEI S1,[BYTE (7)10,40,10] ;OUTPUT BACKSPACE,SPACE,BACKSPACE
PUSHJ P,STROUT ;TYPE IT
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
MOVEI S1,[BYTE (7)10,10,40,40,10,10] ;OUTPUT BACK,BACK,SPACE,SPACE,BACK,BACK
PUSHJ P,STROUT ;TYPE IT
JRST TXTL ;THEN GET NEXT INPUT
SUBTTL CCW -- Handle ^W (Delete back to punctuation character)
CCW: PUSHJ P,FNDLIN ;RESET BEGINNING OF LINE PTR
SETZM RUBFLG ;CLEAR RUBOUT FLAG
MOVE T3,RD+.RDDBP ;SEE IF WE'RE AT TOP OF BUFFER
MOVE T4,BGBUFR ;..
PUSHJ P,CMPPTR ;AT TOP OF BUFFER?
JRST BEGBUF ;YUP, SPECIAL HANDLE
CCW.1: PUSHJ P,USTOC ;UN-STORE ONE CHARACTER
MOVE T3,RD+.RDDBP ;SEE IF WE'RE AT
MOVE T4,BGLINE ; THE BEGINNING OF A LINE
PUSHJ P,CMPPTR ;ARE WE?
JRST CCW.3 ;YES, THAT'S 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
MOVX S1,.CHBEL ;LOAD A "BELL"
PUSHJ P,TXTOUT ;AND SEND IT
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
CAIE S1,(POINT 7,0) ;WORD ALIGNED?
JRST STRO.1 ;NO.. DUMP THE STRING BY CHARACTER
TYPE.2: MOVE S1,T1 ;PUT ADDRESS IN S1
PUSHJ P,STROUT ;AND TYPE THE STRING
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL FROM K%TXTI
KBD%L: ;LABEL THE LITERAL POOL
END