Google
 

Trailing-Edge - PDP-10 Archives - steco_19840320_1er_E35 - 10,5676/teco/newsrc/teccmd.mac
There are 3 other files named teccmd.mac in the archive. Click here to see a list.
	SUBTTL	Introduction

; Copyright (c) 1980 Stevens Institute of Technology,
; Hoboken, New Jersey, 07030


; This software may be used and copied provided that this copyright notice
;is included, and provided that copies of all modifications are sent to:
;
;	TECO Project
;	Computer Center
;	Stevens Institute of Technology
;	Castle Point Station
;	Hoboken, New Jersey    07030
;
;
; The information in this software is subject to change without notice
; and should not be construed as a commitment by the authors or their
; employers.

  ; Search needed universals

	SEARCH	TECUNV		; TECO universal file

  ; Generate the prologue


	TECVER==200		; Major version number
	TECMIN==1		; Minor version number
	TECEDT==1162		; Edit level
	TECWHO==0		; Last editor


	PROLOGUE(CMD,<Command processing>)	; Generate the TITLE and other stuff


;+
;.no flag all
;.fig 15
;.c;TECCMD
;.title TECCMD - Command processor
;-
	SUBTTL	Table of Contents

;+
;.pag.lit

;		Table of Contents for TECCMD - Command processing
;
;
;			   Section			      Page
;   1. Introduction . . . . . . . . . . . . . . . . . . . . .    1
;   2. Table of Contents. . . . . . . . . . . . . . . . . . .    2
;   3. Revision History . . . . . . . . . . . . . . . . . . .    3
;   4. Command modifiers
;        4.1.   "@" - Delimited mode. . . . . . . . . . . . .    4
;        4.2.   ":" . . . . . . . . . . . . . . . . . . . . .    4
;   5. Values
;        5.1.   "^E" - Form feed flag . . . . . . . . . . . .    5
;        5.2.   "^N" - EOF flag . . . . . . . . . . . . . . .    6
;        5.3.   "H" - B,Z . . . . . . . . . . . . . . . . . .    7
;        5.4.   "." - Position of the pointer . . . . . . . .    7
;        5.5.   "Z" - Number of characters in the buffer. . .    7
;   6. Commands
;        6.1.   Control-L - Type a form feed or refresh the screen   8
;        6.2.   "=" and "==" - Type out a value . . . . . . .    9
;        6.3.   "^T" - Input a character. . . . . . . . . . .   10
;        6.4.   Extended ^T operations. . . . . . . . . . . .   11
;        6.5.   "^H" - Return daytime in jiffies. . . . . . .   12
;        6.6.   "^F" - Read the console switches. . . . . . .   12
;        6.7.   "^^" - Return the value of the next character   13
;        6.8.   "\" - Read a number from the buffer . . . . .   14
;        6.9.   "A" - Append or return value of character . .   16
;        6.10.  Q-register
;             6.10.1.    "U" - Store numeric value. . . . . .   18
;             6.10.2.    "Q" - Fetch numeric value. . . . . .   19
;             6.10.3.    "%" - Increment the value. . . . . .   20
;             6.10.4.    "X" - Insert text into Q-reg . . . .   21
;             6.10.5.    "G". . . . . . . . . . . . . . . . .   22
;             6.10.6.    "M" and "W". . . . . . . . . . . . .   23
;             6.10.7.    "]" - Pop Q-register . . . . . . . .   24
;             6.10.8.    "[" - Push a Q-reg . . . . . . . . .   25
;             6.10.9.    Utility routines
;                  6.10.9.1.      QREGVI. . . . . . . . . . .   26
;                  6.10.9.2.      SCNQRG. . . . . . . . . . .   27
;                  6.10.9.3.      QTXTEI. . . . . . . . . . .   28
;                  6.10.9.4.      QTXTST. . . . . . . . . . .   29
;        6.11.  "^U" - Set next block to read . . . . . . . .   30
;        6.12.  "^G" - GETTAB or EXIT . . . . . . . . . . . .   31
;        6.13.  "^V" and "^W" - Lower and upper case flags. .   32
;        6.14.  "^X" - Set or clear exact match . . . . . . .   33
;        6.15.  "Y" ("EY") - Render the buffer empty. . . . .   34
;        6.16.  ^Y and ^P - quick page scan commands. . . . .   36
;        6.17.  "I"
;             6.17.1.    Insert . . . . . . . . . . . . . . .   37
;             6.17.2.    Utilities
;                  6.17.2.1.      Casing routines . . . . . .   41
;                  6.17.2.2.      CKNCC . . . . . . . . . . .   42
;             6.17.3.    "nI" . . . . . . . . . . . . . . . .   43
;        6.18.  T . . . . . . . . . . . . . . . . . . . . . .   44
;        6.19.  V . . . . . . . . . . . . . . . . . . . . . .   45
;        6.20.  P . . . . . . . . . . . . . . . . . . . . . .   46
;        6.21.  "J" - Move the pointer to absolute position .   47
;        6.22.  "R" - Move pointer backwards. . . . . . . . .   47
;        6.23.  "C" - Move the pointer forwards . . . . . . .   47
;        6.24.  "L" - Move the pointer n lines. . . . . . . .   48
;        6.25.  "K" - Delete some text. . . . . . . . . . . .   49
;        6.26.  "D" - Delete a number of characters . . . . .   50
;        6.27.  "<" - Open iteration. . . . . . . . . . . . .   51
;        6.28.  ">" - End an iteration loop . . . . . . . . .   52
;        6.29.  ";" - Exit iteration. . . . . . . . . . . . .   53
;        6.30.  "!" - Define a tag. . . . . . . . . . . . . .   54
;        6.31.  "O" - Go to the tag named.. . . . . . . . . .   55
;        6.32.  "?" - Enter or leave trace mode . . . . . . .   56
;        6.33.  "^A" - Type out the comment . . . . . . . . .   56
;   7. Conditional excution . . . . . . . . . . . . . . . . .   57
;   8. Utility routines
;        8.1.   GETARG - Return string type args. . . . . . .   59
;        8.2.   SETINC, GETINC, and PUTINC. . . . . . . . . .   60
;        8.3.   BTAB - Byte pointer table . . . . . . . . . .   61
;        8.4.   CKEOL - Check if CH contains an EOL . . . . .   62
;        8.5.   GETFDI - Get the address of an FDB. . . . . .   63
;        8.6.   GETFDO - Get the address of an FDB. . . . . .   64
;        8.7.   WRTBUF - Write out the buffer . . . . . . . .   65
;   9. Low segment. . . . . . . . . . . . . . . . . . . . . .   66
;  10. End of TECCMD. . . . . . . . . . . . . . . . . . . . .   67

;.end lit.pag
;-
	SUBTTL	Revision History
COMMENT	|

1000	Start of this version

1003	By: Robert McQueen		On: 17-July-1980
	The look ahead for the PW command caused random errors.  The TXZ
	should not be, since it will mange special characters.
	Modules: TECCMD

1004	By: Robert McQueen		On: 21-July-1980
	The O command would cause ?ill mem ref if the tag was null.  Give a better
	error message for the O command.
	Modules: TECUNV,TECCMD,TECERR

1021	By: Nick Bush		On: 14-August-1980
	Fix GETARG to not allow two argument commands to have values outside
	of the range for the buffer.
	Modules: TECCMD

1040	By: Robert McQueen		On: 2-September-1980
	I^Gq or S^Gq gave bad error messages if single character q-register
	names were used.  Move QREGV2 back one line, so the name is stored.
	Modules: TECCMD

1041	By: Robert McQueen		On: 2-September-1980
	Make the O command give the correct tag all the time, if the tag can not
	be found.
	Modules: TECCMD

1052	By: Nick Bush		On: 12-November-1980
	Make sure RCHSVD gets cleared when we start command execution.
	Also make :M(FOOBAR) work correctly.
	Modules: TECPRS,TECCMD

1055	By: Robert McQueen		On: 18-November-1980
	Add two new :^T commands to put the terminal into packed image mode and to
	take it out again.
		:-3^T - Put into packed image mode
		:-4^T - Take it out of packed image mode
	Modules: TECUNV,TECFIL,TECCMD,TECMVM

1063	By: Nick Bush		On: 19-December-1980
	Fix FW command to clear current ^D column so we will remember a new one.
	Fix ] command to respect the settings of the QR$xxx flags and not
	store text into a value only Q-reg or a value into a text only Q-reg.
	Modules: TECCMD,TECSRH

1071	By: Nick Bush		On: 10-January-1981
	Add F$RBUF and F$WBUF routines to improve I/O performance.
	Also add /MODE:DUMP for all file commands.
	Modules: TECUNV,TECFIL,TECCMD,TECECM

1073	By: Nick Bush		On: 22-January-1981
	Fix ^P command.  WRTBUF has to save A1 and A2.
	Also make M and W illegal for the current text buffer.  While there
	are still methods of ending up executing the current text buffer,
	this should catch most of them.
	Modules: TECCMD,TECERR

1076	By: Nick Bush		On: 30-January-1981
	Add a default mode to be mode type 0. This will allow /MODE:ASCII
	to really be such with LSA files. Also make /MODE: properly default
	from ER/EW to EB and vice versa.
	Modules: TECUNV,TECCMD,TECFIL,TECECM

1077	By: Nick Bush		On: 6-Febuary-1981
	1) Add routine do delete all tags for a given text buffer, and have it
	   called anytime the buffer becomes editable, or is destroyed.
	
	2) Reset CUREDT to point at TXTBUF anytime the q-register which it points
	   at becomes disassociated with it.
	Modules: TECUNV,TECPRS,TECCMD,TECECM,TECSYM

1106	By: Nick Bush		On: 13-May-1981
	Improve screen updating for times when the new screen has portions which
	are identical with the old.  This will also fix most cases of wrapped
	around lines on the top of the section of the screen.
	Also fix some random /MODE:DUMP bugs.
	Modules: TECUNV,TECVID,TECCMD,TECECM,TECUUO,TECMEM

Start of Version 200A(1126)

1127	By: Nick Bush@SIT, Robert C. McQueen@SIT		On: 15-October-1981
	Add the following new features:
	- String arguments.  {...} is a string argument.
	- Make I take them, = and == return them.
	- Implement the FC command to define immediate command tables
	- Implement the E? command to return various items.
	- Start doing some work so that TECO will work on TOPS-20
	- Start doing some work so that TECO some day may run in a section
	  besides zero.
	Modules: TECUNV,TECERR,TECPRS,TECCMD,TECSRH,TECMEM,TECUUO,TECECM,TECMVM,TECCOM,TECINI

1132	By: Nick Bush		On: 10-December-1981
	1) Add Q-register data types for the sake of FC(Q-reg)SAVE$ and
	FC(Q-reg)RESTORE$ commands.
	2) Fix FC(q-reg)REPLACE$ to correctly replace the ALWAYS and OTHER options.
	Modules: TECUNV,TECCMD,TECECM,TECMEM,TECPRS,TECMVM

1134	By: Nick Bush		On: 21-December-1981
	Make sure QR$PRD gets turned on for predefined Q-register names.
	Modules: TECCMD

1143	By: Nick Bush		On: 3-January-1982
	Fix insert to correctly call M$INSS.  It was calling it with the address
	of the buffer where the text was located, not the address of the pointer
	to the buffer.
	Modules: TECCMD

1156	By: Robert C. McQueen		On: 14-April-1982
	- Fix bug in the last edit.
	- Fix problem with screen updating if /MODE:ASCI and P command.
	Modules: TECSRH,TECCMD

1161	By: Nick Bush		On: 13-May-1982
	Add new code to support peek-ahead for immediate (FC table) commands and
	for a new form of the control-T command.
	Add the new form of the control-T command to allow macros to peek at
	input, and to make use of timed input.  Also add the Q-register
	TERMINAL-INPUT-BUFFER to hold the text being peeked at, with the side
	effect of allowing macros to store text into the Q-register, and have
	it be treated as input typed on the terminal.
	Also change the space command to just pass through the arguments unless
	EO is set to 4 or less.
	Modules: TECUNV,TECVID,TECUPD,TECMVM,TECPRS,TECTRM,TECCMD,TECTBL

1162	By: Nick Bush		On: 14-May-1982
	Add a new flag for Q-regs to indicate that the Q-reg may not become the
	current editing buffer with the E. command.  This keeps TERMINAL-INPUT-BUFFER
	from causing problems
	Modules: TECUNV,TECECM,TECCMD
|
	SUBTTL	Command modifiers -- "@" - Delimited mode

;+
;.hl1 Command modifiers
; Some commands may be prefixed with a command modifer which causes it to
;do different things than normally.
;.hl2 Delimited text strings ("@")
; If a command is prefixed by a "@" it will use the first character
;after the command as the delimiter character for the end of its string
;argument, instead of an altmode (escape). This modifier only makes
;sense for commands which take string arguments (i.e. I, S, etc.).
;-

	$CODE			; Put into code PSECT

ATSIGN:	TXOA	F,F.SLSL	; Flag we have seen an "@"
	FALL	COLON		; Fall into the colon modifier


	SUBTTL	Command modifiers -- ":"

;+
;.hl2 Colon modifier (":")
; The colon modifer is used for two things. On certain commands ("A", "^T")
;it just flags that the command should do a different function than without
;the colon. On any other it flags that an error should not print an error
;message, but should return either zero as the commands value.
;-

COLON:	TXO	F,F.COLN	; Set the flag
	POPJ	P,		; Return
	SUBTTL	Values -- "^E" - Form feed flag


;+
;.hl1 Values
;.hl2 Form feed (^E)
; This command will return the value -1 if the current buffer ended
;with a form feed, and return a zero otherwise.
;-

FFEED:	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
	MOVX	T2,TF.FFD	; Get the flag to check
	TDNN	T2,.BKTFL(T1)	; See if buffer stopped because of form feed
	 JRST	RETZER		; Yes, return a zero
	JRST	RTONES		; No, return minus one
	SUBTTL	Values -- "^N" - EOF flag

;+
;.hl2 End of file (^N command)
; This command returns the value -1 if the current file is at EOF, otherwise
;it will return a zero.
;-

EOF:	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the address of the buffer
	PUSHJ	P,GETFDI	; Get the FDB address
	 JRST	RETZER		; No file, return a zero
	MOVX	T2,FD.EOF	; Have a file, check
	TDNN	T2,.FDFLG(T1)	; if it is at eof
	 JRST	RETZER		; Not at eof
	JRST	RTONES		; At eof return -1
	SUBTTL	Values -- "H" - B,Z
;+
;.hl2 H = B,Z
; This routine will return a pair of args, zero for the first and
;Z for the second.
;-

HOLE:	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
	LOAD.	A1,BLKEND,(T1)	; Get the end address
	SETZ	A2,		; First arg is zero
	JRST	VALRT2		; Return the values


	SUBTTL	Values -- "." - Position of the pointer

;+
;.hl2 Number of characters to the left of the pointer (.)
; This routine will return the position of the pointer.
;-

PNT:	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
	LOAD.	A1,BLKPT,(T1)	; And get the pointer
	JRST	VALRET		; And return it


	SUBTTL	Values -- "Z" - Number of characters in the buffer

;+
;.hl2 Number of characters in the buffer (Z)
; This routine will return the number of characters in the buffer.
;-

END1:	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
	LOAD.	A1,BLKEND,(T1)	; Get the end address (= number of chars)
	JRST	VALRET		; And return the value
	SUBTTL	Commands -- Control-L - Type a form feed or refresh the screen

;+
;.hl1 Commands
;.hl2 Type a form feed or refresh the screen
; This command will type a form feed if TECO is running in non-video
;mode. Otherwise this command will cause the screen to be refreshed.
;-

FFDCMD:	JMPS	SC$REF		; If screen mode just refresh the screen
	MOVX	CH,.CHFFD	; Otherwise type a form feed
	PJRST	T$OCHR		; Output it and return
	SUBTTL	Commands -- "=" and "==" - Type out a value

;+
;.hl2 Type out a value ("=" and "==")
; These commands type out values. A single equals will type out the value
;in decimal. A double equals sign will type it in octal.
;-


PRNT:	PUSHJ	P,SKRCH		; Get the next character
	 JRST	PRNT.D		; Decimal print, no character to eat
	CAIN	CH,"="		; Equals?
	 JRST	PRNT.O		; Yes, print number in octal
	PUSHJ	P,REEAT		; Save the character for next
PRNT.D:	SKIPA	T1,[[$STRING(<^X/T$TCHR/^D/A1/^N>)]] ; Get the thing to type
PRNT.O:	 XMOVEI	T1,[$STRING(<^X/T$TCHR/^O/A1/^N>)] ; Get what to type for octal
	TXNN	F,F.ARG2	; Have a second arg?
	 JRST	PRNT.1		; No, go do default thing
	JUMPE	A2,PRNT.2	; If 0,n no crlf
	JUMPL	A2,PRNT.1	; If -x,n type a crlf
	PUSH	P,A2		; Save A2
	PUSHJ	P,PRNT.2	; Print the number
	POP	P,A1		; Get back the character to type
	ANDX	A1,177		; Keep only what matters
	XMOVEI	T1,[$STRING(<^7/A1/^N>)] ; Set to type the character
	PJRST	T$TYPE		; And go do it

PRNT.1:	TDZA	A2,A2		; Clear the second arg
PRNT.2:	 SETO	A2,		; Flag we don't want a crlf
	TXNE	F,F.STR1	; First argument a string?
	 JRST	PRNT.3		; Yes, go handle it
	PUSHJ	P,T$TYPE	; Type the thing
	JUMPE	A2,.TCRLF	; If a crlf needed, go type it
	POPJ	P,		; Else just return

; Here if the argument is a string.  Type out the entire string.

PRNT.3:	LOAD.	P1,TPTADR,+SARG$1	; Get the buffer address
	SETZ	A2,		; Flag we want the entire buffer
	LOAD.	A1,BLKEND,(P1)	;  .  .  .
	SETZM	XCTING		; Flag REENTER should punt immediately
	PUSHJ	P,TYPE.T	; Type the buffer
	SETOM	XCTING		; Really executing again
	POPJ	P,		; Return
	SUBTTL	Commands -- "^T" - Input a character


;+
;.hl2 Input a character ("^T")
; This routine will handle the "^T" command. If there is no colon
;it will simply input a character, returning the ascii value as
;its value. If the command is prefixed by a colon, it will do a TTCALL
;and return the value (if any) from the UUO.
;If it is not prefixed by a colon, it works as follows:
;.b
;n,m_^T
;.b
;Where n is the amount of time to wait, and m is the character to input.
;If the amount of time to wait (n) is positive, TECO will wait up to
;n milli-seconds for the type-in, and return -1 if the timer expires.
;If the amount of time to wait is negative, TECO will wait |n| milli-seconds,
;and return -1 if the character is not present.  In this case TECO will
;wait the full time, even if the character is typed; when the time is
;positive, TECO will return as soon as the character is typed, or
;when the timer expires, whichever happens first.
;A value of 0 for the time will cause TECO to wait forever.
;The second argument (m) is used to indicate which character should
;be read.  A value of 1 will read the very next character from the input
;stream.  A value of i will read the next i characters from the input
;stream, and return the value of the i^&th\& character.
;If m is negative, the value of the character is returned, but the
;character is left in the input stream, so it can be read again either
;by TECO's normal input, or by another ^T command.
;A value of 0 for the character to read will return the number of characters
;currently in the input stream (characters actually read from the terminal).
;
;The default value for the time (n) is 0.  The default value for
;the character to read (m) is 1.
;-

SPTYI:	$SAVE	<XCTING>	; Save the REENTER flag
	TXZE	F,F.COLN	; Colon modified type?
	 JRST	EXTTTY		; Yes, go do a TTCALL or set value
	TXNN	F,F.ARG		; First argument there?
	 MOVEI	A1,1		; No, default to 1
	TXNE	F,F.ARG2	; Have two arguments?
	 JUMPN	A2,SPTY.S	; Yes, if we have a sleep time, go handle it
SPTY.0:	JUMPG	A1,SPTY.1	; Want to read some characters?
	JUMPL	A1,SPTY.2	; No, want to peek at some?
	PUSH	P,ICHINS	; Save the get-a-char instruction
	MOVE	T1,[PUSHJ P,T$ICHS] ; Get the instruction to use
	MOVEM	T1,ICHINS	; Save it
	PUSHJ	P,T$RBUF	; Read whatever is there
	POP	P,ICHINS	; Reset the instruction
	SKIPN	TTIBUF+$QRTPT+$TPADR ; Any text here?
	 PJRST	RETZER		; No, return a zero
	LOAD.	T1,TPTADR,+$QRTPT+TTIBUF ; Get the address of the buffer
	LOAD.	A1,BLKEND,(T1)	; And get the number of characters in it
	PJRST	VALRET		; Return the value

; Here to read some text

SPTY.1:	SETZM	XCTING		; Flag that REENTER should just get a command
	PUSHJ	P,@TY.IBY	; Input a character (with all processing)
	SOJG	A1,.-1		; Skip the characters we want to ignore
	MOVE	A1,CH		; Get the character typed
	PJRST	VALRET		; And return it

; Here to peek ahead some number of characters

SPTY.2:	SETZM	XCTING		; Flag REENTER should re-prompt
	MOVM	T1,A1		; Get the character number we want
	PUSHJ	P,T$PEKW	; Get it
	MOVE	A1,CH		; Get the character
	PJRST	VALRET		; And return it


; Here for timed input

SPTY.S:	SETZM	XCTING		; While we are waiting, allow REENTER to work
	$SAVE	<ICHINS>	; Save current input instruction
	MOVE	T1,[PUSHJ P,T$ICHS] ; Get the instruction to use
	MOVEM	T1,ICHINS	; Save it
	MOVE	T1,A2		; Get the time to wait
	MOVM	T2,A1		; And the number of characters to wait for
	PUSHJ	P,T$WAIT	; Wait for the correct condition
	 PJRST	RTONES		; Nothing there, return -1
	JRST	SPTY.0		; Characters are there, go get the correct one
	SUBTTL	Commands -- Extended ^T operations

;+
;.hl2 Extended "^T" commands
; If the "^T" command is preceded by a colon, it will do a TTCALL.
;The value returned by the TTCALL will be returned as the value
;for the command. If the TTCALL is one which takes an argument (i.e. OUTCHR)
;the first argument is used for the value fo the TTCALL, otherwise the
;command takes only one argument (the TTCALL number).
;-


; Tables for extended ^T command.
;	TABLE1 is the bit mask for which TTCALLs are legal.
;	TABLE2 is the bit mask for which TTCALLs may skip.
;	TABLE3 is the bit mask for which TTCALLs return values.
;
; Macro to help defining the masks

	DEFINE TT(TTCALL),<<<TTCALL>&IW.REG>_-<ALIGN.(IW.REG)>>

	BITMSK(TABLE1,,<<TT(INCHRW)>,<TT(OUTCHR)>,<TT(INCHRS)>,
		<TT(INCHWL)>,<TT(INCHSL)>,<TT(GETLCH)>,<TT(SETLCH)>,
		<TT(RESCAN)>,<TT(CLRBFI)>,<TT(CLRBFO)>,<TT(SKPINC)>,
		<TT(SKPINL)>,<TT(IONEOU)>>)
	BITMSK(TABLE2,,<<TT(INCHRS)>,<TT(INCHSL)>,<TT(SKPINC)>,<TT(SKPINL)>>)
	BITMSK(TABLE3,,<<TT(INCHRW)>,<TT(INCHRS)>,<TT(INCHWL)>,
		<TT(INCHSL)>,<TT(GETLCH)>,<TT(RESCAN)>>)
	BITMSK(TABLE4,,<<TT(INCHRW)>,<TT(OUTCHR)>,<TT(INCHRS)>,
		<TT(INCHWL)>,<TT(INCHSL)>,<TT(IONEOU)>>)

EXTTTY:	MOVN	T1,A1		; Get the TTCALL number
	JUMPG	T1,SETECH	; Go do the extended terminal processing
	MOVX	T2,1B0		; Get a bit
	LSH	T2,(T1)		; Shift to place in mask
	TXNN	T2,TABLE1	; Check if valid TTCALL
	 ERROR	E.ITT		; No, give the error (Illegal TTCALL)
	TXNE	T2,TABLE4	; Need to do output first?
	 TXNN	F,F.TYOF	; Need an output UUO?
	  JRST	.+2		; Skip
	PUSHJ	P,TTYOUT	; Do the output
	CAXN	A1,<TT(RESCAN)>	; Is it the rescan function?
	 JRST	EXTT.1		; Yes, go handle it
	MOVX	T1,<TTCALL 0,A2> ; Get the instruction
	STOR	A1,T1,IW.REG	; Store the index
	SETZM	XCTING		; Flag REENTER allowed while waiting
	XCT	T1		; Do the TTCALL
	 JRST	EXTT.2		; Didn't skip, go see what to do
	TXNN	T2,TABLE3	; Does the TTCALL return a value?
	 SETO	A2,		; No value, return minus one
	MOVE	A1,A2		; Get the value
	PJRST	VALRET		; And return the value

EXTT.2:	TXNE	T2,TABLE2	; Should it have skipped?
	 PJRST	RETZER		; No, return zero
	TXNN	T2,TABLE3	; Does it return a value?
	 POPJ	P,		; No, nothing to return
	MOVE	A1,A2		; Yes, get the value
	PJRST	VALRET		; And return it


EXTT.1:	MOVX	T1,<RESCAN 1>	; Get the instruction for a rescan
	TXZE	F,F.ARG2	; Two args means return the CCL flag value
	 MOVE	T1,[SKIPE CCLSW] ; Test the CCL entry value
	XCT	T1		; Do the instruction
	 PJRST	RTONES		; We have a command, return -1
	PJRST	RETZER		; Nothing there, return 0

SETECH:	CAXLE	T1,SETELN	; Is it legal?
	 ERROR	E.ITT		; No, punt it
	PJRST	@SETETB-1(T1)	; Set the echo correctly

SETETB:	EXP	T$CECH		; Clear echo
	EXP	T$SECH		; Set echo
	EXP	I$SIMG		; Set packed image mode
	EXP	I$CIMG		; Clear packed image mode
SETELN==.-SETETB

	SUBTTL	Commands -- "^H" - Return daytime in jiffies

;+
;.hl2 Return the daytime in jiffies ("^H")
; This routine will handle the "^H" command. It will return the value
;returned by the monitor from a TIMER UUO.
;-

GTIME:	TIMER	A1,		; Get the value
	PJRST	VALRET		; And return it

	SUBTTL	Commands -- "^F" - Read the console switches

;+
;.hl2 Read the console switches ("^F")
; This routine will return the value returned by the SWITCH UUO.
;-

LAT:	TXZE	F,F.ARG!F.ARG2	; If there is an argument
	 JRST	REDUDX		; Read the terminal universal device index
	SWITCH	A1,		; Read the switches
	JRST	VALRET		; Return the value

; Here for "n^F".  Return the UDX for the terminal for job n.

REDUDX:	TRMNO.	A1,		; Get the UDX
	 PJRST	RETZER		; Can't
	PJRST	VALRET		; Got it, return the value
	SUBTTL	Commands -- "^^" - Return the value of the next character

;+
;.hl2 Return the value of the next character ("^^")
; This routine will return the value of the next character in the command
;string. It will give an error if there are no more characters in the string.
;-

CNTRUP:	PUSHJ	P,SKRCH		; Get the next character
	 ERROR	E.MUU		; None, give the error
	MOVE	A1,CH		; Get the character in the right place
	JRST	VALRET		; And return it
	SUBTTL	Commands -- "\" - Read a number from the buffer

;+
;.hl2 Read a number from the buffer ("\" and "\\")
; This routine will return the value of the number which follows the pointer.
;The single backslash command reads this number in decimal, the double
;backslash reads it in octal.
;-

BAKSL:	PUSHJ	P,SKRCH		; Get the next character
	 JRST	BAKS.D		; None, assume decimal
	CAIN	CH,"\"		; Is it the second backslash?
	 JRST	BAKS.O		; Yes, read in octal
BAKS.D:	PUSHJ	P,REEAT		; Only single slash, back up the character
	SKIPA	P1,[EXP ^D10]	; And get the radix
BAKS.O:	 MOVEI	P1,^D8		; Get the radix
	TXZE	F,F.ARG		; Have an arg?
	 JRST	BAKS.1		; yes, go handle the number insertion
	SETZ	A1,		; Clear the value to return
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the address
	LOAD.	T2,BLKPT,(T1)	; Get the pointer location
	PUSHJ	P,SETINC	; Set up for GETINC
	 JRST	VALRET		; Return the zero
	PUSHJ	P,GETINC	; Get the first character
	 JRST	BAKS.3		; Go return the value
	CAIN	CH,"+"		; Is it a plus sign?
	 JRST	BAKS.0		; Ignore the plus
	CAIE	CH,"-"		; Is it a minus sign?
	 JRST	BAKS.2		; No sign
	TXO	F,F.ARG		; Flag we must negate the arg
BAKS.0:	PUSHJ	P,GETINC	; Get a character
	 JRST	BAKS.3		; None left, this is it
BAKS.2:	CAIGE	CH,"0"(P1)	; Is this a valid digit?
	 CAIGE	CH,"0"		;  .  .  .
	  JRST	BAKS.4		; Not a digit, go exit
	IMULI	A1,(P1)		; Bump what we already have
	ADDI	A1,-"0"(CH)	; And add the character
	JRST	BAKS.0		; Go for next character

BAKS.4:	DECR.	,BLKPT,(T1)	; Decrement the pointer
BAKS.3:	TXZE	F,F.ARG		; Did we see a minus sign?
	 MOVN	A1,A1		; Yes, make it negative
	PJRST	VALRET		; And return it
; Here if an argument was given. Convert the number to ascii
;and insert the text into the buffer.

BAKS.1:	MOVE	T1,A1		; Get the number
	SETZB	P2,P3		; And clear the digit count
	JUMPGE	T1,BAKS.5	; If positive just continue
	AOS	P2,P3		; Otherwise bump the flag
	MOVM	T1,T1		; And make the number positive

BAKS.5:	IDIVI	T1,(P1)		; Get a digit off
	PUSH	P,T2		; Stack the digit
	AOJ	P2,		; And count it
	JUMPN	T1,BAKS.5	; And loop for all of the digits

	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
	MOVE	T2,P2		; Get the number of characters
	LOAD.	T3,BLKPT,(T1)	; And where to put them
	PUSHJ	P,M$XPND	; Make room for the characters
	LOAD.	T2,BLKPT,(T1)	; Insert after the pointer
	PUSHJ	P,SETINC	;  .  .  .
	 STOPCD	BXS,<Backslash command expansion of buffer failed>
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the address back again
	LOAD.	T2,BLKPT,(T1)	; Get the current position
	MOVE	T3,T2		; And make the end of the modified section
	ADD	T3,P2		;  .  .  .
	PUSHJ	P,UPDBND	; Update the bounds
	JUMPE	P3,BAKS.6	; If it wasn't negative just continue
	MOVEI	CH,"-"		; Otherwise put the sign first
	PUSHJ	P,PUTINC	; Write it
	 JFCL			; Couldn't?
	SOJ	P2,		; And count the character
BAKS.6:	POP	P,CH		; Get a character
	ADDX	CH,"0"		; Convert the digit to ASCII
	PUSHJ	P,PUTINC	; Stuff in the character
	 JFCL			; Ignore it
	SOJG	P2,BAKS.6	; Loop for all the chars
	POPJ	P,		; And return when done

	SUBTTL	Commands -- "A" - Append or return value of character

;+
;.hl2 Return value of character in text buffer
; This routine will return the value of the specified character in the
;text buffer, unless no arguments are given, in which case it will append
;the next buffer to the current one. nA will return the nth character
;to the right of the pointer. 0A will return the character to the left
;of the pointer. -nA will return the n+1st character to the left of the pointer.
;If.+n-1 is not within the buffer 0 will be returned, unless
;two arguments are given, in which case the first argument will be
;returned as the value.
;-


ACMD:	TXNE	F,F.ARG		; No argument implies Append
	 TXNE	F,F.COLN	; Or is there a colon?
	  JRST	APPEND		; Yes, this is an append command
	MOVE	T1,A1		; Get the number of chars
	SETZB	A1,CH		; And set up for returning zero
				; Set up 0 for return value
	CHKEO	EODEC,ACMD2	; If EO = 2, do old-style 1A
	TXZE	F,F.ARG2	; Was there a 2nd arg?
	 MOVE	A1,A2		; Yes, use it instead
ACMD1:	SOS	T2,T1		; Get arg-1
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the address of the buffer
	LOAD.	T3,BLKPT,(T1)	; Get the pointer
	ADD	T2,T3		; And get the place we want to see
	JUMPL	T2,VALRET	; Just return value if negative
	CFMG.	,BLKEND,(T1),T2 ; Is it after Z?
	 JRST	VALRET		; Yes, return the value we have
	IDIVI	T2,5		; Convert to a byte pointer
	TDO	T2,BTAB(T3)	;  .  .  .
	ADDI	T2,.BKTLN(T1)	; And make it absolute
	LDB	A1,T2		; Get the character
	PJRST	VALRET		; And go return it

ACMD2:	MOVEI	T1,1		; IF EO < 3, make arg=1
	JRST	ACMD1		;
; Here for an append command ("A" or ":nA")
;If no argument just call YANK to read in another buffer load of input.
;If the argument is given, read in the number of lines specified by the
;argument.

APPEND:	TXNN	F,F.COLN	; Colon seen?
	 MOVX	A1,.INFIN	; No, use infinity
	MOVE	T2,A1		; Get the number to read
	JUMPG	T2,YANK.0	; And go read the data
	XMOVEI	T1,$QRTPT+TXTBUF ; Get the TPT address
	MOVX	T2,.INFIN	; Assume as many line feeds as necessary
	MOVX	T3,.INFIN	; And as many chars
	MOVN	T4,A1		; Get the the number of form feeds to read
	PJRST	F$RBUF		; Read a buffer
	SUBTTL	Commands -- Q-register -- "U" - Store numeric value

;+
;.hl2 Q-register commands
;.hl3 Store numeric value into the Q-register ("U")
; This command will store the argument into the Q-register. If two arguments
;are given the first argument is returned as the value.
;-

USE:	PUSHJ	P,QREGVI	; Get the Q-register index into T1
USE.0:	MOVE	P1,T1		; Get the address of the QRG
	TXNE	F,F.STR1	; First argument a string?
	 JRST	USE.1		; Yes, go handle it
	LOAD.	T1,QRGDTP,(P1)	; Get the datatype
	MOVX	T2,$DTNUM	; New value is numeric
	XCT	RQRGTB(T1)	; And release the previous item
	STOR.	A1,QRGVAL,(P1)	; Store the argument into the Q-register
USE.R:	TXZN	F,F.ARG2	; Is there another arg?
	 POPJ	P,		; No, just return
	MOVE	A1,A2		; Move the arg
	TXNN	F,F.STR2	; Second arg a string?
	 PJRST	VALRET		; And return
	LOAD.	A1,TPTADR,+SARG$2 ; Yes, get the address
	MOVE	T1,CPYAG2	; And the flag
	PJRST	STRRET		; And return

; Here if the argument is a string.  Replace the Q-register value
;with the string argument.

USE.1:	MOVE	T2,$QRFLG(T1)	; Get the flags
	TXNE	T2,QR$TXT	; Allowed to put text in here?
	 ERROR	E.VOQ		; No, value only
	LOAD.	T1,QRGDTP,(P1)	; Get the old data type
	MOVX	T2,$DTTXT	; And the new
	XCT	RQRGTB(T1)	; Release the previous value
	PUSHJ	P,GETAG1	; Get the address of the arg
	XMOVEI	T2,$QRTPT(P1)	; And the pointer
	PUSHJ	P,M$USEB	; Set up the pointer
	JRST	USE.R		; Return the other arg, if one
	SUBTTL	Commands -- Q-register -- "Q" - Fetch numeric value

;+
;.hl3 Fetch numeric value ("Q")
; This command will fetch the numeric value from a q-register.
;-

QREG:	PUSHJ	P,QTXTST	; Get the Q-register index and check if text
	 JRST	[MOVE	A1,T1		; Get the value
		PJRST	VALRET]		; And return it
	MOVE	A1,T1		; Get the buffer address
	MOVX	T1,.FALSE	; Flag there arg more pointers here
	PJRST	STRRET		; And return the string
	SUBTTL	Commands -- Q-register -- "%" - Increment the value

;+
;.hl3 Increment the value ("%")
; This command will increment the numeric value that is in the Q-register.
;It will return the new value of the Q-register.
;-

PCNT:	PUSHJ	P,QTXTST	; Get the Q-register index and check for text
	 JRST	.+2		; Skip
	  ERROR	E.NNQ		; Non-numeric Q-register
	LOAD	T4,$QRFLG(T2),QR$VLU ; Get the flag
	JMPT	T4,[ERROR E.TOQ] ; Text only ?
	TXNN	F,F.ARG		; Have an arg?
	 MOVEI	A1,1		; No, use a one
	ADDB	A1,$QRVAL(T2)	; Bump the value
	PJRST	VALRET		; And return the new value
	SUBTTL	Commands -- Q-register -- "X" - Insert text into Q-reg

;+
;.hl3 Insert text ("X")
; This command will copy the specified text into the Q-register. If
;two args are given they are the character positions for the text
;to be copied. If only one arg is given it is the number of lines
;before (if negative) or after (if negative) to copy.
;-


XCMD:	PUSHJ	P,GETARG	; Set up A1/A2 with character indices
	PUSHJ	P,QREGVI	; Get the Q-register index
	MOVE	T2,$QRFLG(T1)	; Get the flags
	TXNE	T2,QR$TXT	; Allowed to put text in here?
	 ERROR	E.VOQ		; No, value only
	MOVE	P1,T1		; Into a safer place
	LOAD.	T1,QRGDTP,(P1)	; Get the previous data type
	MOVX	T2,$DTTXT	; And the new data type
	XCT	RQRGTB(T2)	; And return the previous value
	MOVE	T1,A1		; Get the number of chars
	SUB	T1,A2		; We need
	PUSHJ	P,M$GTXT	; Get the buffer
	MOVE	P2,T1		; Get the address
	XMOVEI	T2,$QRTPT(P1)	; Set up to set the address
	PUSHJ	P,M$USEB	; And add the user
	MOVE	T1,A2		; Set up where to move from
	LOAD.	T3,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
	BLDBPT	(T1,(T3))	; Build the byte pinter
	MOVE	T2,A1		; Set up the count
	SUB	T2,A2		;  .  .  .
	MOVE	T3,P2		; And the buffer address
	ZERO.	,BLKPT,(T3)	; Insert from start of buffer
	ZERO.	T4,BLKCOL,(T3)	; Clear the current column
	XMOVEI	T4,$QRTPT+TXTBUF ; Get the pointer to the source
	PJRST	M$INSS		; Do it
	SUBTTL	Commands -- Q-register -- "G"
;+
;.hl3 Fetch text from Q-register ("G")
; This command will insert the text from the given Q-register into
;the text buffer after the pointer. The pointer will be positioned after
;the the newly inserted text.  The Q-register will not be modified.
;-

QGET:	PUSHJ	P,QTXTST	; Get the buffer address
	 ERROR	E.NTQ		; Give the error (no text in Q-register)
	XMOVEI	T4,$QRTPT(T2)	; Get the address of the pointer
	LOAD.	P1,TPTADR,+T1	; Get the buffer address
	XMOVEI	T1,.BKTLN(P1)	; Get the address of the text
	TXO	T1,<$POINT(7)>	; Get the byte pointer
	LOAD.	T2,BLKEND,(P1)	; Get the character count
	LOAD.	T3,TPTADR,+$QRTPT+TXTBUF ; And get the text buffer address
	PUSH	P,.BKPT(T3)	; Save the old PT
	PUSHJ	P,M$INSS	; Move the string
	LOAD.	T2,TPTADR,+$QRTPT+TXTBUF ; Get the address back
	STOR.	T1,BLKPT,(T2)	; Store the pointer back
	ZERO.	T3,BLKCOL,(T2)	; Clear the current column
	MOVE	T3,T1		; Get the end of mod address
	MOVE	T1,T2		; And the buffer address
	POP	P,T2		; And get back the start of mod address
	PJRST	UPDBND		; And go update the bounds
	SUBTTL	Commands -- Q-register -- "M" and "W"

;+
;.hl3 Q-register execution ("M" and "W")
; These commands cause the Q-register to be executed as commands. From
;command level M and W work the same, however, when executed in a macro
;M is a subroutine call, and W is a GOTO.
;-

MJRST:	SKIPE	EQM		; Here for W command, at command level?
	 JRST	QACCES		; Not at command level, do stack anything

MAC:	PUSHJ	P,QTXTST	; Get the buffer address and check for text
	 ERROR	E.NTQ		; No text in Q-reg

; Here from EP processing in TECECM.  At this point the Q-register has
; been read into core and is about to be executed.

MAC.0:	MOVE	P1,T2		; Save the address of the QRG block
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer
	CFMN.	T2,TPTADR,+$QRTPT(P1),T1 ; Is this what we are currently editing?
	 ERROR	E.XTI		; Yes, that is not allowed
	$ADJSP	XS,$XSMLN	; Allocate the space for the items
	STOR.	F,XSBFLG,(XS)	; Store the flags
	TXZ	F,F.COLN	; Clear the colon flag (:EI command)
	MOVE	T1,ERRPT	; Get the current error position
	STOR.	T1,XSBERA,(XS)	; Store it
	XMOVEI	T2,$XSBUF(XS)	; Get the address
	LOAD.	T1,TPTADR,+XCTBUF ; And the buffer address
IFN FTDEBUG,SETZM	(T2)	; Clear the pointer if debugging
	PUSHJ	P,M$USEB	; And add the user
	MOVX	T1,$XEMAC	; Get the block type
	STOR.	T1,XSBTYP,(XS)	; Store it
	AOS	EQM		; Bump the level we are at
	JRST	MAC.2		; And go store new stuff

QACCES:	PUSHJ	P,QTXTST	; See if text in buffer
	 ERROR	E.NTQ		; No text in Q-register
	MOVE	P1,T2		; Get the table index
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer
	CFMN.	T2,TPTADR,+$QRTPT(P1),T1 ; Is this what we are currently editing?
	 ERROR	E.XTI		; Yes, that is not allowed

MAC.2:	XMOVEI	T1,XCTBUF	; Unlink the old buffer
	PUSHJ	P,M$RELB	;  .  .  .
	XMOVEI	T2,XCTBUF	; And set up the new one
	LOAD.	T1,TPTADR,+$QRTPT(P1) ; And get the address of te new one
	PUSHJ	P,M$USEB	; Set up the new user
	LOAD.	T2,TPTADR,+XCTBUF ; Get the buffer address
	XMOVEI	T1,.BKTLN(T2)	; Get the address of the text
	TXO	T1,<$POINT(7)>	; And set up the byte pointer
	STOR.	T1,BLKPTR,(T2)	; Store the byte pointer
	ZERO.	,BLKPT,(T2)	; Clear the value of PT
	ZERO.	T1,BLKCOL,(T2)	; Clear current column
	PJRST	PASRET		; Pass the values through to the macro
	SUBTTL	Commands -- Q-register -- "]" - Pop Q-register


;+
;.hl3 Pop Q-register ("]")
; This command will pop a Q-register off of the Q-register stack. Note
;that the Q-register stack is cleared at the start of each complete
;command string (every time TECO prompts).
;-

CLOSEB:	PUSHJ	P,QREGVI	; Get the index
	MOVE	P1,T1		; Get the index into a safe place
	MOVE	P2,QRGSTK	; Get stack pointer
IFN FTXADR,CAMG	P2,[EXP PFL]	; Anything on the stack?
IFE FTXADR,CAIG	P2,PFL		; Anything on the stack?
	 ERROR	E.PDQ		; No, give the error
	LOAD.	T1,QRGDTP,(P1)	; Get the data type
	MOVE	T2,(P2)		; Get the new data type
	XCT	RQRGTB(T1)	; Release the previous data
	MOVE	T1,(P2)		; Get the old data type
	CAXE	T1,$DTNUM	; Numeric value?
	 JRST	CLSB.1		; No, try again
	MOVE	T1,-1(P2)	; Remove the value
	MOVEM	T1,$QRVAL(P1)	; Save it
	JRST	CLSB.2		; And remove the items from the stack

CLSB.1:	XMOVEI	T1,$QRTPT(P1)	; Get the pointer address
	SKIPE	(T1)		; Anything to free up?
	 PUSHJ	P,M$RELB	; Yes, release this use of it
	LOAD.	T1,TPTADR,-1(P2) ; Get the buffer address
	XMOVEI	T2,$QRTPT(P1)	; And the pointer address
	PUSHJ	P,M$USEB	; Yes, remember the new use
	XMOVEI	T1,-1(P2)	; And release
	PUSHJ	P,M$RELB	; The old use

CLSB.2:	SUBI	P2,2		; Remove the two items
	MOVEM	P2,QRGSTK	; And store the updated pointer
	POPJ	P,		; And return
	SUBTTL	Commands -- Q-register -- "[" - Push a Q-reg

;+
;.hl3 Push a Q-register ("[")
; This command will save the value of a Q-register on the stack.
;It saves both the numeric part and the text part of the Q-register.
;If this command is preceded by arguments it will push the Q-register
;and then act like a "U" command.  Note that values stored on the stack
;are cleared every time we prompt, therefore the PUSH/POP sequence must
;be within the same command.
;-

OPENB:	PUSHJ	P,QREGVI
	MOVE	P1,T1		; Get the value
	MOVE	P2,QRGSTK	; Get the current stack pointer for the Q-reg stack
IFN FTXADR,CAML	P2,[EXP PFL+LPF] ; At the end of the stack?
IFE FTXADR,CAIL	P2,PFL+LPF	; At the end?
	 ERROR	E.PDQ		; Yes, can't stack any more items
	ADDI	P2,2		; Make room for the value and the data type
	SETZM	-1(P2)		; Clear the text pointer word
	LOAD.	T1,QRGDTP,(P1)	; Get the data type of the Q-register
	MOVEM	T1,(P2)		; Save the data type
	CAXN	T1,$DTNUM	; Numeric value?
	 JRST	OPEN.1		; Yes, skip this
	XMOVEI	T2,-1(P2)	; Yes, get the address of the new pointer
	LOAD.	T1,TPTADR,+$QRTPT(P1) ; And the buffer address
	PUSHJ	P,M$USEB	; And add this user of the block
	JRST	OPEN.2		; And go store the new pointer

OPEN.1:	LOAD.	T1,QRGVAL,(P1)	; Get the value
	MOVEM	T1,-1(P2)	; Save it
OPEN.2:	MOVEM	P2,QRGSTK	; Store the pointer back
	TXNN	F,F.ARG		; Have any args?
	 POPJ	P,		; No, return
	MOVE	T1,P1		; Get the index back
	PJRST	USE.0		; And go handle the args
	SUBTTL	Commands -- Q-register -- Utility routines -- RQRGTB

;+
;.hl3 Utility routines
;.hl4 RQRGTB
; This set of routines is used to release the previous contents of a
;Q-register when a new item is to be stored into it.
;.lit
;
; Usage:
;	P1/ QRG address
;	T1/ QRGDTP (data type)
;	T2/ New data type
;	XCT	RQRGTB(T1)
;	 (return here, value can now be stored)
;
;.end lit
;-


; Table of instructions to release the previous contents of the Q-reg.

TABDEF	RQRG,$DT
 TABENT	TXT,<PUSHJ P,RQRGTX>	; For a text buffer
 TABENT	FCT,<PUSHJ P,RQRGFC>	; For an FC table
 TABENT	NUM,<PUSHJ P,RQRGNM>	; For a numeric value
TABEND

; Table of to check if new value is allowed.

TABDEF	NQRG,$DT
 TABENT	TXT,<IFIW NQRGTX>	; For text
 TABENT	FCT,<IFIW NQRGFC>	; For an FC table
 TABENT	NUM,<IFIW NQRGNM>	; For a numeric value
TABEND

; Here for numeric values

RQRGNM:	PUSHJ	P,@NQRGTB(T2)	; Check if new value is allowed
	STOR.	T2,QRGDTP,(P1)	; Store the new type
	ZERO.	,QRGPDB,(P1)	; And clear the previous buffer field
	POPJ	P,		; And return

; To check for the new numeric value

NQRGNM:	LOAD	T3,$QRFLG(P1),QR$VLU ; Get the flag
	JMPF	T3,.POPJ	; Just return if allowed
	ERROR	E.TOQ		; Text only Q-reg

; Here for text values

RQRGTX:	PUSHJ	P,@NQRGTB(T2)	; Check if new value is allowed
	CAXN	T2,$DTTXT	; New value also text?
	 JRST	RQTX.1		; Yes, don't bother with PDB field
	PUSH	P,T2		; Save the new type
	XMOVEI	T1,$QRPDB(P1)	; Get the previous buffer field
	SKIPE	(T1)		; Anything there?
	 PUSHJ	P,M$RELB	; Yes, release it
	ZERO.	,QRGPDB,(P1)	; Clear out the previous buffer pointer field
	POP	P,T2		; Restore the new type
RQTX.1:	STOR.	T2,QRGDTP,(P1)	; Store the new data type
	XMOVEI	T1,$QRTPT(P1)	; Get the TPT address
	SKIPE	(T1)		; Already zero?
	 PUSHJ	P,M$RELB	; No, clear it
	POPJ	P,		; And return

; Here to check if text value is allowed

NQRGTX:	LOAD	T3,$QRFLG(P1),QR$TXT ; See if text allowed
	JMPF	T3,.POPJ	; Yes, just return
	ERROR	E.VOQ		; No, complain


; Here for an FC table

RQRGFC:	PUSHJ	P,@NQRGTB(T2)	; Check the new value
	JRST	RQTX.1		; And go return the old FC table

; Here to check if FC table is allowed

NQRGFC:	LOAD	T3,$QRFLG(P1),QR$FCT ; Allowed to store this here?
	JMPF	T3,.POPJ	; No, don't allow this
	ERROR	E.TOQ		; Assume it is text only
	POPJ	P,		; For now allow all QRG's
	SUBTTL	Commands -- Q-register -- Utility routines -- QREGVI

;+
;.HL4 QREGVI
; This routine will return a Q register index.  There is an alternate
;entry point at QREGV2, which expect the character in CH.
;.b.literal
; Usage:
;	PUSHJ	P,QREGVI
;	(Return index in T1)
;
; or
;
;	MOVEI	CH,Character
;	PUSHJ	P,QREGV2
;	(Return index in T1)
;.end literal
;-

QREGVI:	SETZ	T1,		; No default
	PUSHJ	P,SCNQRG	; Get the Q-register name
	 JRST	QREG.0		; Couldn't, must be old style
	LOAD	T2,$QRFLG(T1),QR$WRT ; See if we can read/write it
	CAME	T1,CUREDT	; Current editing buffer?
	 JMPF	T2,.POPJ	; Yes, just return then
	ERROR	E.DOQ		; No, Display only Q-register

QREG.0:	PUSHJ	P,SKRCH		; Get the Q-register name from the command string
	 ERROR	E.MIQ		; Missing Q-reg name

QREGV2:	MOVE	T1,CHRFLG(CH)	; Get the flags
	TXNN	T1,CF.QRG	; Valid Q-register name?
	 ERROR	E.IQN		; No give up
	LOAD.	T1,CDTQRI,+T1	; Get the Q-register index
	IMULX	T1,$QRLEN	; Make the offset
	ADDI	T1,QTAB		; And make it the base address
	MOVEM	T1,LASQRG	; Save the last Q-reg used
	CAME	T1,CUREDT	; Same as current editing buffer?
	 POPJ	P,		; And return it
	ERROR	E.DOQ		; No, punt
	SUBTTL	Commands -- Q-register -- Utility routines -- SCNQRG

;+
;.HL4 SCNQRG
; This routine will scan off a Q-register name and return the index.
;The format of the Q-register name is "(Q-register name)".
;.b.literal
; Usage:
;	MOVEI	T1,"default Q-register name"
;	PUSHJ	P,SCNQRG
;	 (Failed)
;	(good return, T1= QRG block)
;
;.end lit
;-

SCNQRG: XMOVEI	T2,SKRCH	; Get the routine to call to get the chars
	XMOVEI	T3,REEAT	; Routine to re-eat characters
	XMOVEI	T4,XCTBUF	; Get the default pointer address
REDQRG:	$SAVE	<P1,P2,P3,S,F>	; Save P1 and P2
	TXNE	S,S.NTRC	; Tracing suppressed?
	 TXZ	F,F.TRAC	; Yes, turn it off
	SETZM	LASQRG		; Clear the last Q-reg
	DMOVE	P1,T2		; Save the routine address
	MOVE	P3,T4		; Get the TPT address
	PUSH	P,T1		; Save the default
	XMOVEI	T1,QRNTPT	; Get the TPT address
	SKIPE	(T1)		; Anything there?
	 PUSHJ	P,M$RELB	; Yes, release it
	SETZM	QRNTPT		; Clear it out
	POP	P,T1		; Get the default back
	PUSHJ	P,(P1)		; Get what should be a paren
	 ERROR	E.IQN		; Give the error (Illegal Q-register name)
	CAXE	CH,"("		; Is it an open paren?
	 JRST	SCNQ.0		; No, not a Q-register name
	LOAD.	T2,TPTADR,(P3)	; Get the text buffer address
	LOAD.	T3,BLKPTR,(T2)	; Get the byte pointer
	LOAD.	T4,BLKPT,(T2)	; Get the current pointer
	TXO	S,S.NTRC	; Turn off tracing for a moment
	PUSHJ	P,(P1)		; Get the Q-register name
	 ERROR	E.IQN		; No good
	MOVE	T1,CH		; Get the character
	PUSHJ	P,(P1)		; And get the close paren
	 JRST	[MOVE	CH,T1		; Reset the character
		TXZ	S,S.NTRC	; Turn tracing back on (maybe)
		TXNE	F,F.TRAC	; Are we tracing?
		 PUSHJ	P,T$OCHR	; Yes, type the character
		 ERROR	E.MRP]		; Missing right paren
	TXZ	S,S.NTRC	; Clear the trace suppression
	CAXE	T1,$CHQOT	; Quoting character?
	 CAXE	CH,")"		; Is it really one?
	  JRST	.+2		; Not a short name
	   JRST	SCNQ.1		; It is, short old-style q-register
	CHKEO	EO200,SCNQ.2	; If all chars allowed in Q-reg names, go get the name

; Here to scan off the long name.  We will build it into a BLK doing
;the necessary conversions.  The name will be converted to upper case only,
;and the ^Gi construct will be allowed.
;Note that it will not allow nesting of long Q-register names.
;The argument for the ^G must be a single character Q-reg name.

	STOR.	T3,BLKPTR,(T2)	; Reset the position so we scan from the
	STOR.	T4,BLKPT,(T2)	; start of the name.

	MOVX	T1,^D15		; Get a reasonable size for a name
	PUSHJ	P,M$GTXT	; And get the text block
	XMOVEI	T2,QRNTPT	; Get the address of the pointer
	PUSHJ	P,M$USEB	; Set up the pointer
	SETZM	QRNQRG		; Flag not nested yet
	PUSH	P,S		; Save the secondary flags
	TXZ	S,S.NCCT!S.CTLV!S.CTLW!S.CTVV ; Flag no control-T seen yet
	TXO	S,S.CTWW	; Flag we really want upper case

SCNLQN:	PUSHJ	P,(P1)		; Get a character
	 ERROR	E.MRP		; Nothing there?
	CAXN	CH,")"		; End of the name?
	 SKIPE	QRNQRG		; Yes, in a nested Q-reg?
	  JRST	.+2		; Not end of name
	   JRST	SLQN.E		; End of name
	XMOVEI	T1,SLQTB1	; Get the table address
	TXNE	S,S.NCCT	; Control-T seen?
	 XMOVEI	T1,SLQTB2	; Yes, get the other table pointer
	PUSHJ	P,NDISPT	; Dispatch on the character
	PUSHJ	P,CASE.0	; Do proper casing
	PUSHJ	P,CKNCC		; Check if legal control-character
	XMOVEI	T1,QRNTPT	; Get the address of the TPT
	PUSHJ	P,M$ACHR	; And add the character in
	JRST	SCNLQN		; Get the next character

; Dispatch tables

SLQTB1:	XWD	SLQN.G,.CHBEL	; ^G
	XWD	SLQN.V,.CHCNA	; ^A
	XWD	SLQN.W,.CHCNB	; ^B
	XWD	SLQN.V,.CHCNV	; ^V
	XWD	SLQN.W,.CHCNW	; ^W
SLQTB2:	XWD	SLQN.T,.CHCNT	; ^T
	XWD	SLQN.R,$CHQOT	; Quoting character
	XWD	0,0		; End of table

; Here on a control-T.  Complement the flag

SLQN.T:	TXC	S,S.NCCT	; Change whether control chars are allowed
	JRST	SCNLQN		; And try again

; Here on a control-R. Take the next character literally

SLQN.R:	PUSHJ	P,(P1)		; Get a character
	 ERROR	E.MRP		; Punt
	XMOVEI	T1,QRNTPT	; Get the TPT address
	PUSHJ	P,M$ACHR	; Append the character
	JRST	SCNLQN		; And get the next character

; Here on an ^W (^A)

SLQN.W:	PUSHJ	P,C.W		; Use common routine
	JRST	SCNLQN		; And get next character

; Here on an ^V (^B)

SLQN.V:	PUSHJ	P,C.V		; Play with the flags
	JRST	SCNLQN		; And try again

; Here on a ^G.  The next character should be a single character Q-reg
;name.

SLQN.G:	PUSHJ	P,(P1)		; Get the next character
	 ERROR	E.IQN		; None there, punt
	PUSHJ	P,QREGV2	; Get the QRG address
	PUSHJ	P,QTXTEI	; And make sure it has text
	PUSH	P,P1		; Save the get-a-char address
	PUSH	P,QRNQRG	; Save the nested address
	MOVEM	T2,QRNQRG	; Save the QRG address
	SETZ	T2,		; Set up to fetch the first character
	PUSHJ	P,SETINC	;  .  .  .
	 JFCL			; First GETINC call will fail
	XMOVEI	P1,SLQN.H	; Get the routine to fetch characters
	JRST	SCNLQN		; And try again

; Routine to fetch characters from the Q-reg for ^Gi

SLQN.H:	MOVE	T1,QRNQRG	; Get the QRG address
	LOAD.	T1,TPTADR,+$QRTPT(T1) ; And get the BLK address
	PUSHJ	P,GETINC	; Get a character
	 JRST	SLQN.I		; All done, get out
	PJRST	.POPJ1		; Give the good return

SLQN.I:	POP	P,CH		; Get the return address
	POP	P,QRNQRG	; Get the previous QRG address
	POP	P,P1		; And the previous routine
	PUSH	P,CH		; Stuff the return address back
	PJRST	(P1)		; And try again

; Here when we have found a close paren ")".  If we are in a ^Gi at
;all, complain.  If not, set things up for the common code to do the
;lookup.  Also, check for the case of a single character name showing up here.

SLQN.E:	TXZ	S,S.NCCT!S.CTLV!S.CTVV!S.CTLW!S.CTWW ; Clear the control-T flag
	POP	P,T2		; Restore T2
	TXNE	T2,S.CTLV	; Control V inforce?
	 TXO	S,S.CTLV	; Yes, turn it back on
	TXNE	T2,S.CTLW	; Control W inforce?
	 TXO	S,S.CTLW	; Yes, turn it back on
	TXNE	T2,S.CTWW	; ^W^W?
	 TXO	S,S.CTWW	; Yes, turn that on too
	TXNE	T2,S.CTVV	; ^V^V?
	 TXO	S,S.CTVV	; Yes, turn that on too
	SKIPE	QRNQRG		; At top level?
	 ERROR	E.IQN		; No, punt
	LOAD.	T2,TPTADR,+QRNTPT ; Get the address of the text
	XMOVEI	T3,.BKTLN(T2)	; Get the address of the text
	TXO	T3,<$POINT(7)>	; And set up the byte pointer
	LOAD.	T4,BLKEND,(T2)	; Get the length
	XMOVEI	P3,QRNTPT	; And the address of the pointer
	CAXE	T4,1		; Only a single character name?
	 JRST	SCNQ.9		; No, go do the lookup
	ILDB	CH,T3		; Yes, get the character
	XMOVEI	T1,QRNTPT	; Get the TPT address
	PUSHJ	P,M$RELB	; Release the buffer
	MOVE	T1,CH		; Get the character
	JRST	SCNQ.3		; And go check if valid Q-reg
; Here for original long names.  All characters except ")" are allowed,
;and no conversion to upper case is done.
;Enters with T2/ BLK address, T3/ Byte pointer to start, T4/ PT to start

SCNQ.2:	TXNN	F,F.TRAC	; Tracing enabled?
	 JRST	SCNQ.6		; No, skip this
	EXCH	CH,T1		; Yes, get the first character
	PUSHJ	P,T$OCHR	; Print it
	EXCH	CH,T1		; Get the second character
	PUSHJ	P,T$OCHR	; and type it out

SCNQ.6:	PUSHJ	P,(P1)		; Get the next character
	  ERROR	E.MRP		; ++ Missing right paren
	CAXE	CH,")"		; Is it the closing paren ?
	 JRST	SCNQ.6		; No, Try again
	LOAD.	T1,BLKPT,(T2)	; Get the current pointer
	SUBM	T1,T4		; Compute the length of the name
	SOS	T4		; Decrement by one more to account for the )
SCNQ.9:	$SAVE	<P4>		; Save a few registers
	DMOVE	P1,T3		; Move the length and the byte pointer

	MOVE	T1,[XWD -QNMLEN,QNMTBL] ; Get the pointer to the table
	DMOVE	T2,P1		; Copy the items
	PUSHJ	P,FNDSTR	; Find the string
	 JRST	SCNQ.4		; Failed - Process it via symbol table
	DMOVE	T1,2(T1)	; Get the address and the flags
	MOVEM	T1,LASQRG	; Save the address of the last Q-reg
	IORM	T2,$QRFLG(T1)	; Turn on the bits
	JRST	.POPJ1		; Give a good return

; Here if we have to call the symbol table management for the Q-register
; name.

SCNQ.4:	LOAD.	T1,TPTADR,(P3)	; Get the text buffer address
	LOAD.	T2,BLKPT,(T1)	; Get the address of the current PT
	SUBI	T2,1(P2)	; Remove the length
	CAIN	P3,QRNTPT	; Is this a new type name?
	 AOJ	T2,		; Yes, don't count the paren
	MOVE	T3,P2		; Get the length of the symbol
	PUSHJ	P,S$QREG	; Call the symbol table management for it
	 JRST	SCNQ.5		; Already defined, return the QRG block
	STKTPT	(T1,STETPT)	; Set up the pointer to the symbol
	MOVX	T1,$QRLEN	; Get the length of a QRG block
	MOVX	T2,.BTGEN	; Allocate it from general storage
	PUSHJ	P,M$ZBLK	; Allocate a zero block
	LOAD.	P4,TPTADR,+STETPT ; Get the address of the block
	STOR.	T1,SYMQRG,(P4)	; Store the address of the QRG block
	MOVEM	T1,LASQRG	; Save the last QRG seen
	EXCH	P4,T1		; Get the address of the STE
	XMOVEI	T2,$QRQRN(P4)	; And set up the pointer
	PUSHJ	P,M$USEB	;  .  .  .
	EXCH	T1,P4		; Switch things back
	BITON	T2,QR$LQR,$QRFLG(T1) ; Flag this is a user long name
	SKIPE	QRNTPT		; Have a TPT to return?
	 JRST	SCNQ.8		; Yes, go do it
	PJRST	.POPJ1		; Return to the caller

; Here if the Q-register was defined before

SCNQ.5:	LOAD.	T1,SYMQRG,(T1)	; Get the QRG block address
	MOVEM	T1,LASQRG	; Save the Q-register name
	SKIPN	QRNTPT		; Have something to return?
	 PJRST	.POPJ1		; Return to the caller
SCNQ.8:	PUSH	P,T1		; Yes, save T1
	XMOVEI	T1,QRNTPT	; Get the address
	PUSHJ	P,M$RELB	; Release the BLK
	SETZM	QRNTPT		; Flag nothing there now
	POP	P,T1		; Restore T1
	PJRST	.POPJ1		; And return


; Here the old style Q-register names

SCNQ.0:	PUSHJ	P,(P2)		; Call the routine to reeat the character
	JUMPE	T1,.POPJ	; If no Q-register name give up
	JRST	SCNQ.3		; Go find the QRG block for this character

SCNQ.1:	TXNN	F,F.TRAC	; Tracing enabled?
	 JRST	SCNQ.3		; No, skip this
	MOVE	CH,T1		; Get the character back
	PUSHJ	P,T$OCHR	; Print the trace character
	MOVX	CH,")"		; Get the close paren
	PUSHJ	P,T$OCHR	; And output it


SCNQ.3:	MOVE	CH,T1		; Get the character
	AOS	(P)		; Give the good return
	MOVE	T1,CHRFLG(CH)	; Get the flags
	TXNN	T1,CF.QRG	; Valid Q-reg name?
	 ERROR	E.IQN		; No, punt
	LOAD.	T1,CDTQRI,+T1	; Get the index
	IMULX	T1,$QRLEN	; Get the offset
	ADDI	T1,QTAB		; Point to the QRG
	MOVEM	T1,LASQRG	; Save the last Q-reg name
	POPJ	P,		; And return

; Table of special Q-register names

	SYN	QRGNAM,	STRTBL

DEFINE	STRSUB	(ADR,FLG),<
	EXP	ADR
	EXP	QR$PRD!FLG
>
	DOSTR	(QNM)		; Build the names
	SUBTTL	Commands -- Q-register -- Utility routines -- QTXTEI

;+
;.HL4 QTXTEI
; This routine will check to see if the specified Q-register contains text or
;a numeric value.  If it contains a value it will give an error message (NTQ).
;Otherwise it will return the address of the text block.
;.literal
;
; Usage:
;	PUSHJ	P,QREGV2 	; (or QREGVI)
;	PUSHJ	P,QTXTEI
;	(Return -- T1 contains the text block address)
;.end literal
;-

QTXTEI:	MOVE	T2,T1		; Copy the index
	LOAD.	T1,QRGDTP,(T2)	; Get the data type
	CAXE	T1,$DTTXT	; Is it a text Q-reg?
	 ERROR	E.NTQ		; No, no text here
	LOAD.	T1,TPTADR,+$QRTPT(T2) ; Is there any text ?
	POPJ	P,		; Yes - Just return
	SUBTTL	Commands -- Q-register -- Utility routines -- QTXTST

;+
;.hl4 QTXTST
; This routine will set up the Q-register index and return the value of the
;Q-register. If the Q-register contains text, the value will be the address
;of the text block, otherwise it will be the numeric value from the Q-reg.
;A skip return will be given if the Q-reg contains text.
;.b
;.literal
; Usage:
;	PUSHJ	P,QTXTST
;	 (Q-reg contains number, value in T1, index in T2)
;	(Q-reg contains text, address in T1, index in T2)
;
;.end literal
;-

QTXTST:	PUSHJ	P,QREGVI	; Get the index into T1
	MOVE	T2,T1		; Get the index
	LOAD.	T1,QRGDTP,(T2)	; Get the data type
	CAXN	T1,$DTFCT	; Is this an FC table?
	 ERROR	E.NTQ		; Yes, punt
	CAXE	T1,$DTTXT	; Text?
	 JRST	QTXT.1		; No, must be numeric
	LOAD.	T1,TPTADR,+$QRTPT(T2) ; Get the address of the text
	PJRST	.POPJ1		; And give the text return

QTXT.1:	MOVE	T1,$QRVAL(T2)	; Get the number
	POPJ	P,		; And return it
	SUBTTL	Commands -- "^U" - Set next block to read

;+
;.hl2 Set next block to read ("^U")
; This command will set the next block to be read from an input file.
;This command is only legal on a file which is open only for input
;(i.e., ER command or EB/READ command).
;-


IUSET:	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the block address
	PUSHJ	P,GETFDI	; Get the FDB address
	 ERROR	E.NFI		; No file for input
	MOVE	T2,.FDFLG(T1)	; Get the flags
	TXNE	T2,FD.OPN	; Is this open
	 TXNN	T2,FD.IN	; Open for input?
	  ERROR E.NFI		; No file for input
	TXNN	T2,FD.TMP	; Is it a TMPCOR file?
	 TXNE	T2,FD.EB	; Or open for EB?
USTERR:	  ERROR	E.UST		; Yes, give the USETI illegal message
	JUMPLE	A1,USTERR	; Give the error if block is not positive
	MOVE	T2,A1		; Get the arg
	PUSHJ	P,F$USET	; Set up the block
	 PJRST	F$ERR		; Go handle the error
	POPJ	P,		; and return
	SUBTTL	Commands -- "^G" - GETTAB or EXIT

;+
;.hl2 GETTAB or EXIT ("^G")
; This command will return the value of the given GETTAB table entry.
;If no arguments arg given it will return the user's job number.
;If only one argument is given it will return the result of a PEEK
;on the address given as the argument (don't ask me why).
;If the EO level is set to EO21 or less, it will do the old function of
;exiting.
;-

BELDMP:	CHKEO	EO21,DECDMP	; Old exit command if EO level set back
	TXNE	F,F.ARG		; If no arg then return the job number
	 JRST	BELD.1		; Have an arg, go do the gettab
	PJOB	A1,		; Get our job number
	PJRST	VALRET		; And return it

BELD.1:	TXZN	F,F.ARG2	; Give two args?
	 JRST	BELD.2		; No, he wants a PEEK
	HRL	A1,A2		; Get the table index
	GETTAB	A1,		; Get the value
	 SETZ	A1,		; Return a zero if not there
	PJRST	VALRET		; Go return it


BELD.2:	PEEK	A1,		; Get the value
	PJRST	VALRET		; And return it
	SUBTTL	Commands -- "^V" and "^W" - Lower and upper case flags

;+
;.hl2 Lower and upper case conversion ("^V" and "^W")
; These commands control whether case conversion should be done, and
;what should be converted to what. "^V" with no args will cause all
;upper case to be converted to lower case.  "^W" with no args will
;cause lower case to be converted to upper case.  If either is
;given the argument of zero, it will clear all case conversion.
;-

; "^V" command

LOWCAS:	TXNE	F,F.ARG		; Did we have an arg?
	 JUMPE	A1,CLRCAS	; Yes, if it was 0 clear both flags
	TXZ	S,S.UCAS	; Otherwise clear lower to upper
	TXO	S,S.LCAS	; And set upper to lower
	POPJ	P,		; And return

; "^W" command

STDCAS:	TXNE	F,F.ARG		; Did we have an argument?
	 JUMPE	A1,CLRCAS	; Yes, if it was 0 clear case conversion
	TXZ	S,S.LCAS	; Else clear upper to lower
	TXO	S,S.UCAS	; And set lower to upper
	POPJ	P,		; Return

; Here for both "0^V" and "0^W"

CLRCAS:	TXZ	S,S.LCAS+S.UCAS	; Clear all case converion
	POPJ	P,		; And return
	SUBTTL	Commands -- "^X" - Set or clear exact match

;+
;.hl2 Set or clear exact match flag (^X)
; This command is used to determine whether the case of a letter is
;to matter in a search. "0^X" will make upper and lower case considered
;the same during a search. "n^X" (n not 0) will make upper and
;lower case be considered different during searches. The command
;with no argument will return the value of the flag, 0 if casing
;is not considered, and -1 if casing is considered different.
;-

SETMCH:	TXNE	F,F.ARG		; Did we have an arg?
	 JRST	SETM.1		; Yes, set or clear the flag
	TXNE	F,F.PMAT	; No, is the flag on?
	 JRST	RTONES		; Yes, return -1
	JRST	RETZER		; No, return 0

SETM.1:	TXZ	F,F.PMAT	; Assume arg is zero
	JUMPE	A1,.POPJ	; If zero just return
	TXO	F,F.PMAT	; Else set the flag
	POPJ	P,		; And return
	SUBTTL	Commands -- "Y" ("EY") - Render the buffer empty

;+
;.hl2 Yank in a new buffer ("Y" or "EY")
; This command will input a new text buffer without writing out
;the current buffer. This command must be typed as "EY" from
;command level, unless the EO level is set to EODEC or less. This
;is prevent an accidental "Y" command.
;This routine will first clear the current buffer. It will then read
;into the buffer until a form feed is read, the end of file
;is encountered, the buffer is within one third or 128 characters
;of being full, and a line feed is read, or the buffer is completely
;full.
;-

YANKER:	CHKEO	EODEC,YANK	; Y is OK if EO level is 2 or less
	SKIPN	EQM		; "Y" is illegal from TTY
	 ERROR	E.UEY		; Give use "EY" message instead

YANK:	LOAD.	P1,TPTADR,+$QRTPT+TXTBUF ; Get the address of the text buffer
	ZERO.	,BLKPT,(P1)	; And clear it
	ZERO.	T1,BLKCOL,(P1)	; Clear current column
	LOAD.	T1,BLKEND,(P1)	; Get the number in the buffer
	ZERO.	,BLKEND,(P1)	; Of all characters
	LOAD.	T2,BLKFRE,(P1)	; Get the number free
	ADD	T1,T2		; Compute the new number free
	STOR.	T1,BLKFRE,(P1)	; Store it
	MOVX	T2,.INFIN	; Get the number of line feeds

; Here to read more into the buffer. The buffer will be expanded and the characters
;read until one of the above conditions terminates the read.

YANK.0:	PUSH	P,T2		; Save the number of lines to read
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
	LOAD.	T2,BLKEND,(T1)	; Get the current end
	MOVX	T3,.INFIN	; Last modified loc
	PUSHJ	P,UPDBND	; Update the bounds
	XMOVEI	T1,$QRTPT+TXTBUF ; Get the buffer address
	POP	P,T2		; Get the number of line feeds back
	MOVX	T3,D.TXTS	; Get the amount to expand the buffer
	MOVX	T4,0		; And the number of form feeds
	PJRST	F$RBUF		; Just read it in
SUBTTL	Commands -- ^Y and ^P - quick page scan commands

;+
;.hl2 Quick page scan commands ("^Y" and "^P")
; These commands are used to scan ahead for a given page number in the
;file. When given with no argument they return the current page number
;in the file. Control-Y will cause the new page to be read discarding
;the current buffer and all data between that buffer and the given page.
;-

QYANK:	TXO	S,S.YANK	; Note control-Y command
QPAGE:	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
	PUSHJ	P,GETFDI	; And get the FDB address
	 JRST	[TXNE	F,F.ARG		; No open file
		 ERROR	E.NFI		; No file for input
		PJRST	RETZER]		; Just wanted page number, return 0
	MOVE	P1,T1		; Get a safe copy of the FDB address
	TXNE	F,F.ARG		; Just return a value?
	 JRST	QPAG.1		; No, go read the page.
	LOAD.	A1,FDBFFC,(P1)	; Yes, get the page number
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address again
	MOVX	T2,TF.FFD	; Check if we had a form feed
	TDNE	T2,.BKTFL(T1)	;  .  .  .
	 SOJ	A1,		; Have a form feed at the end, don't count that one
	PJRST	VALRET		; And return it

; Here if the user gave an argument

QPAG.1:	TXNE	S,S.YANK	; Doing an^Y?
	 JRST	QPAG.0		; Yes, don't need output
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address again
	PUSHJ	P,GETFDO	; Get the output FDB
	 ERROR	E.NFO		; No file for output
	MOVE	P2,T1		; Save for later
QPAG.0:	LOAD.	T2,FDBFFC,(P1)	; Get the page number
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address back
	MOVX	T3,TF.FFD	; Form feed at end
	TDNE	T3,.BKTFL(T1)	;  ?
	 SOJ	T2,		; Real page number is minus one
	CAMLE	T2,A1		; Past the right page?
	 ERROR	E.IPA		; Yes, give up
	CAMN	T2,A1		; At the correct page already?
	 POPJ	P,		; Yes, just return
	LOAD.	T2,FDBFFC,(P1)	; Get the page number
	JUMPN	T2,QPAG.6	; Is it zero?
	INCR.	T2,FDBFFC,(P1)	; Yes, bump it
QPAG.6:	MOVX	T2,FD.EOF	; Check for eof
	TDNE	T2,.FDFLG(P1)	;  .  .  .
	 ERROR	E.PTL		; At eof, page number is too large
	TXO	F,F.NSRH	; Flag no free form feeds
	TXNN	S,S.YANK	; Doing an ^Y?
	 PUSHJ	P,WRTBUF	; No, write the buffer
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address again
	MOVX	T2,TF.FFD	; Get the form feed flag
	TDNE	T2,.BKTFL(T1)	; Page end with a from feed?
	 JRST	QPAG.7		; Go check if correct page yet

QPAG.2:	MOVE	T1,P1		; Get the address again
	PUSHJ	P,F$READ	; Get a character
	 PJRST	QPAG.4		; Go check if EOF
	TXNE	S,S.YANK	; Need to write it?
	 JRST	QPAG.3		; No, skip it
	MOVE	T1,P2		; Get the output FDB
	PUSHJ	P,F$WRIT	; Yes, write the character
	 PJRST	F$ERR		; Give up

QPAG.3:	CAXE	CH,.CHFFD	; Form feed?
	 JRST	QPAG.2		; No, try again
QPAG.7:	CFMGE.	T1,FDBFFC,(P1),A1 ; Right page yet?
	 JRST	QPAG.2		; No, try again
	PJRST	YANK		; Yes, go read in the buffer and return

QPAG.4:	CAXE	T1,$FEEOF	; End of file?
	 PJRST	F$ERR		; No, give up
	ERROR	E.PTL		; Yes, give the error message
	SUBTTL	Commands -- "I" -- Insert

;+
;.hl2 Insert ("I" or tab)
; This command will insert the text which follows it into the text buffer.
;The tab command will insert the text preceded by a tab. If the "I"
;command is preceded by an argument, the character with the value of the
;argument is inserted into the buffer.  If the command is preceded by
;an atsign ("@") the end of the text will be signified by an occurance
;of the first character seen after the "I", otherwise the string is
;terminated by the first non-quoted altmode.
;The pointer is left after the newly inserted string.
;-

TAB:	PUSHJ	P,TAB2		; Insert the tab

INSERT:	TXNE	F,F.ARG		; Is there an argument?
	 JRST	INS1A		; Yes, go handle that form
	MOVX	CH,.CHESC	; Get the normal terminator
	TXZN	F,F.SLSL	; Is this an "@I" command?
	 JRST	INSE.A		; No, altmode is terminator
	PUSHJ	P,SKRCH		; Get the terminator character
	 ERROR	E.UIN		; Unterminated insert string
INSE.A:	PUSHJ	P,INSE.0	; Do the first pass of the command
	JUMPE	T1,.POPJ	; Return if nothing to insert
	MOVE	CH,P1		; Get the delimeter character
	XMOVEI	T2,TXTBUF+$QRTPT ; And the TPT address
	PJRST	INSE.I		; Go insert the string
; Subroutine to parse the input string and determine its length.

INSE.0:	MOVEI	P1,(CH)		; Get the terminator character
	LOAD.	T1,TPTADR,+XCTBUF ; Get the address of the command buffer
	LOAD.	T2,BLKPT,(T1)	; Get the pointer address
	MOVEM	T2,STAINS	; Save it for second pass
	XMOVEI	T1,SKRCH	; Get the address of the input routine
	MOVEM	T1,INSRCH	; Save it
	XMOVEI	T1,REEAT	; Routine to re-eat characters
	MOVEM	T1,INSREE	; Store the routine address
	SETZB	P2,CTGLVL	; Clear the count of characters to insert
	TXO	S,S.NRAD	; Flag null insert (will clear if it isn't)
	TXZ	S,S.NCCT	; Clear control-T flag

INSE.1:	PUSHJ	P,@INSRCH	; Get a character
	 ERROR	E.UIN		; Ran out?
	SKIPN	CTGLVL		; in a Q-reg?
	 CAIE	CH,(P1)		; No, is this the terminator?
	  JRST	.+2		; In q-reg, or not terminator
	   JRST	INSE.3		; Have the terminator
	TXZ	S,S.NRAD	; Flag not null insert string (for FS/FN)
	CHKEO	EO21,INSE.2	; If old version commands, control chars are legal
	XMOVEI	T1,I1ATAB	; Get the old table address
	CHKEO	EO200,INS.2A	; Is this an old version?
	XMOVEI	T1,IN1TAB	; No, get the new one
INS.2A:	TXNE	S,S.NCCT	; ^T flag on?
	 XMOVEI	T1,IN2TAB	; Yes, allow the control chars
	PUSHJ	P,DISP1		; Get dispatch on the char
	 JRST	INSE.8		; Not a special char
	JUMPE	CH,INSE.1	; Special char, don't count it
	AOJA	P2,INSE.1	; Count if it returns character
INSE.8:	TXNN	S,S.NCCT	; Allowing control-chars?
	 PUSHJ	P,CKNCC		; No, check if control char
INSE.2:	AOJA	P2,INSE.1	; Character is okay, count it and loop

; Here at the end of the string

INSE.3:	TXZ	S,S.NCCT!S.CTLV!S.CTVV!S.CTLW!S.CTWW ; Clear the flags for second pass
	MOVE	T1,P2		; Get the length
	POPJ	P,		; And return
; Dispatch table for first pass control characters

IN1TAB:	XWD	CLRCH,.CHCNA	; ^A
	XWD	CLRCH,.CHCNB	; ^B

I1ATAB:	XWD	CTRGI,.CHBEL	; ^G
	XWD	CLRCH,.CHCNV	; ^V
	XWD	CLRCH,.CHCNW	; ^W
	XWD	INSE.R,.CHCCF	; ^^

IN2TAB:	XWD	INSE.T,.CHCNT	; ^T
	XWD	INSE.R,$CHQOT	; Quoting character
	XWD	0,0		; End of list

; Here for control-R.  Get next character with no checks

INSE.R:	PUSHJ	P,@INSRCH	; Get the next character
	 ERROR	E.UIN		; Unterminated insert
	POPJ	P,		; and return

; Here for control-T command. Complement the no-control-commands flag

INSE.T:	TXC	S,S.NCCT	; Complement the flag
CLRCH:	SETZ	CH,		; Flag this was a special char
	POPJ	P,		; And return


; Here for control-G command. Set up the input routines to read
;from the Q-register.

CTRGI:	SETZ	T1,		; Clear the default
	XMOVEI	T2,@INSRCH	; Get the routine to use
	XMOVEI	T3,@INSREE	; Get the routine to re-eat
	MOVE	T4,CTGBUF	; Get the current TPT address
	SKIPN	CTGLVL		; Are we down a level already?
	 XMOVEI	T4,XCTBUF	; Yes, get the normal pointer
	PUSHJ	P,REDQRG	; Get the Q-register name
	 JRST	[PUSHJ	P,@INSRCH	; Get a character
		  ERROR	E.ICG		; Couldn't
		PUSHJ	P,QREGV2	; Make sure it is a Q-reg name
		JRST	.+1]		; And continue on
	MOVE	T3,T1		; Save the address
	MOVE	T1,CTGBUF	; Get the buffer address
	$ADJSP	XS,$XSQLN	; Make room for the data
	STOR.	T1,XSBQAD,(XS)	; Store the previous address
	MOVX	T1,$XEIQG	; Get the item type
	STOR.	T1,XSBTYP,(XS)	; Store it
	AOS	T2,CTGLVL	; Bump the level
	CAIE	T2,1		; Is this the first Q-reg?
	 JRST	CTRGI0		; Skip if the first level
	MOVE	T1,INSRCH	; Get the routine address
	MOVEM	T1,OLDINR	; Yes, save the old routine
	MOVE	T1,INSREE	; Get the re-eat routine
	MOVEM	T1,OLDREE	; Store the old routine
CTRGI0:	XMOVEI	T1,INSRCG	; Get the routine to fetch from Q-reg
	MOVEM	T1,INSRCH	; And save it
	XMOVEI	T1,INSQRE	; Get the q-register re-eat routine
	MOVEM	T1,INSREE	; Store the routine address
	LOAD.	T1,TPTADR,+$QRTPT(T3) ; Get the buffer address
	JUMPE	T1,[ERROR	E.NTQ]	; No text in Q-reg
	MOVEM	T3,CTGBUF	; Save the address
	SETZ	T2,		; Clear the pointer offset
	PUSHJ	P,SETINC	; Set up to get chars
	 JFCL			; Ignore the error, let first call to GETINC fail
	PJRST	CLRCH		; Clear the character

; Get a character routine from Q-registers

INSRCG:	$SAVE	<T1,T2>		; Save T1 and T2
	MOVE	T1,CTGBUF	; Get the buffer address
	LOAD.	T1,TPTADR,(T1)	;   .  .  .
	PUSHJ	P,GETINC	; Get a character
	 JRST	.+2		; None left
	  JRST	.POPJ1		; Got one, return it
	LOAD.	T1,XSBQAD,(XS)	; Get the item off the stack
	MOVEM	T1,CTGBUF	; Save it
	ADJSP	XS,-$XSQLN	; Remove the items
	SOS	T1,CTGLVL	; And decrement the level
	JUMPN	T1,INSRCG	; If still in Q-reg, try again
	MOVE	T1,OLDINR	; Get the routine to call
	MOVEM	T1,INSRCH	; Save it
	MOVE	T1,OLDREE	; Get the old re-eat routine
	MOVEM	T1,INSREE	; Store it back
	PJRST	@INSRCH		; And go get a character

; Routine to re-eat a character in a q-register

INSQRE:	$SAVE	<T1,T2,T3,T4>	; Don't smash anything
	MOVE	T1,CTGBUF	; Get the buffer address
	LOAD.	T1,TPTADR,(T1)	; Get the address
	LOAD.	T2,BLKPT,(T1)	; Get pointer
	SUBI	T2,1		; Decrement it
	PUSHJ	P,SETINC	; Back up the character
	 JFCL			; Don't care
	POPJ	P,		; Return
; Here from the search code to complete an FS or FN type search.
;
; Usage:
;	MOVE	T1,Length
;	MOVEI	T2,Address.of.TPT to buffer
;	MOVE	CH,Delimeter character
;	PUSHJ	P,INSE.I
;	(Return)

INSE.I:	MOVE	P1,CH		; Reset the delimeter character
	MOVE	P2,T1		; Get the number of characters to insert
	MOVE	P3,T2		; Get the TPT address

; Here after first pass of string is done with count of chars in P2

INSE.7:	LOAD.	T1,TPTADR,+XCTBUF ; Get the buffer address
	MOVE	T2,STAINS	; Get the start PT
	PUSHJ	P,SETINC	; Set up the pointers
	 STOPCD	(CBS,<Command buffer shrank>)

	LOAD.	T1,TPTADR,+$QRTPT(P3) ; Get the text buffer address
	MOVE	T2,P2		; And te number of characters we need to insert
	LOAD.	T3,BLKPT,(T1)	; Get the pointer
	PUSHJ	P,M$XPND	; Expand the buffer
	LOAD.	T2,BLKPT,(T1)	; Set up for inserting the string
	PUSHJ	P,SETINC	;  .  .  .
	 STOPCD	BSD,<Buffer space disappeared> ; ?
	LOAD.	T1,TPTADR,+$QRTPT(P3) ; Get the text buffer address
	LOAD.	T2,BLKPT,(T1)	; and the place we will start the modification
	MOVE	T3,T2		; Get the end
	ADD	T3,P2		; Plus the amount we are inserting
	AOJ	T3,		; Plus one to point past end
	PUSHJ	P,UPDBND	; Update the bounds
	XMOVEI	T1,SKRCH	; Get the input routine again
	MOVEM	T1,INSRCH	; Store the routine
	XMOVEI	T1,REEAT	; Get the re-eat routine
	MOVEM	T1,INSREE	; Store the routine address
	TXO	S,S.NTRC	; Suppress tracing
INSE.4:	PUSHJ	P,@INSRCH	; Get a character
	 STOPCD	(ISS,<Insert string shrank>)
	SKIPN	CTGLVL		; In a Q-reg?
	 CAIE	CH,(P1)		; No, is this the terminator?
	  JRST	.+2		; Not the end, skip
	   JRST	[TXZ	S,S.NTRC	; Allow tracing again
		POPJ	P,]		; Return to the caller
	CHKEO	EO21,INSE.5	; EO level allow control chars?
	XMOVEI	T1,I3ATAB	; Get the old table address to control commands
	CHKEO	EO200,INS.5A	; Is this an older version?
	XMOVEI	T1,IN3TAB	; No, use the newer table
INS.5A:	TXNE	S,S.NCCT	; Allow control commands?
	 XMOVEI	T1,IN4TAB	; No, use other table
	PUSHJ	P,DISP1		; Dispatch to correct routine
	 JRST	.+2		; Skip if not command
	  JUMPE	CH,INSE.4	; Just loop if a command char
	PUSHJ	P,CASE		; Fix the casing
INSE.5:	LOAD.	T1,TPTADR,+$QRTPT(P3) ; Get the buffer address back
	PUSHJ	P,PUTINC	; And store the character
	 STOPCD	(TBS,<Text buffer shrank>)
	JRST	INSE.4		; Loop for all chars
; Dispatch table for insert pass control-chars

IN3TAB:	XWD	C.V,.CHCNA	; ^A is same as ^V
	XWD	C.W,.CHCNB	; ^B is same as ^W

I3ATAB:	XWD	CTRGI,.CHBEL	; ^G
	XWD	C.V,.CHCNV	; ^V
	XWD	C.W,.CHCNW	; ^W
	XWD	INSSPC,.CHCCF	; ^^
IN4TAB:	XWD	INSE.T,.CHCNT	; ^T
	XWD	INSE.R,$CHQOT	; Quoting character
	XWD	0,0		; End of list


; Here on control-^. If next char is a special char with  lower case
;equivalent convert it to it's lower case form.

INSSPC:	PUSHJ	P,@INSRCH	; Get the next character
	 JFCL			; Ignore the error
	PJRST	CVTSPC		; And go convert the character

	SUBTTL	Commands -- "I" -- Utilities -- Casing routines

; Here on a control-V.  If it is the second one, convert the flags
;for locked lower case. If first, just remember it for the next character.

C.V:	TXON	S,S.CTLV	; Set the single control-v flag and check if on
	 PJRST	CLRCH		; Clear out CH
	TXZ	S,S.CTLV+S.CTWW	; Clear single control-V and double control-W
	TXO	S,S.CTVV	; Set double control-V
	PJRST	CLRCH		; Clear out CH

; Here on a control-W. If second in a row lock upper case, else
;just handle as single char.

C.W:	TXON	S,S.CTLW	; Flag we had a single, have one before?
	 PJRST	CLRCH		; Clear out CH
	TXZ	S,S.CTLW+S.CTVV	; Yes, lock upper case on
	TXO	S,S.CTWW	; Flag it
	PJRST	CLRCH		; Clear out CH

; Here to convert upper to lower or lower to upper according
;to flags.

CASE:	CAIL	CH,"A"		; Is this an upper case char?
	 CAILE	CH,"Z"		;  .  .  .
	  CAIL	CH,"a"		; Or is it loser case?
	   CAILE CH,"z"		;  .  .  .
	JRST	CASE3		; Not a letter, skip this
	TXNE	S,S.LCAS	; Lower case prevailing?
	 TRO	CH,"a"-"A"	; Yes, convert to lower
	TXNE	S,S.UCAS	; Or is it upper case prevailing?
	 TRZ	CH,"a"-"A"	; Yes, convert to upper
CASE.1:	TXNE	S,S.CTVV	; lower case lock on?
	 TRO	CH,"a"-"A"	; Yes, convert to lower case
	TXNE	S,S.CTWW	; Upper case lock on?
	 TRZ	CH,"a"-"A"	; Yes, convert to upper
	TXZE	S,S.CTLV	; Single control-V?
	 TRO	CH,"a"-"A"	; Yes, convert to lower
	TXZE	S,S.CTLW	; Single control-W?
	 TRZ	CH,"a"-"A"	; Yes, convert to upper
CASE3:	TXZ	S,S.CTLV+S.CTLW	; Clear in case no conversion
	POPJ	P,

; Here to convert characters according to ^W/^V settings, without regard to
;the prevailing case mode flags

CASE.0:	CAIL	CH,"A"		; Is this a letter?
	 CAILE	CH,"Z"		; At all?
	  CAIL	CH,"a"		;  Maybe lower case?
	   CAILE CH,"z"		;  .  .  .
	JRST	CASE3		; No, clear the flag out
	JRST	CASE.1		; Yes, go do the necessary conversions

; Here to convert upper case range special chars to their
;lower case equivalent character.

CVTSPC:	CAIL	CH,"["		; Is this in the range past the upper case letters?
	 CAILE	CH,"_"		;  .  .  .
	  CAIN	CH,"@"		; Or is it the atsign?
	   TRO	CH,"a"-"A"	; Yes, convert to lower case range
	POPJ	P,		; And return it
	SUBTTL	Commands -- "I" -- Utilities -- CKNCC

; Here to check if CH contains a legal character to be inserted
;without quoting. Characters less than control-H (.CNCNH) or between
;a carriage return (.CHCRT) and an escape (.CHESC) or between
;an escape and a space are illegal.

CKNCC:	CAIGE	CH," "		; If above a space it is legal
	 CAXG	CH,.CHCRT	; Below a carriage return?
	  CAXGE	CH,.CHCNH	; and above a backspace?
	   CAXN	CH,.CHESC	; Or is it an escape?
	     POPJ P,		; Legal character
	ERROR	E.ICT		; Not a legal char, give the error
	SUBTTL	Commands -- "I" -- "nI"

;+
; If an I is preceded by an argument the character with that numeric
;value is inserted.
;-

INS1A:	TXNN	F,F.STR1	; First argument a string?
	 JRST	INS1B		; No, numeric value
	LOAD.	T4,TPTADR,+SARG$1 ; Get the address of the text buffer
	LOAD.	T1,TPTADR,$QRTPT+TXTBUF ; Get the address of the text buffer
	LOAD.	T2,BLKPT,(T1)	; Get the current position
	LOAD.	T3,BLKEND,(T4)	; Get the amount we are inserting
	ADD	T2,T3		; And make the overall amount
	PUSHJ	P,UPDBND	; Update the bounds
	SETZ	T1,		; Clear the offset
	BLDBPT	(T1,(T4))	; Build the byte pointer
	LOAD.	T2,BLKEND,(T4)	; Get the number of characters
	LOAD.	T3,TPTADR,+$QRTPT+TXTBUF ; Get the address of the text buffer
	XMOVEI	T4,SARG$1	; Get the address of the pointer
	PUSHJ	P,M$INSS	; Insert the string
	LOAD.	T2,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address back
	STOR.	T1,BLKPT,(T2)	; And reset the position
	POPJ	P,		; And return


INS1B:	CHKEO	EO21,INS1X	; Don't need to worry about altmode after the I if old mode
	PUSHJ	P,SKRCH		; Get the character after the I
	 ERROR	E.NAI		; No altmode after nI
	CAXE	CH,.CHESC	; Was it an altmode?
	 ERROR	E.NAI		; No, complain
INS1X:	MOVE	CH,A1		; Get the arg
	FALL	TAB2		; And fall into single character insert routine

; Here to insert the one character from CH at the current pointer

TAB2:	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
	MOVEI	T2,1		; One character
	LOAD.	T3,BLKPT,(T1)	; At the pointer
	PUSHJ	P,M$XPND	; Expand the buffer one char
	LOAD.	T2,BLKPT,(T1)	; Get the pointer again
	MOVE	T3,T2		; Get the address
	AOJ	T3,		; Plus one for the character we are inserting
	PUSHJ	P,UPDBND	; Update the bounds
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer back
	LOAD.	T2,BLKPT,(T1)	; And the pointer
	PUSHJ	P,SETINC	; Set up for storing the char
	 JFCL			; Can't happen I hope
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
	PUSHJ	P,PUTINC	; And store the character
	 JFCL			; Who cares
	POPJ	P,		; And return
	SUBTTL	Commands -- T

;+
;.hl2 Type out ("T")
; This command will type a portion of the text buffer on the terminal.
;If no arg is given it will type from the pointer to the end of the current
;line. If one argument is given it will type that number of lines. If the
;argument is zero it will type from the beginning of the line to the pointer,
;if it is negative, it will type from the pointer back argument number of lines.
;If two arguments arg given it will type from the character specified by
;the first argument to the character specified by the second.
;-

TYPE:	SETZM	XCTING		;SO ^C^C REE WORKS PROPERLY
	PUSHJ	P,TYPE.0	; Call the common routine
	SETOM	XCTING		; Flag we should continue again
	POPJ	P,		; and return

; Enter here with args set up like command processing

TYPE.0:	PUSHJ	P,GETARG	; Get the arguments

; Enter here with A1/A2 set up as character positions within current text
;buffer

TYPE.1:	$SAVE	(<P1,P2>)	; Save P1/P2
	LOAD.	P1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
TYPE.T:	CFMGE.	T2,BLKEND,(P1),A1 ; Is the second arg too large?
	 LOAD.	A1,BLKEND,(P1)	; Yes, get the end instead
	MOVE	T1,A2		; Get the start address
	BLDBPT	(T1,(P1))	; Make the byte pointer
	STOR.	T1,BLKPTR,(P1)	; Store the pointer
	MOVE	P2,A1		; Set up the counter
	SUB	P2,A2		;  .  .  .

TYPE.2:	JUMPE	P2,[TXZE F,F.TYOF	; Need to output some yet?
		 PJRST	TTYOUT		; Yes, go do it
		POPJ	P,]	; No, return
	ILDB	CH,.BKPTR(P1)	; Get a character
	PUSHJ	P,T$TCHR	; Type it
	SOJA	P2,TYPE.2	; And loop for all the chars
	SUBTTL	Commands -- V

;+
;.hl2 Type around the pointer ("V")
; This command will effectively do a (1-n)T nT command sequence.
;-

VCMD:	JMPS	VV$CMD		; If video mode we do things different
	TXNE	F,F.ARG2	; Two args given?
	 ERROR	E.SAN		; Only one arg allowed
	PUSH	P,A1		; Save the argument
	MOVN	A1,A1		; Get the minus amount to type
	ADDI	A1,1		;  .  .  .
	PUSHJ	P,TYPE		; Type the lines above
	POP	P,A1		; Restore arg
	PJRST	TYPE		; Type the lines below
	SUBTTL	Commands -- P

;+
;.hl2 Write out the buffer ("P")
; There are a number of different forms of the P command:
;.b.ls1
;.le;"P" - Output the current buffer and yank in a new one.
;.le;"nP" - Perform a "P" command n times.
;.le;"i,jP" - Output from posistions i-j.
;.le;"PW" - Output the current buffer appending a form feed to the end
;and leave the buffer unchanged.
;.els
;-

PUNCHA:	TXNE	F,F.ARG2	; Two arguments?
	 JRST	PUNC.2		; Yes, go handle it
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
	MOVE	P1,A1		; Get the number of times to loop
	LOAD.	A1,BLKEND,(T1)	; And get the ending thing to write
	SETZ	A2,		; Clear the first char to write
	PUSHJ	P,SKRCH		; Get the next character
	 JRST	PUNC.0		; None there, skip it
	CAXE	CH,"w"		; Lower case W ?
	 CAIN	CH,"W"		; Is it a W?
	  JRST	PUNC.1		; Skip this
	PUSHJ	P,REEAT		; No, back up a character
PUNC.0:	TXO	F,F.NSRH		; Flag not a PW command

; The following is the entry point for searches to allow them to
; punch a buffer for N or FN searches

PUNSCH:
PUNC.1:	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
	PUSHJ	P,WRTBUF	; Write the buffer
	TXNN	F,F.NSRH	; PW command?
	 JRST	PUNC.3		; Yes, go handle it
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
	PUSHJ	P,GETFDI	; Check if we have an input file
	 JRST	PUNC.4		; No, just go clear the buffer
	PUSH	P,P1		; Save the count of the number of times
	PUSHJ	P,YANK		; No, yank in a new buffer
	POP	P,P1		; Restore the count
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
	CFXN.	T2,BLKEND,(T1),0 ; Empty buffer?
	 JRST	PUNC.3		; Yes, go handle it
	PUSHJ	P,GETFDI	; No, get the FDB address
	 ERROR	E.NFI		; No file for input
	MOVX	T2,FD.EOF	; Check if end of file
	TDNN	T2,.FDFLG(T1)	;  .  .  .
PUNC.3:	 SOJG	P1,PUNC.1	; Otherwise loop for more
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
	SETZ	T2,		; Clear this
	LOAD.	T3,BLKEND,(T1)	; Get the end of the buffer
	PJRST	UPDBND		; Update the bounds


; Here for i,jP

PUNC.2:	MOVEI	P1,1		; Assume one time
	PJRST	PUNC.1		; And go use normal routine


PUNC.4:	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
	LOAD.	T2,BLKEND,(T1)	; Get the end
	ZERO.	T3,BLKPT,(T1)	; Clear the pointer
	ZERO.	T3,BLKCOL,(T1)	; Clear the current column also
	SETZ	T3,		; Clear the whole thing
	PUSHJ	P,M$SRNK	; Shrink it
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address again
	SETZB	T2,T3		; Clear the bounds
	PJRST	UPDBND		; And update the bounds
	SUBTTL	Commands -- "J" - Move the pointer to absolute position

;+
;.hl2 Absolute pointer movement ("J")
; This command will move the pointer to the right of the nth character
;in the buffer.
;-

JMP:	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
JMP1:	JUMPL	A1,[ERROR E.POP] ; If negative, give error
	CFMGE.	T2,BLKEND,(T1),A1 ; Is the value within range?
	 ERROR	E.POP		; No, complian
	ZERO.	T2,BLKCOL,(T1)	; Clear the column
	STOR.	A1,BLKPT,(T1)	; Store the new pointer
	POPJ	P,		; And return


	SUBTTL	Commands -- "R" - Move pointer backwards

;+
;.hl2 Move pointer backwards ("R")
; This command will move the pointer backwards n positions. Note that
;the argument may be negative.
;-

REVERS:	MOVN	A1,A1		; Make the arg negative
	FALL	CHARAC		; And fall into C command


	SUBTTL	Commands -- "C" - Move the pointer forwards

;+
;.hl2 Move the pointer forwards ("C")
; This command will move the pointer forward n characters. Note that
;n may be negative.
;-

CHARAC:	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
	LOAD.	T2,BLKPT,(T1)	; And get the pointer
	ADD	A1,T2		; Make it point to the new place
	PJRST	JMP1		; And go store it
	SUBTTL	Commands -- "L" - Move the pointer n lines

;+
;.hl2 Move the pointer n lines ("L")
; This command will move the pointer forward or backward a given number
;of lines (line feeds).
;If n is greater than zero move the pointer to the right (down)
;stopping after passing over n line feeds.
;If n is negative, move the pointer to the left (up), stopping
;after passing n+1 line feeds, then place the pointer to the right of
;the last line feed passed over.
;-

LINE:	PUSHJ	P,GETARG	; Convert the arg into character indices
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
	XOR	A1,A2		; And magicically convert the correct one
	XORM	A1,.BKPT(T1)	; This works because either A1 or A2 must be
				; equal to PT. XORing them together and then
				; with the old PT will give the correct new
				; value for PT.
	ZERO.	T2,BLKCOL,(T1)	; Clear current column
	POPJ	P,		; Return
	SUBTTL	Commands -- "K" - Delete some text

;+
;.hl2 Delete text ("K")
; This command will delete a given number of lines of text, or
;a given range of characters.
;-

KILL:	PUSHJ	P,GETARG	; Convert the arg if necessary
	CAMN	A1,A2		; Deleting something?
	 POPJ	P,		; No, just return
	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
	MOVE	T2,A2		; Get the start of the section
	MOVE	T3,A1		; And the end
	PUSHJ	P,UPDBND	; Update the bounds
	MOVE	T2,A1		; Get the end address
	SUB	T2,A2		; And make it the number of characters
	LOAD.	T3,BLKPT,(T1)	; Get the pointer
	CAMGE	T3,A2		; Deleting before the pointer?
	 JRST	KILL.1		; No, keep going
	CAMGE	T3,A1		; All of the deletion before the pointer?
	 SKIPA	T3,A2		; No, use the start of section being deleted
	  SUB	T3,T2		; Yes, account for the chars being deleted
	STOR.	T3,BLKPT,(T1)	; Store the new pointer
	ZERO.	T4,BLKCOL,(T1)	; Clear the current column
KILL.1:	MOVE	T3,A2		; Get the offset to start
	PJRST	M$SRNK		; And go shrink the buffer
	SUBTTL	Commands -- "D" - Delete a number of characters

;+
;.hl2 Delete a number of characters ("D")
; This command will delete a given number of characters starting from
;the pointer.  Note that the argument may be negative.
;-

DELETE:	LOAD.	T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
	LOAD.	T2,BLKPT,(T1)	; Get the current position
	MOVE	T3,T2		; Get a copy
	ADD	T3,A1		; Make the end (or start)
	CAMLE	T2,T3		; Need to be reversed?
	 EXCH	T2,T3		; Yes, do it
	PUSHJ	P,UPDBND	; Update the bounds
	LOAD.	T3,BLKPT,(T1)	; Get the place to delete from
	MOVM	T2,A1		; And the number to delete
	JUMPGE	A1,DELE.1	; Positive number to delete?
	ADD	T3,A1		; No, back up that many characters
	JUMPGE	T3,DELE.0	; Moving pointer off page?
	ERROR	E.POP		; Yes, give the error

DELE.0:	ZERO.	T4,BLKCOL,(T1)	; Clear the current column
	STOR.	T3,BLKPT,(T1)	; No, store the new pointer
	PJRST	M$SRNK		; Go shrink the buffer

DELE.1:	ADD	A1,T3		; Get the final pointer address
	CFMGE.	T4,BLKEND,(T1),A1 ; Is the last character off the page?
	 ERROR	E.POP		; Yes, give the error
	PJRST	M$SRNK		; No, go shrink it
	SUBTTL	Commands -- "<" - Open iteration

;+
;.hl2 Open iteration ("<")
; This command is the start of a loop to be iterated. It will save
;the current iteration info on the stack and return.
;-

LSSTH:	$ADJSP	XS,$XSLLN	; Make room for the data
	MOVE	T1,ITERCT	; Save the iteration count
	STOR.	T1,XSBITC,(XS)	; Store it
	MOVE	T1,LOPADR	; And the loop address
	STOR.	T1,XSBLOP,(XS)	; Store the loop address
	MOVX	T1,$XELOP	; Get the block type
	STOR.	T1,XSBTYP,(XS)	; Store it
	LOAD.	T1,TPTADR,+XCTBUF ; Get the current buffer address
	LOAD.	T2,BLKPT,(T1)	; And get the pointer
	MOVEM	T2,LOPADR	; Save the address
	AOS	ANGLVL		; Remember the bracket level
	TXNN	F,F.ARG		; Have an argument?
	 POPJ	P,		; No, return now
	JUMPLE	A1,INCMA1	; Yes, if not positive, skip loop
	MOVEM	A1,ITERCT	; Otherwise save the count
	POPJ	P,		; And return
	SUBTTL	Commands -- ">" - End an iteration loop

;+
;.hl2 End of iteration (">")
; This command ends a loop. It will cause the command to go back to
;the matching bracket unless the iteration count hits zero.
;-

GRTH:	LOAD.	T1,XSBTYP,(XS)	; Get the type of the last block
	CAXN	T1,$XELOP	; Loop?
	 JRST	GRTH2		; Yes, go handle it
	CAXN	T1,$XEPAR	; Was last thing a paren?
	 ERROR	E.MRP		; Missing a paren?
	ERROR	E.MLA		; No, missing a left angle


GRTH2:	SOSN	ITERCT		; Decrement the iteration count
	 JRST	INCMA2		; Yes, go handle it
	MOVE	T2,LOPADR	; Get the loop address
	LOAD.	T1,TPTADR,+XCTBUF ; Get the buffer address
	PUSHJ	P,SETINC	; And set the pointers
	 STOPCD	CBD,<Command buffer disappeared>
	TXNE	F,F.TRAC	; Tracing?
	 PUSHJ	P,.TCRLF	; Yes, type the crlf
	POPJ	P,		; And return
	SUBTTL	Commands -- ";" - Exit iteration

;+
;.hl2 Exit iteration ";"
; This command will cause an exit from the current iteration if
;the last search failed.
;-

SEMICL:	LOAD.	T1,XSBTYP,(XS)	; Get the block type
	CAXE	T1,$XELOP	; Are we in a loop?
	 ERROR	E.SNI		; Semi-colon not in iteration
	TXNN	F,F.ARG		; Did we have an arg?
	 MOVE	A1,SFINDF	; No, use last search switch
	JUMPL	A1,.POPJ	; If arg less than zero just return
INCMA1:	MOVEI	T2,">"		; Loop for the bracket
	MOVEI	T3,"<"		; Ignoring matched pairs
	PUSHJ	P,SKAN		; Find it
	 ERROR	E.MRA		; Missing right angle brack
INCMA2:	LOAD.	T1,XSBLOP,(XS)	; Get the loop address
	MOVEM	T1,LOPADR	; Save it
	LOAD.	T1,XSBITC,(XS)	; get the iteration count
	MOVEM	T1,ITERCT	; Save it
	$ADJSP	XS,-$XSLLN	; And remove the entry from the stack
	SOS	ANGLVL		; Back up one level
	POPJ	P,		; And return
	SUBTTL	Commands -- "!" - Define a tag


;+
;.hl2 Define a tag ("!")
; This command will define a tag which is the string which is
;between two exclamation points.
;-

EXCLAM:	PUSHJ	P,EXCL.2	; Call common routine
	 JRST	EXCL.9		; Check if multiply defined
	LOAD.	T3,TPTADR,+XCTBUF ; Get the buffer address back
	LOAD.	T2,BLKPT,(T3)	; Get the pointer
	STOR.	T2,SYMIDX,(T1)	; Store the index
	PJRST	PASRET		; Return

EXCL.9:	JUMPE	P3,PASRET	; If a !! label just retur
	LOAD.	T3,TPTADR,+XCTBUF ; Get the buffer address
	LOAD.	T2,BLKPT,(T3)	; And get the pointer
	CFME.	T3,SYMIDX,(T1),T2 ; Check if this is the correct place
	 ERROR	E.MDT		; No, give the error
	PJRST	PASRET		; Return any values

; Common routine to scan off a tag and make an STE

EXCL.2:	LOAD.	P1,TPTADR,+XCTBUF ; Get the buffer address
	LOAD.	P2,BLKPT,(P1)	; And get the character index
	SETZ	P3,		; Clear the counter
EXCL.1:	PUSHJ	P,SKRCH		; Get a character
	 ERROR	E.UTG		; Unterminated tag
	CAIE	CH,"!"		; End of the tag?
	 AOJA	P3,EXCL.1	; No, count the character
	JUMPE	P3,.POPJ	; Return if no characters in label
	DMOVE	T1,P1		; Get the start of string info
	MOVE	T3,P3		; Get the length
	PUSHJ	P,S$LABL	; Define the label
	 SOS	-1(P)		; Don't give a skip return
	MOVEM	T1,LASLBL	; Store the last label
	JRST	.POPJ1		; Give the good return

; Entry point for O command

EXCL.0:	$SAVE	<P1,P2,P3>	; Save some ac's
	TXO	S,S.NTRC	; Flag no tracing
	PUSHJ	P,EXCL.2	; Define the label
	 JRST	.+2		; Skip
	  AOS	(P)		; Pass on the skip return
	JUMPE	P3,.POPJ	; Just return if !!
	TXZ	S,S.NTRC	; Clear the trace inhibit
	LOAD.	P1,TPTADR,+XCTBUF ; Get the buffer address back
	LOAD.	T2,BLKPT,(P1)	; Get the pointer
	STOR.	T2,SYMIDX,(T1)	; Store the index
	POPJ	P,		; And return
	SUBTTL	Commands -- "O" - Go to the tag named.

;+
;.hl2 Go to the named tag ("O")
; This command will cause the command flow to be transferred to the
;tag given.
;-


OG:	LOAD.	P1,TPTADR,+XCTBUF ; Get the buffer address
	LOAD.	P2,BLKPT,(P1)	; And the pointer index
	SETZ	P3,		; Clear the counter

OG.1:	PUSHJ	P,SKRCH		; Get a character
	 ERROR	E.UTG		; Unterminated tag
	CAXE	CH,.CHESC	; Is it an escape?
	 AOJA	P3,OG.1		; No, try again
	JUMPE	P3,[ERROR E.NTG] ; Null tags are illegal
	DMOVE	T1,P1		; Yes, get the info
	MOVE	T3,P3		;  .  .  .
	PUSHJ	P,S$LABL	; And try to find the symbol
	 JRST	OG.2		; Found it
	MOVE	P1,T1		; Get the address for later
	LOAD.	T1,TPTADR,+XCTBUF ; Get the buffer address
	SETZ	T2,		; And reset to the beginning
	PUSHJ	P,SETINC	; Set the pointer
	 JFCL			; Never happens
OG.4:	MOVEI	T2,"!"		; Search for next tag
	MOVEI	T3,-1		; No matched string
	PUSHJ	P,SKAN		; Go find it
	 JRST	OG.E		; Couldn't
	PUSHJ	P,EXCL.0	; Define the label
	 JRST	OG.3		; Already defined, check it is the one we want
	JRST	OG.4		; Not the one we want, try again

OG.3:	CAIE	T1,(P1)		; Right label?
	 JRST	OG.4		; Not the right one, try again
OG.2:	LOAD.	T2,SYMIDX,(T1)	; Get the index
	LOAD.	T1,TPTADR,+XCTBUF ; Get the buffer address
	PUSHJ	P,SETINC	; Set up the pointers
	 JFCL			; Ignore if at end, top level will give error
	POPJ	P,		; Return

; Here if we couldn't find the tag. Reset the command pointer in case the
;command is colon'ed

OG.E:	MOVEM	P1,LASLBL	; Store the address of the label STE
	TXZ	S,S.NTRC	; Clear the trace bit
	LOAD.	T1,TPTADR,+XCTBUF ; Get the buffer address back
	MOVE	T2,P2		; Get the start of the symbol
	ADD	T2,P3		; And point past the end
	AOJ	T2,		; Also bump past the altmode
	PUSHJ	P,SETINC	; Reset the pointer
	 JFCL			; Who cares
	ERROR	E.TAG		; And give the error
	SUBTTL	Commands -- "?" - Enter or leave trace mode

;+
;.hl2 Trace mode ("?")
; This command will complement trace mode.
;-

QUESTN:	TXCE	F,F.TRAC	; Complement the flag and check if on
	 PUSHJ	P,.TCRLF	; Type a crlf if leaving
	POPJ	P,		; And return


	SUBTTL	Commands -- "^A" - Type out the comment

;+
;.hl2 Type out comment ("^A")
; This command will cause all text following the first control-A
;until the next to be typed on the terminal.
;-

CMNT:	PUSHJ	P,SKRCH		; Get a character
	 ERROR	E.UCA		; Unterminated control-A command
	CAXN	CH,.CHCNA	; Is this a control-A?
	 JRST	[TXZE	F,F.TYOF	; Need to force typeout?
		  PJRST	TTYOUT		; Yes, go do it
		POPJ	P,]		; No, return
	TXNN	F,F.TRAC	; Omit the double type-out
	 PUSHJ	P,T$ACHR	; Type the character
	JRST	CMNT		; Loop for next character
	SUBTTL	Conditional excution

;+
;.hl1 Conditionals
; The value"x ... ' construct is for conditional execution of the
;commands between the "x and the single quote. The following are the
;possibilities for x:
;.b.ls1
;.le;n"G - Only if n is greater than zero.
;.le;n"L - Only if n is less than zero.
;.le;n"N - Only if n is not equal to zero.
;.le;n"E - Only if n is equal to zero.
;.le;n"F - Only if n is false (equal to zero).
;.le;n"U - Only if previous command was unsuccessful (returned 0).
;.le;n"T - Only if n is true (less than zero).
;.le;n"S - Only if previous command was successful (returned negative value).
;.le;n"C - Only if n is the value of an ASCII character allowable in
;symbols (letters, digits, period, dollar sign, or percent).
;.le;n"A - Only if n is the value of an ASCII alphabetic character.
;.le;n"D - Only if n is the value of an ASCII numeric character.
;.le;n"V - Only if n is the value of a lower case alphabetic character.
;.le;n"W - Only if n is the value of an upper case alphabetic character.
;.els
;-

; Here for the tests for the individual commands

DQ.V:	TRZN	A1,40		; If this bit not on can't be lower case
	 JRST	NOGO		; Not LC, go skip the rest

DQ.A:	TRZ	A1,40		; Convert possible upper to lower
DQ.W:	CAIL	A1,"A"		; Check if a letter
	 CAILE	A1,"Z"		;  .  .  .
	  JRST	NOGO		; Not a letter
	POPJ	P,		; It is a letter

DQ.D:	CAIL	A1,"0"		; Check if it is a digit
	 CAILE	A1,"9"		;  .  .  .
	  JRST	NOGO		; Not a digit
	POPJ	P,		; digit, return okay


DQ.C:	MOVE	CH,A1		; Get the character into the correct place
	PUSHJ	P,CKSYM		; Check if a symbol character
	 POPJ	P,		; Good character, return
	JRST	NOGO		; No good

DQ.T:
DQ.S:	JUMPL	A1,.POPJ	; Okay if less than zero
	JRST	NOGO		; No good, go skip
; The following four commands check for various conditions.  The
; conditions are:
;
; 1. Not equal
; 2. Equal
; 3. Less than
; 4. Greater than
;
; The following are the offsets to the execute tables.

	INTNUM	DQ
	NUM	EQU		; Equal to
	NUM	NEQ		; Not equal to
	NUM	LSS		; Less than
	NUM	GTR		; Greater than
	ENDNUM

; The following are the entry points into the main routine for the
; four commands:
;
; DQ.E - Equal
; DQ.N - Not equal
; DQ.L - Less than
; DQ.G - Greater than

DQ.E:	SKIPA	P1,[EXP	$DQEQU]	; Get the offset
DQ.N:	MOVX	P1,$DQNEQ	; Get the not equal
	JRST	DQSUB		; Join the main routine

DQ.G:	SKIPA	P1,[EXP $DQGTR]	; Get the offset
DQ.L:	MOVX	P1,$DQLSS	; . . .

; Here to enter the main routine to process the four commands

DQSUB:	TXNE	F,F.ARG2	; Have two arguments?
	 JRST	DQG.2		; Yes, go check them out
	TXNE	F,F.STR1	; No, first argument a string?
	 ERROR	E.FNS		; Yes, punt it
	XCT	DQJTBL(P1)	; Execute the first option
	JRST	NOGO		; no good

TABDEF	DQJ,$DQ
 TABENT	GTR,<JUMPG A1,.POPJ>	; "G - Greater than
 TABENT	LSS,<JUMPL A1,.POPJ>	; "L - Less than
 TABENT	EQU,<JUMPE A1,.POPJ>	; "E - Equal to
 TABENT	NEQ,<JUMPN A1,.POPJ>	; "N - Not equal to
TABEND

; Here if we have two arguments.  We must check to see if both of these
; arguments are greater then

DQG.2:	TXNE	F,F.STR1!F.STR2	; Both numeric?
	 JRST	DQG.1		; No, make sure both are string
	XCT	DQCTBL(P1)	; Do the comparison
	  PJRST	NOGO		; No, skip it
	POPJ	P,		; Yes, all is fine

TABDEF	DQC,$DQ
 TABENT	GTR,<CAMLE A1,A2>	; "G - Greater than
 TABENT	LSS,<CAMGE A1,A2>	; "L - Less than
 TABENT	EQU,<CAME A1,A2>	; "E - Equal to
 TABENT	NEQ,<CAMN A1,A2>	; "N - Not equal to
TABEND

; Here if both args are not numeric

DQG.1:	TXC	F,F.STR1!F.STR2	; Make sure both are strings
	TXCE	F,F.STR1!F.STR2	; Are they?
	 PJRST	[TXNE	F,F.STR1	; No, first arg a string?
		  ERROR	E.SMS		; Yes, so must second
		ERROR	E.SMN]		; No, second must be numeric also
	PUSHJ	P,CMPSAG	; Compare the arguments
	XCT	DQJTBL(P1)	; Do the jump
	JRST	NOGO		; Skip the text
DQ.F:
DQ.U:	JUMPE	A1,.POPJ	; If equal to zero all is fine
	FALL	NOGO		; And go skip the commands

NOGO:	MOVEI	T2,"'"		; Scan for the proper quote
	MOVEI	T3,""""		; Ignore any  "...' strings
	PUSHJ	P,SKAN		; Go do it
	 ERROR	E.MAP		; Missing the single quote
	PUSHJ	P,SKRCH		; Get the next character
	 POPJ	P,		; There aren't any
	CAXE	CH,""""		; Is this a double quote?
	 PJRST	REEAT		; No, back up over it
	PUSHJ	P,REEAT		; Yes, back up over it
	PJRST	RETZER		; And return a zero
	SUBTTL	CMPSAG - Compare two string arguments

;+
;.hl1 CMPSAG
; This routine will compare two string arguments and determine whether
;the first string is less than, equal to, or greater than the second
;string.
;.literal
;
; Usage:
;	PUSHJ	P,CMPSAG
;	 (return)
;
; On return:
;	A1/ 0 if strings are equal
;	A1/ -1 if second less than first
;	A1/ +1 if second greater than first
;.end lit
;-

CMPSAG:	$SAVE	<P1,P2,P3,P4>	; Save some ac's
	LOAD.	P1,TPTADR,+SARG$2 ; Get the address of the first argument
	LOAD.	P2,BLKEND,(P1)	; Get the length of the string
	ADDX	P1,<POINT 7,.BKTLN> ; Point to the text
	LOAD.	P3,TPTADR,+SARG$1 ; Get the second argument
	LOAD.	P4,BLKEND,(P3)	; Get the length
	ADDX	P3,<POINT 7,.BKTLN> ; And make it point to the text also
	TXNN	F,F.PMAT	; Exact case match?
	 TDZA	T4,T4		; No, no flag to check
	  MOVX	T4,CF.LC	; Yes, check the LC flag

CSAG.1:	SOJL	P2,CSAG.2	; Done with first string?
	SOJL	P4,CSAG.3	; No, done with second?
	ILDB	T1,P1		; No, get a char from the first
	ILDB	T2,P3		; And the second
	TDNE	T4,CHRFLG(T1)	; Is this lower case?
	 SUBX	T1,"a"-"A"	; Yes, convert to upper if needed
	TDNE	T4,CHRFLG(T2)	; Other character lower case?
	 SUBX	T2,"a"-"A"	; Yes, convert if necessary
	CAIN	T2,(T1)		; Same character?
	 JRST	CSAG.1		; Yes, keep checking
CSAG.4:	CAIGE	T2,(T1)		; Second less than first?
CSAG.6:	 SKIPA	A1,[EXP 1]	; Get the number
CSAG.7:	SETO	A1,		; Yes, return that
	POPJ	P,		;  .  .  .

; Here if the first string ran out of characters

CSAG.2:	SOJL	P4,CSAG.5	; If the second did also, then strings are equal
	ILDB	T2,P3		; Get the next character
	CAILE	T2," "		; Less than a space?
	  JRST	CSAG.7		; Return a one
	CAIN	T2," "		; Is this a space?
	 JRST	CSAG.2		; Yes, try again
	MOVEI	A1,1		; Return a one
	POPJ	P,		; Return to the caller

; Here if the second string ran out of characters

CSAG.3:	ILDB	T1,P1		; Get the character
	CAIGE	T1," "		; Less than a space?
	 PJRST	CSAG.7		; Yes, return greater
	CAIE	T1," "		; Is it a space?
	  JRST	CSAG.6		; Return greater than
	SOJGE	P2,CSAG.3	; Yes, try next character
CSAG.5:	SETZ	T1,		; Return equals
	POPJ	P,		;  .  .  .
	SUBTTL	SQUOTE - Handle single quotes


;+
;.hl1 SQUOTE
; This routine will handle the single quote.  If the next item is
;a double quote, it will process it with a value of true.  Otherwise
;it will just continue processing.
;-

SQUOTE:	PUSHJ	P,SKRCH		; Get the next character
	 POPJ	P,		; End of buffer
	CAXE	CH,""""		; Double quote?
	 PJRST	REEAT		; No, back up over it
	PUSHJ	P,REEAT		; Back up over the quote
	PJRST	RTONES		; Return minus one
	SUBTTL	Utility routines -- GETARG - Return string type args

;+
;.hl1 Utility routines
;.hl2 GETARG
; This routine will take standard arguments and convert them to string
;indices. If the user gave two arguments, it will just return them.
;If the user gave only one argument (or none and TECPRS used a default),
;it will use it as a relative line index.
;It always returns A1 and A2 set up as character indices.
;.hl2 GETCMD
; This routine will work  the same as GETARG except it will only allow
;a single argument in A1 and will work for the command buffer.
;.hl2 GETTXT
; This routine is a generallized GETARG or GETCMD routine.  It will
;expect to be given the text buffer that is to be used for looking
;up the lines.
;.literal
;
; Usage:
;	MOVE	T1,TPT.address
;	MOVE	A1,Number.of.lines
;	PUSHJ	P,GETTXT
;	(Return -- A1 and A2 set up)
;.end literal
;-

GETCMD:	$SAVE	<CH,P1>		; Save CH and P1
	LOAD.	P1,TPTADR,+CMDBUF ; Get the address of the command buffer
	JRST	GETA.A		; Enter by the alternate point

GETARG:	$SAVE	<CH,P1>		; Save CH and P1
	LOAD.	P1,TPTADR,+$QRTPT+TXTBUF ; Get the address of the text buffer
	TXNE	F,F.ARG2	; Were there two arguments?
	 JRST	GETA.6		; Yes, go check if negative
GETA.A:	JUMPLE	A1,GETA.3	; argument negative
	LOAD.	T2,BLKPT,(P1)	; And get the pointer
	MOVE	T1,P1		; Get the buffer address
	MOVE	A2,T2		; Set up the beginning address
	PUSHJ	P,SETINC	; Set up for GETINC
	 JRST	[MOVE	A1,A2		; Get the end for both indices
		POPJ	P,]		; And return
	MOVE	T3,A1		; Get the counter
GETA.1:	MOVE	T1,P1		; Get the buffer address again
	PUSHJ	P,GETINC	; Get the next character
	 JRST	GETA.2		; None left, go set up A1
	PUSHJ	P,CKEOL		; Is it an end of line character
	 JRST	GETA.1		; No, try again
	SOJG	T3,GETA.1	; Is it the correct end of line?

GETA.2:	LOAD.	A1,BLKPT,(P1)	; Get the pointer
	STOR.	A2,BLKPT,(P1)	; And reset it
	POPJ	P,		; And return

; Here if the single argument is negative

GETA.3:	LOAD.	T1,BLKPT,(P1)	; Get the pointer
	SOSGE	T4,T1		; Minus one character
	 JRST	GETA.5		; If negative we don't have to look any further
	IDIVI	T1,5		; Make into a byte pointer
	TDO	T1,BTAB(T2)	;  .  .  .
	ADDI	T1,.BKTLN(P1)	;  .  .  .

GETA.4:	LDB	CH,T1		; Get the character
	PUSHJ	P,CKEOL		; Check if end of line
	 JRST	GETA.7		; Nope, back up the byte pointer and try again
	AOJG	A1,GETA.5	; Yes, are we done?

GETA.7:	$DBP	(T1,T2)		; Decrement the byte pointer
	SOJGE	T4,GETA.4	; And loop unless we hit the start of the buffer
GETA.5:	AOS	A2,T4		; Get the start of the string
	LOAD.	A1,BLKPT,(P1)	; And the end
	POPJ	P,		; And return

; Here if two arguments were given. Check that the first is less than
;the second, and force them to be within the buffer bounds.

GETA.6:	CAMLE	A2,A1		; Make sure first arg given is less than second
	 ERROR	E.SAL		; No, second arg less than first
	JUMPGE	A2,.+2		; First argument okay?
	 SETZ	A2,		; No, assume zero
	CFMGE.	,BLKEND,(P1),A1	; Second arg within valid range?
	 LOAD.	A1,BLKEND,(P1)	; No, get the value
	CFMGE.	,BLKEND,(P1),A2	; First arg within range?
	 LOAD.	A2,BLKEND,(P1)	; No, assume end
	POPJ	P,		; And return
	SUBTTL	Utility routines -- GETAG1/GETAG2

;+
;.HL2 GETAG1 and GETAG2
; These routines are used to fetch the address of a string argument.
;The routines will copy the argument into a new buffer if necessary.
;.lit
;
; Usage:
;	PUSHJ	P,GETAG1(or GETAG2)
;	 (return, T1=text buffer address)
;
;.end lit
;-

GETAG2:	LOAD.	T1,TPTADR,+SARG$2 ; Get the buffer address
	SKPF	CPYAG2		; Does it need to be copied?
	 POPJ	P,		; And return
	XMOVEI	T1,SARG$2	; Yes,get the address
	JRST	GETAG0		; And go do it

GETAG1:	LOAD.	T1,TPTADR,+SARG$1 ; Get the argument buffer address
	SKPF	CPYAG1		; Need to copy it?
	 POPJ	P,		; No, return now
	XMOVEI	T1,SARG$1	; Get the address
	FALL	GETAG0		; And fall into the routine to copy it

; Routine to copy the argument into a new buffer.

GETAG0:	$SAVE	<P1>		; Save P1
	MOVE	P1,T1		; Get the pointer address
	LOAD.	T1,TPTADR,(P1)	; Get the address of the text
	LOAD.	T1,BLKEND,(T1)	; And get the size
	JUMPN	T1,.+2		; Really have a length?
	 MOVEI	T1,1		; No, we really want at least one character
	PUSHJ	P,M$GTXT	; Get the text block
	LOAD.	T2,TPTADR,(P1)	; Get the address of the argument
	LOAD.	T3,BLKEND,(T2)	; Get the size
	JUMPE	T3,.POPJ	; Just return if null string
	STOR.	T3,BLKEND,(T1)	; Save it
	LOAD.	T4,BLKFRE,(T1)	; Get the amount free in new block
	SUB	T4,T3		; Fix it up
	STOR.	T4,BLKFRE,(T1)	; And store it back
	IDIVI	T3,5		; Get the amount of text to move
	JUMPE	T4,.+2		; partial word also?
	 AOJ	T3,		; Yes, count it
	HRLI	T4,.BKTLN(T2)	; Get the source address
	HRRI	T4,.BKTLN(T1)	; And destination
	ADDI	T3,(T4)		; Get the final word
	BLT	T4,-1(T3)	; And copy the argument
	POPJ	P,		; And return the address
	SUBTTL	Utility routines -- SETINC, GETINC, and PUTINC

;+
;.hl2 SETINC, GETINC, and PUTINC
; These routines are used to fetch or store characters in a text buffer.
;The caller must first call SETINC to set up the index for the first
;character to be fetched or stored.
;.b.literal
; Usage:
;	MOVEI	T1,Text.buffer.address
;	MOVEI	T2,Index.into.buffer
;	PUSHJ	P,SETINC
;	 (No characters after pointer)
;	(Good return)
;
;	MOVEI	T1,Text.buffer.address
;	PUSHJ	P,GETINC
;	 (No characters left)
;	(Character in CH)
;
;
;	MOVEI	T1,Text.buffer.address
;	MOVEI	CH,Character
;	PUSHJ	P,PUTINC
;	 (No room left)
;	(Good return)
;
;.end literal
;
; Note that the BLKPT and BLKPTR fields of the text buffer are used
;by these routines.
;-

SETINC:	STOR.	T2,BLKPT,(T1)	; Store the index
	BLDBPT	(T2,(T1))	; Build the byte pointer to it
	STOR.	T2,BLKPTR,(T1)	;  .  .  .
	LOAD.	T2,BLKPT,(T1)	; Get the pointer back
	CFML.	,BLKEND,(T1),T2	; At end of buffer?
	 AOS	(P)		; No, give the good return
	ZERO.	T3,BLKCOL,(T1)	; Flag we need a new column
	POPJ	P,		; return


GETINC:	INCR.	CH,BLKPT,(T1)	; Bump the pointer
	CFMGE.	,BLKEND,(T1),CH	; Hit the end yet?
	 JRST	[DECR.	CH,BLKPT,(T1)	; Yes, back it up
		POPJ	P,]		; And return
	ILDB	CH,.BKPTR(T1)	; Otherwise get the character
	PJRST	.POPJ1		; ANd give the good return


PUTINC:	$SAVE	<P1>		; Save P1
	INCR.	P1,BLKPT,(T1)	; Bump the pointer
	CFMGE.	,BLKEND,(T1),P1	; Hit the end?
	 JRST	[DECR.	P1,BLKPT,(T1)	; Yes, back up the pointer
		POPJ	P,]		; And return
	IDPB	CH,.BKPTR(T1)	; Otherwise store the character
	PJRST	.POPJ1		; And return happy

	SUBTTL	Utility routines -- BTAB - Byte pointer table

; This table is used to convert a character index into a byte pointer

	POINT	7,		; Initial byte pointer for ILDB/IDPB
BTAB:

REPEAT 5,<
	POINT	7,,6+<<.-BTAB>*7> ; Generate the rest of the pointers
> ; End of REPEAT 5
	SUBTTL	Utility routines -- CKEOL - Check if CH contains an EOL

;+
;.hl2 CKEOL
; This routine will check if the character in CH is an end of line
;character.  Which characters are considered to be end of line characters
;is dependant upon the EO level.
;.b.literal
; Usage:
;	MOVEI	CH,Character.to.check
;	PUSHJ	P,CKEOL
;	 (Character is not an end of line)
;	(Character is an end of line)
;
;.end literal
;-

CKEOL:	CAXN	CH,.CHLFD	; Line feed?
	 JRST	.POPJ1		; Yes, give the good return
	CHKEO	EO21,.POPJ	; Any other EOL's allowed?
	CAXE	CH,.CHVTB	; Yes, is this one of them?
	 CAXN	CH,.CHFFD	;  .  .  .
	  AOS	(P)		; Yes, give the skip return
	POPJ	P,		; Return
	SUBTTL	Utility routines -- GETFDI - Get the address of an FDB

;+
;.hl2 GETFDI
; This routine will get the address of an FDB from a text buffer.
;.b.literal
; Usage:
;	MOVEI	T1,Text.buffer.address
;	PUSHJ	P,GETFDI
;	 (No file associated with buffer)
;	(T1= FDB address)
;
;.end literal
;-

GETFDI:	MOVX	T2,TF.OPI	; Check if buffer has a file
	TDNN	T2,.BKTFL(T1)	;  .  .  .
	 POPJ	P,		; No file for this buffer
	LOAD.	T1,BLKFDI,(T1)	; Get the address
	PJRST	.POPJ1		; And return happy
	SUBTTL	Utility routines -- GETFDO - Get the address of an FDB

;+
;.hl2 GETFDO
; This routine will get the address of an FDB from a text buffer.
;.b.literal
; Usage:
;	MOVEI	T1,Text.buffer.address
;	PUSHJ	P,GETFDO
;	 (No file associated with buffer)
;	(T1= FDB address)
;
;.end literal
;-

GETFDO:	MOVX	T2,TF.OPO	; Check if buffer has a file
	TDNN	T2,.BKTFL(T1)	;  .  .  .
	 POPJ	P,		; No file for this buffer
	LOAD.	T1,BLKFDO,(T1)	; Get the address
	PJRST	.POPJ1		; And return happy
	SUBTTL	Utility routines -- WRTBUF - Write out the buffer

;+
;.hl2 WRTBUF
; This routine will write out a given portion of the buffer. If F.ARG2
;is on it will write out the portion specified by A1/A2 with no form feed.
;If F.ARG2 is off, it will write out the entire buffer and append a form
;feed unless F.NSRH is on.
;.b.literal
; Usage:
;	MOVEI	T1,Text.buffer.address
;	PUSHJ	P,WRTBUF
;	(return here)
;
;.end literal
;-

WRTBUF:	$SAVE	(<P1,P2,P3,P4>)	; Save some room to work
	$SAVE	<A1,A2>		; Save the arg ac's also
	MOVE	P1,T1		; Get the address
	TXNN	F,F.ARG2	; Two args?
	 SETZ	A2,		; No, make sure it is clear
	TXNN	F,F.ARG2	;  .  .  .
	 LOAD.	A1,BLKEND,(P1)	; Get the ending address
	MOVE	T1,P1		; Get the buffer address
	PUSHJ	P,GETFDO	; Get the output FDB address
	 ERROR	E.NFO		; None
	MOVE	T4,T1		; Get a copy
	MOVE	T1,P1		; Get the buffer address back
	LOAD	T2,F,F.ARG2	; Get the form feed flag
	LOAD	T3,F,F.NSRH	; And the forced form feed
	PJRST	F$WBUF		; Write out the data

	SUBTTL	Low segment

	$IMPURE			; To the impure section
	LOWVER(CMD,2)		; Low segment version number

; Storage for loops ("<...>")

ITERCT:	BLOCK	1		; Iteration count
LOPADR:	BLOCK	1		; Address in command buffer for start of current loop
ANGLVL:	BLOCK	1		; Current depth in angle brackets

; Storage for insert command

STAINS:	BLOCK	1		; Address in buffer of beginning of insert string
INSRCH:	BLOCK	1		; Address of routine to call to get a character
INSREE:	BLOCK	1		; Re-eat routine
OLDREE:	BLOCK	1		; Old re-eat routine
OLDINR:	BLOCK	1		; Address of level 0 input routine for INSERT
CTGLVL:	BLOCK	1		; Current nesting level of ^G's
CTGBUF:	BLOCK	1		; Address of current Q-register

EOFLAG:	BLOCK	1		; EO flag
AUTOF:	BLOCK	1		; Auto type out after search flag

QTAB:	BLOCK	<.QRMAX+1>*$QRLEN	; Q-registers

TXTBUF:	BLOCK	$QRLEN		; Address of the text buffer

; Items for scanning off Q-register names

QRNQRG:	BLOCK	1		; Address of nested QRG
QRNTPT:	BLOCK	$TPLEN		; Pointer to text buffer

; Last Q-register name

LASQRG:	BLOCK	1		; Last Q-register name

; Last Label STE address

LASLBL:	BLOCK	1		; Last label STE address
	SUBTTL	End of TECCMD

	END			; End of TECCMD