Trailing-Edge
-
PDP-10 Archives
-
BB-F493Z-DD_1986
-
10,7/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/NT/LWS 18-Feb-84
;
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982,
; 1983,1984,1985,1986
; DIGITAL EQUIPMENT CORPORATION
; ALL RIGHTS RESERVED.
;
; 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==101 ;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. TXTINP -- INPUT ROUTINE FOR NON TERMINAL INPUT...... 20
; 18. TXTOUT -- CHARACTER OUTPUT FOR TERMINALS AND FILES.. 20
; 19. STROUT -- STRING OUTPUT TO FILE AND TERMINAL........ 20
; 20. Utilities for text handling............................... 21
; 21. STOC -- Store an input character...................... 21
; 22. USTOC -- Unstore a character........................... 21
; 23. CONVRT -- Do case conversion as necessary............... 22
; 24. CONVBP -- Convert default byte pointers................. 22
; 25. MAKBP -- Un-default a byte pointer..................... 23
; 26. IMGSTR -- Output a string as it was echoed.............. 23
; 27. CLINE -- Clear current video line...................... 23
; 28. GETCOC -- Fetch COC for a given character............... 23
; 29. ECHO -- HANDLE CHARACTER ECHOING...................... 24
; 30. CBRK -- Check to see if character is a break.......... 25
; 31. SPCHK -- Check for special characters.................. 26
; 32. CCU -- Handle ^U (Rubout entire line)................ 27
; 33. CCR -- Handle ^R (Re-type the line).................. 28
; 34. FNDLIN -- Find beginning of current line................ 29
; 35. CCDEL -- Handle Rubout (Delete one character).......... 30
; 36. CCW -- Handle ^W (Delete back to punctuation character) 31
; 37. BEGBUF -- Handle rubouts to beginning of buffer......... 32
; 38. TYPEBP -- Type a string according to a byte-pointer..... 32
; 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.
0025 Add a check to K%BIN to skip HIBER if under batch
0026 Delete <CRLF> pairs when rubbout is seen
0027 If BATCH, do no reset keypad mode on initialization.
0030 Zero out our own $DATA space.
0031 Change K%INIT to open the TTY on the -20 if IB.OCT
is lit. Also save the channel or JFN of the TTY
and the UDX or device designator in global storage.
Add entries K%BUFF and K%FLSH for buffering output.
Add K%OPEN routine.
0032 On TOPS10, make K%TPOS wait for all output to terminal
to be finished before checking horizontal position.
0033 For edit 32, do not loop continuously, but wait half
a second between TRMOP.'s.
0034 Change the meaning of BATFLG to mean any random PTY, not
just a Batch job.
0035 If a ^H is typed (not as the first character in a line),
haldle it like the TOPS-10 monitor does.
0036 Add VT61 support for TOPS-10.
0037 Repair edit 33 so it sleeps until output is finished
0040 Remove edit 25 which causes K%BIN to skip Hiber
if we are a batch job. This edit caused characters
to be lost and IPCF interrupts to be postponed
until a character was typed.
0041 QAR 10-4661 Fix K%TXTI to look for byte pointer in .RDIOJ
if RD%JFN is not set in .RDFLG
0042 Always set terminal type in K%INIT to prevent
nasty Illegal Memory Reference when no type is set.
0043 At TXTL.4, if EOF on input file, update user's
arg block before returning.
0044 Fix bugs in TOPS20 K%OPEN routine
0045 Restore original code to cause ONLY batch
jobs to go into character wait.
0046 Delete the code to reset the terminals keypad state in SETVT5
0047 Change K%BIN to use I%SLP instead of HIBER
0050 Fix clobberage of S1 at K%OPEN which caused terminal
to always be opened in image mode on TOPS20.
0051 Make MIC files work. Check for MIC status and set the "batch"
flag if a MIC controlled TTY.
0052 More of edit 51.
0053 Correct TOPS-10 break character set.
0054 Fix a bad byte pointer at MAKPTR+ a few.
0055 Make sure that K%INIT always calls MAKBUF on the -20.
Also make sure that K%FLSH has correct character count
when SOUT'ing.
0056 Add INTCHR and INCHRW the next character into it @BIN.2 to
prevent losing characters due to interrupt.
0057 Make K%SUET use new format of TRMTYP macro so it can handle
setting of keypad mode on all terminals. 24-Oct-83/NT
0060 Make sure controlling TTY is opened as physical TTY in K%INIT.
SPR 10-33713 7-Nov-83 /LWS
0061 Set BATFLG positive if MIC controlled and check before
each input of a character to see if still under MIC's
control.
SPR 10-34367 19-Jan-83 /LWS
0062 Fix "delete char" problem for hard copy.
9-Feb-84 /NT
0064 Add routine K%ECHO to enable/disable terminal echo.
15-Aug-84 /WXD
0065 Rearranged keypad escape sequence processing to make OPR
a bit more compact. 31-Aug-84 /NT
0066 Fix lose echo on too many deletes bug.
5-Nov-84 /NT
0067 Fix lose echo on delete across multi-line messages.
14-Jan-85 /NT
0070 Fix some loose ends:
1. Turn off control C from break mask table.
2. Make K%BOUT and K%SOUT default to OUTCHR and OUTSTR
if TRMOP. fails.
15-Jan-85 /NT
0071 10149 Remove code to fake out MIC. Let the monitor do it
right for us (MCO 11845).
18-Feb-85 /DPM
0072 Fix double carriage return after typing <DEL><CR>.
22-Feb-85 /NT
0073 10215 Sleep in line mode, not characters. This allows
interrupts in the middle of type in.
21-May-85 /NT
0074 10235 Try not to stopcode too easily if we can't set break mask.
Job could just be detached.
19-Jun-85 /NT
0075 10251 Echo line feed if CRLF typed just after DELETE.
15-Jul-85 /NT
0076 10284 Restore code to fake out MIC under FTFLBK. MCO 11845
is not part of 7.02.
09-Sep-85 /RCB
0077 10290 Finish code started by MCO 11845. Don't go into TI for BATCON.
17-Sep-85 /RCB
0100 10298 Update code to handle MCO 12482.
07-Oct-85 /RCB
101 10303 Check to see if JFN belongs to .PRIIN before attempting to
begin processing Escape sequences.
Also, if K%SOUT TRMOP. fails do OUTSTR on contents of
P3, not T3.
16-Oct-85 /NT
\ ;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
ENTRY K%BUFF ;BUFFER A BYTE OR A STRING
ENTRY K%FLSH ;FLUSH THE OUTPUT BUFFER
ENTRY K%OPEN ;OPEN THE TERMINAL
ENTRY K%ECHO ;ENABLE/DISABLE TERMINAL ECHO
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
; Buffer symbols
SYSPRM .BFPTR,.BFPTR,1 ;OFFSET TO BUFFER POINTER
SYSPRM .BFCTR,.BFCTR,2 ;OFFSET TO BUFFER COUNTER
BUFSIZ==23 ;NUMBER OF WORDS IN TTY BUFFERS
BUFFUL==BUFSIZ*5-1 ;MAX CHARS IN TTY BUFFER
SUBTTL Module Storage
EXT IIB ;PERSONAL IB FOR LIBRARY
$DATA KBDBEG,0 ;START OF ZEROABLE $DATA SPACE
$DATA TTYFLG ;FLAGS FROM INITIALIZATION BLOCK
$DATA BATFLG ;-1 IF RUNNING UNDER BATCH
$GDATA RD,.RDSIZ ;INTERNAL ARGUMENT BLOCK
$DATA COCTAB,2 ;CHARACTER OUTPUT CONTROL TABLE
$DATA TRMPTR ;POINTER TO TERMINAL CONTROL
$DATA ECHFLG ;ECHO FLAG (0= DISABLE ECHO)
$DATA PMPTNG ;-1 means we're at the prompt
$DATA ARGLOC ;LOCATION OF CALLER'S ARGUMENT BLOCK
$DATA BCKFLG ;-1 WHEN BACKUP LIMIT HAS BEEN PASSED
$DATA CHREAD ;Read single character at K%BIN
$DATA UESCTB ;ADDRESS OF USER ESCAPE TABLE
$DATA CURESC ;CURRENT STATE OF ESCAPE SEQ PROCESSOR
$DATA TRMTY ;TERMINAL TYPE
$GDATA TRMUDX ;UDX FOR TERMINAL
$GDATA CHNJFN ;CHANNEL OR JFN OF OPEN TERMINAL
$DATA BUFIN,3 ;INPUT BUFFER CONTROL BLOCK
$DATA BUFOUT,3 ;OUTPUT BUFFER CONTROL BLOCK
$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
$DATA KBDEND,0 ;END OF ZEROABLE $DATA SPACE
TOPS10<
$DATA INTCHR ;Interim character that is read in.
; -1 indicates no character yet.
$DATA BRKBLK,7 ;Place to do the break set TRMOP.
> ; End of TOPS10
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
K%INIT: MOVE S1,[KBDBEG,,KBDBEG+1] ;BLT PTR TO ZEROABLE $DATA SPACE
SETZM KBDBEG ;KILL THE FIRST LOCATION
BLT S1,KBDEND-1 ;AND FIRE AWAY AT THE REST
LOAD S1,IIB+IB.FLG ;GET TTY FLAG WORD
MOVEM S1,TTYFLG ;BY CALLING PROGRAM
SETOM CHNJFN ;NO JFN OR CHANNEL YET
SETOM ECHFLG ;ENABLE TERMINAL ECHO
TXNE S1,IT.OCT ;WANT CONTROLLING TTY OPENED?
;**;[60] Change 1 line and delete 1 line at K%INIT+7L. 7-Nov-83 /LWS
JRST [MOVSI S1,200000 ;[60] TELL K%OPEN TO USE UU.PHS
$CALL K%OPEN ;GO OPEN THE TTY
JRST KINI.3] ;AND CONTINUE WITH REST OF K%INIT
SETZ S1, ;THEN USE LOGICAL TERMINAL
PUSHJ P,FNDUDX ;TO FIND OUT OUR UDX
KINI.3:
TOPS10 <
SETOM INTCHR ;Have no characters yet
SETOM S1 ;MY JOB
MOVX S2,JI.BAT ;GET BATCH WORD
$CALL I%JINF ;...
SETZM BATFLG ;ASSUME NOT BATCH
IFN FTFLBK,<
MOVX S1,%CNDAE ;POINTER TO DAEMON CONFIG WORD
GETTAB S1, ;FETCH IT FROM THE MONITOR
SETZ S1, ;ANCIENT MONITOR
HRRZS S1 ;KEEP ONLY BINARY PORTION
CAIL S1,703 ;CAN WE IGNORE MIC AND BATCON?
JRST KINI.0 ;YES, DO SO
TXNE S2,JB.LBT ;ARE WE BATCH?
SETOM BATFLG ;YES, REMEMBER IT
SKIPE BATFLG ;DETERMINED IF BATCH YET ?
JRST KINI.0 ;YES CONTINUE
MOVE TF,[2,,S1] ;NO, SET UP AC
MOVX S1,.TOGMS ;FUNCTION CODE TO GET MIC STATUS
MOVE S2,TRMUDX ;GET UDX
TRMOP. TF, ;READ MIC STATUS
SETZ TF, ;CAN'T
SKIPE TF ;MIC CONTROLLED TTY ?
AOS BATFLG ;YES - INDICATE MIC CONTROLLED
KINI.0:> ;END OF FTFLBK
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
MOVX 0,.TOTRM ;FUNCTION CODE TO GET TERMINAL TYPE
MOVE 1,TRMUDX ;UDX FOR TRMOP.
MOVE S2,[XWD 2,0] ;ARG LIST FOR TRMOP.
TRMOP. S2, ;ASK FOR TERMINAL TYPE
JRST KINI.2 ;NO? ASSUME A DEFAULT
MOVSI S1,-<.TIMAX+1> ;IOWD PTR TO SIXBIT NAME TABLE
KINI.1: CAME S2,TSTAB(S1) ;MATCH THIS ENTRY?
AOBJN S1,KINI.1 ;NO, TRY AGAIN
SKIPL S1 ;HIT ONE?
KINI.2: MOVX S1,.TI33 ;NO, ASSUME THIS IS A 33
HRRZS S2,S1 ;GET ONLY ITS INDEX
$CALL STYP.3 ;[42] ALWAYS SET TYPE AND RETURN
SKIPGE CHNJFN ;TTY OPEN?
> ;END TOPS10 CONDITIONAL
PUSHJ P,MAKBUF ;Make buffers always on the -20
;Or when TTY is not open on -10
$RETT
SUBTTL K%OPEN -- Open the terminal
;Call:
; S1/ Flags
; Flags: 1B0 - Open terminal in image mode (default is Ascii)
; 1B1 - Open controlling terminal. Default is
; to open TTY:.
; 1B2 - Do non-blocking I/O (TOPS-10 only)
; (currently, there is only support for
; non-blocking output, and only with K%FLSH).
;Return:
; S2/ JFN or Channel Number of terminal
;
; JFN or Channel Number is also placed in CHNJFN.
; UDX or device designator of open terminal is placed in TRMUDX.
K%OPEN: $SAVE <T1,T2,T3,T4,P1>
PUSH P,S1 ;Save caller's flags
PUSHJ P,DWBUFF ;DEAL WITH THE BUFFER
PUSHJ P,FNDUDX ;GO GET OUR UDX
POP P,S1 ;Restore flags
TOPS10 <
MOVE T2,[IO.LEM+IO.ABS+.IOASC] ;SET ALL THE FUNNY MODES
TXNE S1,1B0 ;DO WE WANT IMAGE MODE?
TXO T2,.IOIMG ;YES, TURN IT ON
TXNE S1,1B1 ;DO WE WANT PHYSICAL TTY
TXO T2,UU.PHS ;YES, SAY SO
TXNE S1,1B2 ;NON-BLOCKING I/O?
TXO T2,UU.AIO ;YES, TURN IT ON
SKIPGE CHNJFN ;IS THIS OUR FIRST OPEN
JRST [MOVX T1,<FO.ASC+.FOWRT> ;OPEN IN WRITE MODE EXTENDED CHANNEL
MOVSI T3,'TTY' ;ON THE CONTROLLING TERMINAL
MOVE T4,[BUFOUT,,BUFIN] ;WE WANT BUFFERS
MOVX P1,<2,,2> ;2 INPUT AND 2 OUTPUT BUFFERS
MOVEI S1,BUFSIZ*4 ;SPACE FOR 4 BUFFERS
$CALL M%GMEM ;GET IT
MOVEI S1,(S2) ;WHAT WAS THAT ADDRESS?
MOVE S2,[XWD 5,T1] ;LENGTH, ADR OF ARG BLOCK
JRST OPEN.1] ;DO THE FILOP
MOVX T1,.FOGET ;WE'RE GONNA LOOK UP THE MODE
HRL T1,CHNJFN ;GET THE CHANNEL
MOVX S2,<1,,T1> ;FILOP. PTR
FILOP. S2, ;DO THE FILOP.
$STOP (CLS,Can't lookup status of terminal JFN)
ANDX S2,IO.MOD ;WE ONLY CARE ABOUT THE MODE
TXNN S1,1B0 ;ARE WE CHANGING TO IMAGE OR TO ASCII
JRST [CAIN S2,.IOASC ;DO WE ALREADY HAVE ASCII
$RETT ;THEN RETURN
MOVEI S1,7 ;BYTESIZE 7
DPB S1,[POINT 6,BUFOUT+.BFPTR,11] ;CHANGE BYTESIZE
MOVEI S1,5 ;CONVERSION FACTOR FOR WORD COUNT
IMULM S1,BUFOUT+.BFCTR ;DO THE CONVERSION
JRST OPEN.2] ;CONTINUE WITH CALL
CAIN S2,.IOIMG ;DO WE ALREADY HAVE IMAGE MODE
$RETT ;THEN RETURN
MOVEI S1,^D36 ;BYTESIZE FOR IMAGE MODE
DPB S1,[POINT 6,BUFOUT+.BFPTR,11] ;CHANGE BYTESIZE
MOVE S1,BUFOUT+.BFCTR ;WORD COUNT
IDIVI S1,5 ;CONVERT WORD COUNT
MOVEM S1,BUFOUT+.BFCTR ;MAKE THE CHANGE STICK
OPEN.2: MOVX T1,.FOSET ;WE WILL REALLY DO A SETSTS
HRL T1,CHNJFN ;GET CHANNEL NUMBER
MOVE S2,[XWD 2,T1] ;POINTER HAS LENGTH OF 2
MOVE S1,.JBFF ;MAKE THE .JBFF SWITCH JUST A NOOP
OPEN.1: EXCH S1,.JBFF ;STUFF THE BUFFER ADDRESS HERE
FILOP. S2, ;DO THE OPEN OR SETSTS
$STOP(FFT,Action FILOP. failed to terminal)
EXCH S1,.JBFF ;RESTORE .JBFF
LDB S2,[POINTR(T1,FO.CHN)] ;GET THE CHANNEL NUMBER
MOVEM S2,CHNJFN ;SAVE FOR POSTERITY
$RETT
> ; END TOPS 10 CONDITIONAL
TOPS20 <
MOVE T1,S1 ;FREE UP S1 FOR GTJFN
SKIPL CHNJFN ;IS THIS OUR FIRST OPEN?
JRST [MOVE S1,CHNJFN ;YES, DON'T OPEN IT AGAIN
RFMOD ;GET THE MODE
SETZ T2, ;CODE FOR IMAGE MODE
TXNN T1,1B0 ;DO WE WANT IMAGE MODE
ADDI T2,1 ;MAKE INTO CODE FOR ASCII MODE
LDB T3,[POINTR(S2,TT%DAM)] ;GET CURRENT MODE IN T3
CAIN T2,(T3) ;IS OUR MODE WHAT WE WANT
JRST [MOVE S2,CHNJFN ;YES, GET THE JFN IN S2
$RETT] ;AND BEGONE
DPB T2,[POINTR(S2,TT%DAM)] ;PUT OUR DESIRED MODE IN
TXO T2,TT%IGN ;IGNORE BREAKSET
SFMOD ;SET THE MODE
MOVE S2,CHNJFN ;GET THE CHANNEL
$RETT] ;AND RETURN
MOVE S2,TRMUDX ;OUR FIRST OPEN, LET'S DO IT
HRROI S1,T3 ;PUT STRING IN T3 AND T4
DEVST ;GET THE STRING
JRST [MOVE T3,[ASCIZ/TTY:/] ;[44] Use simple default
JRST .+3] ;[44] Don't store terminator
MOVEI S2,":" ;[44] Store device terminator
IDPB S2,S1 ;[44]
HRROI S2,T3 ;MAKE S2 POINT TO THE STRING
MOVX S1,GJ%SHT ;SHORT FORM FOR GTJFN
GTJFN
$STOP(CGT,Cannot GTJFN terminal)
MOVX S2,OF%RD+OF%WR ;READ AND WRITE
OPENF
$STOP(COT,Cannot OPENF terminal)
MOVEM S1,CHNJFN ;SAVE OUR OPEN JFN
MOVE S1,T1 ;RESTORE S1
PJRST K%OPEN ;AND START AGAIN, THIS TIME
;MODE WILL BE SET
> ; END TOPS 20 CONDITIONAL
SUBTTL FNDUDX -- Find UDX or designator of TTY
;Call:
; S1/ 1B1 - Off : get designator for TTY:
; On : get designator for controlling TTY.
FNDUDX: $SAVE <T1>
TOPS10 <
MOVSI T1,'TTY' ;LOGICAL NAME
TXNN S1,1B1 ;PHYSICAL OR LOGICAL TTY?
IONDX. T1, ;HERE IF LOGICAL
HRROI T1,-1 ;HERE IF PHYSICAL OR LOGICAL ERROR
MOVEM T1,TRMUDX ;PUT IT AWAY
$RET ;AND RETURN
> ; END TOPS 10 CONDITIONAL
TOPS20 <
MOVE T1,S1 ;WE NEED THE REG
HRROI S1,[ASCIZ/TTY:/] ;[44] WE NEED IT FOR THIS
TXNN T1,1B1 ;PHYSICAL TTY
STDEV ;IF NOT, GET LOGICAL DESIG
HRRZI S2,-1 ;CONTROLLING DESIGNATOR
MOVEM S2,TRMUDX ;PUT IT PROPER PLACE
$RET ;AND RETURN
> ; END TOPS 20 CONDITIONAL
SUBTTL MAKBUF -- Create buffers when monitor does not
MAKBUF: $SAVE <T1,T2,T3> ;GET REGISTERS
MOVE T1,S1 ;PROTECT S1
MOVEI S1,BUFSIZ ;THIS IS THE SIZE OF BUFFER (WORDS)
$CALL M%GMEM ;GET A BUFFER
MOVEM S2,BUFIN ;ADDRESS OF BUFFER
HRLI S2,(POINT 7,) ;MAKE A BYTE POINTER
MOVEM S2,BUFIN+.BFPTR ;AND PUT IT IN INPUT BCB
SETZM BUFIN+.BFCTR ;NO CHARS YET
$CALL M%GMEM ;NOW GET OUTPUT BUFFER
MOVEM S2,BUFOUT ;ADDRESS OF OUTPUT BUFFER
HRLI S2,(POINT 7,) ;MAKE A BYTE POINTER
MOVEM S2,BUFOUT+.BFPTR ;PUT IT OUTPUT BCB
MOVEI S2,BUFFUL ;THIS IS HOW MANY CHARS WILL FIT
MOVEM S2,BUFOUT+.BFCTR ;LET IT GO TO THE BUFFER
$RET
SUBTTL DWBUFF -- Deal with the buffer
;Call: No arguments
;Effect: On TOPS-20, it flushes and deletes the buffers.
; On TOPS-10, it flushes the buffer and deletes it only if
; it was created by MAKBUF.
DWBUFF: SKIPE BUFOUT ;DOES AN OUTPUT BUFFER EXIST?
$CALL K%FLSH ;YES, FLUSH IT
TOPS10 <
SKIPL CHNJFN ;CONTINUE ONLY IF TTY NEVER OPENED
$RET ;ELSE LEAVE BUFFERS BE
> ; END TOPS 10 CONDITIONAL
$SAVE <T1,T2> ;SO WE DON'T CLOBBER REGS
DMOVE T1,S1 ;SAVE REGS
MOVEI S1,BUFSIZ ;SIZE OF BUFFER
MOVE S2,BUFOUT ;ADDRESS OF OUTPUT BUFFER
SKIPE BUFOUT ;DON'T M%RMEM IF THERE IS NO BUFFER
$CALL M%RMEM ;GIVE BUFFER BACK TO FREE SPACE
SETZM BUFOUT ;NO OUTPUT BUFFER
SETZM BUFOUT+.BFPTR ;NO OUTPUT BUFFER POINTER
SETZM BUFOUT+.BFCTR ;NO OUTPUT BUFFER COUNTER
MOVEI S1,BUFSIZ ;SIZE OF BUFFER
MOVE S2,BUFIN ;ADDRESS OF INPUT BUFFER
SKIPE BUFIN ;DON'T M%RMEM IF THERE IS NO BUFFER
$CALL M%RMEM ;GIVE BACK TO FREE POOL
SETZM BUFIN ;NO INPUT BUFFER
SETZM BUFIN+.BFPTR ;NO INPUT BUFFER POINTER
SETZM BUFIN+.BFCTR ;NO INPUT BUFFER COUNTER
DMOVE S1,T1 ;RESTORE REGS
$RET
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 <
;**;[57]REVAMP K%SUET 24-OCT-83/NT
K%SUET: PUSHJ P,.SAVE1 ;[57]Save P1
MOVEM S1,UESCTB ;SAVE THE ESCAPE TABLE ADDRESS
SETZM CURESC ;CLEAR CURRENT STATE
MOVE S1,TRMTY ;[57]Get the terminal type
MOVE P1,[XWD -<.TIMAX+1>,TTTAB] ;[57]Point to the terminal table
SUET.1: HLRZ S2,(P1) ;[57]Get the entry
CAME S1,S2 ;[57]Is it what we have?
AOBJN P1,SUET.1 ;[57]No, loop for the whole table
SKIPL P1 ;[57]Did we find one
$RETT ;[57]No, MAke belive we did
HRRZ S2,(P1) ;[57]Get the table address
MOVE S1,.TCKBA(S2) ;[57]Assume we're setting it
SKIPN UESCTB ;[57]Are we?
MOVE S1,.TCKBN(S2) ;[57]No, we're clearing
PUSHJ P,K%SOUT ;[57]Output the string
$RETT ;[57]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
HRRZ S1,(S1) ;[62] See if hardcopy
MOVE S1,@(S1) ;[62] . . .
JUMPN S1,STYP.4 ;[62] It isn't
MOVEI S1,[0] ;[62] It is, point to a zero
HRRZM S1,TRMPTR ;[62] . . .
STYP.4: SKIPN S2 ;[62] 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
;**;[57]REVAMP CODE 24-OCT-83/NT
.TCKBA==.TCEOL+1 ;[57]Set keypad application
.TCKBN==.TCKBA+1 ;[57]Set keypad numeric
;DEFINE THE EXPANDER MACRO
DEFINE X(PARNAM,SIXNAM,SUF,INIT,EOLSEQ,KBDSET,KBDCLR),<
DEFINE EOLGEN<
IFNB <EOLSEQ>,<BYTE (7)'EOLSEQ>
IFB <EOLSEQ>,<EXP 0>
>
DEFINE SETGEN<
IFNB <KBDSET>,<BYTE (7)'KBDSET>
IFB <KBDSET>,<EXP 0>
>
DEFINE CLRGEN<
IFNB <KBDCLR>,<BYTE (7)'KBDCLR>
IFB <KBDCLR>,<EXP 0>
>
$SET (.TI'SUF,,<.TT'SUF,,[[EOLGEN]
[SETGEN]
[CLRGEN]]>)
>
TTTAB: $BUILD (.TIMAX+1)
TRMTYP
$EOB
;BUILD A TABLE OF SIXBIT NAMES TO MATCH AGAINST THE TRMOP. RETURNED CODES
DEFINE X(PARNAM,SIXNAM,SUF,INIT,EOLSEQ,KBDSET,KBDCLR),<
$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***
DEFINE X(PARNAM,SIXNAM,SUF,INIT,EOLSEQ,KBDSET,KBDCLR),<
$SET (.TI'SUF,,INIT)
>
TTSET: $BUILD (.TIMAX+1)
TRMTYP
$EOB
;TERMINAL SETUP ROUTINES
SETTLC: 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: PUSHJ P,.SAVE3
MOVE P3,S1
MOVEI P1,.TOOUC
MOVE P2,TRMUDX
MOVE S1,[3,,P1]
TRMOP. S1,
OUTCHR P3 ;TYPE THE CHARACTER
MOVE S1,P3
$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: PUSHJ P,.SAVE3
MOVE P3,S1
MOVEI P1,.TOOUS
MOVE P2,TRMUDX
MOVE S1,[3,,P1]
TRMOP. S1,
OUTSTR (P3) ;Do it the old fashioned way
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
K%SOUT: PSOUT ;TYPE THE STRING
$RETT ;AND RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL K%BUFF - Buffer a byte or a string
;Call:
; S1/ Character right justified
; or
; S1/ Byte pointer to ASCIZ string
; S2/ 0
; or
; S1/ Byte pointer to ASCII string
; S2/ Count of bytes to buffer
;True Return:
; Always
K%BUFF: $SAVE <T1>
TXNN S1,LHMASK ;IS IT A CHARACTER OR A BP
PJRST BBUFF ;IT IS A CHARACTER
SBUFF: TXC S1,LHMASK ;DO WE HAVE A TOPS 20 STYLE BP
TXCN S1,LHMASK
HRLI S1,(POINT 7,) ;MAKE IT A REAL LIVE BP
MOVE T1,S1 ;FREE S1 TO TAKE CHARACTERS
SBUFF1: ILDB S1,T1 ;GET A BYTE
CAIN S2,0 ;ARE WE COUNTING OR ASCIZ?
JRST [CAIN S1,0 ;ASCIZ - HAVE WE FOUND NULL BYTE?
$RETT ;YES, WE'RE DONE
PUSHJ P,BBUFF ;NO, BUFFER THE BYTE WE HAVE
JRST SBUFF1] ;AND GO FOR THE NEXT BYTE
CAIN S2,1 ;COUNTING - WILL THIS BYTE BE THE LAST
PJRST BBUFF ;YES, BUFFER IT AND RETURN
PUSHJ P,BBUFF ;NO, BUFFER IT
SOJA S2,SBUFF1 ;DECREMENT COUNT AND GET NEXT BYTE
BBUFF: SOSGE BUFOUT+.BFCTR ;ROOM IN OUTPUT BUFFER?
JRST [$CALL K%FLSH ;NO, FLUSH BUFFER
JRST BBUFF] ;AND TRY AGAIN
IDPB S1,BUFOUT+.BFPTR ;STICK IT IN OUTPUT BUFFER
$RETT ;AND RETURN
SUBTTL K%FLSH - Flush the output buffer
;Call:
; No arguments
K%FLSH: $SAVE <T1,T2,T3,T4>
TOPS10 <
SKIPL CHNJFN ;IS THE TTY OPEN
PJRST [MOVX T1,.FOOUT ;YES IT IS, WE'RE DOING OUTPUT
HRL T1,CHNJFN ;GET THE CHANNEL
SETZ T2, ;MONITOR KNOWS ABOUT BUFFERS
MOVX T3,<2,,T1> ;FILOP. ARGUMENT POINTER
FILOP. T3, ;WE DO IT
$STOP(TFF,FILOP. OUT failed to terminal)
$RETT] ;WE WON
> ; END TOPS 10 CONDITIONAL
; Here for
; a. TOPS-20
; b. TOPS-10 and no TTY open
LIK20:
TOPS10 <
SETZ T1, ;TTY NOT OPEN, WE WILL OUTPUT
IDPB T1,BUFOUT+.BFPTR ;WE LEFT ROOM FOR TRAILING NULL
MOVE T2,BUFOUT ;GET ADDRESS OF OUTSTR
OUTSTR (T2) ;SEND IT
PJRST RESOUT ;RESTORE BUFFER
> ; END TOPS 10 CONDITIONAL
TOPS20 <
SKIPL CHNJFN ;IS THE TTY OPEN
PJRST [DMOVE T3,S1 ;SAVE THE AC'S
MOVE S1,CHNJFN ;TTY OPEN, WE WILL SOUT
MOVEI T1,BUFFUL ;MAXIMUM NUMBER OF CHARACTERS TO SEND
SUB T1,BUFOUT+.BFCTR ;LESS BYTES THAT REMAIN
CAILE T1,BUFFUL ;BUT WE MUST NOT BE GREATER THAN BUFFUL
MOVEI T1,BUFFUL ;SO WE ENFORCE THIS
MOVNI T1,0(T1) ;IT MUST BE NEGATIVE
HRRO S2,BUFOUT ;"BYTE POINTER" TO BUFFER
SOUT ;HERE GOES
DMOVE S1,T3 ;RESTORE AC'S
PJRST RESOUT] ;FIX UP BUFFERS
MOVE T3,S1 ;SAVE S1
SETZ S1, ;TTY NOT OPEN WE WILL PSOUT
IDPB S1,BUFOUT+.BFPTR ;WE LEFT ROOM FOR IT
HRRO S1,BUFOUT ;"BYTE POINTER" TO BUFFER
PSOUT ;WELL PSOUT ON YOU
MOVE S1,T3 ;RESTORE S1
> ; END TOPS 20 CONDITIONAL
RESOUT: MOVE T1,BUFOUT ;GET ADDRESS OF BUFFER
HRLI T1,(POINT 7,) ;MAKE INTO BYTE POINTER
MOVEM T1,BUFOUT+.BFPTR ;PUT THEM TOGETHER
MOVEI T1,BUFFUL ;MAX CHARS THAT FIT IN BUFFER
MOVEM T1,BUFOUT+.BFCTR ;STICK IT IN BCB
$RETT ;AND WIN
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: SKIPN CHREAD ;READING BY CHARACTER?
JRST BIN.10 ;NO, READ BY LINE THEN
SKPINC ;CHECK FOR CHARACTER
SKIPE BATFLG ;NONE..SLEEP IF NOT BATCH
JRST BIN.2 ;ELSE GET THE CHARACTER
MOVX S1,HB.RTC!HB.DIN ;SLEEP FOR CHARACTER, DEMAND INPUT
JRST BIN.11 ;GOTO SLEEP
BIN.10: SKPINL ;CHECK FOR CHARACTER
SKIPE BATFLG ;NONE..SLEEP IF NOT BATCH
JRST BIN.2 ;ELSE GET THE CHARACTER
MOVX S1,HB.RTL!HB.DIN ;SLEEP FOR CHARACTER, DEMAND INPUT
BIN.11: $CALL I%SLP ;SLEEP TILL CHARACTER INPUT
JRST BIN.1 ;TRY AGAIN
BIN.2: SKIPL INTCHR ;DO WE HAVE A CHARACTER YET?
JRST BIN.4 ;YES, GO GET IT
IFN FTFLBK,<
SKIPG BATFLG ;MIC CONTROLLED?
JRST BIN.21 ;NO, GO READ A CHARACTER
MOVE TF,[XWD 2,S1] ;YES, SEE IF MIC STILL THERE
MOVX S1,.TOGMS ;"GET" MIC STATUS FUNCTION
MOVE S2,TRMUDX ;UDX OF TTY
TRMOP. TF, ;ASK ABOUT MIC STATUS
SETZM TF ;SHOULD NEVER HAPPEN
JUMPN TF,BIN.21 ;JUMP IF MIC STILL IN CONTROL
SETZM BATFLG ;MIC NO LONGER IN CONTROL
JRST BIN.1 ;DON'T GO INTO TI STATE
BIN.21:> ;END OF FTFLBK
SKIPN CHREAD ;IN AN ESCAPE SEQUENCE?
JRST BIN.3 ;NO, CONINUE
INCHRW INTCHR ;GET CHARACTERS ONE AT A TIME
TRNA
BIN.3: INCHWL INTCHR ;GET THE CHARACTER
BIN.4: MOVE S1,INTCHR ;GET THE CHARACTER
MOVEM S1,LSTCHR ;REMEMBER IT
SETOM INTCHR ;WILL NEED ANOTHER CHARACTER
$RETT ;AND RETURN
GETBIN: SETOM CHREAD ;Tell that we want a single char
PUSHJ P,K%BIN ;And go get it
SETZM CHREAD ;Clear the location again
$RETT
> ;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
MOVE S2,TRMUDX ;Get the TTY UDX
TPOS.1: MOVEI S1,.TOSOP ;Skip if output buffer empty
HRLI P1,2 ;Number of args
HRRI P1,S1 ;Address of args
TRMOP. P1, ;See if still typing
JRST TPOS.2 ;Output done..get position
MOVEI S1,0 ;Set 0 sleep time
SLEEP S1, ;ZZZZZZ
JRST TPOS.1 ;Try again
TPOS.2: 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%ECHO -- Control Terminal Echo
;This routine is used to enable or disable the echoing of terminal input.
;It is called with S1 containing 0 to disable echo, 1 to enable.
TOPS10 <
K%ECHO: $SAVE <T1,T2,T3> ; Save T1, T2, and T3
MOVEM S1,ECHFLG ; Save echo flag
MOVX T1,.TOSET+.TOECH; TRMOP. function to set echo state
SETO T2, ; UDX for principal terminal
MOVE T3,ECHFLG ; Echo state to set
MOVE S1,[3,,T1] ; TRMOP. argument pointer
TRMOP. S1, ; Set echo status
$STOP (CSE,<Cannot set echo on terminal>)
$RETT ; And return
>; End TOPS10
TOPS20 <
K%ECHO: MOVEM S1,ECHFLG ; Save echo flag
MOVX S1,.PRIIN ; JFN for principal terminal
RFMOD ; Read current echo setting
ERJMP .RETF ; Error?
TXO S2,TT%ECO ; Set echo flag
SKIPN ECHFLG ; Disable echoing?
TXZ S2,TT%ECO ; Yes, clear echo flag
SFMOD ; Set new terminal mode
ERJMP .RETF ; Error?
$RETT ; Return
>; End TOPS20
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..
MOVE S1,ARGLOC ;Get the address of arg block
PUSHJ P,SETMSK ;Set the break mask
PUSHJ P,GETESC ;Go see if we have an escape sequence
JUMPT .RETT ;Got something, return it
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+.RDIOJ ;[41] 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
PUSHJ P,K%BIN ;NO, GET A CHARACTER
MOVE C,S1 ;PUT THE CHARACTER IN C
TXTL.2: JUMPE C,TXTL ;IGNORE NULLS
PUSHJ P,CONVRT ;CONVERT LOWER TO UPPER, ETC.
MOVE S1,[XWD -SCTBLL,SCTBL] ;Get the address of dispatch table
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,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 [ PUSH P,S1 ;Save error code
PUSHJ P,FINTXT ;Update user's arg block
POP P,S1 ;Restore error code
$RETF] ;Give failure return
SKIPN C,S2 ;NULL?
JRST TXTL.4 ;YES
PUSHJ P,CONVRT ;CONVERT CASING
PUSHJ P,STOC ;STORE
JRST TXTL.3 ;LOOP
SUBTTL SETMSK -- Set input stream break mask
; This routine will set up the break mask so that we may use the
;.TOSBS TRMOP. on TOPS10. If the user does not sent a break mask,
;a default one will be used.
; Call with:
; S1/ Address of TEXTI arg block
SETMSK: $SAVE <P1,P2> ;Get some scratch ACs
MOVE P1,S1 ;Save the block address
MOVE S2,.RDCWB(P1) ;Get the lenght of the block
CAIGE S2,.RDBRK ;Does he send a break set
JRST SMSK.1 ;No, Go set the default one
SKIPN P2,.RDBRK(P1) ;Get the block
JRST SMSK.1 ;Empty block, go set default
DMOVE S1,0(P2) ;Get the first two words of the set
DMOVEM S1,BRKBLK+3 ;Store them in the TRMOP. block
DMOVE S1,2(P2) ;Like-wise the last 2 words
DMOVEM S1,BRKBLK+5 ; . . .
JRST SMSK.2 ;Go join common code
;Here to build a break mask if the user didn't give one.
;Note: it returns the BRKBLK area all set up
SMSK.1: SETZB S1,S2 ;Clear the mask from the TRMOP. block
DMOVEM S1,BRKBLK+3 ; . . .
DMOVEM S1,BRKBLK+5 ; . . .
SMSK.2: MOVE P2,.RDFLG(P1) ;Get the flag word
TXNE P2,RD%BEL ;Only break on EOL?
TLO S1,200 ;Just want two bits on
TXNE P2,RD%BRK ;CTRL/Z and ESC ?
TRO S1,1400 ;Turn them on
TXNE P2,RD%TOP ;TOPS10 break set?
TDOA S1,[XWD 2360,1400] ;Turn them on
TDO S1,[XWD 1000,450000] ;No, then we need editing characters
IORM S1,BRKBLK+3 ;Store this mask
MOVEI S1,20 ;GEt the delete bit
TXNN P2,RD%TOP ;TOPS10 on?
IORM S1,BRKBLK+6 ;No, We must handle delete as well
TXNN P2,RD%PUN ;Does he want all punctuation?
JRST SMSK.3 ;No, don't bother then
DMOVE S1,PUNMSK ;Get the first half of the punctuation
IORM S1,BRKBLK+3 ;Include previously set bits
IORM S2,BRKBLK+4 ;We have to do this in case user
DMOVE S1,PUNMSK+2 ; his own mask, we don't want
IORM S1,BRKBLK+5 ; to overwrite his bits
IORM S2,BRKBLK+6
SMSK.3: MOVEI S1,BUFFUL ;GEt lenght of internal buffer
MOVEM S1,BRKBLK+2 ;This number is as good as any
MOVE S2,TRMUDX ;GEt the terminal's UDX
MOVEM S2,BRKBLK+1 ;Save it
MOVEI S2,.TOSBS ;GEt the function type
MOVEM S2,BRKBLK
MOVE S1,[XWD 7,BRKBLK] ;Point to the break character block
TRMOP. S1, ;Set up the break mask
SKIPF ;Couldn't?
$RETT
SETO S1, ;Get a negative one
TRMNO. S1, ;Get the terminal number
$RETT ;Assume we're detached
$STOP (CSB,<Can't set terminal break mask>)
;The mask for the punctuation characters, note that Editing characters are
;included.
; 000000000011111111112222222222333333
; 012345678901234567890123456789012345
PUNMSK: EXP ^B011011101100001110000010111111110000
EXP ^B111111111111101100000000001111110000
EXP ^B100000000000000000000000000111110000
EXP ^B100000000000000000000000000111100000
SUBTTL GETESC -- Get escape sequence
; This routine will accept and process the user escape sequence
;for the SET TERMINAL KEYPAD command from OPR (for example). It must
;be called only at the beginning of a line.
GETESC: SKIPN UESCTB ;Did the user set up a table?
$RETF ;Nope
HLRZ S1,RD+.RDIOJ ;Input JFN
CAXE S1,.PRIIN ;Primary input JFN?
$RETF ;No, input not terminal
MOVE T3,RD+.RDDBP ;Get the current pointer into buffer
MOVE T4,RD+.RDBFP ;Get pointer to the beginning
PUSHJ P,CMPPTR ;Compare them
TRNA ;The same
$RETF ;Don't process in middle of line
SKIPA S1,[-1] ;Get the first time through flag
GETE.9: MOVEI S1,-1 ;Tell we're just looping through
MOVEM S1,CURESC ;Remember it
PUSHJ P,GETBIN ;Just get one character
CAIE S1,.CHESC ;Is it an ESCAPE
JRST GETE.0 ;No, back up and return
SKIPG CURESC ;First time through?
SETZ S1, ;Turn off echo
PUSHJ P,K%ECHO ;...
GETE90: MOVE S1,UESCTB ;Get address of table
MOVEM S1,CURESC ;Save it as current state
;Here with a table address in CURESC. Not that the first node in the
;tree must be a table address.
GETE.1: PUSHJ P,GETBIN ;Get another character
MOVE C,S1 ;Transfer it for safety
MOVE T1,CURESC ;Get the node address
MOVE S2,(T1) ;Get the lenght of the table
TXZN S2,EF.TBL ;This bit must be on if we are here
JRST GETE.8
HRRZ S1,1(T1) ;Get adress of character table
GETE10: CAMN C,(S1) ;Is the character in the table
JRST GETE11 ;Yes, found then
SOJLE S2,GETE.8 ;Loop for all and exit if no found
AOBJP S1,GETE10 ;No, try for all
GETE11: HLRZ S1,S1 ;Get the index into the char table
MOVE S2,2(T1) ;Get the next node address
ADD S1,S2 ;Add the dispatch offset
MOVE S1,(S1) ;Get the next node
MOVEM S1,CURESC ;Save it as the current state
MOVE S1,(S1) ;Get the node descriptor
TXNE S1,EF.TBL ;Another address?
JRST GETE.1 ;Yes, read another character
TXNE S1,EF.LST ;A list to process?
JRST GETE.2 ;Yes, go set up for it
MOVEI T2,1 ;Otherwise we make believe it's a list
MOVE T4,S1 ; lenght 1, starting at T4
MOVEI T1,T4 ;Address of table
JRST GETE.3 ;Skip set up for real list
GETE.2: MOVE T2,(S1) ;Get the lenght of the list
SUBI T2,1 ;Account for the word count
AOS S1 ;Point to the arguements
MOVE T1,S1 ;Store the address for safety
GETE.3: MOVE S1,(T1) ;Get me an instruction
TXNN S1,EF.IST ;Is it an input string
TXNE S1,EF.OST ;Or output string?
TRNA ;Yes, continue
$STOP (IEI,<Illegal escape sequence instruction>)
MOVE T3,S1 ;Save it so we can build a BP
LOAD S2,(T1),ES.SIZ ;Get the byte size
HRLI T3,(POINT 7,0) ;Get a word aligned byte pointer
DPB S2,[POINT 6,T3,11] ;Insert the size
TXNN S1,EF.IST ;Input string
JRST GETE.5 ;Yes, go handle it
GETE.4: ILDB C,T3 ;Get a character
JUMPE C,GETE.6 ;All done
PUSHJ P,CONVRT ;Convert to upper case
MOVE S1,[XWD -ECTBLL,ECTBL] ;GEt the dispatch table
PUSHJ P,SPCHK ;See if it is a special char
JUMPF GETE40 ;Not special, no problem
PUSHJ P,(S1) ;Call the routine
JRST GETE.4 ;Keep reading
JRST GETE.4 ;Same for the skip return
GETE40: PUSHJ P,STOC ;Store it into the buffer
SETOM CURESC ;Flag that we've done input
MOVE S1,C ;Transfer the character
PUSHJ P,ECHOUT ;Echo it
PUSHJ P,CBRK ;Go see if break
JUMPT GETE.7 ;There was, go finish up
SKIPE RD+.RDDBC ;Any more room
JRST GETE.4 ;Yes, keep processing
$STOP (IBO,<Input buffer overflow on escape sequence processing>)
GETE.5: ILDB S1,T3 ;Get a character
JUMPE S1,GETE.6 ;No more, go finish up
PUSHJ P,TXTOUT ;Type it
JRST GETE.5 ;Loop for them all
GETE.6: AOS T1 ;Point to the next instruction
SOJG T2,GETE.3 ;Keep going if not finished
GETE.7: SKIPN CURESC ;Did we do input?
JRST GETE.9 ;No, nothing to return to caller
MOVX S1,RD%BTM ;Yes, say we're terminated by break
PUSHJ P,FINTXT ;Go set up pointers and buffers etc.
SETZM CURESC ;No longer in an escape sequence
MOVEI S1,1 ;Go finish up
JRST K%ECHO ;...
GETE.8: MOVEI S1,.CHBEL ;Otherwise get a bell
PUSHJ P,TXTOUT ;Tell him he's mistaken
JRST GETE.9 ;And try again
GETE.0: PUSHJ P,K%BACK ;Backup the terminal
MOVEI S1,1 ;Turn echo back on
PUSHJ P,K%ECHO ;...
SETZM CURESC ;No longer in an escape sequence
$RETF ;REturn false
CLSDEL: SETZM CURESC ;No longer in an escape sequence
$RETT ;Return
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
LDB S2,S1 ;GET PRECEEDING CHARACTER
CAIE S2,.CHCRT ;IS IT A <CR>?
JRST USTO.2 ;NO..JUST RETURN
MOVE S2,S1 ;GET THE POINTER
ILDB S2,S2 ;GET DELETED CHARACTER
CAIE S2,.CHLFD ;DID WE HAVE <CRLF>
JRST USTO.2 ;NO..JUST RETURN
SOS S1 ;YES..DELETE THE <CR>
MOVEI S2,4
IBP S1
SOJG S2,.-1
AOS RD+.RDDBC ;ONE MORE BYTE AVAILABLE
USTO.2: PUSHJ P,MAKBP ;CONVERT IT
MOVEM S1,RD+.RDDBP ;RE-STORE THE POINTER
AOS RD+.RDDBC ;ONE MORE BYTE AVAILABLE
$RETT
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
SKIPE ECHFLG ;CHECK ECHO DISABLE FLAG
TDNE S1,RD+.RDFLG ;TEST TEXTI NO ECHO FLAG
$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,ECHOUT ;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 ECHOUT -- TYPE CHARACTERS AS ECHOED
ECHOUT: 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
SUBTTL ECHO -- HANDLE CHARACTER ECHOING
ECHO: MOVX S1,RD%NEC ;GET NO ECHO BIT
TDNE S1,RD+.RDFLG ;TEST IT
$RETT ;RETURN IF SET
MOVE S1,C ;Get the character
IDIVI S1," " ;Seperate into word and bit
MOVE S1,BRKBLK+3(S1) ;Get the correct word from the 4wd mask
LSH S1,(S2) ;Bring the bit over to the sign bit
SKIPL S1 ;It's set so we must echo it
$RETT ;No need to echo it
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: $SAVE <P1> ;GEt a scratch reg
ILDB P1,S2 ;GET BYTE
JUMPE P1,CBRK.4 ;IF NULL, WE HAVE A NO MATCH
CAMN P1,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) .CHBEL,.CHLFD,.CHVTB,.CHFFD,.CHCNZ,.CHESC,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
; S1/ -Table lenght,,table address
;
;TRUE RETURN: S1/ Address of routine to call
;FALSE RETURN: Character was not special
SPCHK: HLRZ S2,(S1) ;GET CHARACTER
CAME S2,C ;A MATCH?
AOBJN S1,SPCHK ;LOOP LOOKING FOR MATCH
JUMPGE S1,.RETF ;IF NO MATCH, RETURN FALSE
HRRZ S1,(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(H),,CCDEL ;^H
$C(U),,CCU ;^U
$C(R),,CCR ;^R
$C(W),,CCW ;^W
SCTBLL==.-SCTBL
ECTBL: .CHDEL,,DELETE ;DELETE (177)
$C(H),,DELETE ;^H
$C(U),,DELINE ;^U
$C(R),,RETYPE ;^R
$C(W),,DELWRD ;^W
ECTBLL==.-SCTBL
SUBTTL CCU -- Handle ^U (Rubout entire line)
;HERE TO PROCESS ^U (RESTART INPUT)
CCU: PUSHJ P,DELINE ;Delete the line
JRST TXTL ;Go back to the main routine
DELINE: PUSHJ P,CLSDEL ;Close possible delete set
PUSHJ P,FNDLIN ;RESET BEGINNING OF LINE
CDX: 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
POPJ P,
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
POPJ P,
SUBTTL CCR -- Handle ^R (Re-type the line)
CCR: PUSHJ P,RETYPE ;Do the retype
JRST TXTL ;Go get another character
RETYPE: PUSHJ P,CLSDEL ;CLOSE POSSIBLE DELETE SET
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
POPJ P, ;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: PUSHJ P,ISLASH ;Type a backslash if appropriate
TRNA ;Done, continue
JRST CCDL00 ;At beginning, handle it
PUSHJ P,DELETE ;Delete the character
JRST CCDL.0 ;At the beginning, go handle it
CCDL00: PUSHJ P,BEGBUF ;Go process beginning of buffer
JRST FINTXT ;User wants return
CCDL.0: SETZ S1, ;Turn off echo
SKIPE ECHFLG ;If echo already off, don't bother
PUSHJ P,K%ECHO ;...
CCDL.1: PUSHJ P,GETBIN ;Read the next character
CAIE S1,.CHDEL ;Is it a delete character?
CAIN S1,.CHBSP ;Or a backspace?
JRST CCDL.2 ;Yes, delete another
MOVE C,S1 ;Get the character
SKIPN PMPTNG ;We're prompting, don't type slash
PUSHJ P,TYPSLS ;Close off set with a backslash
JFCL ;Beginning doesn't matter
SETZM PMPTNG ;No longer prompting
PUSHJ P,ECHOUT ;Echo the character
CAIE C,.CHCRT ;Was character a carriage return?
JRST CCDL10 ;No, onward
MOVEI C,.CHLFD ;Get a line feed
PUSHJ P,ECHOUT ;Echo it out
CCDL10: SETO S1, ;Turn echo back on
PUSHJ P,K%ECHO ; ...
PUSHJ P,K%BACK ;Else back up a character
JRST TXTL ;And go process it
CCDL.2: PUSHJ P,DELETE ;Go delete this character
JRST CCDL.1 ;Process another
PUSHJ P,ATPMPT ;See if back to prompt
TRNA ;User wants return
JRST CCDL.1 ;Process until no more deletes
SETO S1, ;Turn echo back on
PUSHJ P,K%ECHO ; . . .
PJRST FINTXT ;End it
ISLASH: MOVE S1,RD+.RDDBP ;GET CURRENT POINTER
CAMN S1,BGBUFR ;At the beginning?
JRST .POPJ1 ;Yes, return now
TYPSLS: HRRZ S1,@TRMPTR ;Get pointer to control code
JUMPN S1,.POPJ ;If video, no need to type backslash
MOVX S1,.CHBSL ;GEt a backslash character
PJRST TXTOUT ;No, start it then
;The worker routine to delete. Returns +1 if at beginning of
;buffer, and +2 if character deleted.
IFNDEF TABWDT,<TABWDT==10> ;Number of columns in a TAB
DELETE: MOVE S1,RD+.RDDBP ;GET CURRENT POINTER
CAMN S1,BGBUFR ;ARE WE BACK UP TO BEGINNING?
JRST .POPJ1
PUSHJ P,USTOC ;UN-STORE A CHARACTER
MOVE S1,RD+.RDDBP ;GET CORRECTED POINTER
MOVE TF,C ;SAVE ^H OR <RUBOUT>
ILDB C,S1 ;THEN GET DELETED CHARACTER
HRRZ S1,@TRMPTR ;GET POINTER TO CONTROL CODE
JUMPN S1,DELE.1 ;IF THERE IS CODE,DO IT
CAIL C," " ;A printing character?
PJRST ECHOUT ;Yes, echo what has been deleted
CAIE TF,$C(H) ;WAS IT ^H
JRST DELE.0 ;Echo the character
MOVEI S1,$C(H) ;GET ^H
PJRST TXTOUT ;ECHO IT
DELE.0: CAIE C,.CHCRT ;A line feed character?
PJRST ECHOUT ;No, echo the character
MOVEI S1,.CHCRT ;Echo a carriage return
PUSHJ P,TXTOUT ; . . .
MOVEI S1,.CHLFD ;And a line feed
PJRST TXTOUT
POPJ P,
PUSHJ P,RETYPE ;Retype the line on a linefeed
PJRST TYPSLS ;And delimit old from new
DELE.1: CAIGE C," " ;WAS DELETED CHARACTER PRINTING?
JRST DELE.2 ;NO, NEED FURTHER ANALYSIS
MOVEI S1,[BYTE (7).CHBSP," ",.CHBSP,.CHNUL] ;OUTPUT BACK,SPACE,BACK
PJRST STROUT ;TYPE IT
DELE.2: CAIN C,.CHTAB ;Is this a tab character?
JRST DELE.3 ;Yes, special handling
PUSHJ P,GETCOC ;GET COC FOR THIS CHARACTER
JUMPE S1,.POPJ ;IF CODE 0 , NOTHING THERE AT ALL
CAXE S1,1 ;IF ITS A ONE, JUST RUBOUT 2 CHARACTERS
PJRST RETYPE ;ELSE FORCE A RETYPE OF THE LINE
MOVEI S1,[BYTE (7).CHBSP,.CHBSP," "," ",.CHBSP,.CHBSP,.CHNUL]
PJRST STROUT ;TYPE IT
DELE.3: PUSHJ P,FNDLIN ;Find the beginning of the line
MOVE T3,BGLINE ;Get the pointer
MOVE T4,RD+.RDBFP ;Does it begin the buffer?
PUSHJ P,CMPPTR ;Compare them
TRNA ;The same, must calculate prompt
JRST DELE30 ;No, so don't worry about prompt
SKIPN S1,RD+.RDRTY ;Otherwise get the prompt text
JRST DELE30 ;If no prompt, continue
SETZB S2,T1 ;Say it's an ASCIZ string,,column 0
PUSHJ P,STRPOS ;Find out where it ends
SKIPA T1,S1 ;Start the count there
DELE30: SETZ T1, ;Clear the position counter
MOVE S1,BGLINE ;GEt the character we're checking
MOVE S2,RD+.RDDBP ;And the last character
PUSHJ P,STRPOS ;Calculate the position
MOVE T1,S1 ;Save the position
IDIVI S1,TABWDT ;Calculate last tab stop
ADDI S1,1 ;We want position for the next one
IMULI S1,TABWDT ;So calculate it
SUBM S1,T1 ;Now the difference in spaces
DELE31: MOVEI S1,.CHBSP ;Get a backspace character
PUSHJ P,TXTOUT ;Output it
SOJG T1,DELE31 ;And do it for all
POPJ P,
SUBTTL STRPOS -- Calculate prompt position
; This routine will calculate the end position of the cursor when a
;string is typed out. It accepts the starting pointer in S1, and the
;ending point in S2. If the string is ASCIZ, then S2 should be 0.
;T1 contains the beginning column.
STRPOS: PUSHJ P,.SAVET ;Get a scratch reg
DMOVE T3,S1 ;Keep the pointer safe
STRP.1: JUMPE T4,STRP10 ;An ASCIZ string, just looks for null
PUSHJ P,CMPPTR ;Compare the pointers
JRST STRP.9 ;We're at the end
STRP10: ILDB C,T3 ;Get a character
JUMPE C,STRP.9 ;End of string, go finish up
CAIL C," " ;Printing character?
AOJA T1,STRP.1 ;Yes, add one and process another char
PUSHJ P,GETCOC ;Get the echo mask
JRST @[EXP STRP.1,STRP.2,STRP.3,STRP.4](S1) ;Process the character
STRP.2: ADDI T1,2 ;Account for the ^char
JRST STRP.1 ;And continue
STRP.3: CAIE C,.CHTAB ;Tab character?
JRST STRP30 ;No, check for next character then
MOVE S1,T1 ;Get current position
IDIVI S1,TABWDT ;Calculate last tab stop
ADDI S1,1 ;We want position for the next one
IMULI S1,TABWDT ;So calculate it
MOVE T1,S1 ;Put it in its proper place
JRST STRP.1 ;And continue
STRP30: CAIN C,.CHCRT ;Is this a carriage return then?
SETZ T1, ;Yes, starting over then
JRST STRP.1 ;Continue
STRP.4: CAIN C,.CHESC ;Escape?
AOJA T1,STRP.1 ;Yes, then account for "$"
JRST STRP.1 ;The only one we know of, so continue
STRP.9: MOVE S1,T1 ;Return value to caller
POPJ P,
SUBTTL CCW -- Handle ^W (Delete back to punctuation character)
CCW: PUSHJ P,ISLASH ;Print first slash
TRNA ;Continue
JRST CCW.00 ;At beginning, go handle it
PUSHJ P,DELWRD ;Delete a word
JRST CCW.0 ;Done continue
CCW.00: PUSHJ P,BEGBUF ;Else process beginning of buffer
JRST FINTXT ;User wants return
CCW.0: SETZ S1, ;Turn off echo
PUSHJ P,K%ECHO ;...
CCW.1: PUSHJ P,GETBIN ;Get the next character
CAIN S1,$C(W) ;Control W?
JRST CCW.2 ;Yes, delete the previous word
MOVE C,S1 ;Else, Save the character
SKIPN PMPTNG ;We're prompting, don't type slash
PUSHJ P,TYPSLS ;Close off set with a backslash
JFCL ;Beginning doesn't matter
SETZM PMPTNG ;No longer prompting
PUSHJ P,ECHOUT ;Echo it
CAIE C,.CHCRT ;Was character a carriage return?
JRST CCDL10 ;No, onward
MOVEI C,.CHLFD ;Get a line feed
PUSHJ P,ECHOUT ;Echo it out
CCW.10: SETO S1, ;Turn echo back on
PUSHJ P,K%ECHO ; . . .
PUSHJ P,K%BACK ;Back up the character
JRST TXTL ;And go process it
CCW.2: PUSHJ P,DELWRD ;Delete the word
JRST CCW.1 ;Process another character
PUSHJ P,ATPMPT ;Process beginning of buffer
TRNA ;USer wants to return
JRST CCW.1 ;Else process until no more deleters
SETO S1, ;Turn echo back on
PUSHJ P,K%ECHO ; . . .
PJRST FINTXT ;End it
DELWRD: PUSHJ P,FNDLIN ;RESET BEGINNING OF LINE PTR
MOVE T3,RD+.RDDBP ;SEE IF WE'RE AT TOP OF BUFFER
MOVE T4,BGBUFR ;..
PUSHJ P,CMPPTR ;AT TOP OF BUFFER?
TRNA ;YUP, SPECIAL HANDLE
JRST DELW.1 ;No, we can delete something
AOS (P) ;Give a skip from now on
POPJ P,
DELW.1: PUSHJ P,CURCHR ;Get current character
CAIE C,.CHTAB ;A spacing character?
CAIN C," " ; . . .
TRNA ;Yes, get rid of it
JRST DELW.2 ;Else go delete the word
PUSHJ P,DELETE ;Always delete the first character
JRST DELW.1 ;Loop for all spaces
POPJ P, ;At the beginning
DELW.2: PUSHJ P,CHKEOL ;An end of line character
JUMPT DELW20 ;Yes, go delete it
PUSHJ P,CHKPUN ;Is this a punctuation character
JUMPF DELW.4 ;No, then go delete the word
DELW20: PUSHJ P,DELETE ;Otherwise just delete this character
POPJ P, ;And go get another
POPJ P,
DELW.3: PUSHJ P,CURCHR ;Get the current character
PUSHJ P,CHKEOL ;Check for end of line
JUMPT .POPJ ;Yes, all done
PUSHJ P,CHKPUN ;Go see if it is a puctuation character
JUMPT .POPJ ;Yes it is, finished
DELW.4: PUSHJ P,DELETE ;Go delete the character
JRST DELW.3 ;Go try again
POPJ P, ;We're at the beginning
CURCHR: LDB C,RD+.RDDBP ;Get the last byte input
JUMPN C,.POPJ ;Have something, proper pointer
MOVE S1,RD+.RDDBP ;Get the pointer
SUBI S1,1 ;Adjust it by backing back by 5 and
MOVEI S2,5 ; incrementing back up
ILDB C,S1
SOJG S2,.-1
POPJ P,
CHKEOL: CAIE C,.CHCRT ;A carriage return
CAIN C,.CHLFD ; or line feed
$RETT ;Give a skip return
$RETF
CHKPUN: MOVE S1,[POINT 7,PUNTAB] ;POINT TO PUNCTUATION TABLE
PUN.2: ILDB S2,S1 ;GET A PUNCTUATION CHARACTER
JUMPE S2,.RETF ;IF AT END, DELETE ANOTHER CHARACTER
CAME S2,C ;IS NEXT CHAR A PUNCTUATION CHAR?
JRST PUN.2 ;NO, TRY NEXT IN LIST
$RETT
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
POPJ P, ] ;TO CALLER
MOVX S1,.CHBEL ;LOAD A "BELL"
PUSHJ P,TXTOUT ;AND SEND IT
AOS (P) ;Skip return
POPJ P,
ATPMPT: LOAD S1,RD+.RDFLG,RD%RND ;GET FLAG FOR RETURN HERE
JUMPN S1,[ MOVX S1,RD%BFE ;FLAG IS LIT, RETURN BUFFER EMPTRY NOW
POPJ P, ] ;TO CALLER
MOVX S1,.CHBEL ;LOAD A "BELL"
PUSHJ P,TXTOUT ;AND SEND IT
AOS (P) ;Skip return
HRRZ S1,@TRMPTR ;Get pointer to control code
JUMPN S1,.POPJ ;If video, no need to type backslash
SETOM PMPTNG ;Tell we're prompting
JRST RETYPE
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