Trailing-Edge
-
PDP-10 Archives
-
bb-d868c-bm_tops20_v4_2020_distr
-
language-sources/glxkbd.mac
There are 26 other files named glxkbd.mac in the archive. Click here to see a list.
TITLE GLXKBD -- Keyboard Interface for GALAXY
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 GLXMAC ;OPEN SYMBOLS NEEDED
PROLOG(GLXKBD,KBD) ;PART OF LIBRARY, ETC...
KBDEDT==24 ;VERSION OF MODULE
;This module provides a timesharing terminal interface for the GALAXY
; 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%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
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).
0006 015 1. The interrupt races supposedly solved in edit 2 actually
weren't solved, take the code out.
2. If backup-limit is reached, flag word can get garbaged.
3. If user requests return on buffer empty, ^U re-prompts
before returning to user, it shouldn't.
0007 020 Add the following new entry points:
K%BIN -- Input one character from TTY
K%BOUT -- Type one character on TTY
K%SOUT -- Type a string on TTY
K%BACK -- Back up over the last character read by K%BIN
0010 030 K%TPOS -- Get the Horizontal terminal position
also fix K%BIN to sleep if no character
0011 031 MAKE EDITING CHARACTERS EMULATE THE 20 IMPLEMENTATION.
0012 045 Modify K%INIT for the -20 not to do K%WCOC
0013 Modify K%INIT to USE IIB instead of calling args
0014 Modify K%INIT to conform to new IB (IB.TTY went away)
0015 Remove PJUMPN in TOPS10 conditional (replace with JUMPN)
0016 Change SAVE to $SAVE
0017 TOPS10.. make use of new TRMTYP macro to build tables
And, try to get terminal type from monitor and set it up.
0020 TOPS10.. Fix 0017. Make RH of TTTAB 0 if not video terminal
0021 TOPS10.. Make K%STYP tell the monitor.
Make K%INIT use extnded chan
0022 TOPS10.. Don't bother (re-)telling monitor of terminal type
during K%INIT. This keeps us from setting page n as a
side effect of reading tty type, and resetting it.
0023 Add -10 KEYPAD support for VT100
0024 Add Support for .NULIO and OUTPUT IFN for the -10
on K%TXTI call.
\ ;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
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
EXT IIB ;PERSONAL IB FOR LIBRARY
$DATA TTYFLG ;FLAGS FROM INITIALIZATION BLOCK
$GDATA 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
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: Arguments set up in our personal IIB
;
;TRUE RETURN: No arguments are returned
TOPS10 <
K%INIT: LOAD S1,IIB+IB.FLG ;GET TTY FLAG WORD
MOVEM S1,TTYFLG ;BY CALLING PROGRAM
TXNN S1,IT.OCT ;WANT CONTROLLING TTY OPENED?
$RETT ;NO, SO RETURN NOW
$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 GLXMAC)
;
;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: SKPINC ;CHECK FOR CHARACTER
SKIPA ;NONE..GO TO SLEEP
JRST BIN.2 ;GET THE CHARACTER
MOVX S1,HB.RTC ;SLEEP FOR CHARACTER
HIBER S1, ;DO THE HIBER
JFCL ;IGNORE IT
JRST BIN.1 ;TRY AGAIN
BIN.2: 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: 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
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?
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
$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
PUSHJ P,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
MOVE S2,S1 ;GET THE CHARACTER
HRRZ S1,RD+.RDIOJ ;GET THE OUTPUT JFN
PUSHJ P,F%OBYT ;DUMP THE CHARACTER
JUMPT .POPJ ;O.K.. RETURN
MOVE P,TSTACK ;RESTORE THE STACK
$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