Google
 

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

; Copyright (c) 1980, 1981 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 Stevens Institute of
; Technology.

  ; Search needed universals

	SEARCH	TECUNV		; TECO universal file

  ; Generate the prologue


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


	PROLOGUE(ECM,<TECO E command processing>)	; Generate the TITLE and other stuff
	SUBTTL	Table of Contents

;+
;.pag.lit

;		Table of Contents for TECECM - E command processing
;
;
;			   Section			      Page
;   1. Introduction . . . . . . . . . . . . . . . . . . . . .    1
;   2. Table of Contents. . . . . . . . . . . . . . . . . . .    2
;   3. Revision History . . . . . . . . . . . . . . . . . . .    3
;   4. Misc symbol definitions. . . . . . . . . . . . . . . .    4
;   5. E Commands
;        5.1.   Initialization. . . . . . . . . . . . . . . .    5
;        5.2.   E. - Switch editing buffers . . . . . . . . .    6
;        5.3.   E<(Q-reg) - Type input file name into buffer.    7
;        5.4.   E>(Q-reg) - Type output file name into buffer    8
;        5.5.   EL
;             5.5.1.     LOGCHR . . . . . . . . . . . . . . .    9
;             5.5.2.     MAKLOG . . . . . . . . . . . . . . .   10
;        5.6.   EE - Write out a save file. . . . . . . . . .   12
;        5.7.   EE - Restart code . . . . . . . . . . . . . .   14
;        5.8.   EE
;             5.8.1.     RST - Restart routine. . . . . . . .   15
;        5.9.   EC - Perform a garbege collection . . . . . .   16
;        5.10.  EI and EP - Read into a Q-register. . . . . .   17
;        5.11.  EQ - Write out Q-register . . . . . . . . . .   20
;        5.12.  EG - Exit closing all files & run COMPIL. . .   21
;        5.13.  EX
;             5.13.1.    Exit closing all files . . . . . . .   22
;             5.13.2.    Common routines
;                  5.13.2.1.      FINI.0. . . . . . . . . . .   23
;                  5.13.2.2.      CLSFIL. . . . . . . . . . .   24
;                  5.13.2.3.      FIN.EB. . . . . . . . . . .   25
;        5.14.  ED (Run a program on exit). . . . . . . . . .   26
;        5.15.  ET - Set type out mode. . . . . . . . . . . .   29
;        5.16.  EO. . . . . . . . . . . . . . . . . . . . . .   30
;        5.17.  EU command. . . . . . . . . . . . . . . . . .   31
;        5.18.  ES. . . . . . . . . . . . . . . . . . . . . .   32
;        5.19.  EH - Change error message level . . . . . . .   33
;        5.20.  EK - Kill off the output file . . . . . . . .   34
;        5.21.  EN - rename the input file. . . . . . . . . .   35
;        5.22.  ER - Read a file. . . . . . . . . . . . . . .   36
;        5.23.  EB - Edit and backup command. . . . . . . . .   37
;        5.24.  EW - Write a file . . . . . . . . . . . . . .   39
;        5.25.  EA - Append to a file . . . . . . . . . . . .   39
;        5.26.  EZ and EF . . . . . . . . . . . . . . . . . .   41
;        5.27.  EM - MTAPE UUO's. . . . . . . . . . . . . . .   43
;        5.28.  Subroutines
;             5.28.1.    E$DFLT . . . . . . . . . . . . . . .   44
;   6. Low segment. . . . . . . . . . . . . . . . . . . . . .   45
;   7. End of TECECM. . . . . . . . . . . . . . . . . . . . .   46

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

1000	Start of this version

1006	By: Nick Bush		On: 28-July-1980
	1. EE files get "Not a save file" from monitor. The byte size specified in
	   TECUNV was getting expanded as 36 octal, not decimal.
	
	2. EW was using the wrong address for calling F$RSET when there already was
	   an output file. Make it use the FDB address, not the text buffer address.
	Modules: TECUNV,TECECM

1014	By: Nick Bush		On: 11-August-1980
	1) Don't do the AUTO-BUFFER command if we had a error on the last command.
	   This avoids losing info for the error messages.
	2) Make an EB/ER/EX sequence end up renaming the correct files, not
	   trying to rename the ER'ed file to the EB'ed file.BAK, ...
	3) Make TEC file=file work the way it is supposed to.
	Modules: TECPRS,TECFIL,TECECM,TECINI

1016	By: Robert McQueen		On: 12-August-1980
	- Log files do not work for /NOOUTPUT and /NOINPUT
	- Make :E< and :E> work.
	Modules: TECECM

1017	By: Robert McQueen		On: 12-August-1980
	- The ENQ'd path was wrong sometimes, test backwards.
	- ^Z command caused files to be renamed for EB'd files.
	Modules: TECTRM,TECECM

1030	By: Robert McQueen		On: 21-August-1980
	- Clean up defaulting routines
	- Prevent EB files from always seeming to be /INPLACE.
	Modules: TECFIL,TECECM

1061	By: Nick Bush		On: 18-December-1980
	1) Finish and debug Tektronix 4025 support.
	2) Add FW command.
	3) Add capability of logging screen update info in log file.
	Modules: TECUNV,TECTEK,TECSRH,TECTBL,TECECM,TECVID,TECERR

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

1074	By: Nick Bush		On: 23-January-1981
	Make TECONC ask for an initial command string for TECINI. This can be
	any set of TECO commands terminated by two altmodes.
	Also make TECECM do a physical-only GETSEG during an EE file restart if
	the original run-from info was gotten from the GETTAB's.
	Modules: TECINI,TECONC,TECECM

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

1100	By: Robert McQueen		On: 8-Febuary-1981
	- Issue a ?TECNFO error message if there are no files for output on an EX
	  command or anything else that runs through FINI.0.
	- Cause the ?TECNFO error message from the above to only print one.  U$WW??
	  should not save TY.OBY on the stack, but use the ^X feature of $STRING.
	Modules: TECECM,TECUUO

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

1125	By: Robert McQueen		On: 29-September-1981
	- Make symbol table entries movable blocks.
	- Use the new linked list processing.
	- Initial work to make TECSYM run in non-zero section.
	Modules: TECUNV,TECECM,TECSYM,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

1135	By: Nick Bush		On: 21-December-1981
	Add /YANK and /NOYANK switches to ER and EB commands.  These will
	cause an EY command to be done along with the ER/EB command.
	The switch will have a single default for both ER and EB.
	Modules: TECECM

1140	By: Nick Bush		On: 1-January-1982
	Fix E?TERMINAL-TYPE$ to not put a CRLF after the terminal name.
	Modules: TECECM

1141	By: Nick Bush		On: 1-January-1982
	Fix EW/EA command to correctly turn off the "output open" flag when
	reseting the previous file.
	Modules: TECECM

1142	By: Nick Bush		On: 3-January-1982
	Fix SETWIN to properly copy the VIN block when it had to be expanded
	and moved.  It was not copying the last word of the old block.
	Modules: TECECM

1147	By: Nick Bush		On: 17-March-1982
	Fix control-C code to correctly restore T1-3 before saving them on the stack.
	This got broken when the check for DDT was put in.
	Modules: TECECM

1151	By: Nick Bush		On: 24-March-1982
	Add Q-register 'EXIT-BUFFER' to be executed whenever TECO is exiting.
	Also remove the string to set VT-100's to smooth scroll on exit.  This
	can now be done by putting the correct macro in 'EXIT-BUFFER'.
	Modules: TECUNV,TECECM,TECPRS,TECTBL,TECDEC

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

1164	By: Nick Bush		On: 29-May-1982
	Last edit broke redefining the screen without intervening update.
	In SETWIN, always call SC$CLS, whether the Q-reg claims to be displayed
	or not.
	Modules: TECECM
|
	SUBTTL	Misc symbol definitions

; The following symbols are not defined in UUOSYM.  These are the GETSEG
; and RUN arguments

TOPS10<
	$RNDEV==0		; Offset to the device name
	$RNNAM==1		; Offset to the name
	$RNEXT==2		; Offset to the extension
	$RNPPN==4		; Offset to the PPN
	$RNCOR==5		; Offset to the core argument (Right half)
>; End of TOPS10
	SUBTTL	E Commands -- Initialization

;+
;.HL1 E$INIT
;Here to initialize the E command processing.
;-

	$CODE			; In the CODE PSECT


; First define the permanent default file specs.

PDF$EW:
PDF$ER:
;PDF$EB:
	$BUILD	FDB,.FDLEN	; Initialize the macro
	$SET	DEV,<SIXBIT |DSK|> ; Default device name
	$EOB			; End of the block

PDF$EL:	$BUILD	FDB,.FDLEN	; Prime the macro
TOPS10<
	$SET	DEV,<SIXBIT |DSK|> ; Default the device name
	$SET	NAM,<SIXBIT |TECO|> ; Default the name
	$SET	EXT,'LOG'	; Default the extension
>; End of TOPS10
TOPS20<
	$SET	FIL,<ASCIZ |DSK:TECO.LOG|>
>; End of TOPS20
	$SET	FLG,FD.HEX	; And the flags
	$EOB			; End the block

PDF$EQ:	$BUILD	FDB,.FDLEN	; Prime the macro
	$SET	NAM,<SIXBIT |TECO|> ; Default the name
	$SET	EXT,'TEC'	; Default the extension
	$SET	FLG,FD.HEX	; And the flags
	$EOB			; End the block

PDF$EE:	$BUILD	FDB,.FDLEN	; Prime the macro
TOPS10<
	$SET	DEV,<SIXBIT |DSK|> ; Default the device name
	$SET	NAM,<SIXBIT |TECO|> ; Default the name
	$SET	EXT,'SAV'	; Default the extension
>; End of TOPS10 conditional
TOPS20<
	$SET	FIL,<ASCIZ |DSK:TECO.EXE|>
>; End of TOPS20
	$SET	FLG,FD.HEX	; And the flags
	$EOB			; End the block


E$INIT:	STORE	T1,E$ZBEG,E$ZEND,0 ; Clear the data
	STORE	T1,E$OBEG,E$OEND,-1 ; And initialize the default switches
	MOVE	T1,[XWD RUNCOD,ED$COD] ; Get set to move the code
	BLT	T1,ED$COD+RUNLEN-1 ; Move all the RUN UUO code

DEFINE ..DFT(NAME),<IRP <NAME>,<
	MOVE	T1,[XWD PDF$'NAME,DEF$'NAME] ;; Get the BLT pointer
	BLT	T1,DEF$'NAME+.FDLEN-1 ;; And copy the block
>> ; End of ..DFT(NAME)

; Now set up the defaults

	..DFT(<EW,EL,ER,EE,EQ>)

; Set up the default switch tables

	STORE	T1,ER$DFS,ER$DFS+<ER$END-ER$BEG>,-1 ; All defaults in ER

; Set up the EO instruction table.

	MOVX	A1,EOVAL	; Get the value
	PJRST	OLD.0		; And go set it
	SUBTTL	E Commands -- E. - Switch editing buffers

;+
;.HL1 SWTBUF
; This routine will cause the editing buffer to be changed to the given
;Q-register.  The editing buffer initially the "." Q-register.
;.literal
;
; Command format:
;
;	E.(Q-register)
;
; Q-register - This is the new editing buffer.
;.end literal
;-

SWTBUF:	SETZ	T1,		; Clear the default Q-register
	PUSHJ	P,SCNQRG	; Scan off the Q-reg names
	  ERROR	E.IQN		; ++ Invalid Q-reg name
	MOVE	T2,$QRFLG(T1)	; Get the flags
	TXNE	T2,QR$WRT	; Allowed to write into this?
	 ERROR	E.DOQ		; No, display only
	TXNE	T2,QR$TXT!QR$EDT ; Allowed to have text in this?
	 ERROR	E.VOQ		; No, value only
	MOVE	P1,T1		; Copy the index
	MOVEI	T1,TXTBUF+$QRTPT ; Get the address of the TPT
	SKIPE	$TPADR(T1)	; If not text then skip this
	 PUSHJ	P,M$RELB	; Release the block

	LOAD.	T1,QRGDTP,(P1)	; Get the Q-register data type
	CAXN	T1,$DTTXT	; Is there text in it?
	 JRST	SWTB.0		; Yes, leave it alone
	MOVX	T2,$DTTXT	; Get the new type
	XCT	RQRGTB(T1)	; And change types

	MOVX	T1,D.TXTS	; Get the default text size
	PUSHJ	P,M$GTXT	; Allocate a text buffer
	MOVEI	T2,$QRTPT(P1)	; Get the address
	PUSHJ	P,M$USEB	; Store it

; Now release the current text buffer

SWTB.0:	MOVEM	P1,CUREDT	; Save the QRG address we are currently editing
	LOAD.	T1,TPTADR,+$QRTPT(P1) ; Get the buffer address
	PUSHJ	P,S$TAGC	; Clean up any tags laying around
	LOAD.	T1,TPTADR,+$QRTPT(P1) ; Get the address of the block
	MOVEI	T2,TXTBUF+$QRTPT ; And the new text buffer
	PJRST	M$USEB		; Set it as the new text buffer
	SUBTTL	E Commands -- E$ - Set window items.

;+
;.HL1 E$
;This command will set which q-registers are typed on the screen for the
;screen editing.  It will require two arguments.
;.literal
;
; Command format:
;
;	m,nE$(q-register)
;
; m - Starting line number.
; n - Ending line number.
; q-register - Item to be displayed.
;
;.end literal
;-

SETWIN:	SETZ	T1,		; No default
	PUSHJ	P,SCNQRG	; Scan the q-register name
	 ERROR	E.IQN		; Illegal Q-register name
	LOAD	T2,$QRFLG(T1),QR$DIS ; Can we display this one ?
	JMPT	T2,[ERROR E.VOQ] ; No, Value only Q-register
	PUSHJ	P,QTXTEI	; Have any text in the Q-register ?
				;  Does not return if not
	MOVE	P1,T2		; Copy the address to a safe place
	SKIPN	$CRXYP(CRT)	; Have a terminal which supports this?
	 ERROR	E.NSM		; No, punt
	CAMLE	A1,A2		; Are they in the correct order
	 EXCH	A1,A2		; No - Put them in the correct order
	JUMPLE	A1,ERRLOR	; This one valid?
	JUMPLE	A2,ERRLOR	; How about this one
	CAMG	A1,$CRLIN(CRT)	; Within range ?
	 CAMLE	A2,$CRLIN(CRT)	; . . .
ERRLOR:	  ERROR	E.LOR		; ++ Line number out of range
	SOJ	A1,		; Decrement to internal form

; Now we must update the VIN block to include this QRG, remove any conflicting
;QRG, and update the max screen length seen so far.

	SKIPE	VINADR+$TPADR	; Already have the block?
	 JRST	SETW.1		; Yes, must go do all the checks
	MOVE	T1,A2		; Get the last line number
	ADDX	T1,$VIQRG-.BKLEN ; Get the correct length needed
	MOVX	T2,.BTMOV	; And the block type
	PUSHJ	P,M$ZBLK	; Get a block
	SUBX	T1,.BKLEN	; Point to the start of the block
	XMOVEI	T2,VINADR	; Get the address of the pointer
	PUSHJ	P,M$USEB	; Set it up
	MOVE	P2,T1		; Get a copy
	STOR.	A2,VINNLN,(P2)	; Store the number of lines
	JRST	SETW.3		; And go setup the QRG

; Here if we already have a VIN block.  Check to see if we are conflicting
;with any of the entries.
;First check to see if this QRG is already displayed.

SETW.1:	LOAD.	P2,TPTADR,+VINADR ; Get the address of the VIN block
	MOVE	T1,P1		; Get the address of the QRG
	PUSHJ	P,SC$CLS	; Clear out that section of video info

; See if we need to expand the block

SETW.2:	LOAD.	T2,VINNLN,(P2)	; Get the number of lines in the block
	CAML	T2,A2		; Enough?
	 JRST	SETW.3		; Yes, skip the expansion

	SUBM	A2,T2		; Get the amount we need to add
	MOVE	T1,P2		; Get the address of the block
	PUSHJ	P,M$APPD	; And expand the block
	 JRST	.+2		; Need to copy the data
	  JRST	SETW.3		; Nothing to copy

	MOVE	P2,T3		; Here also
	XMOVEI	T2,$VINLN(T1)	; Get the old address
	XMOVEI	T3,$VINLN(T3)	; And the new
	LOAD.	T1,VINNLN,(T1)	; And the old size
	AOJ	T1,		; Plus one word for the number of lines
	PUSHJ	P,M$MCOR	; Move the data

; Now set up the correct lines with the QRG address.  If there already is
;something displayed there, remove the display attributes.

SETW.3:	LOAD.	P2,TPTADR,+VINADR ; Get the address of the info
	CFMGE.	,VINNLN,(P2),A2	; This a new max?
	 STOR.	A2,VINNLN,(P2)	; Yes, save it
	MOVE	P3,A1		; Get the first line number
	ADD	P3,P2		; And point to the VIN info
	SUB	A2,A1		; Get the number of lines
	MOVE	P4,A2		; Get a copy

SETW.4:	LOAD.	T1,VINQRG,(P3)	; Get the QRG address
	JUMPE	T1,SETW.5	; If nothing was displayed here, try the next
	PUSHJ	P,SC$CLS	; Clear out this QRG display info

SETW.5:	STOR.	P1,VINQRG,(P3)	; Store the info
	AOJ	P3,		; Advance to the next line
	SOJG	P4,SETW.4	; And go do it

	BITON	T1,QR$VLU!QR$FCT,$QRFLG(P1) ; Flag this is displayed
	POPJ	P,		; And return
	SUBTTL	E Commands -- EV processing -- General command

;+
;.HL1 EV command
; The EV command is handled by the VIDEO routine.  This routine will set
;various terminal parameters, return information or set the terminal type
;for the user.  This command has the format of one of the following:
;.literal
;
;	arg1,arg2EV$		- Set parameter arg2 to have the value arg1
;	EVterminal$		- Set the terminal type to be 'terminal'
;	EVparameter$		- Return a value of a parameter
;	argEVparameter$		- Set the parameter to be ARG
;.end literal
;-

VIDEO:	MOVEI	T1,[ERROR E.UTK] ; Get the error name
	PUSHJ	P,F$SETI	; Set the input routine
	PUSHJ	P,F$SXBT	; Input a sixbit token
	TXNE	F,F.ARG		; An argument seen ?
	 JRST	VIDCHG		; Yes - Other type of processing
	MOVE	T2,CRTPTR	; Set up for the matching routine
	PUSHJ	P,LOKNAM	; Look for this in the table
	 JRST	[JUMPE	T2,VIDE.0	; If unknown see if parameter
		ERROR	E.ABT]		; Not - Ambig
	MOVEI	T2,-CRTTAB(T2)	; Calculate the offset

	MOVE	CRT,CRTDSP(T2)	; Get the first parameter
	MOVEM	CRT,CRTTYP	; Store the flags
; Check if there is an initialization string and if we are in video mode.
;If so, do the initialization now.

	JMPNS	.POPJ		; If not screen mode, just return
	PJRST	INTCRT		; Initialize the terminal

; Here if it was not a terminal type to set.  Try for a parameter

VIDE.0:	MOVE	T2,PARPTR	; Get the pointer to the parameter table
	PUSHJ	P,LOKNAM	; Lookup the value
	  JRST	[SKIPE	T2		; Unkown ?
		  ERROR	E.ABV		; Ambiguous parameter
		  ERROR	E.UTP]		; Unknown video parameter
	MOVEI	T1,-VPRMTB(T2)	; Get the offset into the table
	SKIPE	VPRMVAL(T1)	; Have something to do??
	 XCT	VPRMVAL(T1)	; Yes, do it
	SKIPE	T1,VPRMOFS(T1)	; Get the offset into the CRT block
	 MOVE	T1,CRTFNC(T1)	; And get the value
	PJRST	VALRET		; Go return the value

CRTPTR:	XWD -NUMCRT,CRTTAB	; Pointer to the table of CRT names
PARPTR:	XWD -VPRMLN,VPRMTB	; Pointer to the table of video parameters
	SUBTTL	E Commands -- EV processing -- Parameter setting

; Here if the EV command had numerical arguments

VIDCHG:	JUMPN	T1,VIDPRM	; Try for a keyword
	SUBI	A1,1		; Correct the offset (So symbols work)
	TXZE	F,F.ARG2	; Only one argument ?
	 ERROR	E.ROP		; ++ Read only parameter
	SKIPL	A1		; Check the range
	CAILE	A1,$CRMAX	; . . .
	ERROR	E.VOR		; ++ Value out of range
	MOVE	A1,CRTTYP(A1)	; Get the value
	JRST	VALRET		; Return the value
	SUBTTL	E Commands -- EV processing -- Parameter keywords

;VIDPRM - Routine to handle VIDEO terminals parameters.
;This routine will dispatch to the correct routine to handle the video
;parameters.

VIDPRM:	MOVE	T2,[XWD -VPRMLN,VPRMTB] ; Get the table offset
	PUSHJ	P,LOKNAM	; Lookup in the table
	  JRST	[SKIPE	T2		; Unknown ?
		 ERROR	E.ABV		; ++ Ambigous video parameter
		ERROR	E.UVP]		; ++ Unknown video parameter
	MOVEI	T2,-VPRMTB(T2)	; Get the offset
	SKIPE	VPRMRT(T2)	; Have a routine??
	 JRST	@VPRMRT(T2)	; Dispatch to the routine
	ERROR	E.ROP		; Read-only video parameter
	SUBTTL	E Commands -- EV processing -- Keyword table

DEFINE	VIDPR.,<
VPRM	FAST,,,VPFAST
VPRM	LINE,,,RTLINE
VPRM	MODE,,,RTMODE
VPRM	NODE,,,RTNODE
VPRM	OFF,,,VPOFF
VPRM	ON,,,VPON
VPRM	REFRESH,,,VPREFRESH
VPRM	SCREEN,VPSCREEN,,RTSCREEN
VPRM	SCROLL,VPSCRL,,RTSCRL
VPRM	SLOW,,,VPSLOW
VPRM	TRMOP,RTTRMP
VPRM	UPDATE,VPUP.0,,VPUPDATE
VPRM	WINDOW,VPWINDOW,,RTWINDOW
>; End of the VIDPR. definition

DEFINE	VPRM(A,B,C,D),<EXP SIXBIT |A| >

VPRMTB:	VIDPR.
	VPRMLN==.-VPRMTB

DEFINE	VPRM(A,B,C,D),<EXP B>
VPRMRT:	VIDPR.

DEFINE	VPRM(A,B,C,D),<EXP C>

VPRMOFS:
	VIDPR.			; Generate the offsets

DEFINE	VPRM(A,B,C,D),<IFNB <D>,<JRST D ;> 0>

VPRMVAL:
	VIDPR.			; Generate the instructions
	SUBTTL	E Commands -- EV processing -- SCROLL parameter

; This parameter is used to determine whether the command section of the screen
;should be scrolled or not.

VPSCRL:	TXZ	S,S.SCRL	; Assume no scrolling
	JUMPE	A1,.POPJ	; If zero, don't scroll
	TXO	S,S.SCRL	; Otherwise flag we should scroll if possible
	POPJ	P,		; And return

RTSCRL:	TXNE	S,S.SCRL	; Check the flag
	 PJRST	RTONES		; Return -1
	PJRST	RETZER		; Return 0
	SUBTTL	E Commands -- EV processing -- ON command

; This command will turn on OLD video mode.

VPON:	SKIPN	$CRXYP(CRT)	; Can we do this?
	 POPJ	P,		; No, just return
	TXOE	S,S.SCRN	; Flag we are in complete video mode now
	 POPJ	P,		; Already were, skip this
	SETZM	OUTFLG		; Clear the flag to avoid an unnecessary --cont--
	PUSHJ	P,INTCRT	; Initialize the terminal
	PUSHJ	P,T$SRTN	; And set up the typein/out routines
	SKIPE	T1,$CRERS(CRT)	; Have a way to erase the screen?
	 PUSHJ	P,SC$STR	; Yes, do it
	SETZM	CURPOS+$OFSX	; Remember where we are
	SETZM	CURPOS+$OFSY	;  .  .  .
	POPJ	P,		; And return

INTCRT:	SKIPE	$CRINT(CRT)	; Need to do this?
	 XCT	$CRINT(CRT)	; Initialize the terminal
	POPJ	P,		; And return

	SUBTTL	E Commands -- EV processing -- OFF command

; Here to clear video mode

VPOFF:	TXZN	S,S.SCRN	; Clear the flags
	 POPJ	P,		; Return
	PUSHJ	P,SC$ERS	; Erase the whole screen
	XCT	$CRFIN(CRT)	; Cause the terminal to be put in reasonable state
	PUSHJ	P,SC$RVD	; Return the video info
	PUSHJ	P,T$SRTN	; Set the typein routines
	PJRST	.TCRLF		; And type a CRLF

	SUBTTL	E Commands -- EV processing -- MODE command
;+
;.hl2 RTMODE
; This command will return the state of the video mode flags.
;It returns values as follows: 0 for video processing turned off
;(version 124A terminal I/O), -1 for video processing turned on in
;version 125 mode, 1 for video processing turned on in IMMEDIATE
;(MAGIC) mode.
;-

RTMODE:	JMPNS	RETZER		; Return a zero if not on at all
	MOVX	A1,-1		; No, get the correct value
	PJRST	VALRET		; And return it
	SUBTTL	E Commands -- EV processing -- WINDOW command
	SUBTTL	E Commands -- EV processing -- SCREEN command

;+
;.HL2 RTWINDOW
;Return the widow size of the window.
;-

RTWINDOW:
RTSCREEN:
	SKIPN	T1,SCRNLN	; Have the screen set up yet?
	 SKIPE	T1,CRTLEN	; Have the length set by the user yet?
	  JRST	RTWI.1		; Yes, go return it
	SKIPN	T1,TRMLEN	; No, get the length from the TRMOP
	 MOVE	T1,$CRLIN(CRT)	; Wasn't one, get the default
RTWI.1:	SKIPN	A1,SCRWID	; Get the width of the screen
	 SKIPE	A1,CRTWID	; Isn't one yet, get that set by user
	  JRST	.+2		; We have the width
	   MOVE	A1,TRMWID	; Otherwise use width from TRMOP.
	HRL	A1,T1		; Set up the values
	AOJA	A1,VALRET	; And return the value



; Here for EVSCREEN and EVWINDOW commands which had arguments
; A1 will contain the new width, and A2 the new length (if given)

VPWINDOW:
VPSCREEN:
	JUMPL	A1,[MOVE A1,$CRWID(CRT)	; Negative value means use default
		JRST	VPWI.1]		;  .  .  .
	SOJGE	A1,.+2		; Convert to internal width
	 SETZ	A1,		; Zero or one means use default
VPWI.1:	ANDX	A1,777		; Keep it reasonable
	MOVEM	A1,CRTWID	; Save the width
	TXNN	F,F.ARG2	; Second argument given?
	 POPJ	P,		; No, just return now
	JUMPGE	A2,.+2		; Want default value?
	 MOVE	A2,$CRLIN(CRT)	; Yes, get it
	ANDX	A2,777		; Keep the length reasonable
	MOVEM	A2,CRTLEN	; Save the value
	POPJ	P,		; And return
	SUBTTL	E Commands -- EV processing -- Refresh command

VPREFRESH:
SC$REF:	PUSHJ	P,SC$ERS	; Erase the screen
	POPJ	P,		; Return


	SUBTTL	E Commands -- EV processing -- Update command

;.hl2 VPUPDATE
; This routine is called when a EVUPDATE$ command is given. It will
;cause the screen to be updated.
;-

VPUP.0:	$SAVE	<NOTYIA>	; Save the type-ahead flag
	MOVEM	A1,NOTYIA	; Save the new value

VPUPDATE:
	MOVX	T1,.TRUE	; SC$UPD should use new user info if any
	JRST	SC$UPD		; Call the update routine
	SUBTTL	E Commands -- EV processing -- NODE command

;+
;.HL1 EVNODE
; This command will return the value of the node number to which the
;controlling terminal is attached.
;-

RTNODE:	MOVE	A1,TRMUDX	; Get our UDX
	GTNTN.	A1,		; Get the node number
	 JRST	RETZER		; Not a network system
	HLRZ	A1,A1		; Get the node number for our terminal
	JRST	VALRET		; And return it


	SUBTTL	E Commands -- EV processing -- LINE command

;+
;.HL1 EVLINE
; This command returns the line number on the node on which the terminal
;controlling this job is connected.
;-

RTLINE:	MOVE	A1,TRMUDX	; Get the teminal UDX
	MOVE	T1,A1		; Get a copy
	SUBX	T1,.UXTRM	; And convert to line number
	GTNTN.	A1,		; Get the node and line on node
	 MOVE	A1,T1		; Not a network system, return the line number
				; from TRMNO.
	HRRZ	A1,A1		; Clear the node number
	JRST	VALRET		; And return the value
	SUBTTL	E Commands -- EV processing -- TRMOP command

;+
;.HL1 EVTRMOP
; This command will perform a TRMOP. for the users terminal.  A1 will
;contain the TRMOP. function, and A2 will contain the argument (if any).
;It will return the value from the TRMOP. if it returns one.
;-

RTTRMP:	MOVE	T2,A1		; Get the function code
	MOVE	T3,TRMUDX	; And the UDX
	MOVE	T4,A2		; Get the argument (maybe)
	MOVX	T1,<XWD 3,T2>	; Get the pointer
	CAXL	A1,^O1000	; Legal function?
	 TRMOP.	T1,		; Yes, do it
	  ERROR	E.ITT		; Illegal function
	MOVE	A1,T1		; Get the return value
	CAXE	T1,<XWD 3,T2>	; Did we get our arg pointer back?
	 PJRST	VALRET		; No, return the value
	POPJ	P,		; Yes, no value
	SUBTTL	E Commands -- EV processing -- FAST command

;+
;.HL1 EVFAST
;This command will set a flag telling TECO to override the smart video
;updating. It comes in handy on fast terminals and slow systems.
;.Literal
; Command usage:
;	EVFAST$
;
;.End literal
;-

VPFAST:	SETOM	FSTFLG		;Set the fast flag
	POPJ	P,		;Return
	SUBTTL	E Commands -- EV processing -- SLOW command

;+
;.HL1 EVSLOW
;This comand is the opposite of the EVFAST command. It tells TECO
;to use smart updating. It comes in handy on slow terminal and fast systems
;.Literal
; Command usage:
;	EVSLOW$
;
;.End literal
;-

VPSLOW:	SETZM	FSTFLG		;Clear the fast flag
	POPJ	P,		;Return
	SUBTTL	E Commands -- E<(Q-reg) - Type input file name into buffer

;+
;.HL1 E<
;This command will type the input file specification into the current editing
;buffer.
;.literal
; Command usage:
;	E<(Q-register)$
;
;.end literal
;-

E$LANG:	SETZ	T1,		; No default
	PUSHJ	P,SCNQRG	; Scan for the Q-register name
	 ERROR	E.IQN		; Missing Q-register name
	PUSHJ	P,QTXTEI	; Have any text in the Q-register ?
	PUSHJ	P,GETFDI	; Get the FD assoicated with the input file
	 ERROR	E.NFI		; No file for input

; Here for the typing of the FD into the current editing buffer.  Set up
; a $STRING to type the information into the buffer and return

LANG.0:	MOVE	P1,T1		; Copy the information to a safer place
	MOVEI	T1,TXTBUF+$QRTPT ; Get the current editing buffer
	MOVEI	T2,[$STRING(<^F/P1/^N>)] ; Get the string to type
	PJRST	.INSRT		; Insert it into the buffer
	SUBTTL	E Commands -- E>(Q-reg) - Type output file name into buffer

;+
;.HL1 E>(Q-reg)
;This command will cause the output file specification associated with
;the named Q-register to be typed into the current editing buffer.
;.literal
; Command Usage:
;
;	E>(Q-register-name)$
;
;.end literal
;-

E$RANG:	SETZ	T1,		; No default name
	PUSHJ	P,SCNQRG	; Scan for the Q-register name
	 ERROR	E.IQN		; Failed, Issue an error message
	PUSHJ	P,QTXTEI	; Have any text in the Q-register ?
	PUSHJ	P,GETFDO	; Get the output FD block
	  ERROR	E.NFO		; No file for output
	PJRST	LANG.0		; Join the common type out routine
	SUBTTL	E commands -- EJ - Set pointer for other than current buffer

;+
;.HL1 EJCMD (EJ command)
; This command will perform a "J" command for a Q-reg other than the current
;editing buffer.
;Command format:
;.b.c;nEJ(Q-register name)
;-

EJCMD:	SETZ	T1,		; Clear T1
	PUSHJ	P,SCNQRG	; Scan off the Q-register name
	 ERROR	E.IQN		; Illegal Q-register name
	PUSHJ	P,QTXTEI	; Have any text in the Q-register ?
	PJRST	JMP1		; And go set it
	SUBTTL E Commands -- EL -- LOGCHR

;+
;.hl1 EL command
;.hl2 LOGCHR
; This routine is called to write the current character into the log
;file.
;.b.literal
; Usage:
;	MOVEI	CH,Character
;	PUSHJ	P,LOGCHR
;	 (return always)
;
;.end literal
;-


LOGCHR:	TXNN	S,S.SLOG	; Suppressing the log file?
LOGC.0:	 SKIPN	FDB$EL		; Have a log file?
	  POPJ	P,		; No, return
	$SAVE	<T1,T2,T3,T4,LASFDB> ; Save the Tx ac's
	MOVE	T1,FDB$EL	; Get the fdb address
	PUSHJ	P,F$WRIT	; And write the character
	 PJRST	F$ERR		; Give up
	SKIPE	T1,L$COUNT	; Want checkpoints at all?
	 SOSLE	L$CNTR		; Yes, want one now?
	  POPJ	P,		; No, return
	MOVEM	T1,L$CNTR	; Reset the counter
	MOVE	T1,FDB$EL	; Yes, get the FDB address again
	PUSHJ	P,F$CHKP	; Checkpoint it
	POPJ	P,		; All done
	SUBTTL	E Commands -- EL -- MAKLOG

;+
;.hl2 MAKLOG
; This routine will handle the EL command. If no argument is given
;this will start the log file. If an argument is given it will change
;whether input or output or both are written to the log file. If the
;argument is negative it will close the log file.
;-


MAKLOG:	TXNE	F,F.ARG		; Argument given?
	 JRST	CHANGL		; Yes, go change what we are doing
	SKIPN	T1,FDB$EL	; Have a log file already?
	 JRST	MAKL.1		; No, skip this
	PUSHJ	P,F$CLOS	; Yes, close the file
	 PJRST	F$ERR		; Go give up
	SETZ	T1,		; Clear T1
	EXCH	T1,FDB$EL	; Get the address back
	JRST	MAKL.2		; And skip getting an FDB

MAKL.1:	MOVX	T1,.FDLEN	; Get the length
	MOVX	T2,.BTFDB	; Get the block type
	PUSHJ	P,M$GBLK	; Get the block

MAKL.2:	$SAVE	<P1>		; Save P1
	MOVE	P1,T1		; Get the FDB address
	STORE	T2,SL$BEG,SL$END,-1 ; Clear the switches
	MOVEI	T2,LOGSWT	; Get the switch pointer
	PUSHJ	P,F$PARS	; Parse the file spec
	 PJRST	F$ERR		; Give an error message

	MOVEI	T3,PDF$EL	; Get the permanent default address
	MOVEI	T2,DEF$EL	; Get the default FDB
	MOVE	T1,P1		; And the FDB address
	PUSHJ	P,F$DFLT	; And default it
	TXO	S,S.LIN!S.LOUT	; Flag input and output logged
	SKIPL	LS$NOI		; /NOINPUT given?
	 TXZ	S,S.LIN		; Flag he wants input
	SKIPL	LS$NOO		;  .  .  .
	 TXZ	S,S.LOUT	; Flag he wants output
	SKIPL	LS$VID		; Want video info?
	 TXO	S,S.LVID	; Yes, flag that
	SKIPL	LS$IIN		; Image type in wanted?
	 TXO	S,S.LIIN	; Yes, flag that
	MOVE	T2,P1		; Get the FDB address
	SKIPGE	T1,LS$CHK	; Get the frequency of checkpoints
	 SETZ	T1,		; 0 and -1 mean never
	MOVEM	T1,L$COUN	; Save for reseting the counter
	MOVEM	T1,L$CNTR	; And save in the counter
	MOVX	T1,$IOWRI	; Get the code
	SKIPL	LS$APP		; Or should it be append
	 MOVX	T1,$IOAPP	; Yes, get the right code
	PUSHJ	P,F$OPEN	; And open the file
	 JRST	MAKL.5		; Skip
	MOVEM	P1,FDB$EL	; Save the FDB address
	POPJ	P,		; And return

MAKL.5:	SETZM	FDB$EL		; Clear the pointer
	TXZ	S,S.LIN!S.LOUT	; And flag no logging
	PJRST	F$ERR		; And go give the error

DEFINE SWT$EL,<
SW	APPEND,LS$APP,,1,
SW	CHECKP,LS$CHK,.IDECW,^D640,
SW	IMGINP,LS$IIN,,1,
SW	NOINPUT,LS$NOI,,1,
SW	NOOUTPUT,LS$NOO,,1,
SW	VIDEO,LS$VID,,1,
> ; End of SWT$EL definition
	DOSWTCH(LOG,SWT$EL)	; Generate the switch tables
LOGSWT:	SWTPTR(LOG)		; Generate the pointers to the switch table


; Here when :nEL is given. Reset the /NOINPUT or /NOOUTPUT flags
; Argument bits:
	AB$OUT==1		; Output wanted
	AB$INP==2		; Input wanted
	AB$VID==4		; Video wanted
	AB$IIN==10		; Image input wanted

CHANGL:	PUSHJ	P,SKRCH		; Get the next character
	 ERROR	E.NAL		; Must have the altmode
	CAXE	CH,.CHESC	; Is it one?
	 ERROR	E.NAL		; No, complain
	SKIPE	T1,FDB$EL	; Do we have one?
	 SKPOPN	0(T1)		; Yes, is it open?
	  ERROR	E.NLF		; No log file open
	TXNE	A1,AB$INP	; Want input?
	 TXO	S,S.LIN		; Yes, flag he wants input
	TXNE	A1,AB$OUT	; Want output?
	 TXO	S,S.LOUT	; Flag he wants output
	TXNE	A1,AB$VID	; Want video logged?
	 TXO	S,S.LVID	; Yes, flag it
	TXNE	A1,AB$IIN	; Want image of input?
	 TXO	S,S.LIIN	; Yes, flag that
	JUMPGE	A1,.POPJ	; If the arg is negative close the file
	TXZ	S,S.LIN!S.LOUT!S.LVID ; Flag no more logging
	PUSHJ	P,F$CLOS	; Close the file
	 PJRST	F$ERR		; Couldn't?
	MOVE	T1,FDB$EL	; Get the FDB
	SETZM	FDB$EL		; Clear the pointer
	PJRST	M$RBLK		; And return the FDB
	SUBTTL E Commands -- EE -- Write out a save file

;+
;.hl1 EECMD
; The EE command causes TECO to write out its low segment into a save
;file which is set up so that when the save file is run it will
;GETSEG TECO's high segment and continue execution with the command
;after the EE command.
;-

EECMD:	MOVEM	17,EEACS+17	; Save 17 for restart
	MOVEI	17,EEACS	; And set up to save the world
	BLT	17,EEACS+16	; Save the rest
	MOVE	17,EEACS+17	; And restore 17
	MOVX	T1,.FDLEN	; Get the length
	MOVX	T2,.BTFDB	; And the block type
	PUSHJ	P,M$GBLK	; Get the FDB
	MOVE	P1,T1		; Save in safe place
	SETZ	T2,		; No switches
	PUSHJ	P,F$PARS	; Parse the file spec
	 PJRST	F$ERR		; Couldn't

	MOVE	T1,P1		; Get the FDB address
	MOVEI	T2,DEF$EE	; Get the default block
	MOVEI	T3,PDF$EE	; Get the perm defaults
	PUSHJ	P,F$DFLT	; And default it
	STORI.	$FMBIN,T1,FDBMOD,(P1) ; store the mode
	MOVX	T1,$IOWRI	; Get the functin
	MOVE	T2,P1		; And the FDB address
	PUSHJ	P,F$OPEN	; And open the file
	 PJRST	F$ERR		; Couldn't, give an error

	MOVE	T1,[XWD GETBLK,STARTL] ; Move the restart code into the
	BLT	T1,STARTL+STR.LN-1 ; low segment
	$SAVE	<.JBSA,.JBCOR,FDB$EL> ; Save the locs we must change
	SETZM	FDB$EL		; Clear the log file pointer
	MOVEI	T1,STARTL	; And set up the new start address
	HRL	T1,.JBFF	; And first free
	MOVEM	T1,.JBSA	; Save it
	HRR	T1,.JBREL	; Get the end of core address
	MOVEM	T1,.JBCOR	; And store it
	MOVEI	P2,.JBHRL+1	; Start after HRL
EECM.3:	SKIPE	(P2)		; Word zero?
	 JRST	EECM.4		; No, first non-zero word
	CAMGE	P2,FSTBLK	; Into free core yet?
	 AOJA	P2,EECM.3	; No, bump to the next word

EECM.4:	MOVE	P3,P2		; Get the address of first non-zero word
EECM.B:	SKIPN	(P2)		; Is this word zero?
	 JRST	EECM.5		; Yes, end of non-zero block
	CAMGE	P2,FSTBLK	; Hit allocated section yet?
	 AOJA	P2,EECM.B	; No, try next word
	MOVE	P4,P3		; Get the address
	SETZ	P3,		; Clear the junk address
	JRST	EECM.7		; And go handle free core

EECM.5:	SUBM	P3,P2		; Get the different
	JUMPE	P2,[MOVE P2,FSTBLK	; If nothing to write, go handle
		JRST	EECM.A]		; Go handle allocated core
	MOVSI	P2,(P2)		; Get the count into the left half
	HRRI	P2,-1(P3)	; And make the IOWD
	MOVE	CH,P2		; First write the IOWD
	MOVE	T1,P1		; Get the address of the FDB
	PUSHJ	P,F$WRIT	; And write the word
	 PJRST	F$ERR		; Give up

EECM.6:	MOVE	CH,1(P2)	; Get the next word
	MOVE	T1,P1		; Reset the FDB address
	PUSHJ	P,F$WRIT	; Write the word
	 PJRST	F$ERR		; Give up
	AOBJN	P2,EECM.6	; Loop for all the words
	AOJ	P2,		; Point to the next word to check
	CAMGE	P2,FSTBLK	; Are we into allocated core?
	 JRST	EECM.3		; No, go look for next non-zero word

IFN FTDEBUG,<
	CAME	P2,FSTBLK	; Is this the right value?
	 STOPCD	NFB,<EE loop stopped after FSTBLK>
> ; End of IFN FTDEBUG

EECM.A:	SETZB	P3,P4		; Flag we haven't seen anything yet
EECM.7:	LOAD.	T1,BLKTYP,(P2)	; Get the block type
	PUSHJ	P,@EETBL(T1)	; Do the correct thing for this block type
	LOAD.	T1,BLKSIZ,(P2)	; Get the size of this block
	MOVX	T2,BF.LST	; Make sure not last on page
	TDNN	T2,.BKFLG(P2)	;  .  .  .
	 JRST	EECM.8		; It isn't
	LOAD.	T2,BLKNXT,(P2)	; Get the pointer to the next page
	JUMPE	T2,EECM.9	; If no more we are done
	PG2ADR	T2		; And convert to an address
	SKIPA	P2,T2		; Get the address
EECM.8:	ADD	P2,T1		; Point to the next block
	JRST	EECM.7		; And loop

EECM.9:	ADD	P2,T1		; Point to the end
	SKIPE	P3		; End a junk block?
	 PUSHJ	P,ENDJNK	; Yes, end the block
	SKIPE	P4		; Any non-zero block to end?
	 PUSHJ	P,ENDBLK	; Yes, end it
	MOVE	CH,[JRST STARTL] ; Get the start instruction
	MOVE	T1,P1		; And the FDB address
	PUSHJ	P,F$WRIT	; Write it
	 PJRST	F$ERR		; Give up
	MOVE	T1,P1		; Get the address
	PUSHJ	P,F$CLOS	; And close the file
	 PJRST	F$ERR		; Couldn't
	MOVE	T1,P1		; Get the address again
	PJRST	M$RBLK		; And return it


TABDEF	EE,.BT,EETXT		; Generate the dispatch table
	TABENT	JNK,EEJNK	; Do different things for junk
	TABENT	FDB,EEJNK	; and FDB's
	TABENT	BUF,EEJNK	; And buffers
TABEND

; Here for a block which is neither junk or an FDB

EETXT:	SKIPE	P3		; Have a previous junk block?
	 PUSHJ	P,ENDJNK	; Yes, end it
	LOAD.	T1,BLKSIZ,(P2)	; Get the size of this block
	MOVN	T1,T1		; And make an loop counter
	MOVSI	T1,(T1)		;  .  .  .
	HRRI	T1,(P2)		;  .  .  .

EETX.2:	SKIPN	(T1)		; Zero word?
	 JRST	EETX.4		; Yes, go handle it
	JUMPN	P4,EETX.3	; First non-zero word?
	MOVEI	P4,(T1)		; Yes, get the address
EETX.3:	AOBJN	T1,EETX.2	; Loop through the block
	POPJ	P,		; Return

EETX.4:	JUMPE	P4,EETX.3	; If not first zero word, just loop
	PUSH	P,P2		; Save P2
	MOVEI	P2,(T1)		; Get the address of the word
	PUSHJ	P,ENDBLK	; No, end the current block
	POP	P,P2		; Restore P2
	AOBJN	T1,EETX.2	; And loop
	POPJ	P,		; Return since we are done

ENDBLK:	$SAVE	<T1,P2>		; Save P2
	SUBM	P4,P2		; And get the number to read
	HRLI	P4,(P2)		; Make the IOWD
	SOJ	P4,		;  .  .  .
	MOVE	CH,P4		; And write
	MOVE	T1,P1		; it into the file
	PUSHJ	P,F$WRIT	;  .  .  .
	 PJRST	F$ERR		; And give the error

ENDB.1:	MOVE	CH,1(P4)	; Get the word
	MOVE	T1,P1		; And reset the FDB
	PUSHJ	P,F$WRIT	; Write out the word
	 PJRST	F$ERR		; Give the error
	AOBJN	P4,ENDB.1	; Loop for the whole block
	SETZ	P4,		; In a zero block now
	POPJ	P,		; Return

; Here for an FDB or a junk block

EEJNK:	JUMPN	P4,EEJN.1	; In a good section already?
	JUMPN	P3,.POPJ	; Already in a junk section?
	MOVE	P3,P2		; No, remember where this one is
	POPJ	P,		; And return
EEJN.1:	$SAVE	<P2>		; Save P2
	AOJ	P2,		; And bump it
	PJRST	ENDBLK		; And end the current block


; Here to end a junk section. P2 contains address after the section, P3
;the address of the start of the section.

ENDJNK:	CAIN	P3,-1(P2)	; Was this right before this block?
	 JRST	[MOVE	P4,P3		; Yes, get the address for later
		SETZ	P3,		; Flag no junk
		POPJ	P,]		; And return
	MOVEI	CH,-1(P3)	; Get the address for the IOWD
	HRLI	CH,-1		; And the count
	MOVE	T1,P1		; Get the FDB address
	PUSHJ	P,F$WRIT	; And write the IOWD
	 PJRST	F$ERR		; Couldn't
	MOVE	CH,P2		; Get the end address
	SUBI	CH,(P3)		; And get the length
IFN <ALIGN.(BK.SIZ)>,LSH CH,<ALIGN.(BK.SIZ)> ; Put in correct place
	STORI.	.BTJNK,T1,BLKTYP,+CH ; Store the block type
	CAML	P2,.JBFF	; Is this the last block?
	 TXO	CH,BF.LST	; Yes, flag it
	MOVE	T1,P1		; Get the FDB address
	PUSHJ	P,F$WRIT	; And write the word
	 PJRST	F$ERR		; Couldn't
	SETZ	P3,		; Not in a junk section anymore
	POPJ	P,		; Return
	SUBTTL E Commands -- EE - Restart code

GETBLK:	TDZA	1,1		; Remember not CCL entry
	 SETO	1,		; Flag CCL
	MOVEM	T1,CCLSW	; Flag whether CCL entry or not
	MOVE	2+$RNDEV,RUNDEV	; Get the device
	MOVE	2+$RNNAM,RUNNAM	; And the name
	MOVEI	2+$RNPPN,RUNPTH	; And the path block address
	SETZB	2+$RNEXT,2+$RNCOR ; clear the rest
	MOVEI	0,2		; Get the address of the GETSEG block
	SETZ	1,		; Assume non-physical
	SKIPE	PHYSON		; Should we do physical only GETSEG?
	 TRO	1,UU.PHY	; Yes, flag it
	GETSEG	0,(1)		; Get back our original segment
	 HALT
	MOVEI	P1,%TECOV	; Get the normal low segment version
	MOVEI	P2,%TECTV	; And the terminal dependent section
	HRRZ	T1,.JBREL	; Get the end of the low seg
	TXNN	T1,1B18		; Over 128k??
	 MOVEI	T1,400000-1	; No, use 400000 as default
	HRLI	T2,-2		; Get it from monitor
	HRRI	T2,.GTUPM	; If we can
	GETTAB	T2,		;  .  .  .
	 HRLI	T2,1(T1)	; Can't, use our default
	HLRZ	T2,T2		; Get the offset
	ANDI	T2,777000	; Clear low order bits
	JRST	.JBHDA(T2)	; And go restart

STR.LN==.-GETBLK
	SUBTTL	E Commands -- EE -- RST - Restart routine

;+
;.HL1 RST
; This routine is called from the low segment after TECO's high
;segment has been GETSEG'ed from an EE'ed file. It is entered
;with P1= %TECOV and P2=%TECTV from the copy which wrote the EE'ed file, and
;T2= the base address of the high segment.
;-

RST:	CAIN	P1,%TECOV	; Check if this is the correct version of the low segment
	 CAIE	P2,%TECTV	; Terminal low segment version the same?
	  JRST	.+2		; One or the other wrong, give the error
	   JRST	RST1		; Yes, all is okay
	OUTSTR	[ASCIZ	.?TECWVT Wrong version of TECO GETSEG'd
.]
	MONRT.			; Exit to the monitor
	JRST	.-1		; Can't really continue

RST1:	MOVE	T1,.JBHSA(T2)	; Get the starting address
	MOVEM	T1,.JBSA	; Reset it
	MOVE	T1,.JBHCR(T2)	; Get the copy of .JBCOR
	MOVEM	T1,.JBCOR	; Reset it
	MOVE	T1,.JBH41(T2)	; And get the error instruction
	MOVEM	T1,.JB41	; Save it
	MOVE	T1,.JBHRN(T2)	; Get the values to fix .JBHRL and .JBREN
	HLLM	T1,.JBHRL	; Fix .JBHRL
	HRRZM	T1,.JBREN	; And .JBREN
	MOVSI	17,EEACS	; Set up to restore the registers
	BLT	17,17		; Do it

; Now to fix up any text blocks (or FDB's) so we don't think we have any
;open files.

	MOVE	T1,FSTBLK	; Get the first block

RST.2:	CFXE.	T2,BLKTYP,(T1),.BTTXT ; Text block?
	 JRST	RST.3		; No, go check if an FDB
	BITOFF	T2,TF.OPO!TF.OPI,.BKTFL(T1) ; Yes, clear the open file flags
	JRST	RST.4		; And try the next

RST.3:	CFXE.	T2,BLKTYP,(T1),.BTFDB ; Is this an FDB?
	 JRST	RST.4		; No, try the next block
	STORI.	.BTJNK,T2,BLKTYP,(T1) ; Yes, make it junk

RST.4:	MOVX	T2,BF.LST	; Last block?
	TDNE	T2,.BKFLG(T1)	;  .  .  .
	 JRST	RST.5		; Yes, go check page field
	LOAD.	T2,BLKSIZ,(T1)	; No, get the size
	ADD	T1,T2		; And advance to the next block
	JRST	RST.2		; Loop

RST.5:	LOAD.	T1,BLKNXT,(T1)	; Get the next block page number
	PG2ADR	T1		; Convert to address
	JUMPN	T1,RST.2	; And loop if any address
	PUSHJ	P,M$GC		; Do a garbage collection to clean up

; Now re-initialize some things

	PUSHJ	P,U$INIT	; Do the UUO initialization
	PUSHJ	P,T$INIT	; Reintialize the terminal
	PUSHJ	P,I$JOB		; Do the job initialization
	PUSHJ	P,I$INIT	; Reinitialize the immediate mode stuff
	POPJ	P,		; And return
	SUBTTL	E Commands -- EC - Perform a garbege collection

;+
;.HL1 ECCMD
;This routine will force a garbage collection to occur, so that TECO
;may shrink in size.
;-

ECCMD:	TXNE	F,F.ARG		; Have an arg?
	 JUMPG	A1,ECCM.9	; Yes, if positive expand
	MOVE	P1,.JBREL	; Get our current size
	TXO	F,F.ECMD	; Flag this is for an EC command
	PUSHJ	P,S$QRGC	; Collect all zero valued Q-registers
	LOAD.	T1,TPTADR,+$QRTPT+ERRQRG ; Get the last error message QRG
	JUMPE	T1,ECCM.7	; Anything there?
	LOAD.	T2,BLKEND,(T1)	; Get the number of chars in the buffer
	SETZ	T3,		; Delete from the first character
	PUSHJ	P,M$SRNK	; Shrink the buffer
ECCM.7:	LOAD.	T1,TPTADR,+$QRTPT+QTAB+QRGIDX(?) ; Get the address of the last error command
	JUMPE	T1,ECCM.8	; Anythin here?
	LOAD.	T2,BLKEND,(T1)	; And the size
	SETZ	T3,		; Delete from first char
	PUSHJ	P,M$SRNK	; Shrink the buffer
ECCM.8:	PUSHJ	P,M$GC		; Collect the garbage
	TXZ	F,F.ECMD	; Turn off the EC command flag
	MOVE	T1,FSTBLK	; Get the first block
	MOVX	T2,BF.LST	; And get the flag to check
	SETZ	T4,		; Flag no previous block

ECCM.1:	TDNE	T2,.BKFLG(T1)	; Is this the last block?
	 JRST	ECCM.2		; Yes, go handle it
	LOAD.	T3,BLKSIZ,(T1)	; No, get the size
	MOVE	T4,T1		; Remember the previous block
	ADD	T1,T3		; And point to he next block
	JRST	ECCM.1		; Loop

ECCM.2:	LOAD.	T2,BLKNXT,(T1)	; Get the next page number
	JUMPE	T2,ECCM.3	; If done go check if we need this block
	MOVE	T1,T2		; Otherwise get the page number
	PG2ADR	T1		; And convert to an address
	SETZ	T4,		; Remember the previous
	JRST	ECCM.1		; Try again

ECCM.3:	CFXE.	T2,BLKTYP,(T1),.BTJNK ; Is this block junk?
	 POPJ	P,		; No, can't shrink
	MOVEI	T2,-1(T1)	; Yes, get the address minus one
	SKIPN	.JBDDT		; Don't shrink if DDT is loaded.
	CORE	T2,		; And try to shrink
	 JFCL			; Shouldn't happen
IFN FTDEBUG,<
	SKIPN	T4		; Have a previous block?
	 STOPCD	(NPB,<No previous block - no free core in use>)
> ; End of IFN FTDEBUG
	BITON	T3,BF.LST,.BKFLG(T4) ; Make the previous block the last
	MOVEM	T1,.JBFF	; Save the new first free
	MOVE	T1,.JBREL	; Get the current end
	CAML	T1,P1		; Did we really shrink?
	 POPJ	P,		; No, return
	AOJ	T1,		; Bump the number
	ADR2PG	T1		; Convert to a page number
	MOVE	P1,T1		; Get the number
	MOVEI	T1,[$STRING(<[^D/P1/P core]>)] ; Get the string to type
	TXNE	F,F.ARG		; Have an arg?
	 JUMPL	A1,.POPJ	; Yes, if negative don't type
	PJRST	T$TYPE		; Type it

ECCM.9:	PG2ADR	A1,		; Convert to a word number
	MOVE	T1,A1		; Get it
	CAMG	T1,.JBREL	; Will it really expand?
	 POPJ	P,		; No, just return
	CORE	T1,		; Try to expand
	 JFCL			; Ignore the error
	POPJ	P,		; And return
	SUBTTL	E Commands -- EI and EP - Read into a Q-register

;+
;.hl1 EI and EP commands
; These commands cause an entire file to be read into a Q-register.
;EP just reads the file, EI will cause the Q-register to be executed
;after it is read (effectively doing an M command on the Q-reg after
;reading the file).
;-


EICMD:	TXOA	S,S.DOIT	; Flag to execute after file is read
EPCMD:	 TXZ	S,S.DOIT	; Flag no execution
	MOVX	T1,"*"		; Get the default Q-register
	PUSHJ	P,SCNQRG	; Scan off the Q-register name
	 JFCL			; Shouldn't happen
	MOVE	T2,$QRFLG(T1)	; Get the flags
	CAME	T1,CUREDT	; Current buffer?
	 TXNE	T2,QR$WRT	; Allowed to write into this?
	  ERROR	E.DOQ		; No, display only
	TXNE	T2,QR$TXT	; Allowed to have text in this?
	 ERROR	E.VOQ		; No, value only
	MOVE	P1,T1		; Save the index
	MOVX	T1,.FDLEN	; Get the descriptor block
	MOVX	T2,.BTFDB	; And the block type
	PUSHJ	P,M$GBLK	; Get the block
	MOVE	P2,T1		; Remember where it is
	SETZ	T2,		; No switches
	PUSHJ	P,F$PARS	; Parse the spec
	 PJRST	F$ERR		; Couldn't
	MOVEI	T2,DEF$EQ	; Get the default block address
	MOVE	T1,P2		; Get the FDB address back
	MOVEI	T3,PDF$EQ	; Get the permanent defaults
	PUSHJ	P,F$DFLT	; And default it
;Here to LOOKUP file for EI and EP. 
;If no directory or device has been specified, then look for the
;file as follows:
;	[-]
;	[,,TEC]/SCAN
;	TED:

	MOVX	T1,FD.PTH	; Check if PPN or path given
	CFXN.	,FDBDEV,(P2),0	; Device given?
	 TDNE	T1,.FDFLG(P2)	; Or PPN or path?
	  TDZA	P3,P3		; Yes, no random searches
	   MOVX	P3,3		; No, start with sequence 3
EPILOP:	JRST	@EPITBL(P3)	; Do the right thing for this pass

EPITBL:	EXP	EPIDFT		; Default's from block
	EXP	EPITED		; TED:
	EXP	EPISFD		; DSK:[,,TEC]/SCAN
	EXP	EPIDSK		; DSK:[-]


; Here for DSK:[,,TEC]/SCAN

EPISFD:	MOVE	T1,MYPPN	; Get out PPN
	STOR.	T1,FDBPPN,(P2)	; Store it
	STORI.	<SIXBIT |TEC|>,T1,FDBSFD,(P2) ; Store the SFD name
	BITON	T1,FD.SCN!FD.PTH,.FDFLG(P2) ; And flag /SCAN
	FALL	EPIDSK		; And join common disk code

; Here to look on DSK:[-]

EPIDSK:	STORI.	<SIXBIT |DSK|>,T1,FDBDEV,(P2) ; Store the device name
	PJRST	EPIDFT		; Go join common open routine

; Here to look on TED:

EPITED:	STORI.	<SIXBIT |TED|>,T1,FDBDEV,(P2) ; Store the device name
	ZERO.	,FDBPPN,(P2)	; Clear the path
	ZERO.	,FDBSFD,(P2)	;  .  .  .
	FALL	EPIDFT		; Join common routine
; Here to open the file
EPIDFT:	MOVX	T1,<SIXBIT |DSK|> ; Get the default name
	CFXN.	,FDBDEV,(P2),0	; Have a device?
	 STOR.	T1,FDBDEV,(P2)	; No, use DSK
	MOVX	T1,$IOREA	; Get the function
	MOVE	T2,P2		; And the FDB
	PUSHJ	P,F$OPEN	; Open the file
	 JRST	.+2		; Couldn't, check if more to try
	  JRST	EPIRED		; Go it, go read the file

	SOJG	P3,[MOVE T1,P2		; Get the FDB address
		PUSHJ	P,F$RSET	; Clear the channel
		JRST	EPILOP]		; Loop if anything left
	PJRST	F$ERR		; No, give up

; Here after file has been opened.

EPIRED:	MOVX	T1,D.EPIS	; Get the default size
	PUSHJ	P,M$GTXT	; Get the text buffer
	MOVEI	T2,EPIQRG	; Get the pointer address
	PUSHJ	P,M$USEB	; And set it up
	STOR.	P2,BLKFDI,(T1)	; Store as input file
	BITON	T2,TF.OPI,.BKTFL(T1) ; And flag it
	MOVEI	T1,EPIQRG	; Get the TPT address
	MOVX	T2,.INFIN	; read the entire file
	MOVX	T3,.INFIN	;  .  .  .
	MOVX	T4,.INFIN	;  .  .  .
	PUSHJ	P,F$RBUF	; Read the data
	LOAD.	T1,TPTADR,+EPIQRG ; get the buffer address
	BITOFF	T2,TF.OPI,.BKTFL(T1) ; No input file now
	ZERO.	,BLKFDI,(T1)	;  .  .  .

; Here after file has been read in. Store the Q-register pointer and
;execute the Q-register if this was an EI command

EPIR.E:	LOAD.	T1,QRGDTP,(P1)	; Get the data type
	MOVX	T2,$DTTXT	; And the new data type
	XCT	RQRGTB(T1)	; And release the old data

EPIR.4:	LOAD.	T1,TPTADR,+EPIQRG ; Get the buffer address
	MOVEI	T2,$QRTPT(P1)	; And the pointer address
	PUSHJ	P,M$USEB	; Add the user
	MOVEI	T1,EPIQRG	; Get the old pointer
	PUSHJ	P,M$RELB	; And remove it
	MOVE	T1,P2		; Get the FDB address
	PUSHJ	P,F$CLOS	; Close the file
	 PJRST	F$ERR		; Give up
	MOVE	T1,P2		; Get it again
	PUSHJ	P,M$RBLK	; And return it
	MOVE	T2,P1		; Get the Q-register index
	TXNE	S,S.DOIT	; EI command?
	 PJRST	MAC.0		; Yes, go execute the Q-register
	POPJ	P,		; No, return

SUBTTL	E Commands -- EQ - Write out Q-register

; This command will write out the contents of the given Q-register
; to the file spec given.  The command format is EQ(q)file.ext$,
; where q is the Q-register name. If the (q) is missing it will
; use Q-register *.

EQCMD:	MOVX	T1,"*"		; Get the default
	PUSHJ	P,SCNQRG	; And try for a Q-register name
	 JFCL			; Couldn't?
	LOAD	T2,$QRFLG(T1),QR$WRT ; Get the flag
	JMPT	T2,[ERROR E.DOQ] ; Display only Q-register
	MOVE	P1,T1		; Get the index
	PUSHJ	P,QTXTEI	; And try for text
	MOVX	T1,.FDLEN	; Get an FDB
	MOVX	T2,.BTFDB	;  .  .  .
	PUSHJ	P,M$GBLK	; Get it
	MOVE	P2,T1		; Save in a safer place
	SETZ	T2,		; No switches
	PUSHJ	P,F$PARS	; Parse the spec
	 PJRST	F$ERR		; Couldn't
	MOVX	T3,<SIXBIT |DSK|> ; Get the device
	CFXN.	T4,FDBDEV,+DEF$EQ,0 ; Is this zero ?
	 STOR.	T3,FDBDEV,+DEF$EQ  ; Yes - Store a device
	MOVEI	T2,DEF$EQ	; Get the default block
	MOVE	T1,P2		; Get the other FDB address
	MOVEI	T3,PDF$EQ	; get the permanent defaults
	PUSHJ	P,F$DFLT	; And default it
	MOVX	T1,$IOWRI	; Want to write the file
	MOVE	T2,P2		;  .  .  .
	PUSHJ	P,F$OPEN	; Open up the file
	 PJRST	F$ERR		; Couldn't
	MOVE	T1,P1		; Get the index back
	PUSHJ	P,QTXTEI	; And get the block address
	MOVE	P1,T1		;  .  .  .
	MOVX	T2,.TRUE	; Set up to write entire file
	MOVX	T3,.FALSE	;  .  .  .
	MOVE	T4,P2		; Get the FDB address
	SETZ	A2,		; Start at first character
	LOAD.	A1,BLKEND,(T1)	; And write to the end
	PUSHJ	P,F$WBUF	; Write out the buffer
	MOVE	T1,P2		; Get the FDB address
	PUSHJ	P,F$CLOS	; And close the file
	 PJRST	F$ERR		; Couldn't?
	MOVE	T1,P2		; Get the FDB address again
	PJRST	M$RBLK		; And return the buffer
	SUBTTL	E Commands -- EG - Exit closing all files & run COMPIL

;+
;.HL1 EG command
; This command will cause TECO to exit copying all input files to output
;files and all files will then be closed.  It will then cause COMPIL to be run
;from SYS:
;-

EGCMD:	TXO	F,F.RUN		; Flag we are running a program
	MOVX	T1,<SIXBIT /SYS/> ; Get the default device to run from
	MOVEM	T1,ED$BLK+$RNDEV ; Store the device name
	MOVX	T1,<SIXBIT /COMPIL/> ; Get the program name
	MOVEM	T1,ED$BLK+$RNNAM ; Store the name
	SETZM	ED$BLK+$RNEXT	; Clear the extension
	SETZM	ED$BLK+$RNCOR	; Clear the core argument
	MOVEI	T1,1		; Get the run offset
	HRLM	T1,ED$COD+RNOARG ; Store the run offset
	FALL	(FINISH)	; Fall into the EX code
	SUBTTL	E Commands -- EX -- Exit closing all files

;+
;.hl1 EX command
; This command will cause TECO to exit copying all input files to output
;files and all files closed.
;.hl1 ^Z command
; This command will cause TECO to exit and close all open files. It will
;not copy input to output, nor will it write out the current buffers.
;-

FINISH:	TDZA	P1,P1		; Flag we want everything copied
DECDMP:	 SETO	P1,		; Flag no writing
	PUSHJ	P,DOXITQ	; Do the user's exit routine
	JMPNS	.+2		; Screen mode?
	 PUSHJ	P,SC$FIN	; Set up for exiting
	TXZ	S,S.SCRN	; And flag not screen mode anymore
	PUSHJ	P,T$SRTN	; Set up the correct type out routines
	MOVEI	T1,TTYFDB	; Get the terminal FDB
	PUSHJ	P,F$RSET	; Reset the channel
	MOVE	T1,P1		; Get the flag
	PUSHJ	P,FINI.0	; Call common routine
	 JRST	CONT		; He re-entered, don't exit
	TXNE	F,F.RUN		; Have something to run?
	 JRST	ED$COD		; Yes, go do it
	MONRT.			; And exit
CONT:	SETZM	XCTING		; Flag not executing
	PJRST	@.JBREN		; And fake a re-enter to re-open the world
	SUBTTL	E Commands -- EX -- Common routines -- FINI.0

;+
;.hl1 FINI.0
; This routine will do the work of the EX, EG, and ^Z commands. It will
;search through free core finding all the text buffers and closing there
;associated files. It will also close the LOG file.
;-

FINI.0:	MOVE	P4,T1		; Get the flag into a safer place
	MOVE	P1,FSTBLK	; And the start of the allocated core
	SETO	P2,		; Flag no input files seen yet

FINI.1:	CFXE.	T1,BLKTYP,(P1),.BTTXT ; Is this a text block?
	 JRST	FINI.5		; No, try the next
	MOVE	T1,P1		; Get the block address
	MOVE	T2,P4		; And get the flag
	SETZ	T3,		; Flag we want re-enters to work
	PUSHJ	P,CLSFIL	; Go close the files
	 POPJ	P,		; User typed reenter
	JUMPL	T1,FINI.5	; If no input file, continue on
	JUMPGE	P2,.+2		; Any input files yet?
	 SETZ	P2,		; No, clear for first one
	ADD	P2,T1		; And count whether this one had an output file

; Here when all files are closed.

FINI.5:	LOAD.	T1,BLKSIZ,(P1)	; Get the size of the block
	MOVX	T2,BF.LST	; Get the bit to check
	TDNN	T2,.BKFLG(P1)	; Is this the last block on the page?
	 JRST	FINI.6		; No, go advance to next one
	LOAD.	P1,BLKNXT,(P1)	; Yes, get the next page
	PG2ADR	P1		; Convert to page number
	JUMPE	P1,FINI.8	; Done?
	JRST	FINI.1		; Go try this block

FINI.6:	ADD	P1,T1		; Point to the next block
	JRST	FINI.1		; And loop for this block

FINI.8:	JUMPN	P4,FINI.9	; Don't give an error message if no writing
	JUMPN	P2,FINI.9	; Any output files?
	MOVX	T1,$IOWRI	; Get the function
	MOVEI	T2,TTYFDB	; Get the terminal FDB
	PUSHJ	P,F$OPEN	; Open it
	  JFCL			; Can not happen
	JMPNS	[ERROR E.NFO]	; Screen mode?
	SETOM	MESFLG		; Flag we need to do a complete refresh
	PUSHJ	P,SC$ERS	; Clear the lines, so everything will refresh
	ERROR	E.NFO		; No, No file for output error

FINI.9:	SKIPN	T1,FDB$EL	; Have a log file?
	 PJRST	.POPJ1		; No, give the good return
	PUSHJ	P,F$CLOS	; Yes, close the file
	 PJRST	F$ERR		; Couldn't
	MOVE	T1,FDB$EL	; Get the address again
	SETZM	FDB$EL		; No more log file
	PUSHJ	P,M$RBLK	; And return the block
	PJRST	.POPJ1		; And give the good return
	SUBTTL	E Commands -- EX -- Common routines -- CLSFIL

;+
;.hl1 CLSFIL
; This routine will close any files associated with a text buffer.
;.b.literal
; Usage:
;	MOVE	T1,Text.buffer.address
;	MOVEI	T2,(0 for EX type close, -1 for ^Z type close)
;	PUSHJ	P,CLSFIL
;	 (user typed re-enter)
;	(done)
;
;.end literal
;-

CLSFIL:	$SAVE	<P1,P2,P3,P4>	; Save the Px ac's
	MOVE	P1,T1		; Get the text buffer address
	MOVE	P4,T3		; And get the flag
	HRLI	P4,(T2)		; Also get the other flag
	PUSHJ	P,GETFDI	; And get the input FDB
	 SETZ	T1,		; Isn't any, flag it
	MOVE	P3,T1		; Copy into correct place
	MOVE	T1,P1		; Get the text buffer address again
	PUSHJ	P,GETFDO	; And get the output address
	 SETZ	T1,		; Isn't one
	MOVE	P2,T1		; Copy the address
	JUMPE	P2,CLSF.1	; If no output file, nothing to copy into
	JUMPL	P4,CLSF.0	; Need to copy stuff first?
	MOVE	T1,P1		; Get the buffer address
	SETZ	T2,		; And flag re-enter should abort
	HRRE	T3,P4		; Get the re-enter flag
	PUSHJ	P,F$COPY	; Copy the file data
	 JRST	CLSF.4		; Typed re-enter, go handle it

CLSF.0:	JUMPE	P2,CLSF.1	; Have an output file to close?
	JUMPL	P4,CLSF.2	; If control Z then don't finish EB files
	MOVX	T1,FD.EB	; Check if file is EB'ed
	TDNE	T1,.FDFLG(P2)	;   .  .  .
	 JRST	CLSF.5		; Yes, handle special
CLSF.2:	MOVE	T1,P2		; Yes, get the address
	PUSHJ	P,F$CLOS	; And close the file
	 PJRST	F$ERR		; Couldn't
	MOVE	T1,P2		; Get the FDB address again
	PUSHJ	P,M$RBLK	; And return it

CLSF.1:	JUMPE	P3,CLSF.3	; Have an input file to close?
	MOVE	T1,P3		; Yes, get the address
	PUSHJ	P,F$CLOS	; And close it
	 PJRST	F$ERR		; Couldn't, go complain
	MOVE	T1,P3		; Get the address again
	PUSHJ	P,M$RBLK	; And return the block
	JRST	CLSF.3		; Go turn off the bits

CLSF.4:	LOAD.	T1,TPTADR,+TXTBUF ; Check if we have the current text buffer
	CAIE	T1,(P1)		; No, skip this
	 POPJ	P,		; Return
	PJRST	YANK		; Pull in a new buffer and return

CLSF.5:	PUSHJ	P,FIN.EB	; Finish up the EB'ed file

; All done, flag we don't have any open files

CLSF.3:	BITOFF	T1,TF.OPO!TF.OPI,.BKTFL(P1) ; Flag no files open
	MOVX	T1,-1		; get a -1
	JUMPE	P3,.POPJ1	; If no input file, just return the -1
	SETZ	T1,		; Get a zero
	JUMPE	P2,.POPJ1	; If no output file, return 0
	AOJA	T1,.POPJ1	; And return
	SUBTTL	E Commands -- EX -- Common routines -- FIN.EB

;+
;.hl1 FIN.EB
; This routine will close the files from an EB command. It assumes that
;all data has already been written into the output file.
;.b.literal
; Usage:
;	MOVE	P1,Text.buffer.address
;	MOVE	P2,Output.FDB.address
;	MOVE	P3,Input.FDB.address
;
;.end literal
;-

FIN.EB:	$SAVE	<P1,P2,P3,P4>	; Save P1-P4
	$SAVE	<A1>		; Save A1
	LOAD.	P4,BLKTMP,(P1)	; Get the FDB address for the .BAK file
	LOAD.	A1,FDBEXT,(P4)	; Save the extension
	BITOFF	T1,TF.OPO,.BKTFL(P1) ; Flag no more input or output files
	MOVE	T1,P2		; First close the output file
	PUSHJ	P,F$CLOS	;  .  .  .
	 PJRST	F$ERR		; Couldn't?
	BITOFF	T1,TF.OPI,.BKTFL(P1) ; Flag no more input or output files
	MOVE	T1,P3		; Close the input file
	PUSHJ	P,F$CLOS	;  .  .  .
	 PJRST	F$ERR		; Couldn't
	STORI.	<'BAK'>,T1,FDBEXT,(P4) ; Store the extension
	MOVX	T1,$IODEL	; Delete the back file first
	MOVE	T2,P4		; If there is one
	PUSHJ	P,F$OPEN	; Do it
	 JRST	[CAXE	T1,ERFNF%	; File not found?
		 PJRST	F$ERR		; No, give up
		JRST	.+1]		; Yes, all is okay
	MOVEI	T1,(P3)		; Get the address of the FDB
	HRLI	T1,(P4)		; Get the other address
	BLT	T1,.FDLEN-1(P3)	; Move the data
	STOR.	A1,FDBEXT,(P3)	; And store the extension
	MOVE	T1,P3		; Set up to rename the input file
	MOVE	T2,P4		;  .  .  .
	PUSHJ	P,F$RENM	; Do it
	 PJRST	F$ERR		; Couldn't
	MOVE	T1,P2		; Now rename the output file to the correct thing
	MOVE	T2,P3		;  .  .  .
	PUSHJ	P,F$RENM	; Do it
	 PJRST	F$ERR		; Couldn't
	MOVE	T1,P2		; Get output FDB
	PUSHJ	P,M$RBLK	; And return it
	MOVE	T1,P3		; Get the input FDB
	PUSHJ	P,M$RBLK	; And return it
	MOVE	T1,P4		; Get the other
	PUSHJ	P,M$RBLK	; And return it also
	POPJ	P,		; And return
	SUBTTL	E Commands -- ED (Run a program on exit)

;+
;.HL1 ED
; The routine EDCMD will process the ED TECO command.  This routine will call
;the file specification parser to determine the file to run.  It will then move
;the information into the data segment so that the EX or EG commands will know
;what to run.
; The valid switches for this command are: /RUNOFFSET:n and /CORE:n.  These
;switches specifiy different arguments for the RUN UUO.
;-

EDCMD:	SKIPE	T1,ED$FDB	; Have an FDB (an error occured last time out)
	  JRST	[SETZM	ED$FDB		; Yes - Clear the old pointer
		JRST	EDCM.2]		; And continue processing

	MOVX	T1,.FDLEN	; Get the length of an FDB
	MOVX	T2,.BTGEN	; Core section to get it from
	PUSHJ	P,M$GBLK	; Allocate the block

EDCM.2:	MOVE	P1,T1		; Copy the address to a safer place
	MOVEI	T2,EDPTR	; Get the pointer to the ED switches
	STORE	T3,ED$BEG,ED$END,-1 ; Clear the switch area
	PUSHJ	P,F$PARS	; Parse the file input
	  JRST	EDCM.E		; Process the error

	LOAD.	T1,FDBDEV,(P1)	; Get the device specified
	SKIPN	T1		; Device specified ?
	 MOVX	T1,<SIXBIT |SYS|> ; No, Assume from SYS:
	MOVEM	T1,ED$BLK+$RNDEV ; Store it in the block
	LOAD.	T1,FDBNAM,(P1)	; Get the program name
	MOVEM	T1,ED$BLK+$RNNAM ; Store it in the block
	LOADS.	T1,FDBEXT,(P1)	; Get the extension
	MOVEM	T1,ED$BLK+$RNEXT ; Store the extension
	CFXN.	,FDBPPN,(P1),0	; Is this zero ?
	  JRST	EDCM.0		; Yes - Skip this section

; Now setup the path to run the program from

	LOAD.	T1,FDBPPN,(P1)	; Get the PPN
	MOVEM	T1,ED$PTH+.PTPPN ; Store it in the path block
	MOVEI	T1,ED$PTH	; Get the address of the path block
	MOVEM	T1,ED$BLK+$RNPPN ; Store the pinter to the path block
	MOVX	T2,<<-.PTMAX-.PTSFD>,,.PTSFD> ; Get the AOBJN pointer
	MOVEI	T3,.FDSFD(P1)		; Get the address of the SFDs

EDCM.1:	MOVE	T1,(T3)		; Get an SFD
	MOVEM	T1,ED$PTH(T2)	; Store it in the path block
	ADDI	T3,1		; Increment the pointer
	AOBJN	T2,EDCM.1	; Loop for all items
	SKIPA			; Enter the common code again

EDCM.0:	SETZM	ED$BLK+$RNPPN	; Clear the PPN
	SKIPGE	T1,LS$COR	; Have a core argument ?
	 SETZ	T1,		; No - Assume zero
	MOVEM	T1,ED$BLK+$RNCOR ; Store it in the RUN block
	SKIPGE	T1,LS$RUN	; Have a run offset ?
	 SETZ	T1,		; No - Assume zero
	HRLM	T1,ED$COD+RNOARG ; Store it in the code
	TXO	F,F.RUN		; Flag something to run on an exit
	MOVE	T1,P1		; Copy the FDB address back again
	PJRST	M$RBLK		; Return the block


; Here on an error parsing the file specification.

EDCM.E:	MOVEM	P1,ED$FDB	; Store the FDB for later
	PJRST	F$ERR		; Issue the error message


; The following are the valid switches on the ED command

DEFINE	ED$SW,<
SW	CORE,LS$COR,F$CORE,,SW.VRQ	;;/CORE:n
SW	RUNOFFSET,LS$RUN,.IOCTW,,SW.VRQ	;;/RUNOFFSET:n
> ; End of ED$SW macro definition

	DOSWTCH	(ED,ED$SW)	; Generate the switch block
EDPTR:	SWTPTR	(ED)		; Generate the pointer to the switch block
; The following is the code that is moved into the low segment to 
; do the RUN UUO.

RUNCOD:!PHASE	0		; Make this phased
	MOVSI	T1,1		; Get rid of the high segment
	CORE	T1,		; . . .
	  JFCL			; Don't care
	MOVE	T1,RNOARG+ED$COD ; Get the argument
	RUN	T1,		; Do the RUN UUO
	  HALT			; Can not continue

RNOARG:!EXP	ED$BLK		; Address of the run block
RUNLEN:!DEPHASE			; Back to normal
	SUBTTL	E Commands -- ET - Set type out mode

;ET COMMAND
;		 0 = Normal typeout
;		 1 = Literal typeout
;		 2 = Image typeout  (IONEOU)

TYOCTL:	TXNE	F,F.ARG		; Have an arg?
	 JRST	TYOCT1		; Yes, go set new value
	SKIPE	A1,ETVAL	; Get ET value
	CHKEO	EODEC,RTONES	; If EO > 2 and non-zero, return -1
	PJRST	VALRET		; Return the value

TYOCT1:	CHKEO	EODEC,TYOCT3	; Jump if old style ET
	SKIPL	A1		; Check range
	 CAILE	A1,2		; ...
	  ERROR	E.ETA		; Illegal value
TYOCT2:	MOVEM	A1,ETVAL	; Store value
	POPJ	P,		; And return

TYOCT3:	JUMPE	A1,TYOCT2	; Old ET can be only 0 or 1
	MOVEI	A1,1		; Non zero means 1
	JRST	TYOCT2		; Go store and return
	SUBTTl	E Commands -- EO

;+
;.HL1 OLDMOD
;This routine will do the processing for the EO command.
;-

OLDMOD:	TXNE	F,F.ARG		; Have an arg?
	 JRST	OLD1		; Yes, go set value of EOFLAG
	MOVE	A1,EOFLAG	; No, return the current value
	PJRST	VALRET

OLD1:	CAIG	A1,0		; Greater than zero?
	 MOVEI	A1,EOVAL	; No, use standard value
	CAILE	A1,EOVAL	; Is value within range?
	 ERROR	E.EOA		; No, give the error
	MOVEM	A1,EOFLAG	; Yes, set the value

; Now set up the instruction table for the CHKEO tables.

OLD.0:	MOVSI	T1,-<EOVAL>	; Get the loop pointer
	MOVX	T2,<JFCL>	; And get the no-op to use for things to avoid

OLD.2:	CAIN	A1,1(T1)	; Get to the correct one yet?
	 MOVX	T2,<TRNA>	; Yes, make it a skip instruction
	MOVEM	T2,EOXCTS(T1)	; Save the instruction
	AOBJN	T1,OLD.2	; And loop for all the entries.
	POPJ	P,		; And return

EOMAX:	EXP	EOVAL		; Max EO level for error message
	SUBTTL	E Commands -- EU command

;+
;.HL1 TYCASE
;This routine will execute the EU command.
;-

TYCASE:	TXNE	F,F.ARG		; Have an arg?
	 JRST	TYCAS1		; Yes, go handle it
	MOVE	A1,TYCASF	; No, return the current value
	PJRST	VALRET		; Return it

TYCAS1:	MOVEM	A1,TYCASF	; Set the flag
	CHKEO	EO124,.POPJ	; Just return if old
	CAXL	A1,-1		; Check if argument is valid
	 CAXLE	A1,1		;  Only -1, 0, and 1 are okay
	ERROR	E.EUO		; EU value out of range
	POPJ	P,		; Value is okay
	POPJ	P,		; And return
	SUBTTL E Commands -- ES

AUTOTY:	TXNE	F,F.ARG		; Arg given?
	 JRST	AUTOT1		; Yes, go set type out char
	MOVE	A1,AUTOF	; No, get the current auto type out character
	PJRST	VALRET		; And return it

AUTOT1:	MOVEI	T1,.CHLFD	; Get the default character
	CAIL	A1,1		; Is the character legal?
	 CAILE	A1,37		;  .  .  .
	  MOVE	T1,A1		; Yes, use what he gave
	MOVEM	T1,AUTOF	; Set the new value
	POPJ	P,		; And return
SUBTTL E Commands -- EH - Change error message level

ERRSET:	TXNE	F,F.ARG		;ARG SEEN?
	 JRST	ERRSE1		;YES, RESET INDICATOR
	HLLZ	T1,ERRLEN	;NO, RETURN CURRENT VALUE OF FLAG
	MOVSI	T2,-3		;NUMBER OF POSSIBILITIES
ERRS.0:	TDNE	T1,JWTABL(T2)	;BIT ON?
	 MOVEI	A1,1(T2)
	AOBJN	T2,ERRS.0	;NO, LOOP
	JRST	VALRET

JWTABL:	XWD	JW.WPR_-22,JW.WPR_-22
	XWD	JW.WFL_-22,<JW.WPR!JW.WFL>_-22
	XWD	JW.WCN_-22,<JW.WPR!JW.WFL!JW.WCN>_-22

ERRSE1:	CAILE	A1,3		;3 IS HIEST
	 MOVEI	A1,3		;FORCE IT DOWN IF GREATER
	MOVE	T1,PRMERR	;ASSUME DEFAULT
	SKIPLE	A1		;OK ASSUMPTION?
	HRLZ	T1,JWTABL-1(A1)	;NO
	MOVEM	T1,ERRLEN	;2 BECOMES 0  = MEDIUM
	POPJ	P,		; Return
SUBTTL	E Commands -- EK - Kill off the output file

EKILL:	LOAD.	T1,TPTADR,+TXTBUF ; Get the text buffer address
	PUSHJ	P,GETFDO	; Get the output FDB address
	 POPJ	P,		; Isn't one, just return
	MOVE	P1,T1		; Save a copy
	PUSHJ	P,F$RSET	; Close the file
	LOAD.	T1,TPTADR,+TXTBUF ; Get the buffer address back again
	BITOFF	T2,TF.OPO,.BKTFL(T1) ; Flag file is not open anymore
	PUSHJ	P,GETFDI	; Have an input file?
	 JRST	EKIL.1		; No, skip this
	BITOFF	T2,FD.EB,.FDFLG(T1) ; Yes, flag it is not EB'ed any more
	TXNE	T2,FD.ENQ	; File ENQ'ed?
	 PUSHJ	P,F$DEQ		; Yes, remove the lock

EKIL.1:	MOVE	T1,P1		; Get the address back
	PJRST	M$RBLK		; And return it
	SUBTTL	E Commands -- EN - rename the input file

;+
;.HL1 ENCMD
;This routine will execute the EN command.  This command causes a file
;to be renamed.
;-

ENCMD:	MOVX	T1,.FDLEN	; Get the size of an FDB
	MOVX	T2,.BTFDB	; And the block type
	PUSHJ	P,M$GBLK	; Get a block
	MOVE	P1,T1		; Get the address
	SETZ	T2,		; No switches
	PUSHJ	P,F$PARS	; Parse the file spec
	 PJRST	F$ERR		; Couldn't
	LOAD.	T1,TPTADR,+TXTBUF ; Get the text buffer address
	MOVEM	P1,LASFDB	; Save the FDB address in case of error
	PUSHJ	P,GETFDI	; Get the input file name
	 ERROR	E.ENE		; EN error
	MOVE	P2,T1		; Get the address
	MOVX	T1,FD.EB	; Check if the file is EB'ed
	TDNE	T1,.FDFLG(P2)	; Check if EB'ed?
	 ERROR	E.ENE		; Can't rename EB'ed file
	DMOVE	T1,P1		; Copy the FDBs
	PUSH	P,.FDNAM(P1)	; Save the file name
	PUSHJ	P,E$DFLT	; Cause any defaulting
	POP	P,.FDNAM(P1)	; And reset the file name
	MOVE	T1,P2		; Get the input FDB
	PUSHJ	P,F$CLOS	; And close the file
	 PJRST	F$ERR		; Couldn't
	LOAD.	T1,TPTADR,+TXTBUF ; Get the text buffer address again
	BITOFF	T2,TF.OPI,.BKTFL(T1) ; Clear the input flag
	MOVE	T1,P2		; Get the addresses again
	MOVE	T2,P1		;  .  .  .
	PUSHJ	P,F$RENM	; Rename the file
	 PJRST	F$ERR		; Couldn't
	MOVE	T1,P1		; Get the old input FDB
	PUSHJ	P,M$RBLK	; Return it
	MOVE	T1,P2		; Get the other FDB
	PJRST	M$RBLK		; And return it
SUBTTL	E Commands -- ER - Read a file

;+
;.hl1 ER command
; This command is used to open a file for input. It will associate the
;file with the current text buffer.
;-

OPNRD:	LOAD.	T1,TPTADR,+TXTBUF ; Get the text buffer address
	PUSHJ	P,GETFDI	; Have an input file already?
	 JRST	OPNR.1		; No, no worries
	MOVE	P1,T1		; Save a copy
	LOAD.	T3,TPTADR,+TXTBUF ; Get the buffer address
	BITOFF	T2,TF.OPI,.BKTFL(T3) ; Clear the open input flag
	PUSHJ	P,F$CLOS	; Close off the old input file
	 PJRST	F$ERR		; Couldn't, punt
	JRST	OPNR.2		; Already have an FDB, no need for a new one

OPNR.1:	MOVX	T1,.FDLEN	; Get the length
	MOVX	T2,.BTFDB	; And the block type
	PUSHJ	P,M$ZBLK	; get the block
	MOVE	P1,T1		; Get the address

OPNR.2:	SETOM	ER$BEG		; Clear the only switch
;	STORE	T1,ER$BEG,ER$END,-1 ; Clear the switch block
	MOVE	T1,P1		; Get the FDB address
	MOVEI	T2,ERSWT	; And the pointer to the switch block
	PUSHJ	P,F$PARS	; Parse the block
	 PJRST	F$ERR		; Give up

; Default the ER switches

	MOVE	T4,.FDFLG(P1)	; Get the flags from the FDB
	TXNE	T4,FD.DEF	; /DEFAULT given?
	 SETOM	DFTYNK		; Yes, default the /YANK value
	TXNE	T4,FD.NDF	; /NODEFAULT given?
	 JRST	OPNR.N		; Yes, skip this
	MOVE	T1,LS$YNK	; Get the switch value
	CAXN	T1,-1		; Default?
	 MOVE	T1,DFTYNK	; Get the default
	MOVEM	T1,LS$YNK	; Set the switch value
	MOVEM	T1,DFTYNK	; And save as default

OPNR.N:	XMOVEI	T1,ER$BEG	; Get the start of the ER switches
	XMOVEI	T2,ER$DFS	; And the default ER switches
	MOVEI	T3,ER$END-ER$BEG+1 ; And the length of the table
	PUSHJ	P,E$DFSW	; Default the switch values

; Now do the random defaulting

OPNR.0:	MOVEI	T1,DEF$ER	; Get the default block
	MOVEI	T2,DEF$EW	; Use the EW block forst
	PUSHJ	P,E$DFLT	; Do the defaulting

; Do the defaulting for the file specification now

	MOVEI	T3,PDF$ER	; Get the perm defaults
	MOVEI	T2,DEF$ER	; Get the default block
	MOVE	T1,P1		; Get the FDB address
	PUSHJ	P,F$DFLT	; And default the block
	MOVX	T1,$IOREA	; Set up to read the file
	MOVE	T2,P1		;  .  .  .
	PUSHJ	P,F$OPEN	; And open it up
	 PJRST	F$ERR		; Give up
	LOAD.	T1,TPTADR,+TXTBUF ; Get the buffer address again
	STOR.	P1,BLKFDI,(T1)	; Store the FDB address
	BITON	T2,TF.OPI,.BKTFL(T1) ; Flag we have a file
	SKIPLE	LS$YNK		; User want /YANK?
	 PJRST	YANK		; Yes, go do it
	POPJ	P,		; Return happy

DEFINE ER$SW,<
SW	NOYANK,LS$YNK,,0,
SW	SUPLSN,SR$SLS,,1,
SW	YANK,LS$YNK,,1,
> ; End of ER$SW macro

	DOSWTCH(ER,ER$SW)

ERSWT:	SWTPTR(ER)
	SUBTTL	E Commands -- EB - Edit and backup command

;+
;.HL1 EB command
; This command will cause the file to be edited and a backup of the orginal
;file to be created when the editing is finished.  This command will take
;both input and output modes.  The following are a list of the allowed switches.
;.literal
;
; Switches:
;	/GENLSN		Same as /OMODE:LSA
;	/IMODE:mode	Sets the input mode to the specified mode
;	/INPLACE	Edit the file in the path it was found in
;	/MODE:mode	Sets the input and output mode
;	/OMODE:mode	Sets the output mode
;	/READONLY	Set the file as only being read
;	/SUPLSN		Sets the output mode to /OMODE:ASCII
;.end literal
;-

DEFINE	EB$SW,<
SW	GENLSN,SWTOMD,,$FMLSA,
SW	IMODE,SWTIMD,F$KEY,MODPTR,SW.VRQ!SW.KEY
SW	INPLACE,LS$INP,,0,
SW	MODE,SWTIMD,F$KEY,MODPTR,SW.VRQ!SW.KEY
SW	NOYANK,LS$YNK,,0,
SW	OMODE,SWTOMD,F$KEY,MODPTR,SW.VRQ!SW.KEY
SW	READONLY,LS$RED,,0,
SW	SUPLSN,SWTOMD,,$FMASC,
SW	YANK,LS$YNK,,1,
> ; End of EB$SW macro definition

	DOSWTCH(EB,EB$SW)	; Generate the EB switches

EBPTR:	SWTPTR(EB)		; Generate the switch pointer

DEFINE	FK(A,B,C),<EXP	SIXBIT	/'B'/>
MODKEY:	FM$KEY			; Generate the key words
	MOD.L==.-MODKEY		; Generate the length

MODPTR==:<-MOD.L,,MODKEY>	; Generate a symbol
; Main routine

EBCMD:	MOVX	T1,.FDLEN	; Get the length of an FDB
	MOVX	T2,.BTFDB	; From the FDB area
	PUSHJ	P,M$GBLK	; Allocate the block
	MOVE	P1,T1		; Move to a safer place
	SETOM	SWTIMD		; Set the external values
	SETOM	SWTOMD		; . . .
	SETOM	LS$INP		; Set the local switch
	SETOM	LS$RED		; . . .
	SETOM	LS$YNK		;  .  .  .
	MOVEI	T2,EBPTR	; Get the EB switch pointer
	PUSHJ	P,F$PARS	; Parse the file specification
	  JRST	F$ERR		; Failed
	LOAD.	T1,FDBFLG,(P1)	; Get the flags
	TXNE	T1,FD.DEF	; /DEFAULT?
	 JRST	[SETOM	DFTOMD		; Forget the defaults
		SETOM	DFTIMD		;  .  .  .
		SETOM	DFTYNK		; Clear default /YANK value
		JRST	.+1]		; Continue on
	TXNE	T1,FD.NDF	; /NODEFAULT given?
	 JRST	EBCM.D		; Yes, skip defaulting
	MOVE	T1,SWTIMD	; Get the /IMODE argument
	CAXN	T1,-1		; Any given?
	 MOVE	T1,DFTIMD	; No, get the default
	MOVEM	T1,SWTIMD	; Save as current /MODE
	MOVEM	T1,DFTIMD	; And as new default
	MOVE	T1,SWTOMD	; Get the output mode
	CAXN	T1,-1		; Any given?
	 MOVE	T1,DFTOMD	; No, get the default
	MOVEM	T1,SWTOMD	; Save as current /OMODE
	MOVEM	T1,DFTOMD	; And as new default
	MOVE	T1,LS$YNK	; Get the /YANK switch
	CAXN	T1,-1		; Any given?
	 MOVE	T1,DFTYNK	; No, use default
	MOVEM	T1,LS$YNK	; Save it back
	MOVEM	T1,DFTYNK	;  .  .  .
EBCM.D:	SKIPL	T1,SWTIMD	; Get the /IMODE value
	 STOR.	T1,FDBMOD,(P1)	; There was one, store it
	SKIPGE	LS$INP		; Was /INPLACE specified ?
	  JRST	EBCM.0		; No - Skip this
	BITON	T1,FD.INP,.FDFLG(P1) ; Yes - Light the flag

; Now do the random defaulting

EBCM.0:
;	MOVEI	T1,DEF$EB	; Place to store the defaults
;	MOVEI	T2,DEF$ER	; From the ER
;	PUSHJ	P,E$DFLT	; Do it
	MOVEI	T1,DEF$ER	; Place to store the defaults
	MOVEI	T2,DEF$EW	; From the EW
	PUSHJ	P,E$DFLT	; Do it

; Now to the per file specification defaulting

	MOVE	T1,P1		; Get the FDB address
	MOVEI	T2,DEF$ER	; Get the default block
	MOVEI	T3,PDF$ER	; Get the perm defaults address
	PUSHJ	P,F$DFLT	; And default the FDB
	SKIPL	LS$RED		; Read only?
	 JRST	EBCM.9		; Yes, just do an ER command
	LOAD.	T1,TPTADR,+TXTBUF ; Get the text buffer address
	PUSHJ	P,GETFDI	; Get the input FDB address
	 JRST	EBCM.3		; None, try output
	MOVX	T2,FD.EB	; Check if this is an EB'ed file
	TDNN	T2,.FDFLG(T1)	;  .  .  .
	 JRST	EBCM.5		; Okay, just close the file
	MOVE	T1,P1		; Get the FDB address of the new file
	PUSHJ	P,M$RBLK	; And return it
	ERROR	E.EBO		; EB still open

EBCM.5:	PUSH	P,T1		; Save the address
	PUSHJ	P,F$CLOS	; Close the input file
	 PJRST	F$ERR		; Couldn't
	POP	P,T1		; Get the FDB address back
	PUSHJ	P,M$RBLK	; And return it

EBCM.3:	LOAD.	T1,TPTADR,+TXTBUF ; Get the text buffer address
	BITOFF	T2,TF.OPO!TF.OPI,.BKTFL(T1) ; Clear the open file flags
	PUSHJ	P,GETFDO	; And try for an output file
	 JRST	EBCM.4		; None, skip this
	PUSH	P,T1		; Save the address
	PUSHJ	P,F$CLOS	; Close the file
	 PJRST	F$ERR		; Couldn't
	POP	P,T1		; Get the FDB address back
	PUSHJ	P,M$RBLK	; And return it

EBCM.4:	MOVE	T1,P1		; Get the pointer to the FDB again
	PUSHJ	P,F$EB		; Make this file be in EB mode
	  JRST	F$ERR		; Failed
	LOAD.	T3,TPTADR,+TXTBUF ; Get the address of the text block
	STOR.	T1,BLKFDO,(T3)	; Store the address of the temp file
	STOR.	T2,BLKTMP,(T3)	; Store the output FDB
	STOR.	P1,BLKFDI,(T3)	; Store the input FDB
	BITON	T1,TF.OPO!TF.OPI,.BKTFL(T3) ; Flag the file is open
	SKIPLE	LS$YNK		; /YANK given?
	 PJRST	YANK		; Yes, go do it
	POPJ	P,		; Return to the caller

EBCM.9:	SETOM	SR$SLS		; Flag no /SUPLSN
	MOVE	T1,SWTOMD	; Get the output mode
	CAXN	T1,$FMASC	; Did we get the switch?
	 SETZM	SR$SLS		; Yes, flag it
	JRST	OPNR.0		; And go open for reading
SUBTTL	E Commands -- EW - Write a file
SUBTTL	E Commands -- EA - Append to a file

;+
;.hl1 EA and EW command
; This routine will open an output file. EA opens the file for appending
;EW will supersede the file. The file will be associated with the current
;buffer.
;-


OPNWRA:	SKIPA	P2,[EXP $IOAPP]	; Get the append function
OPNWR:	 MOVX	P2,$IOWRS	; Get the write function
	LOAD.	T1,TPTADR,+TXTBUF ; Get the text buffer address
	PUSHJ	P,GETFDO	; And get the output FDB
	 JRST	OPNW.1		; Don't have one, don't need to close it
	MOVE	P1,T1		; Copy the address
	LOAD.	T1,TPTADR,+TXTBUF ; Get the text buffer
	BITOFF	T2,TF.OPO,.BKTFL(T1) ; Clear the file open flag
	MOVE	T1,P1		; Get the FDB address back
	PUSHJ	P,F$RSET	; And delete the output we were making
	JRST	OPNW.2		; Skip getting a new FDB

OPNW.1:	MOVX	T1,.FDLEN	; Get the length
	MOVX	T2,.BTFDB	; And the block type
	PUSHJ	P,M$GBLK	; Get the FDB
	MOVE	P1,T1		; Into the correct place

OPNW.2:
;	STORE	T1,EW$BEG,EW$END,-1 ; Clear the switches
	SETOM	EW$BEG		; Clear the switch
	MOVE	T1,P1		; Get the block address back
	MOVEI	T2,EWSWT	; And get the EW switches
	PUSHJ	P,F$PARS	; Parse the file spec
	 PJRST	F$ERR		; Go give the error message

; Now do the random defaulting

	MOVEI	T1,DEF$EW	; Get the place to store into
	MOVEI	T2,DEF$ER	; From
	PUSHJ	P,E$DFLT	; Default this block

; Now default the file specification just input

	MOVE	T1,P1		; Get the FDB address
	MOVEI	T2,DEF$EW	; Get the default block
	MOVEI	T3,PDF$EW	; Get the perm default block
	PUSHJ	P,F$DFLT	; Default the block
OPNW.0:	MOVE	T1,P2		; Get the function (either write or append)
	MOVE	T2,P1		; And the FDB address
	PUSHJ	P,F$OPEN	; Open the file
	 PJRST	F$ERR		; Couldn't
	MOVEI	T1,(P1)		; Get the FDB address
	PUSHJ	P,F$ENQ		; ENQ. this file
	  JRST	OPNW.4		; Couldn't forget the whole thing
	LOAD.	T1,TPTADR,+TXTBUF ; Get the text buffer address back
	STOR.	P1,BLKFDO,(T1)	; Store the FDB address
	BITON	T2,TF.OPO,.BKTFL(T1) ; And flag it is there
	POPJ	P,		; Return
OPNW.4:	HRRZM	P1,LASFDB	; Store the FDB address
	ERROR	E.FAE		; And give the error
DEFINE EW$SW,<
SW	GENLSN,SW$GLS,,1,
> ; End of EW$Sw

	DOSWTCH(EW,EW$SW)

EWSWT:	SWTPTR(EW)
SUBTTL	E Commands -- EZ and EF

;EZ	SELECTS THE OUTPUT DEVICE, ISSUES A REWIND COMMAND TO IT,
;	ISSUES A COMMAND TO ZERO ITS DIRECTORY, AND OPENS THE FILE
;	SPECIFIED (IF ANY).

ZERDIR:	MOVX	T1,.FDLEN	; Get the length of an FDB
	MOVX	T2,.BTFDB	; And the block type
	PUSHJ	P,M$GBLK	; Get the FDB
	MOVE	P1,T1		; Get the address
	STORE	T2,EW$BEG,EW$END,-1 ; Clear the switch block
	MOVEI	T2,EWSWT	; Get the Ew switches
	PUSHJ	P,F$PARS	; And parse the file spec
	 PJRST	F$ERR		; Couldn't
	MOVE	T1,P1		; Get the FDB address
	MOVEI	T2,DEF$EW	; Get the default block
	MOVEI	T3,PDF$EW	; Get the default block address
	PUSHJ	P,F$DFLT	; And default the block
	LOAD.	T1,FDBDEV,(P1)	; Get the device name
	IONDX.	T1,		; Get the device index
	 JRST	ZERD.1		; Couldn't, just go try to open the file
	UTPCLR	T1,		; Clear the directory for the device

ZERD.1:	MOVX	P2,$IOWRI	; Get the F$OPEN function
	PJRST	OPNW.0		; Go open the file for output
;EF	FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT
;	SELECTING A NEW OUTPUT FILE.

CLOSEF:	LOAD.	T1,TPTADR,+TXTBUF ; Get the text buffer address
	MOVE	P1,T1		; And get a copy
	PUSHJ	P,GETFDO	; Get the output FDB
	 POPJ	P,		; None, just return
	MOVE	P2,T1		; Get a copy
	MOVE	T1,P1		; Get the buffer address back
	PUSHJ	P,GETFDI	; And try for an input FDB
	 JRST	CLOS.1		; None, can't be an EB'ed file
	MOVE	P3,T1		; Save the address
	MOVX	T1,FD.EB	; Check if EB'ed
	TDNN	T1,.FDFLG(P2)	;  .  .  .
	 JRST	CLOS.1		; No, just close the output file
	PUSHJ	P,FIN.EB	; Finish up
	BITOFF	T1,TF.OPO!TF.OPI,.BKTFL(P1) ; Flag no files open at all
	POPJ	P,		; And return

CLOS.1:	MOVE	T1,P2		; Not EB'ed, just close the output
	PUSHJ	P,F$CLOS	; Close the file
	 PJRST	F$ERR		; Something went wrong
	BITOFF	T1,TF.OPO,.BKTFL(P1) ; Clear the output open flag
	MOVE	T1,P2		; Get the address
	PJRST	M$RBLK		; And return the core
SUBTTL	E Commands -- EM - MTAPE UUO's

	TP.MTP==777B8		; MTAPE code
	TP.ARG==777B17		; Argument for TAPOP.
	TP.TOP==777777		; Function for TAPOP.


EMTAPE:	LOAD.	T1,TPTADR,+TXTBUF ; Get the text buffer address
	PUSHJ	P,GETFDI	; Get the input FDB address
	 ERROR	E.NFI		; No file for input
	MOVE	P1,T1		; Get the address
	LOAD.	T1,FDBCHN,(P1)	; Get the channel number
	DEVCHR	T1,		; And get the bits
	TXNN	T1,DV.MTA!DV.DTA ; Only do this for magtape or DECtape
	 POPJ	P,		; No-op otherwise
	JUMPGE	A1,.+2		; Valid MTAPE?
	 ERROR	E.EMA		; No, punt it
	MOVE	T2,[XWD -MTPLEN,MTPTBL] ; Get the table pointer
	CHKEO	EO124,EMTA.1	; If EO level before 200 use MTAPE args
	JRST	EMTA.3		; Go handle TAPOP. arg

EMTA.1:	LOAD	T1,(T2),TP.MTP	; Get the MTAPE code
	CAIE	A1,(T1)		; Correct one?
	 JRST	EMTA.2		; Yes, go get it
	LOAD	A1,(T2),TP.TOP	; Convert the code to the TAPOP. equivalent
	LOAD	A2,(T2),TP.ARG	; And get the argument
	CAXE	A2,TP.ARG_-<ALIGN.(TP.ARG)> ; No argument?
	 TXO	F,F.ARG2	; No, flag we have a second arg
	JRST	EMTA.3		; And go do it

EMTA.2:	AOBJN	T2,EMTA.1	; Loop through the entire table

; Here to do the requested TAPOP.  See if it requires or returns a value

EMTA.3:	CAXGE	A1,2000		; Set function?
	 JRST	EMTA.4		; No, go read a value
	TXNN	F,F.ARG2	; Have the second arg?
	 SETZ	A2,		; No, assume zero
	MOVE	P2,[XWD 3,T2]	; Get the block pointer
	MOVE	T4,A2		; Get the argument to set
	JRST	EMTA.5		; Go do the TAPOP.

EMTA.4:	MOVE	P2,[XWD 2,T2]	; Get the pointer
EMTA.5:	LOAD.	T3,FDBCHN,(P1)	; get the channel
	MOVE	T2,A1		; Get the funcion
	TAPOP.	P2,		; And do it
	 ERROR	E.TPF		; Couldn't, TAPOP. failed
	CAXL	A1,1000		; Read function?
	 CAXL	A1,2000		;  .  .  .
	  POPJ	P,		; No, just return
	MOVE	A1,P2		; Yes, get the value
	PJRST	VALRET		; And return

MTPTBL:	INSVL.(<MTWAT.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFWAT,TP.TOP)>
	INSVL.(<MTREW.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFREW,TP.TOP)>
	INSVL.(<MTEOF.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFDSE,TP.TOP)>
	INSVL.(<MTSKR.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFFSB,TP.TOP)>
	INSVL.(<MTBSR.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFBSB,TP.TOP)>
	INSVL.(<MTEOT.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFSLE,TP.TOP)>
	INSVL.(<MTUNL.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFUNL,TP.TOP)>
	INSVL.(<MTBLK.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFWLG,TP.TOP)>
	INSVL.(<MTSKF.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFFSF,TP.TOP)>
	INSVL.(<MTBSF.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFBSF,TP.TOP)>
	INSVL.(<MTDEC.>,TP.MTP)!<INSVL.(.TFMDD,TP.ARG)>!<INSVL.(.TFMOD,TP.TOP)>
	INSVL.(<MTIND.>,TP.MTP)!<INSVL.(.TFM8B,TP.ARG)>!<INSVL.(.TFMOD,TP.TOP)>
	INSVL.(<MTLTH.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFLTH,TP.TOP)>

MTPLEN==.-MTPTBL
	SUBTTL	E Commands -- E? command


;+
;.hl1 EQUEST
; This routine will handle the E? command.  This command is used to obtain
;information about various things.
;.b
;Command format:
;.lit
;	E?(Q-REG-NAME)KEYWORD$
;	  - or -
;	E?KEYWORD$
;
;.end lit
;-

; Definition of keyword table entry

	INTSTR	EQU,EQ,$,$SRLEN	; Generate $EQxxx
	WORD	RTN		; Routine address to call
	WORD	FLG		; Flags
		INTFLG	EQ
		FLAG	NMA		; Numeric argument allowed
	ENDSTR			; End the structure

EQUEST:	SETZ	T1,		; Flag no default name
	PUSHJ	P,SCNQRG	; Scan off a Q-register name
	 SETZ	T1,		; None, remember that
	MOVE	P1,T1		; Save the QRG address
	MOVEI	T1,XCTBUF	; Get the address of the TPT
	MOVEI	T2,SKRCH	; And the routine
	PUSHJ	P,SCNKEY	; Get the keyword
	 ERROR	E.UTK		; Not finished
	MOVE	T1,[XWD -EQULEN,EQUTBL] ; Get the table pointer
	PUSHJ	P,FNDKWD	; And look for the keyword
	 ERROR	E.IKW		; Illegal keyword
	MOVE	T2,$EQFLG(T1)	; Get the flags
	TXNE	F,F.ARG		; Is there an argument?
	 TXNE	T2,EQ$NMA	; Yes, is it allowed?
	  PJRST	@$EQRTN(T1)	; Dispatch to the correct routine
	ERROR	E.NAA		; No, no argument allowed

; Table of keywords for E?

DEFINE EQUNAM,<
STR	<CURRENT-TEXT-BUFFER>,<EQUCTB,>
;STR	<DISPLAY-BOUNDS>,<EQUDBN,>
STR	<DISPLAY-LINES>,<EQUDLN,>
STR	<INPUT-FILE>,<EQUIFL,>
STR	<LEAVE-BLANK-LINE>,<EQULBL,EQ$NMA>
STR	<LAST-SEARCH-STRING-LENGTH>,<EQULSL>
STR	<OUTPUT-FILE>,<EQUOFL,>
STR	<Q-DIRECTORY>,<EQUQDR,>
STR	<REVERSE-SEARCH-FLAG>,<EQURVS,EQ$NMA>
STR	<SCREEN-ADDRESS>,<EQUSCA,EQ$NMA>
STR	<TERMINAL-TYPE>,<EQUTTY,>
> ; End of EQUNAM

DEFINE STRSUB(RTN,FLAGS<0>),<EXP <IFIW RTN>,<FLAGS>>

	SYN	EQUNAM,STRTBL
	
	DOSTR(EQU)

	SUBTTL	E Commands -- E? command -- CURRENT-TEXT-BUFFER

;+
;.hl2 CURRENT-TEXT-BUFFER
; This routine will return the name of the Q-register that is currently being
;edited.
;-

EQUCTB:	JUMPN	P1,[ERROR E.QNN] ; Can't have a Q-reg for this command
	MOVEI	T1,1		; Get a character
	PUSHJ	P,GETSTR	; long buffer
	MOVEI	T1,SARG$1	; Get the text buffer pointer
	MOVEI	T2,[$STRING(<^G/CUREDT/^N>)] ; Get the string 
	PUSHJ	P,.INSRT	; Insert it
	PJRST	PASRET		; And return
	SUBTTL	E Commands -- E? command -- INPUT-FILE

;+
;.HL2 INPUT-FILE
; This routine will handle theE?(q-reg)INPUT-FILE$ command. This will return
;a string argument which is the file specification for the current input file
;for the Q-reg.
;-

EQUIFL:	JUMPE	P1,[ERROR E.QNR] ; If no Q-reg given, complain
	MOVE	T1,P1		; Get the Q-reg address
	PUSHJ	P,QTXTEI	; And set up for reading text
	PUSHJ	P,GETFDI	; Get the input file
	 PJRST	EQUNUL		; Return the null string
	JRST	EQUF.0		; Join common routine



	SUBTTL	E Commands -- E? command -- OUTPUT-FILE


;+
;.HL2 OUTPUT-FILE
; This routine will handle the E?(q-reg)OUTPUT-FILE$ command.  It will
;return a string which is the file specification of the output file for
;the given Q-register.
;-

EQUOFL:	JUMPE	P1,[ERROR E.QNR] ; If no Q-reg given, complain
	MOVE	T1,P1		; Get the Q-reg address
	PUSHJ	P,QTXTEI	; And set up for reading text
	PUSHJ	P,GETFDO	; Yes, get the FD address
	 PJRST	EQUNUL		; None, return the null string

EQUF.0:	MOVE	P1,T1		; Get the FDB address
	MOVEI	T1,^D20		; Probably about 20 characters
	PUSHJ	P,GETSTR	; Get the string
	MOVEI	T1,SARG$1	; Get the address of the TPT
	MOVEI	T2,[$STRING(<^F/P1/^N>)] ; Get the address of the string
	PUSHJ	P,.INSRT	; Insert the text
	PJRST	PASRET		; And return


; Here to return the null string for Q-regs which don't have a file open.

EQUNUL:	SETZ	T1,		; Get 0 characters
	PUSHJ	P,GETSTR	;  .  .  .
	PJRST	PASRET		; And return the null
	SUBTTL	E Commands -- E? command -- DISPLAY-LINES

;+
;.hl2 DISPLAY-LINES
; This routine will handle the E?(q-reg)DISPLAY-LINES$ command. It will
;return two arguments as taken by an E$ command.
;If the Q-register name is not given, it will use the current editing
;buffer.
;-

EQUDLN:	MOVX	T1,QR$VID	; Get the flag to check
	JUMPN	P1,EDLN.1	; If we have the Q-reg name, just go do it
	MOVE	P1,CUREDT	; Otherwise use the current editing buffer
	TDNN	T1,$QRFLG(P1)	; Is this displayed?
	 XMOVEI	P1,TXTBUF	; No, assume he wants TEXT-BUFFER
EDLN.1:	LOAD.	A1,QRGOFS,(P1)	; Get the offset to the first line
	LOAD.	A2,QRGNLN,(P1)	; And the number of lines
	ADD	A2,A1		; Get the last line number
	AOJ	A1,		; And the first
	TDNN	T1,$QRFLG(P1)	; Is it really displayed?
	 SETZB	A1,A2		; No, return zeros
	PJRST	VALRT2		; Return the values
	SUBTTL	E Commands -- E? command -- LEAVE-BLANK-LINE

;+
;.hl2 LEAVE-BLANK-LINE
; This routine will return or set the value of the display blank line flag
;for a Q-register.
;-

EQULBL:	JUMPE	P1,[ERROR E.QNR] ; If no Q-reg given, complain
	MOVX	T1,QR$DLC	; Get the flag to check
	TXNE	F,F.ARG		; Argument given?
	 JRST	ELBL.1		; Yes, go set the flag
	TDNN	T1,$QRFLG(P1)	; Check if it is set
	 PJRST	RETZER		; No, return a zero
	PJRST	RTONES		; Yes, return -1

ELBL.1:	CAIN	P1,CMDBUF	; Can't change command buffer flgas
	 POPJ	P,		; Just pretend we allowed it
	ANDCAM	T1,$QRFLG(P1)	; Turn off the flag
	JUMPE	A1,.POPJ	; And return if that is the desired setting
	IORM	T1,$QRFLG(P1)	; Otherwise turn it on
	POPJ	P,		; And return
	SUBTTL	E Commands -- E? command -- Q-DIRECTORY

;+
;.hl2 Q-DIRECTORY
; This routine will handle the E?Q-DIRECTORY$ command.  This will return
;a string argument which is a list of the currently active Q-register names
;and some information about each.
;-

EQUQDR:	MOVEI	T1,^D50		; Assume 50 characters for a start
	PUSHJ	P,GETSTR	; Get a text buffer for the string argument return
	SKIPN	T1,P1		; Have a specific Q-reg?
	 JRST	EQDR.0		; Go do the complete listing
	MOVEI	T2,[$STRING(<^G/LASQRG/^N>)] ; Get the $STRING for the name
	PUSHJ	P,EQDR.S	; List this QRG
	PJRST	PASRET		; And return

; First loop through the single character names, checking for Q-registers
;with either text or a non-zero value.
;

EQDR.0:	MOVSI	P1,-<"Z">	; Get the count for all possible characters (upper case)

EQDR.1:	MOVX	T1,CF.QRG	; See if a valid Q-reg name
	TDNN	T1,CHRFLG(P1)	;  .  .  .
	 JRST	EQDR.2		; No, try the next
	LOAD.	T1,CDTQRI,+CHRFLG(P1) ; Get the Q-reg index
	IMULX	T1,$QRLEN	; Make the offset
	ADDI	T1,QTAB		; Plus the base address
	MOVEI	T2,[$STRING(<^7/CH/^N>)] ; Get the name type out string
	MOVEI	CH,(P1)		; Get the character name
	LOAD.	T3,QRGDTP,(T1)	; Get the data type
	CAXN	T3,$DTNUM	; Numeric value?
	 SKIPE	$QRVAL(T1)	; Yes, non-zero?
	  PUSHJ	P,EQDR.S	; List the info for this QRG
EQDR.2:	AOBJN	P1,EQDR.1	; Loop for all of the permanent Q-registers

; Now do the special purpose long names

	MOVE	P1,[XWD -QNMLEN,QNMTBL] ; Get the pointer to the table

EQDR.3:	MOVE	CH,(P1)		; Get the address of the data
	MOVE	T1,2(CH)	; Get the QRG address
	MOVEI	T2,[$STRING(<^B/(CH)/^N>)] ; Get the string to type the name
	PUSHJ	P,EQDR.S	; Do it
	AOBJN	P1,EQDR.3	; And do the rest of the special Q-regs

; Now go down the chain of the defined Q-registers.

	LOAD.	P1,LNKNXT,+QRGLNK ; Have any Q-registers defined?
	PJUMPE	P1,PASRET	; No, all done

EQDR.4:	LOAD.	T1,SYMQRG,(P1)	; Get the address of the QRG block
	MOVE	A1,T1		; Get a safer copy
	MOVEI	T2,[$STRING(<^G/A1/^N>)] ; Get the string pointer to type out the name
	PUSHJ	P,EQDR.S	; Stuff the text
	LOAD.	P1,LNKNXT,+$SYLNK(P1) ; Get the address of the next Q-register
	JUMPN	P1,EQDR.4	; Have one?

	PJRST	PASRET		; All done, return


; Subroutine to list the information for a Q-register.
; Usage:
;	T1/ QRG block address
;	T2/ Address of $STRING to list the name
;	PUSHJ	P,EQDR.S

EQDR.S:	$SAVE	<P1,P2,P3,P4>	; Save some ac's
	DMOVE	P1,T1		; Get the arguments
	LOAD.	T1,QRGDTP,(P1)	; Get the data type
	CAXE	T1,$DTTXT	; Is this text?
	 JRST	EQDS.1		; No, just a number
	LOAD.	T1,TPTADR,+$QRTPT(P1) ; Yes, get the address of the buffer
	LOAD.	T3,BLKPT,(T1)	; Get the position
	LOAD.	T4,BLKEND,(T1)	; And the length
	XMOVEI	P3,[$STRING(<Text .=^D/T3/, Z=^D/T4/^N>)] ; Get the type out string
	JRST	EQDS.2		; Go write the text
EQDS.1:	CAXE	T1,$DTNUM	; Numeric value?
	 SKIPA	P3,[[$STRING(<FC table>)]] ; No, must be an FC table
	  XMOVEI P3,[$STRING(<Value=^D/$QRVAL(P1)/^N>)] ; For numerics, just print the value
EQDS.2:	XMOVEI	T1,SARG$1	; Get the pointer to where to put the text
	XMOVEI	T2,[$STRING(<(^S/(P2)/):	^S/(P3)/>)] ; Get the text
	PUSHJ	P,.INSRT	; Insert the text
	LOAD.	T3,QRGOFS,(P1)	; Get the offset to where this is displayed
	LOAD.	T4,QRGNLN,(P1)	; Get the number of lines
	ADD	T4,T3		; Get the final line
	AOJ	T3,		; And make them external line numbers
	MOVE	T1,$QRFLG(P1)	; Get the flags
	TXNN	T1,QR$VID	; Is this displayed?
	 SKIPA	T2,[[$STRING(<^N^M^J>)]] ; No, just do the CRLF
	  MOVEI	T2,[$STRING(<,	Displayed:^D/T3/:^D/T4/^N^M^J>)]
	MOVEI	T1,SARG$1	; Get the pointer to the buffer
	PJRST	.INSRT		; And insert the text
	SUBTTL	E Commands -- E? command -- SCREEN-ADDRESS

;+
;.HL2 SCREEN-ADDRESS
; This will return the screen coordinates of the given position.  If no
;Q-register is given it will assume the current editing buffer, and if
;no numeric argument is given it will assume the current pointer position
;for the given Q-register.  It will return two arguments, the first being
;the X position, and the second the Y position.  If the given position is
;not displayed, it will return zeros for both arguments.
;-

EQUSCA:	MOVX	T1,QR$VID	; See if current buffer is displayed
	JUMPN	P1,ESCA.1	; If a Q-reg was given skip this
	MOVE	P1,CUREDT	;  .  .  .
	TDNN	T1,$QRFLG(P1)	; Is it?
	 XMOVEI	P1,TXTBUF	; No, try text-buffer

ESCA.1:	TDNN	T1,$QRFLG(P1)	; Is it displayed?
	 JRST	[SETZB	A1,A2		; No, clear the return args
		PJRST	VALRT2]		; And return both args
	LOAD.	T1,TPTADR,+$QRTPT(P1) ; Get the address of the buffer
	TXNN	F,F.ARG		; Did we have an argument?
	 LOAD.	A1,BLKPT,(T1)	; No, use current position
	MOVE	T1,A1		; Get the position
	MOVE	T2,P1		; And the QRG
	PUSHJ	P,FNDCHP	; Find where the character is
	 SETOB	T1,T2		; Make so we return zeros
	AOS	A2,T1		; Get the X position
	AOS	A1,T2		; And the Y position
	PJRST	VALRT2		; Return the args
	SUBTTL	E Commands -- E? command -- TERMINAL-TYPE

;+
;.HL2 TERMINAL-TYPE
;This will return a string argument that is the name of the current terminal
;type that the user is connected to.
;-

EQUTTY:	JUMPN	P1,[ERROR E.QNN]	; Can't have a Q-reg for this command
	MOVEI	T1,1			; Get a character
	PUSHJ	P,GETSTR		; long buffer
	MOVEI	T1,SARG$1		; Get the text buffer pointer
TOPS10<
	MOVEI	T2,[$STRING(^W/TRMTYP/^N)] ; Get the string to use
>; End of TOPS10
TOPS20<
	MOVE	T3,TRMTYP		; Get the terminal type
	MOVEI	T2,[$STRING(^T/@TRMNAM(T3)/^N)] ; Get the string to use
>
	PUSHJ	P,.INSRT		; Insert the text
	PJRST	PASRET			; And return
	SUBTTL	E Commands -- E? command -- LAST-SEARCH-STRING-LENGTH

;+
;.HL2 LAST-SEARCH-STRING-LENGTH
; This routine will return the length of the last search string that
;was found.
;-

EQULSL:	JUMPN	P1,[ERROR E.QNN] ; Q-reg not allowed
	MOVE	A1,SRHLEN	; Get the last string length found
	PJRST	VALRET		; And return it
	SUBTTL	E Commands -- E? command -- REVERSE-SEARCH-FLAG

;+
;.hl2 REVERSE-SEARCH-FLAG
; This routine will set or clear the reverse search flag, or return the
;value of the flag.  If the reverse search flag is set, then reverse
;searches will leave the pointer immediately before the first character
;in the occurance of the search string that was found.  If the flag
;is clear, then the reverse search will leave the pointer after the
;last character of the occurance of the search string.
;-

EQURVS:	JUMPN	P1,[ERROR E.QNN]	; Complain if Q-reg name given
	TXNE	F,F.ARG			; Argument given?
	 JRST	ERVS.1			; Yes, go set or clear the flag
	TXNE	S,S.RVRS		; No, is the flag set?
	 PJRST	RTONES			; Yes, return -1
	PJRST	RETZER			; No, return 0

ERVS.1:	TXZ	S,S.RVRS		; Assume clearing the flag
	JUMPE	A1,.POPJ		; If value is zero, leave it clear
	TXO	S,S.RVRS		; Otherwise set it
	POPJ	P,			; And return
	SUBTTL	E Commands -- Subroutines -- E$DFLT

;+
;.HL2 E$DFLT
;This is a special defaulting routine for ER/EW and EB processing.
;.literal
;
; Usage:
;	MOVEI	T1,To FDB
;	MOVEI	T2,From FDB
;	PUSHJ	P,E$DFLT
;	(Return)
;.end literal
;-

DEFINE DEFFDB(FIELD,BIT,%1)<
IFNB <BIT>,<
	MOVX	T1,FD.'BIT	;; Get the bit to check
	TDNE	T1,.FDFLG(P1)	;; Check if field was given
	 JRST	%1		;; Given, leave it alone
	TDNE	T1,.FDFLG(P2)	;; Do we need it on?
	 IORM	T1,.FDFLG(P1)	;; Yes, flag it
>;; End of IFNB <BIT>
	LOAD.	T1,FDB'FIELD,(P2) ;; Get the default
IFB <BIT>,<CFXN.	T2,FDB'FIELD,(P1),0	;; Check if given>
	 STOR.	T1,FDB'FIELD,(P1) ;; Store the value
IFNB <BIT>,<%1:!>
> ; End of DEFFDB definition

DEFINE	CPYFDB(FIELD)<
	LOAD.	T1,FDB'FIELD,(P2) ;; Load the field
	STOR.	T1,FDB'FIELD,(P1) ;; Store it into the other field
>; End of CPYFDB

E$DFLT:	$SAVE	<P1,P2>		; Save P1 and P2
	DMOVE	P1,T1		; Copy the arguments
	MOVX	T1,FD.NDF	; Check if /NODEFAULT
	TDNE	T1,.FDFLG(P1)	;  given
	 POPJ	P,		; Yes, don't do any defaulting
	DEFFDB	NOD		; Default the node name
	DEFFDB	NAM		; Default the name
	DEFFDB	EXT,HEX		; Default the extension
	DEFFDB	PRO,HPR		; Default the protection
	DEFFDB	VER		; Default the version
	DEFFDB	MOD		; Default the mode
	MOVX	T1,FD.PTH	; Get the path bit
	TDNE	T1,.FDFLG(P1)	; Was the field specified ?
	  POPJ	P,		; No, just return to the caller
	TDNE	T1,.FDFLG(P2)	; Over here ?
	 IORM	T1,.FDFLG(P1)	; Light it over here too
	CPYFDB	PPN		; Default the PPN
	CPYFDB	SFD		; Default the path
	CPYFDB	SF2		; . . .
	CPYFDB	SF3		; . . .
	CPYFDB	SF4		; . . .
	CPYFDB	SF5		; . . .
	POPJ	P,		; Return to the caller
	SUBTTL	E Commands -- Subroutines -- E$DFSW

;+
;.HL1 E$DFSW
; This routine is called to default any switch values which have not
;been specified.  It will go through the tables and copy the value from
;one to the other.
;.lit
;
; Usage:
;	T1/ Address of user specified switches
;	T2/ Address of default switch block
;	T3/ Length of switch block
;	T4/ Flags from FDB
;	PUSHJ	P,E$DFSW
;	(return)
;
;.end lit
;-

E$DFSW:	TXNN	T4,FD.DEF	; Reset of defaults wanted?
	 JRST	DFSW.0		; No, skip it
	PUSH	P,T1		; Save T1
IFE FTXADR,<
	HRLI	T1,(T2)		; Set up the BLT pointer
	HRRI	T1,1(T2)	; To clear out the switches
	SETOM	(T2)		;  .  .  .
	ADD	T2,T3		; Get the final address +1
	CAIE	T3,1		; Only one word?
	 BLT	T1,-1(T2)	; No, clear the block
	SUB	T2,T3		; Get the base address back
> ; End of IFE FTXADR
IFN FTXADR,<PRINTX ? Clear default switch block in E$DFSW>
	POP	P,T1		; Restore T1

DFSW.0:	TXNE	T4,FD.NDF	; No defaults wanted?
	 POPJ	P,		; No, just return now

DFSW.2:	MOVE	T4,(T1)		; Get the user switch value?
	CAXN	T4,-1		; Want default?
	 MOVE	T4,(T2)		; Yes, get the value
	MOVEM	T4,(T1)		; Reset the value
	MOVEM	T4,(T2)		; And save as default
	AOJ	T1,		; Bump the pointers
	AOJ	T2,		;  .  .  .
	SOJG	T3,DFSW.2	; And loop for all switches
	POPJ	P,		; All done
	SUBTTL	Low segment

	$IMPURE			; Impure data area
	LOWVER(ECM,4)		; Low segment version number


E$ZBEG:!
DEF$EW:	BLOCK	.FDLEN		; Pointer to the default EW
DEF$EL:	BLOCK	.FDLEN		; Pointer to the default EL
DEF$ER:	BLOCK	.FDLEN		; Pointer to the default ER specification
;DEF$EB:	BLOCK	.FDLEN		; Pointer to the default EB specification
DEF$EQ:	BLOCK	.FDLEN		; Pointer to the default EI/EQ/EP spec
DEF$EE:	BLOCK	.FDLEN		; Pointer to default EE spec

; EB command storage

E$OBEG:!			; Start of area to be set to -1

DFTIMD:	BLOCK	1		; Default /IMODE
DFTOMD:	BLOCK	1		; Default /OMODE
DFTYNK:	BLOCK	1		; Default /YANK
E$OEND==.-1

LS$INP:	BLOCK	1		; Inplace switch
LS$RED:	BLOCK	1		; /READONLY switch
LS$YNK:	BLOCK	1		; /YANK switch

; EL command storage

FDB$EL:	BLOCK	1		; Pointer to the currently open log file
L$COUN:	BLOCK	1		; Number of characters to output between checkpoints
L$CNTR:	BLOCK	1		; Running counter
DEFINE SW(NAME,LOC,ROUTINE,VALUE,FLAGS),<LOC:	BLOCK	1>

SL$BEG:!
	SWT$EL			; Generate the storage for the switches
SL$END==.-1


; Storage for ER command


ER$BEG:!
SR$SLS:	BLOCK	1		; /SUPLSN switch
SR$YNK:	BLOCK	1		; /YANK or /NOYANK switch
ER$END==.-1

ER$DFS:	BLOCK	ER$END-ER$BEG+1	; Space for defaults

; Storage for EW command

EW$BEG:!
	DEFINE	SW(NAME,LOC,ROUTINE,VALUE,FLAGS)<LOC:	BLOCK	1>

	EW$SW

EW$END==.-1

; Storage for EI/EP commands

EPIQRG:	BLOCK	1		; Pointer to text buffer for EI/EP command
E$ZEND==.-1

; Storage for EE command

RUNDEV:	BLOCK	1		; Device we were orignally run from
RUNNAM:	BLOCK	1		; Name we were originally run with
RUNPTH:	BLOCK	.PTMAX		; Path block for GETSEG
EEACS:	BLOCK	20		; Ac's saved for restart

; Storage for ED command

ED$FDB:	BLOCK	1		; FDB for the ED command
ED$PTH:	BLOCK	.PTMAX		; Path specification for the RUN
ED$BLK:	BLOCK	6		; RUN argument block
ED$COD:	BLOCK	RUNLEN		; RUN code

ED$BEG:!			; Beginning of the switch area for ED
	ED$SW			; Expand the switch area
ED$END==.-1			; End of the switch area

; For E. command

CUREDT:	BLOCK	1		; Current QRG being edited

;Flag to be used with EVFAST/EVSLOW commands.
FSTFLG:	BLOCK	1		; Just a flag (defaulted to slow mode)

STARTL:	BLOCK	STR.LN		; Block for low segment restart code for EE command

; Table for EO level skip instructions. These are executed by the CHKEO
;macro. If the instruction skips, the EO is less than or equal to the
;index used.

EOXCTS:	BLOCK	EOVAL		; Allocate enough room.
	SUBTTL	End of TECECM

	END			; End of TECECM