Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap2_198111 - decus/20-0033/qed.old
There is 1 other file named qed.old in the archive. Click here to see a list.
TITLE TECO   V.014 - 20 FEB 69 - RC CLEMENTS
SUBTTL TEXT EDITOR AND CORRECTOR

	VTECO=14

;SWITCH FOR SHARED OR UNSHARED VERSION OF TECO

	R=1

;SWITCH FOR INCLUSION OF CCL CODE

	CCL=0

;DEFINITION OF SAVE EXTENSION (SHOULD BE SAV OR DMP)
IFNDEF SAVEXT,<SAVEXT=SIXBIT /   SAV/>

IF2,<IFN R,<SUBTTL SHARED VERSION>>

;ACCUMULATOR ASSIGNMENTS

	FF=0		;CONTROL FLAGS
	P=1		;PUSH DOWN POINTER
;*** A, AA AND B MUST BE CONTIGUOUS AND IN THAT ORDER ***
	A=2
	AA=3		;BYTE POINTER TO COMMAND BUFFER
;*** B AND E MUST BE ADJACENT AND B<11 ***
	B=4		;COMMAND BUFFER END ADDRESS
	E=5
	C=6
	D=7
	F=10
	T=11
;*** TT AND TT1 MUST BE ADJACENT ***
	TT=12
	TT1=13
	I=14
	OU=15
	CH=16
	PF=17

;MODIFIED TO NEW JOBDAT SYMBOLS BY PAUL T. ROBINSON, 15 AUG 1980
;DECUS LIBRARY CONVERSION PROGRAMMER
;JOBXXX BECOMES .JBXXX, DEFINED IN JOBDAT.UNV
;EXTERN	JOBREL,JOBSYM,JOBDDT,JOBFF,JOB41,JOBREN,JOBSA
	SEARCH JOBDAT
INTERN VTECO

.JBVER=137

INTERN .JBVER

LOC .JBVER		;.JB VERSION #
	EXP VTECO
RELOC
;CONTROL FLAGS
;RIGHT HALF

	ALTF=1		;ALT-MODE SEEN
	ARG2=2		;THERE IS A SECOND ARGUMENT
	ARG=4		;THERE IS AN ARGUMENT
	ITERF=10	;INSIDE AN ITERATION
	SLSL=20		;@ SEEN
	PCHFLG=40	;N SEARCH
	COLONF=100	;COLON SEEN
	SYLF=200	;SYLLABLE FLAG
	FINDR=2000	;LEFT ARROW SEARCH
	QMFLG=4000
	NOTF=10000	;^N SEARCH MODIFIER
	TRACEF=20000	;? SEEN
	SEQF=40000	;SEQUENCE NUMBER
	BELLF=100000	;^G SEEN
	DDTMF=200000	;NEED TO TYI IN DDT MODE
	FORM=400000	;A FORM FEED TERMINATED THE LAST YANK OR APPEND COMMAND

;LEFT HALF

	FINF=100	;INPUT CLOSED BY EOF
	UREAD=200	;INPUT FILE IS OPEN
	UWRITE=400	;OUTPUT FILE IS OPEN
	FILWD=2000	;FILE WORD BEING ASSEMBLED.
	FEXTF=4000	;FILE EXT EXPECTED (.TYPED).
	FCSF=10000	;1 FOR BELIEVE LC LTRS
	UBAK=20000	;EB IN EFFECT
	GKTLKF=40000	;MESSAGE TYPE OUT IN GRABAK?
	TYOF=100000	;NEED TO OUTPUT A BUFFER

OPDEF	TYPR1 [30B8]
OPDEF	ERROR [31B8]
;CALLI UUOS
	RESET=0
	DDTIN=1
	DDTOUT=3
	DEVCHR=4
	CORE=11
	EXIT=12
	TIMER=22
	SWITCH=20
	UTPCLR=13
	PJOB=30
	REMAP=37

	INCHN=2
	OUTCHN=3
	TTY=4	;CHANNEL FOR TTY IO
	CCLCHN=5	;CHANNEL FOR THE CCL TMP FILE

	LPDL=75
	GCTBL=100
	LPF=200
	BUFSIZ=203
INTERN .JBCOR
.JBCOR=133
IFE <R>,<	.ZZ=0
DEFINE U(A,B)
<	A:	BLOCK B
	.ZZ=.ZZ+B>
STARTA=TECO
LOC .JBCOR
	EXP 7777
RELOC
>

IFN <R>,
<	ZZ=140
	LOSIZ=4000	;IMPURE AREA AT LOAD TIME
	HISIZ=4000	;SIZE OF PURE HALF OF TECO
	DEFINE U(A,B)<	A=ZZ
	ZZ=ZZ+B>

	HISEG		;FOR THE LOADER

	STARTA=TECO	;TRY TO DO IT WITHOUT SPECIAL INITLZN

>
;PSEUDO RUN UUO IF NEEDED

;STARTUP TIME INITIALIZATION

	INTERNAL TECO
TECO:	CALLI RESET		;INITIALIZE ALL IO
	MOVEI A,DEBUT		;QED MODIFICATION ********************
	HRRM A,.JBSA		;QED MODIFICATION ********************
IFN <R>,<
	HRRZ	A,.JBREL	;SEE IF RUN IN AT LEAST 2K
	CAIGE	A,LOSIZ-1	;ENOUGH?
	MOVEI	A,LOSIZ-1	;NO.
	CALLI	A,CORE		;INSURE SPACE FOR VARIABLES
	CALLI	EXIT		;NO CORE

	SETZM 140
	MOVE A,[XWD 140,141]
	BLT A,@.JBREL
>
	MOVE A,LOC41	;SETUP UUO TRAP  .JB41:=JSR ETYPER
	MOVEM A,.JB41
 	MOVE P,[XWD -LPDL,PDL-1]
	HRRZ A,.JBREL		;IF .JBDDT=0, .JBFF:=C(.JBREL)-202
	SKIPA	;QED MOD **************
	HRRZ A,.JBSYM
	MOVEM A,.JBFF
	SETZM SFINDF
	MOVEI A,DEBUT		;QED MODIFICATION ********************
	MOVEM A,.JBREN
	MOVSI A,263000+P*40
	MOVEM A,TRACS		;TRACS:=POPJ P,
	SETZM OPNR1			;CLEAR INPUT DEVICE NAME
	MOVEI A,CBUF+200
	IMULI A,5
	MOVEM A,BEG			;BEG:=(CBUF+200)*5
	MOVEM A,PT			;PT:=(CBUF+200)*5
	MOVEM A,Z			;Z:=(CBUF+200)*5
	MOVEM A,QRBUF		;QRBUF:=(CBUF+200)*5
	CALLI A,PJOB
	MOVEM A,JOBN

;COMPUTE A VALUE WHICH IS 2/3 THE SIZE OF THE CHARACTER BUFFER.IF
;1/3 IS LESS THAN 128 CHARACTERS, THE BUFFER WILL BE 2/3 FILLED ON
;A "Y" OR "A" COMMAND,OTHERWISE, THE BUFFER WILL BE FILLED TO THE
;TOTAL AVAILABLE BUFFER - 128 CHARACTERS. PAYING ATTENTION TO THE
;FORM FEED AND LF OPERATORS.

;IT SHOULD BE NOTED THAT IN THE CASE OF AUTOMATIC 
;MEMORY EXPANSION, THESE INSTRUCTIONS MUST BE RE-EXECUTED
;TO INSURE PROPER MEMORY BOUNDS.

	PUSH	P,INITG		;FOR IN LINE CODING POPJ
CRE23:	PUSH	P,FF		;SAVE FLAGS
	MOVE	A,BEG	;GET LATEST BASE VALUE
	MOVEM	A,M23	;BASE VALUE FOR 2/3 FULL
	MOVE	A,.JBFF	;LATEST VALUE OF FF
	HRLM A,.JBCOR	;QED MOD *******************
	IMULI	A,5		;5 CHARACTERS PER MEM WORD
	MOVEM	A,MEMSIZ	;MEMSIZ:=C(.JBFF)*5
	MOVEM	A,M23PL	;TO BECOME THE UPPER LIMIT OF FILL
	SUB	A,BEG	;THIS THE TOTAL BUFFER AVAILABILITY
	IDIVI	A,3		;GET 1/3 LENGTH
	ADDM	A,M23	;FOR YANK AND APPEND SUBROUTINES
	ADDM	A,M23	;WHICH WILL CONDUCT LF SEARCH AFTER 2/3
	MOVNI	FF,^D128	;ANTICIPATE LONG BUFFER
	CAIG	A,^D128		;IS 1/3 GREATER THAN 128 CHARACTERS?
	MOVNI	FF,(A)		;NO,THE REMAINING 1/3 WILL BE STOPPER
	ADDM	FF,M23PL	;SETTLE TOP BOUND OF BUFFER FILL ROUTINE
	POP	P,FF		;RESTORE THE FLAGS
INITG:	POPJ	P,.+1		;EXIT OR CONTINUE

	MOVEI A,CBUF+77
	MOVEM A,CBUFH		;CBUFH:=CBUF+77
	MOVEI A,SYL
	MOVEM A,DLIM			;DLIM:=SYL
	MOVE A,[XWD 10014,-1]
	MOVEM A,NROOM2		;NROOM2:=XWD 10014,-1
	MOVE A,[JRST CNTRB2]		;CNTRB1+1:=JRST CNTRB2
	MOVEM A,CNTRB1+1
	MOVEI FF,0			;CLEAR FLAG REGISTER

GOX:
GO:	MOVE P,[XWD -LPDL,PDL-1]	;INITIALIZE PUSHDOWN LIST
	MOVE T,[JRST DQT2]		;INITIALIZE CONTROL B DISPATCH
	MOVEM T,CNTRB1		;CNTRB1:=JRST DQT2
GO1:	CLEARM,LEV
	MOVE PF,[XWD -LPF,PFL-1]
	TRZ FF,777777-TRACEF-QMFLG-FORM
	JRST CLIS


LOC41:	IFE R,<JSR UUOH>
	IFN R,<JSP T,UUOH>
;THIS PAGE CONTAINS THE COMMAND READER FOR THE CCL SYSTEM

;FROM REE COMMAND DISTRIBUTION IN THE MONITOR
;HERE IS THE ROUTINE FOR RESTORING THE ACCUMULATORS IN CASE OF 
;THE SAVE COMMAND (WHICH DESTROYED THEM) IS COMPLEMENTED BY THE
;GET COMMAND.ALSO TO BE RESTORED IS THE UUO TRAP.

REE:	HRLZI	PF,SAVE		;RESTORE THE AC'S AFTER REE
	BLT	PF,PF		;CAUSE SAVE DESTROYS THEM
	JRST	GO		;GO AND LISTEN FOR INPUT
QEDDBT:	MOVE AA,[XWD 700,CBUF-1]	;QED MOD ***************
	MOVEI CH,11		;QED MOD *****************
	MOVEM CH,QEDCNT		;QED MOD ******************
	MOVEI CH,"-"		;QED MOD ***************
	IDPB CH,AA		;QED MOD ******************
	MOVEI CH,"1"		;QED MOD *****************
	IDPB CH,AA		;QED MOD ****************
	MOVEI CH,"U"		;QED MOD ****************
	IDPB CH,AA		;QED MOD ******************
	MOVEI CH,"J"		;QED MOD ********************
	IDPB CH,AA		;QED MOD *********************
	JRST QEDDEB		;QED MOD ********************
DEBUT:	HRLZI	PF,SAVE		;QED MODIFICATION ********************
	BLT	PF,PF		;QED MODIFICATION ********************
	MOVE P,LOC41	;QED MOD ********************
	MOVEM	P,.JB41	;QED MOD *********************
	MOVE P,[XWD -LPDL,PDL-1]	;QED MODIFICATION ************
	MOVE T,[JRST DQT2]	;QED MODIFICATION ********************
	MOVEM T,CNTRB1		;QED MODIFICATION ********************
	CLEARM,LEV		;QED MODIFICATION ********************
	MOVE PF,[XWD -LPF,PFL-1]	;QED MODIFICATION ************
	TRZ FF,777777-TRACEF-QMFLG-FORM	;QED MODIFICATION ************
	PUSHJ	P,TTOPEN	;QED MODIFICATION ********************
	MOVEI CH,5		;QED MOD ********************
	MOVEM CH,QEDCNT		;QED MOD *********************
	MOVE	AA,[XWD 700,CBUF-1]	;QED MODIFICATION ************
QEDDEB:	MOVEI	CH,"M"		;QED MODIFICATION ********************
	IDPB CH,AA		;QED MODIFICATION ********************
	MOVEI CH,"Q"		;QED MODIFICATION ********************
	IDPB CH,AA		;QED MODIFICATION ********************
	MOVEI CH,"}"		;QED MODIFICATION ********************
	IDPB CH,AA		;QED MODIFICATION ********************
	MOVEI CH,"}"		;QED MODIFICATION ********************
	IDPB CH,AA		;QED MODIFICATION ********************
	MOVEI CH,141		;QED MODIFICATION ********************
	IDPB CH,AA		;QED MODIFICATION ********************
	MOVE A,QEDCNT		;QED MODIFICATION ********************
	MOVEM A,COMCNT		;QED MODIFICATION ********************
	JRST LI4+7		;QED MODIFICATION ********************


TYI:
;ROUTINE TO RETURN NON-NULL TTY CHARACTER IN CH.
;CALL	PUSHJ PDP,TYI 
;	RETURN

TYI:	TLZE	FF,TYOF		;NEED A TYO?
	OUTPUT	TTY,0		;YES. DO SO.
TYI0:	SOSG TIB+2	;CHARS IN NORMAL MODE?
	JRST TYI1	;NONE LEFT
TYI2:	ILDB CH,TIB+1	;YES. GET ONE
	JUMPE CH,TYI0	;FLUSH NULLS
TYI3:	POPJ P,0	;RETURN.
TYI1:	TRNE FF,DDTMF	;SHOULD TYI BE DDT STYLE?
	JRST TYIDDT	;YES
	INPUT TTY,0	;NO. ORDINARY.
	STATO TTY,20000	;END OF FILE?
	JRST TYI2
	PUSHJ P,TTOPEN	;CLEAR EOF THE HARD WAY
	JRST TYI0	;^Z WAS SEEN ALREADY. GET ANOTHER CH
TYIDDT:	ILDB CH,TYIPT	;DDT CHAR LEFT?
	JUMPN CH,TYI3	;YES. RETURN VIA LC FILTER
	MOVE T,TTYPT	;NO. GET POINTER
	MOVEM T,TYIPT	;SET FOR FIRST CH
	CALLI T,DDTIN	;GET CHARS
	JRST TYIDDT	;GET THE CHARS FROM BUFFER

TTOPEN:	MOVEI T,TTYBFS
	EXCH T,.JBFF	;SET .JBFF AND SAVE IT
	INIT TTY,100	;INIT THE CONSOLE
	SIXBIT /TTY/
	XWD TOB,TIB	;SHOULD BE 
	JRST .-3	;I REALLY WANT TTY
	INBUF TTY,1
	OUTBUF TTY,1	;KEEP IT SMALL
	MOVEM T,.JBFF	;RESTORE .JBFF
	SETZM TYIPT	;SIGNAL DDT BUFFER EMPTY
	POPJ P,0
;ROUTINE TO TYPE A CHARACTER.
;CALL	MOVE CH,CHARACTER
;	PUSHJ P,TYO
;	RETURN
;CONTROL CHARACTERS ARE TYPED WITH "^" FOLLOWED BY THE CORRESPONDING
;PRINTING CHARACTER.

TYO:	PUSH P,CH		;NULL/IDLE,START OF MESSAGE,END OF ADDRESS, END OF
				;TRANSMISSION,WRU,ARE YOU OR BELL?
	CAIGE CH,7
	JRST TYO1		;YES.
	CAIG CH,15		;NO. HORIZONTAL TAB,LINE FEED,VERTICAL TAB
				;FORM FEED OR CARRIAGE RETURN?
	JRST TYOB		;YES. TYPE IT AND RETURN
	CAIGE CH,40		;NO. ANY OTHER CONTROL CHARACTER?
	JRST TYO1		;YES.
	CAIN CH,175		;NO. ALT-MODE?
	MOVEI CH,"$"		;YES. CONVERT IT TO $.
TYOB:	PUSHJ P,TYOA		;TYPE CH.
	POP P,CH		;RESTORE CH
	POPJ P,0		;RETURN

TYOA:	TLO	FF,TYOF		;MARK WILL NEED TO OUTPUT
	SOSG TOB+2	;OUTPUT SPACE AVAIL?
	OUTPUT TTY,0	;NO. OUTPUT.
	IDPB CH,TOB+1
	CAILE CH,14		;FORCE OUTPUT ON LF,FF ETC
	POPJ	P,0		;NO
	OUTPUT TTY,0
	TLZ	FF,TYOF	;NO LONGER NEED TO OUTPUT
	POPJ P,0

TYO1:	PUSH P,CH		;TYPE CONTROL CHARACTER IN FORM "^CH"
	MOVEI CH, "^"
	PUSHJ P,TYOA		;TYPE ^
	POP P,CH
	ADDI CH,100		;CONVERT TO PRINTING CHARACTER
	JRST TYOB		;AND TYPE IT.

TTYPT:	XWD 440700,TTYBUF
U TYIPT,1
U TTYBFS,46	;100 MODE TTY BFRS
U TIB,3	;BUFFER HEADER
U TOB,3	;DITTO
U TTYBUF,22
U JOBN,1

;ROUTINE TO TYPE "? ERROR MESSAGE"
;CALL	JSP A,ERRMES
;	ASCIZ /ERROR MESSAGE/
;	RETURN


ERRMES:	MOVEI CH,"?"
	PUSHJ P,TYO

;ROUTINE TO TYPE "MESSAGE"
;CALL JSP A,CONMES
;	ASCIZ /MESSAGE/
;	RETURN

CONMES:	HRLI A,440700
	ILDB CH,A
	JUMPE CH,1(A)
	PUSHJ P,TYO
	JRST .-3


;ROUTINE TO TYPE C(A) IN SIXBIT
;CALL	MOVE A,[SIXBIT /MESSAGE/]
;	PUSHJ P,SIXBMS
;	RETURN


SIXBMS:	MOVNI B,6
	MOVE E,[XWD 440600,A]
	ILDB CH,E
	JUMPE CH,CPOPJ
	ADDI CH,40
	PUSHJ P,TYO
	AOJL B,.-4
	POPJ P,0

U IBUF,3
U OBF,3
U OUTBUF,3

U IBUF1,2*BUFSIZ
U OBUF1,2*BUFSIZ

;ROUTINE TO OUTPUT DECIMAL INTEGER
;CALL	MOVE B, DECIMAL INTEGER
;	MOVEI A,ADDRESS OF OUTPUT ROUTINE
;	HRRM A,LISTF5
;	PUSHJ P,DPT
;	RETURN

DPT:	JUMPGE B,.+3		;NUMBER > 0?
	MOVEI CH,"-"		;NO. OUTPUT -
	PUSHJ P,@LISTF5
	MOVMS B			;B:=ABSOLUTE VALUE OF B
	IDIVI B,12		;E:=DIGIT
	HRLM E,(P)		;PUT DIGIT ON LEFT HALF OF TOP OF PUSH DOWN LIST
	JUMPE B,.+2		;DONE?
	PUSHJ P,.-3		;NO. PUSH THIS DIGIT AND PRINT RETURN ADDRESS.
	HLRZ CH,(P)		;YES. CH:=DIGIT
	ADDI CH,60		;CONVERT IT TO ASCII.
	JRST @LISTF5		;PRINT IT



;ROUTINE TO TYPE CARRIAGE RETURN LINE FEED
;CALL	PUSHJ P,CRR
;	RETURN
CRR:	MOVEI CH,TYO		;SET OUTPUT DISPATCH TO TTY AND
	HRRM CH,LISTF5

CRR1:	MOVEI CH,15		;OUTPUT CRLF
	PUSHJ P,@LISTF5
	MOVEI CH,12
	JRST @LISTF5

;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER AND ERROR IF EMPTY.
;CALL	PUSHJ P,SKRCH
;	RETURN WITH CHARACTER IN CH
;GOES TO ERR IF COMMAND BUFFER IS EMPTY

SKRCH:	SKIPN COMCNT		;COMMAND BUFFER EMPTY?
	ERROR ^D1
			;YES. SKRCH SHOULDN'T RUN OUT.

;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER.
;CALL	PUSHJ P,RCH
;	RETURN ALWAYS WITH CHARACTER IN CH

RCH:	SOSGE COMCNT		;DECREMENT COMMAND BUFFER CHARACTER COUNT
				;IS COMMAND BUFFER EMPTY?
	JRST RCH2		;YES. POP UP TO HIGHER MACRO LEVEL.
	ILDB CH,CPTR		;NO. GET COMMAND CHARACTER IN CH
	XCT TRACS		;RETURN OR JRST TYO IN TRACE MODE
RCH2:	POP P,CH		;SAVE RETURN FOR POPJ IN CH
	POP P,COMCNT		;GET COUNT FROM NEXT MACRO LEVEL
	POP P,CPTR		;POINTER TOO.
	POP P,COMAX		;NUMBER OF COMMANDS.
	PUSH P,CH		;GET RETURN BACK ON PDL.
	JRST RCH		;TRY AGAIN.

U TRACS,1

SKRCH1:	SOSGE COMCNT		;ANY CHARACTERS LEFT?
	ERROR ^D2
			;NO. SUPPOSEDLY CAN'T RUN OUT OF
				;COMMANDS AT THIS ROUTINE.
	ILDB CH,CPTR		;YES. GET A CHARACTER.
	POPJ P,			;RETURN.

CLIS:	PUSHJ P,TTOPEN	;GET TELETYPE

LIS:	MOVEI CH,"*"
LIS0:	PUSHJ P,TYO		;TYPE *
	TRNE FF,QMFLG
	TRO FF,DDTMF	;NEED DDT MODE FOR "?"
	CLEARM COMCNT	;COMCNT:=0
	CLEARM INTDPH	;INTDPH:=0
	CLEARM SYMS
	MOVE T,[XWD SYMS,SYMS+1]
	BLT T,SYMEND-1
	MOVE AA,[XWD 700,CBUF-1]
	MOVE B,CBUFH

LI1:	TRZ FF,ALTF+BELLF

LI2:	CAILE B,(AA)		;COMMAND BUFFER EXCEEDED?
	JRST LI3		;NO


;TO SEE IF TECO WILL NEED MORE CORE FOR COMMAND 
;BUFFER EXPANSION. IF SO, GET IT

	MOVE	C,Z		;GET THE NUMBER OF CHARACTERS NOW
	ADDI	C,100		;WILL WE OVERFLOW IF THIS IS REQUESTED?
	CAIG	C,MEMSIZ	;WILL THIS OVERFLOW?
	JRST	.+5		;NO, FORGET THIS EVER HAPPENED
	PUSH	P,17		;WILL OVERFLOW, THEREFORE, SAVE AC#17
	MOVE	17,C		;THIS IS THE REQUEST FOR MEMORY
	PUSHJ	P,GRABKQ	;GET THE NECESSARY CORE
	POP	P,17		;RESTORE AC#17
;OK, EXPAND THE COMMAND BUFFER CONFIDENTLY

	ADDI B,100		;YES. EXPAND COMMAND BUFFER 100 WORDS.
	MOVE C,Z
	IDIVI C,5		;C:=DATA BUFFER END WORD ADDRESS.
	MOVE D,QRBUF
	IDIVI D,5		;D:=Q-REG BUFFER BASE WORD ADDRESS.
	SUBM C,D		;D:=NO. OF WORDS IN Q-REG BUFFER AND DATA BUFFER.
	MOVE CH,(C)
	MOVEM CH,100(C)		;MOVE Q-REG AND DATA BUFFERS UP 100 WORDS.
	SOS C
	SOJGE D,.-3
	MOVEI C,500
	ADDM C,BEG		;BEG:=C(BEG)+500
	ADDM C,PT		;PT:=C(PT)+500
	ADDM C,Z		;Z:=C(Z)+500
	ADDM C,QRBUF		;QRBUF:=C(QRBUF)+500
	MOVE D,Z
LI3:	MOVEM B,CBUFH	;NO. RESET HIGH END OF COMMAND BUFFER.
	PUSHJ P,TYI		;GET A NON-NULL CHARACTER IN CH
	CAIE CH,33		;IS IT AN OLD ALT-MODE CODE?
	CAIN CH,176
	MOVEI CH,175		;YES. CONVERT TO NEW ALT-MODE CODE.
	TRZE FF,QMFLG		;CLEAR ? FLAG. WAS IT ON?
	CAIE CH,"?"		;YES. IS THIS A "?"?
	AOSA COMCNT		;NO. INCREMENT COMMAND CHARACTER COUNT
	JRST ERRTYP		;YES. TYPE BAD STRING
	IDPB CH,AA		;NO. STORE CHARACTER IN COMMAND BUFFER.
	CAIE CH,177		;IS IT A RUBOUT?
	JRST LI4		;NO.

;DELETE A CHARACTER FROM THE COMMAND BUFFER.
	IBP AA			;YES. BACKUP BYTE POINTER TWO BYTES
	IBP AA
	IBP AA
	SOS D,AA
	CAMN AA,[XWD 100700,CBUF-1]	;DID IT GO PAST THE BEGINNING
				;OF THE BUFFER
	JRST CLIS1		;YES. TYPE CRLF *
	ILDB CH,D		;NO. TYPE DELETED CHARACTER
	PUSHJ P,TYO
	SOS COMCNT		;REMOVE TWO CHARACTERS FROM COMMAND COUNT.
	SOS COMCNT
	JRST LI1		;AND GET ANOTHER COMMAND CHARACTER
LI4:	CAIE CH,175		;ALT-MODE?
	JRST LI5		;NO
	TRON FF,ALTF		;YES. SET ALT-MODE FLAG. WAS IT ON?
	JRST LI2		;NO
	MOVEI CH,141		;YES. TWO SUCCESSIVE ALT-MODES. END OF COMMAND.
	AOS A,COMCNT		;MARK END OF COMMAND STRING WITH ASCII 141
	IDPB CH,AA
	MOVE AA,[XWD 700,CBUF-1]	;INITIALIZE COMMAND BYTE POINTER
	MOVEM AA,CPTR
	PUSHJ P,CRR		;TYPE CRLF
	MOVEM A,COMAX	;SET COMMAND CHARACTER ADDRESS UPPER BOUND
	MOVEM	PF,SAV17	;TO SAVE AC'S IN CASE OF A 
	MOVEI	PF,SAVE		;SNEEK SAVE
	BLT	PF,SAV16	;WHICH WILL DESTROY THEM
	MOVE	PF,.JBFF	;GET CONTENTS OF FIRST FREE
	HRLM	PF,.JBSA	;FOR .JBSA. MONITOR OR LOADER SHOULD DO THIS
	HRLM PF,.JBCOR	;QED MOD ***********************

				;BUT UNTILL IT DOES, THIS IS NEC
				;ESSARY FOR THE SAVE TO WORK
	MOVE	PF,SAV17	;RESTORE THE AC#17, GO TO WORK
	JRST CD			;DECODE COMMAND

CLIS1:	PUSHJ P,CRR	;TYPE CRLF
	JRST CLIS	;AND GO TYPE *.

LI5:	CAIE CH,7		;BELL?
	JRST LI1		;NO. GET MORE CHARACTERS.
	TRON FF,BELLF		;YES. SET BELL FLAG. TWO SUCCESSIVE BELLS?
	JRST LI2		;NO.
	PUSHJ P,CRR		;YES. TYPE A CRLF
	JRST GOX		;AND CLEAR COMMAND BUFFER.
CD:
RET:	TRZ FF,ARG2+ARG+FINDR+PCHFLG
CD1:	CLEARM NUM

;ADD TAKES ONE OR TWO ARGUMENTS

CD2:	MOVSI A,270000+B*40	;DELIM:=ADD B,
CD3:	HLLM A,DLIM
CD4:	CLEARM SYL
CD5:
	PUSHJ P,RCH
CD9:	XCT DTB(CH)		;A:=XWD VALUE FLAG,DISPATCH ADDRESS
				;OR DISPATCH DIRECTLY
CD6:	MOVE B,NUM
	TRZE FF,SYLF		;DID LAST CHARACTER RETURN A VALUE OR WAS IT A DIGIT?
	XCT DLIM		;YES. NUM:=NUM (DLIM OPERATOR) SYL
	MOVEM B,NUM
	MOVE C,SARG		;SAVE SECOND ARGUMENT IN C.
	TRZ FF,NOTF
	JUMPGE A,(A)		;DISPATCH IF VALUE RETURN COMMAND.
	PUSHJ P,(A)		;DISPATCH FOR NON-VALUE RETURN COMMANDS.
	JRST RET



U DLIM,1
U NUM,1
U SYL,1
U SARG,1
;DIGITS FORM DECIMAL INTEGERS.

CDNUM:	MOVE A,SYL
	IMULI A,12
	ADDI A,-60(CH)

;SOME COMMANDS HAVE A NUMERIC VALUE
VALRET:	MOVEM A,SYL
CD7:	TRO FF,ARG+SYLF
	JRST CD5
ALTMOD:	MOVE T,CPTR		;IF NEXT COMMAND CHARACTER IS ALT-MODE,
				;OR END OF COMMAND BUFFER, GO;ELSE CD.
	ILDB CH,T
	CAIE CH,175
	CAIN CH,141
	JRST GO
	JRST CD

;^ MEANS THAT THE NEXT CHARACTER IS A CONTROL CHARACTER.

UAR:	PUSHJ P,SKRCH		;GET NEXT COMMAND CHARACTER.
	TRZ CH,140		;CHANGE IT TO CONTROL CHARACTER
	JRST CD9		;DISPATCH


;FINISH OUTPUT AND RETURN TO THE TIME-SHARING EXEC.

DECDMP:	TLZ FF,UREAD+UWRITE+FINF+UBAK	;INCASE SOMEONE REENTERS
	CALLI EXIT

;IF A COMMAND TAKES TWO NUMERIC ARGUMENTS, COMMA IS USED TO SEPARATE THEM

COMMA:	MOVEM B,SARG		;SAVE CURRENT ARGUMENT IN SARG.
	TRZE FF,ARG		;WAS THERE A CURRENT ARGUMENT?
	TROE FF,ARG2		;YES. WAS THERE ALREADY A SECOND ARGUMENT?
	ERROR ^D3
			;NO. EITHER NO ARGUMENT OR MORE THAN TWO ARGUMENTS.
	JRST CD1		;YES. CLEAR CURRENT ARGUMENT.

;LOGICAL AND

CAND:	MOVSI A,404000+B*40		;DLIM:=AND B,
	JRST CD3

;LOGICAL OR

COR:	MOVSI A,434000+B*40		;DLIM:=OR B,
	JRST CD3

;SUBTRACT TAKES ONE OR TWO ARGUMENTS

MINUS:	MOVSI A,274000+B*40		;DLIM:=SUB B,
	JRST CD3

;MULTIPLY TAKES TWO ARGUMENTS

TIMES:	MOVSI A,220000+B*40		;DLIM:=IMUL B,
	JRST CD3

;DIVIDE (TRUNCATES) TAKES TWO ARGUMENTS

SLASH:	MOVSI A,230000+B*40		;DLIM:=IDIV B,
	JRST CD3


;RETURNS THE VALUE OF THE FORM FEED FLAG

FFEED:	TRNE	FF,FORM		;IS IT SET?
	JRST	FFOK		;YES, RETURN A -1
				;NO, DO BEGIN ROUTINE
;RETURNS THE NUMERIC VALUE 0.

BEGIN:	MOVEI A,0
	JRST VALRET


;AN ABBREVIATION FOR B,Z

HOLE:	CLEARM SARG		;SET SECOND ARGUMENT TO 0.
	TRZN FF,ARG	;ANY ARGS BEFORE H?
	TRNE FF,ARG2	; ..
	ERROR ^D3	;THATS TOO BAD
	TROA FF,ARG2

;.=NUMBER OF CHARACTERS TO THE LEFT OF THE POINTER
PNT:	SKIPA A,PT

;Z=NUMBER OF CHARACTERS IN THE BUFFER

END1:	MOVE A,Z
	SUB A,BEG
	JRST VALRET

;() MAY BE USED TO OVERRIDE LEFT TO RIGHT OPERATOR SCAN FOR +,-,*,/,& AND #.

OPEN:	PUSH P,NUM		;PUSH CURRENT ARGUMENT.
	HLLZ A,DLIM		;GET CURRENT OPERATOR.
	TRZE FF,ITERF		;ARE WE INSIDE AN ITERATION?
	IORI A,1		;YES. MARK OPERATOR AS BEING WITHIN AN ITERATION.
	PUSH P,A		;PUSH CURRENT OPERATOR.
	AOS LEV		;INCREMENT ( LEVEL.
	JRST RET

CLOSE:	SOSGE LEV		;IS THERE A (?
	ERROR ^D4
			;NO.
	MOVEM B,SYL		;YES. SAVE CURRENT ARGUMENT.
	POP P,CH		;RESTORE OPERATOR.
	HLLM CH,DLIM
	TRZ FF,ITERF
	TRNE CH,1
	TRO FF,ITERF		;RESTORE ITERATION FLAG FOR THIS OPERATOR.
	POP P,NUM		;RESTORE ARGUMENT.
	JRST CD7

U LEV,1
;N=	CAUSES THE VALUE OF N TO BE TYPED OUT.

PRNT:	TRNN FF,ARG		;HERE ON "=" COMMAND
	ERROR ^D5
			;MUST HAVE ARG
PRNT9:	MOVEI A,TYO
	HRRM A,LISTF5	;CONSOLE
	JRST	DPT



;CAUSES COMMAND INTERPRETATION TO STOP UNTIL THE USER TYPES A CHARACTER
;ON THE TELETYPE AND THEN HAS THE ASCII VALUE OF THE CHARACTER TYPED IN.

QEDIN:	SETZM QED	;QED MOD ****************
	POPJ P,		;QED MOD ******************

QEDOUT:	SETOM QED	;QED MOD *****************
	POPJ P,		;QED MOD ******************

QEDTYP:	MOVEM T,QEDT	;QED MOD *******************
	MOVEI T,">"	;QED MOD ********************
	TTCALL 13,0	;QED MOD ***********************
	TTCALL 1,T	;QED MOD *********************
	MOVE T,QEDT	;QED MOD ********************
	POPJ P,		;QED MOD **********************


SPTYI:	TRO FF,DDTMF	;NEED DDT MODE FOR THIS
	PUSHJ P,TYI
	SKIPE	0,QED
	JRST	DUHELB
	SKIPN	QED1		;QED MODIFICATION ********************
	JRST	DUHEL		;QED MODIFICATION ********************
	SETO	A,		;QED MODIFICATION ********************
	TTCALL	6,A		;QED MODIFICATION ********************
	TLZ	A,4		;QED MODIFICATION ********************
	TTCALL	7,A		;QED MODIFICATION ********************
	SETZM	QED1		;QED MODIFICATION ********************
DUHEL:	CAIN	CH,22		;QED MODIFICATION ********************
	JRST	.+3		;QED MODIFICATION ********************
	CAIE	CH,31		;QED MODIFICATION ********************
	JRST	DUHELA		;QED MODIFICATION ********************
	SETO	A,		;QED MODIFICATION ********************
	TTCALL	6,A		;QED MODIFICATION ********************
	TLO	A,4		;QED MODIFICATION ********************
	TTCALL	7,A		;QED MODIFICATION ********************
	SETOM	QED1		;QED MODIFICATION ********************
DUHELA:	CAIE	CH,21		;QED MODIFICATION ********************
	JRST	DUHELB		;QED MODIFICATION ********************
	SETO	A,		;QED MODIFICATION ********************
	TTCALL	6,A		;QED MODIFICATION ********************
	TLZ	A,2		;QED MODIFICATION ********************
	TTCALL	7,A		;QED MODIFICATION ********************
DUHELB:	SKIPA A,CH		;QED MODIFICATION ********************


;HAS THE VALUE OF ELAPSED TIME, IN 60THS OF A SECOND, SINCE MIDNITE.

GTIME:	CALLI A,TIMER
	JRST VALRET
;HAS THE VALUE OF THE CONSOLE DATA SWITCHES.

LAT:	CALLI A,SWITCH
	JRST VALRET



;HAS THE VALUE OF THE NEXT CHARACTER IN THE COMMAND STRING.

CNTRUP:	PUSHJ P,RCH	;^^ HAS VALUE OF CHAR FOLLOWING IT
	MOVE A,CH
	JRST VALRET



;HAS THE VALUE OF THE NUMBER REPRESENTED BY THE DIGITS (OR MINUS SIGN)
;FOLLOWING THE POINTER IN THE BUFFER.  THE SCAN TERMINATES ON ANY OTHER
;CHARACTER.  THE POINTER IS MOVED OVER THE NUMBER FOUND (IF ANY).

BAKSL:	TRZE FF,ARG	;WHICH KIND OF BACKSLASH?
	JRST BAKSL1	;ARG TO MEMORY
	MOVE I,PT	;MEMORY TO VALRET
BAKSLA:	CAML I,Z	;OVERDID IT ?
	JRST BAKSL3	;YES. EXIT
	PUSHJ P,GETINC	;NO. GET A CHAR
	CAIN CH,"-"	;MINUS SIGN?
	JRST BAKSLM	;YES. GO MARK IT.
	CAIG CH,"9"	;DIGIT?
	CAIGE CH,"0"	;DIGIT?
	SOJA I,BAKSL2	;NOT A DIGIT. BACKUP AND LEAVE LOOP
	SUBI CH,"0"	;CONVERT TO NUMBER
	EXCH CH,SYL
	IMULI CH,12
	ADDM CH,SYL	;SYL:= 10.*SYL+CH
	JRST BAKSLA	;LOOP

BAKSL3:	MOVE I,Z	;HERE ON OVERFLOW
BAKSL2:	TRZE FF,ARG	;MINUS SIGN SEEN?
	MOVNS SYL	;YES. NEGATE
	MOVEM I,PT	;MOVE POINTER PAST #
	JRST CD7	;DONE


BAKSLM:	TRO FF,ARG
	JRST BAKSLA




;NA (WHERE N IS A NUMERIC ARGUMENT) = VALUE IN 7-BIT ASCII OF THE
;CHARACTER TO THE RIGHT OF THE POINTER.

ACMD:	TRNN FF,ARG		;DOES AN ARGUMENT PRECEED A?
	JRST APPEND		;NO. THIS IN AN APPEND COMMAND.
	MOVE I,PT		;YES.
	PUSHJ P,GET		;CH:=CHARACTER TO THE RIGHT OF PT.
	MOVE A,CH		;RETURN CH AS VALUE.
	JRST VALRET
;NUI	PUTS THE NUMERIC VALUE N IN Q-REGISTER I.

USE:	TRNN FF,ARG		;DID AN ARGUMENT PRECEED U?
	ERROR ^D6
			;NO.


USEA:	PUSHJ P,QREGVI		;YES. CH:=Q-REGISTER INDEX.
	MOVEM B,QTAB-"0"(CH)	;STORE ARGUMENT IN SELECTED Q-REG.
	JRST RET

;QI	HAS THE VALUE OF THE LATEST QUANTITY PUT INTO Q-REGISTER I.

QREG:	PUSH P,USE1		;SET RETURN ADDRESS TO VALRET AND FALL INTO QREGVI.

;ROUTINE TO RETURN Q-REGISTER INDEX IN CH AND CONTENT IN A.
;CALL	PUSHJ P,QREGVI
;	RETURN
;ASSUMES COMCNT,CPTR AND COMAX ARE SET UP.
;IF NEXT CHARACTER IN COMMAND STRING IS NOT A LETTER OR A DIGIT, DOES NOT RETURN.
;FROM USEA,PCNT,OPENB+1,MAC,QGET

QREGVI:	PUSHJ P,RCH		;CH:=NEXT COMMAND STRING CHARACTER.
	CAIL CH,140	;LC LETTER?
	TRZ CH,40	;MAKE UC
	CAIL CH,"0"		;LETTER OR DIGIT?
	CAILE CH,"Z"
	ERROR ^D7
			;NO
	CAIL CH,1+"9"		;YES. DIGIT?
	SUBI CH,"A"-"9"-1	;NO. TRANSLATE LETTERS DOWN BY NUMBER OF
				;CHARACTERS BETWEEN 9 AND A. ONLY 36 Q REG'S
	MOVE A,QTAB-"0"(CH)	;A:=CONTENTS OF Q-REGISTER.
USE1:	POPJ P,VALRET


;%I	ADDS 1 TO THE QUANTITY IN Q-REGISTER I AND STANDS FOR THE
;	NEW VALUE

PCNT:	PUSHJ P,QREGVI		;CH:=Q-REGISTER INDEX.
	AOS A,QTAB-"0"(CH)	;INCREMENT Q-REG.
	JRST VALRET		;RETURN NEW VALUE.

;M,NXI	COPIES A PORTION OF THE BUFFER INTO Q-REGISTER I.
;	IT SETS Q-REGISTER I TO A DUPLICATE OF THE (M+1)TH
;	THROUGH NTH CHARACTERS IN THE BUFFER.  THE BUFFER IS UNCHANGED.
;NXI	INTO Q-REGISTER I IS COPIED THE STRING OF CHARACTERS STARTING
;	IMMEDIATELY TO THE RIGHT OF THE POINTER AND PROCEEDING THROUGH
;	THE NTH LINE FEED.

X:	PUSHJ P,GETARG		;C:=FIRST STRING ARGUMENT ADDRESS
				;B:=SECOND STRING ARGUMENT ADDRESS.
	CAMLE C,B		;IS SECOND ARG. ADDR. > FIRST ARG. ADDR.?
	ERROR ^D8
			;NO.
	EXCH B,C		;YES.
	SUBI C,-3(B)		;C:=LENGTH OF STRING+3.
	ADD B,C			;B:=FIRST ARG ADDR + LENGTH OF STRING + 3
	PUSH P,PT
	ADDM C,(P)		;(P):=PT + LENGTH OF STRING + 3.
	MOVE D,BEG
	MOVEM D,PT		;PT:=BEG
	PUSHJ P,NROOM		;INSERT STRING AT BEG
	MOVE OU,RREL	;RREL CONTAINS RELOCATION CONSTANT IF
				;GARBAGE COL. OCCURRED.
	ADDM OU,(P)		;RELOCATE TOP OF STRING POINTER.
	ADD B,OU		;B:=FIRST ARG ADDR + LENGTH OF STRING + 3 + RREL
	MOVE OU,BEG		;OU:=ADDRESS OF Q-REG BUFFER
	ADDM C,BEG		;BEG:=C(BEG)+LENGTH OF STRING + 3
	MOVEI CH,141		;FIRST CHARACTER OF BUFFER := 141
	PUSHJ P,PUT
	AOS OU
	MOVE CH,C		;SECOND CHAR OF BUFFER :=LEAST SIGNIFICANT 7 BITS
				;OF LENGTH OF STRING + 3
	PUSHJ P,PUT
	ROT CH,-7
	MOVE I,B		;THIRD CHAR OF BUFFER := MOST SIGNIFICANT 7 BITS
				;OF LENGTH OF STRING + 3
	AOS OU
X1:	PUSHJ P,PUT		;MOVE STRING TO Q-REG BUFFER.
	AOS OU
	CAIN C,3
	JRST X2
	PUSHJ P,GETINC
	SOJA C,X1
X2:	MOVE B,PT		;QTAB ENTRY :=XWD 400000,Q-REG BUFFER
				;ADDRESS RELATIVE TO C(QRBUF)
	SUB B,QRBUF
	TLO B,400000
	POP P,PT		;MOVE PT PAST STRING.
	JRST USEA		;MAKE QTAB ENTRY.

;GI	THE TEXT IN Q-REGISTER I IS INSERTED INTO THE BUFFER AT THE
;	CURRENT LOCATION OF THE POINTER.  THE POINTER IS THEN PUT JUST
;	TO THE RIGHT OF THE INSERTION.  THE Q-REGISTER IS NOT CHANGED.

QGET:	PUSHJ P,QREGVI		;A:=QTAB ENTRY, CH:=Q-REG INDEX
	MOVE B,A
	TLZN B,377777		;DOES Q-REG CONTAIN TEXT?
	TLZN B,400000
	ERROR ^D9
			;NO
	ADD B,QRBUF		;YES
	MOVE I,B		;IN:=Q-REG BUFFER ADDRESS
	MOVE B,CH		;SAVE INDEX
	PUSHJ P,GETINC		;IS FIRST CHARACTER IN BUFFER 141?
	CAIE CH,141
	ERROR ^D10
			;NO
	PUSHJ P,GETINC		;C:=LENGTH OF STRING
	MOVEM CH,C
	PUSHJ P,GETINC
	ROT CH,7
	IORM CH,C
	SUBI C,3
	PUSHJ P,NROOM		;MOVE FROM PT THROUGH Z UP C POSITIONS
	MOVE OU,PT
	HRRZ I,QTAB-"0"(B)
	ADD I,QRBUF
	ADDI I,3
QGET1:	JUMPE C,RET		;MOVE STRING INTO DATA BUFFER
	PUSHJ P,GETINC
	PUSHJ P,PUT
	AOS OU,PT
	SOJA C,QGET1

;]I	POPS Q-REGISTER I OFF THE Q-REGISTER PUSHDOWN LIST.
;	THE Q-REGISTER PUSHDOWN LIST IS CLEARED EACH TIME $$ IS TYPED.

CLOSEB:	SKIPA C,[POP PF,]

;[I	PUSHES Q-REGISTER I ONTO THE Q-REGISTER PUSHDOWN LIST.

OPENB:	MOVSI C,261000+PF*40
	PUSHJ P,QREGVI
	HRRI C,QTAB-"0"(CH)	;C:=Q-REGISTER INDEX.
	XCT C			;PUSH OR POP Q-REGISTER.
	TRNE FF,ARG		;IS THERE AN ARGUMENT?
	JRST CD2		;YES. DON'T DESTROY IT.
	JRST RET		;NO. CLEAR FLAGS.

;E COMMANDS SELECT AND CONTROL FILE INPUT-OUTPUT MEDIA

ECMD:	PUSHJ P,RCH
	TRZ CH,40	;LC TO UC
	CAIN CH,"R"		;NO. ER?
	JRST OPNRD		;YES. NEW INPUT FILE.
	CAIN CH,"W"		;NO. EW?
	JRST OPNWR		;YES. NEW OUTPUT FILE.
	CAIN CH,"F"		;NO. EF?
	JRST CLOSEF		;YES. CLOSE OUTPUT FILE.
	CAIN CH,"Z"		;NO. EZ?
	JRST ZERDIR		;YES. CLEAR DIRECTORY.
	CAIN CH,"M"		;NO. EM?
	JRST EMTAPE		;YES. EXECUTE MTAPE UUO.
	CAIN CH,"B"	;NO. EB?
	JRST EBAKUP	;YES. BACKUP SYSTEM
	CAIN CH,"X"	;EX?
	JRST FINISH	;YES. DO 69000PEF<DING>
	ERROR ^D11
			;NO. COMMAND ERROR.

U FILDEV,1	;FILSPC+1(0),FILSP1+1	
U FILNAM,4	;NAME IN SIXBIT.  FILSPC+2(0),FILLS1+5
		;(EXT)BLK #.  FILSPC+3(0),FILLS1+2
		;PROT,DATE.  FILSPC+4(0)
		;(PROJ)PROG.  FILSPC+5(0),FILSPS,FILSP6
U BAKNAM,2	;FOR THE BACKUP NAME
FINIS1:	TRNE FF,ARG+ARG2	;ARGUMENT?
	ERROR ^D46		;SHOULDNT BE.
	TLON	FF,UREAD	;SAY READING A FILE. TRUE?
	TLO	FF,FINF	;NO, SO ALSO SAY EOF.
	MOVSI B,1	;A LARGE NUMBER OF PAGES
	PUSHJ P,PUNCH	;PUNCH THOSE PAGES
	JRST CLOSEF	;CLOSE AND RENAME FILES
			;RETURN FROM FINIS1

FINISH:	PUSHJ	P,FINIS1	;FINISH UP.
	JRST	DECDMP		;AND CALL EXIT

;ER	PREPARE TO READ FILE

OPNRD:	TLZ FF,FINF	;NOT EOF
	TLOE FF,UREAD		;SET INPUT FILE OPEN FLAG. WAS IT ON?
	RELEAS INCHN,0		;YES. RELEASE IT BEFORE OPENING NEW FILE.
	PUSHJ P,FILSPC		;GET FILE SPEC
	MOVEI E,1
	MOVEM E,OPNRI
	MOVE E,FILDEV	;INITIALIZE OPEN UUO ARGUMENTS
	MOVEM E,OPNR1
	MOVEI E,IBUF
	MOVEM E,OPNRB
	OPEN INCHN,OPNRI	;OPEN INPUT FILE
	JRST ININER
	MOVE T,.JBFF
	MOVEI E,IBUF1
	MOVEM E,.JBFF
	INBUF INCHN,2
	MOVEM T,.JBFF
	LOOKUP INCHN,FILNAM
	JRST TYINPT
	POPJ P,

EBAKUP:	PUSHJ P,OPNRD	;READ THE SPECIFIED FILE
	MOVE E,FILNAM	;SAVE IT
	MOVEM E,BAKNAM	;IN BACKUP STORE
	HLLZ E,FILNAM+1	;AND THE EXTENSION
	MOVEM E,BAKNAM+1
	MOVE E,JOBN
	LSH E,3
	IOR E,JOBN
	TRZ E,70
	TRO E,2020
	IOR E,[SIXBIT /TECO/]	;MAGIC NAME
	MOVEM E,FILNAM
	MOVEM	E,BAKTMP		;SAVE FOR DTA RENAME
	MOVSI E,(SIXBIT /TMP/)
	MOVEM E,FILNAM+1
	SETZM FILNAM+2
	PUSHJ P,OPNW4	;WRITE THE TMP FILE
	PUSHJ P,OPNW2
	TLO FF,UBAK
	POPJ P,0


U OPNRI,1		;INPUT FILE OPEN ARGUMENTS. OPNRD+4(1)
U OPNR1,1		;INPUT DEVICE.  INIT+27(0),OPNRD+6
U OPNRB,1		;INITIALIZE TO XWD 0,INBUF. OPNRD+10
U BAKTMP,1		;FOR DECTAPE TEMP NAME
;TYPE INPUT DEVICE ERROR

TYINPT:	JSP	A,ERRMES
	ASCIZ	/INPUT ERROR.../
	JRST	ERRMG2

;TYPE OUTPUT ERROR

ENTERR:	JSP	A,ERRMES
	ASCIZ	/OUTPUT ERROR.../

;SELECT AND TYPE THE ERROR CONDITION GIVEN BY THE
;MONITOR IN RESPONSE TO ERRORS IN LOOKUP AND ENTER.
;TYPE 6 HAS NOT BEEN INVENTED YET, BUT MAY BE ENTERED
;INTO THE DISPATCH TABLE BELOW

ERRMG2:	MOVE	E,FILNAM+1	;GET ERROR NUMBER PROVIDED
	ANDI	A,-1		;INPUT OR OUTPUT SWITCH
	ANDI	E,7		;ISOLATE THE NUMBER FOR FURTHER OPERATIONS
	CAIN	A,ERRMG2-1	;WAS THIS AN OUTPUT ERROR?
	JUMPE	E,IOFN		;YES,TYPE 0 ERROR,ILL NAME
	HRRZ	A,EDSP(E)	;ANTICIPATE RIGHT BANK
	CAILE	E,3		;BE SURE THIS IS SO
	HLRZ	A,EDSP-4(E)	;BLUNDER
	JRST	@A		;PERFORM THE DISPATCHED ROUTINE

;UPDATE THIS DISPATCH TABLE IF 6 INVENTED

EDSP:	XWD	RNFAIL,NTFD	;RENAME.......NOT FOUND
	XWD	RNFAIL,IPP	;RENAME.......INCORRECT PP#
	XWD	USP,FPR		;UNDEFINED....FILE PROTECT FAILURE
	XWD	NDV,FBM		;NO DEVICE....FILE BEING MODIFIED

;;TYPE 0 ERROR ON INPUT ONLY

NTFD:	PUSHJ	P,LKUPER	;TYPE NAME.EXT
	JSP	A,CONMES
	ASCIZ	/ FILE NOT FOUND
/
	ERROR ^D12

;TYPE 0 ERROR ON OUTPUT ONLY

IOFN:	SKIPE	FILNAM
	JRST	DIF
	JSP	A,CONMES
	ASCIZ	/ ILLEGAL NAME FORMAT
/
	ERROR ^D13

;TYPE 1 ERROR, ILLEGAL PROJECT PROGRAMMER NUMBER

IPP:	PUSHJ	P,LKUPER	;TYPE NAME.EXT
	JSP	A,CONMES
	ASCIZ	/ INCORRECT PROJECT-PROGRAMMER NUMBER
/
	ERROR ^D14

;TYPE 2 ERROR, FILE PROTECT FAILURE

FPR:	PUSHJ	P,LKUPER	;TYPE NAME.EXT
	JSP	A,CONMES
	ASCIZ	/ FILE PROTECT FAILURE
/
	ERROR ^D15

;TYPE 3 ERROR, FILE BEING MODIFIED

FBM:	PUSHJ	P,LKUPER	;TYPE NAME.EXT
	JSP	A,CONMES
	ASCIZ	/ FILE BEING MODIFIED
/
	ERROR ^D16

;TYPE 6 NOT YET INVENTED

USP:	PUSHJ	P,LKUPER	;TYPE NAME.EXT
	JSP	A,CONMES
	ASCIZ	% UNDEFINED I/O ERROR
%
	ERROR ^D17

;TYPE 7 ERROR, NO DEVICE

NDV:	JSP	A,CONMES
	ASCIZ	/ NO DEVICE ASSIGNED
/
	ERROR ^D18

;DIRECTORY FULL MESSAGE

DIF:	JSP	A,CONMES
	ASCIZ	/DIRECTORY IS FULL
/
	ERROR ^D19



ININER:	JSP A,ERRMES
	ASCIZ /DEVICE /
	MOVE A,FILDEV
	PUSHJ P,SIXBMS
	JSP A,CONMES
	ASCIZ / NOT AVAILABLE
/
	ERROR ^D20

LKUPER:	MOVE A,FILNAM
	PUSHJ P,SIXBMS
	HLLZ A,FILNAM+1
	JUMPE A,LKUPE1
	MOVEI CH,"."
	PUSHJ P,TYO
	PUSHJ P,SIXBMS
LKUPE1:  POPJ	P,
	ERROR ^D21

RNFAIL:	PUSHJ P,LKUPER	;TYPES 4,5
	JSP A,CONMES
	ASCIZ /RENAME FAILURE
/
	ERROR ^D45
;EW	SELECTS THE OUTPUT DEVICE AND OPENS THE FILE SPECIFIED (IF ANY)

OPNWR:	PUSHJ P,OPNW1


OPNW2:	ENTER OUTCHN,FILNAM
	JRST ENTERR
	POPJ P,



OPNW1:	TLNE FF,UBAK
	ERROR ^D22
	PUSHJ P,FILSPC
OPNW4:	TLOE FF,UWRITE	;CALL HERE FROM EB
	RELEAS OUTCHN,0
	MOVEI E,1	
	MOVEM E,OPNWI
	MOVE E,FILDEV
	MOVEM E,OPNWD
	MOVSI	E,OBF
	MOVEM E,OPNWB
	OPEN OUTCHN,OPNWI
	JRST ININERR
	MOVE T,.JBFF
	MOVEI E,OBUF1
	MOVEM E,.JBFF
	OUTBUF OUTCHN,2
	MOVEM T,.JBFF
	POPJ P,0

U OPNWI,1		;OUTPUT FILE OPEN ARGUMENTS. OPNW1+4(1)
U OPNWD,1		;OUTPUT DEVICE.  OPNW1+6
U OPNWB,1		;OUTBUT BUFFER HEADER ADDRESS. OPNW1+10(OUTBUF)






;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:	PUSHJ P,OPNW1		;DETERMINE OUTPUT DEVICE
	CALLI OUTCHN, UTPCLR	;CLEAR DIRECTORY OF OUTPUT DEVICE
	MTAPE OUTCHN,1		;REWIND OUTPUT DEVICE
	JRST OPNW2		;ENTER FILE




;EF	FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT
;	SELECTING A NEW OUTPUT FILE.

CLOSEF:	TLNE FF,UBAK
	PUSHJ P,BAKCLS
	TLZN FF,UWRITE
	POPJ P,
	CLOSE OUTCHN,2
	STATZ OUTCHN,740000
	JRST OUTERR
	TLZN FF,UBAK
	JRST CLSF1
	PUSH	P,FILNAM
	PUSH	P,FILNAM+1	;DECTAPE NEEDS A SECOND LOOKUP
	MOVE	A,BAKTMP	;TEMP NAME
	MOVEM	A,FILNAM
	MOVSI	A,(SIXBIT /TMP/)	;.TMP
	MOVEM	A,FILNAM+1
	SETZM	FILNAM+3
	LOOKUP	OUTCHN,FILNAM
	JFCL	;CANT POSSIBLY FAIL
	POP	P,FILNAM+1
	POP	P,FILNAM	;RESTORE REAL FILE NAME
	CLOSE	OUTCHN,2	;CLOSE OUTPUT FOR RENAME
	RENAME OUTCHN,FILNAM
	JRST ENTERR
CLSF1:	RELEAS OUTCHN,0
	POPJ P,
;EM	EXECUTE MTAPE UUO.

EMTAPE:	TLNN FF,UREAD
	ERROR ^D23
	PUSHJ P,CHK2
	CAIGE B,20
	CAIGE B,1
	ERROR ^D24
	MTAPE INCHN,0(B)
	POPJ P,

;THIS ROUTINE IS CALLED AT EF IF AN EB WAS DONE. IT DOES
;THE WORK OF MAKING THE INPUT FILE HAVE THE EXTENSION .BAK ,
;DELETING ANY PREVIOUS FILE.BAK, AND RENAMING THE NEW OUTPUT
;FILE AS THE ORIGINAL FILE.EXT

BAKCLS:	TLNN FF,UREAD+FINF
	ERROR ^D25
	CLOSE INCHN,0
	MOVE E,BAKNAM
	MOVEM E,FILNAM
	MOVSI E,(SIXBIT /BAK/)
	MOVEM E,FILNAM+1
	SETZM FILNAM+2
	LOOKUP INCHN,FILNAM
	JRST BKCLS1
	CLOSE INCHN,0
	SETZM FILNAM
	SETZM FILNAM+1
	RENAME INCHN,FILNAM
	JRST ENTERR
BKCLS1:	MOVE E,BAKNAM
	MOVEM E,FILNAM
	HLLZ E,BAKNAM+1
	MOVEM E,FILNAM+1
	LOOKUP INCHN,FILNAM
	JRST ENTERR
	CLOSE INCHN,0
	MOVSI E,(SIXBIT /BAK/)
	MOVEM E,FILNAM+1
	RENAME INCHN,FILNAM
	JRST ENTERR
	MOVE E,BAKNAM+1
	MOVEM E,FILNAM+1
	POPJ P,0

;ROUTINE TO PARSE FILE DESIGNATOR

FILSPC:	TLZ FF,FILWD
	SETZM FILDEV		;CLEAR FILE DESIGNATOR ARGUMENTS.
	SETZM FILNAM
	SETZM FILNAM+1
	SETZM FILNAM+2
	SETZB E,FILNAM+3

;FROM FILSPL+21,FILSP1+3,FILSP3+3,FILSP6+1


FILSPL:	PUSHJ P,SKRCH		;GET NEXT COM CHARACTER. ERROR IF COMMAND BUFFER EMPTY.
	CAIN CH,175
	JRST FILSP2		;ALT MODE
	CAIL CH,140	;LC TO UC
	TRZ CH,40
	CAIN CH,":"
	JRST FILSP1		;DEVICE
	CAIN CH,"."
	JRST FILSP3		;EXTENSION MARK
	CAIN CH,"["
	JRST FILSP4		;PROJ PROG PAIR
	PUSHJ P,DQT2		;LETTER OR DIGIT?
	TRZA B,777700		;YES. DQT2 LEAVES CHARACTER IN B AND CH.
	ERROR ^D26		;NO
	TRC B,40		;CONVERT TO SIXBIT.
	ROT B,-6
	TLNN E,770000		;SIX CHARACTERS YET?
	ROTC B,6		;NO. PACK IT INTO E
	TLO FF,FILWD		;YES.
	JRST FILSPL

;END OF DESIGNATOR.  STORE FILE NAME OR EXTENSION AND RETURN
;THROW IN DSK IF NEEDED

FILSP2:	PUSHJ P,FILLSH
	MOVSI E,(SIXBIT /DSK/)
	SKIPN FILDEV
	MOVEM E,FILDEV
	POPJ P,0


;ROUTINE TO LEFT JUSTIFY E AND STORE IN FILE NAME OR FILE EXTENSION.
;CALL	MOVE E,SIXBIT NAME RIGHT JUSTIFIED
;	SET FILWD OR FEXTF FLAG
;	PUSHJ P,FILLSH
;	RETURN
;FROM FILSP1,FILSP3,FILSP4

FILLSH:	SKIPE E			;NULL NAME?
	TLNE E,770000		;NO. LEFT JUSTIFIED?
	JRST FILLS1		;YES.
	LSH E,6			;NO.
	JRST .-3
FILLS1:	TLZN FF,FEXTF		;EXTENSION?
	JRST .+3		;NO.
	HLLZM E,FILNAM+1	;YES. STORE IT.
	TLZ FF,FILWD
	TLZE FF,FILWD		;FILE NAME?
	MOVEM E,FILNAM	;YES. STORE IT.
	POPJ P,0		;NO. RETURN.

;DEVICE NAME

FILSP1:	TLZ FF,FILWD+FEXTF	;RESET THESE FLAGS FOR DEVICE LOAD
	PUSHJ P,FILLSH		;LEFT JUSTIFY IT.
	MOVEM E,FILDEV
FILS1A:	MOVEI E,0
	JRST FILSPL

;FILE NAME EXTENSION FOLLOWS

FILSP3:	PUSHJ P,FILLSH		;STORE FILE NAME.
	TLO FF,FEXTF		;GET EXTENSION.
	JRST FILS1A

;PROJECT-PROGRAMMER PAIR

FILSP4:	PUSHJ P,FILLSH		;STORE NAME OR EXTENSION.
	MOVEI B,","		;SCAN FOR ,
	PUSHJ P,FILSPP
FILSP5:	HRLZM E,FILNAM+3	;STORE PROJECT NUMBER.
	MOVEI B,"]"		;SCAN FOR ]
	PUSHJ P,FILSPP
FILSP6:	HRRM E,FILNAM+3
	JRST FILSPL

FILSPP:	MOVEI E,0
FILS4L:	PUSHJ P,SKRCH		;GET NEXT COMMAND CHARACTER.
	CAIN CH,(B)		;DELIMITER?
	POPJ P,			;YES
	PUSHJ P,FILSOC
	JRST FILS4L


FILSOC:	XORI CH,60
	CAIL CH,12
	ERROR ^D27
	LSH E,3
	ADDI E,(CH)
	POPJ P,
;Y	RENDER THE BUFFER EMPTY.  READ INTO THE BUFFER UNTIL
;	(A)  A FORM FEED CHARACTER IS READ, OR
;	(B)  THE BUFFER IS WITHIN ONE THIRD OR
;128 CHARACTERS OF CAPACITY AND A LINE FEED IS READ, OR
;	(C)  AN END OF FILE IS READ, OR
;	(D)  THE BUFFER IS COMPLETELY FULL.
;THE FORM FEED (IF PRESENT) DOES NOT ENTER THE BUFFER.

YANK:

YANK1:	MOVE OU,BEG
	MOVEM OU,PT		;PT:=BEG

YANK2:	TRZ FF,FORM		;RESET THE YANK,APPEND FORM FEED FLAG

;MAINTAIN AT LEAST A MINIMUM SIZE BUFFER OF 5000 
;CHARACTERS AT ALL TIMES, WHEN TECO ASKS FOR INPUT FROM
;ANYTHING BUT THE CONSOLE.

	PUSH	P,17		;SAVE AC#17
	MOVE	17,MEMSIZ	;TOTAL CHARACTERS AVAILABLE
	SUB	17,OU		;THIS IS TOTAL IN BUFFER FOR Y (OR P),
				; OR ABOVE BUFFER IF "A" COMMAND
	CAIG	17,^D3000	;HAVE WE 3000 CHARACTERS?
	PUSHJ	P,GRABAK	;NO, GET 1 K OF CORE
	POP	P,17		;RESTORE AC#17
	JRST	YANK4		;PRE-CHECK FOR SPACE

YANK3:	TLNN FF,UREAD		;HAS AN INPUT FILE BEEN SPECIFIED?
	JRST YANK09		;NO.
	SOSLE IBUF+2	;YES. IS DEVICE BUFFER EMPTY?
	JRST YANK5		;NO.
	INPUT INCHN,0		;YES. FILL IT.
	STATZ INCHN,740000	;ERROR?
	JRST INERR		;YES.
	STATO INCHN,20000	;NO. END OF FILE?
	JRST YANK5		;NO.
	TLZ FF,UREAD		;YES. DE-SELECT INPUT FILE.
	TLO FF,FINF
	JRST YANK51		;CLEAR BUFFER AND RETURN.
YANK5:	ILDB CH,IBUF+1	;CH:=NEXT CHARACTER.
	JUMPE CH,YANK3		;IF NULL, IGNORE IT.
	MOVE T,@IBUF+1
	TRNE T,1		;SEQUENCE NUMBER?
	JRST YNKSEQ		;YES. IGNORE THEM.
	PUSHJ P,PUT		;NO. PUT CHARACTER IN DATA BUFFER.
	CAIE CH,14		;FORM FEED?
	AOJA OU,YANK4		;NO. UPDATE DATA BUFFER POINTER AND CHECK FOR OVERFLOW.
	TRO  FF,FORM		;YANK AND/OR APPEND TERMINATED ON A LFORM FEED
YANK51:	MOVEM OU,Z		;YES. SET END OF DATA BUFFER AND RETURN
	POPJ P,0
YANK09:	SKIPE OPNR1		;INPUT DEVICE SPECIFIED?
	JRST YANK51		;YES. CLEAR BUFFER.
	JSP A,ERRMES		;NO.
	ASCIZ /NO FILE FOR INPUT
/
	ERROR ^D28


YNKSEQ:	MOVNI T,5		;IGNORE SEQ. NO. AND FOLLOWING TAB
	ADDM T,IBUF+2	;DECREASE CHAR COUNT BY 5
	AOS	IBUF+1	;INCREMENT POINTER OVER SEQ. NO., & TAB
	JRST YANK3
INERR:	JSP A,ERRMES
	ASCIZ /ERROR ON INPUT DEVICE
/
	ERROR ^D29

YANK4:	MOVE T,M23
	CAIL T,(OU)		;WITHIN 128 CHARACTERS FROM TOP OF MEMORY?
	JRST YANK3		;NO. GET MORE.
	MOVE	T,M23PL	;!!!!!!!!!!!!!!TEST!!!!!!!!!
	CAILE T,0(OU)		;YES. FULL?
	CAIN CH,12		;NO. LINE FEED?
	JRST YANK51		;YES. THAT'S ALL.
	JRST YANK3		;NO. GET MORE.



;A   APPEND TO THE END OF THE BUFFER FROM THE SELECTED INPUT
;	TERMINATING THE READ IN THE SAME MANNER AS Y.  THE POINTER
;	IS NOT MOVED BY A.

APPEND:	MOVE OU,Z		;STORE DATA AT END OF BUFFER.
	PUSHJ P,YANK2
	JRST RET


;^ITEXT$	INSERTS AT THE CURRENT POINTER LOCATION THE ^I (TAB)
;	AND THE TEXT FOLLOWING THE ^I UP TO BUT NOT INCLUDING THE
;	ALT MODE.  THE POINTER IS PUT TO THE RIGHT OF THE INSERTED
;	MATERIAL.

TAB:	PUSHJ P,TAB2		;INSERT TAB

;ITEXT$	INSERT, AT THE CURRENT POINTER LOCATION, THE TEXT FOLLOWING
;	THE I UP TO BUT NOT INCLUDING THE FIRST ALT. MODE.  THE
;	POINTER IS PUT TO THE RIGHT OF THE INSERTED MATERIAL.

INSERT:	TRNE FF,ARG		;IS THERE AN ARGUMENT?
	JRST INS1A		;YES. NI COMMAND.
	MOVEI CH,175		;NO. CH:=ALT-MODE.
	TRZE FF,SLSL		;DID @ PRECEED I?
	PUSHJ P,RCH		;YES. CH:=USER SELECTED TERMINATOR.
	MOVEM CH,A		;A:=INSERTION TERMINATOR.
				;EITHER ALT-MODE OR USER CHOICE.
	MOVE B,CPTR		;SAVE CURRENT POSITION OF CPTR.
	MOVEI C,0		;COUNT # CHARACTERS TO INSERT IN C AND
				;MOVE CPTR TO END OF STRING.
	PUSHJ P,SKRCH		;GET NEXT CHARACTER
	CAME CH,A		;IS IT THE TERMINATOR?
	AOJA C,.-2		;NO. TRY AGAIN.
	PUSHJ P,NROOM		;YES. MOVE FROM PT THROUGH Z UP C POSITIONS.
	ADD B,CRREL		;RELOCATE INITIAL VALUE OF CPTR IN CASE OF GARB. COL.

;MOVE INSERTION INTO DATA BUFFER

INS1B:	MOVE OU,PT
	ILDB CH,B		;CH:=CHARACTER FROM COMMAND STRING.
	CAMN CH,A		;IS IT THE TERMINATOR?
	POPJ P,			;YES. DON'T STORE IT.
	PUSHJ P,PUT		;NO. STORE CHARACTER IN DATA BUFFER TO RIGHT OF PT.
	AOS PT		;PT:=PT+1
	JRST INS1B		;LOOP


;NI	INSERT AT THE POINTER A CHARACTER WHOSE 7-BIT ASCII CODE IS N
;	(BASE 10).  THE POINTER IS MOVED TO THE RIGHT OF THE NEW CHARACTER.

INS1A:
TAB1:	MOVE CH,NUM		;CH:=NUM

;INSERT CH IN DATA BUFFER AT PT

TAB2:	MOVEI C,1		;MOVE FROM PT THROUGH Z UP 1 POSITION.
	PUSHJ P,NROOM
	AOS OU,PT		;PT:=PT+1
	SOJA OU,PUT		;STORE CH AT PT-1




;@IJTEXTJ	INSERT, AT THE CURRENT POINTER POSITION, THE TEXT
;	SURROUNDED BY THE INSTANCES OF THE TERMINATOR J, WHICH MAY BE AT
;	THE USER'S CHOICE ANY CHARACTER NOT APPEARING IN THE TEXT.
;	THE POINTER IS PUT TO THE RIGHT OF THE INSERTED MATERIAL.

ATSIGN:	TRO FF,SLSL		;SLSL:=1
	JRST RET


;NBACKSLASH	INSERT AT THE CURRENT POINTER LOCATION THE ASCII NUMBERS
;	EQUAL TO N.

BAKSL1:	MOVE T,[XWD 700,BAKTAB-1]
	MOVEI C,0		;COUNT # DIGITS IN C.
	MOVEI CH,BAKSL4		;SET DPT TO RETURN TO BAKSL4
	HRRM CH,LISTF5
	PUSHJ P,DPT		;CONVERT C(B) TO ASCII AND STORE STRING IN BAKTAB.
	MOVEI A,141		;MARK END OF STRING IN BAKTAB
	IDPB A,T
	MOVE B,[XWD 700,BAKTAB-1]
	PUSHJ P,NROOM		;MOVE FROM PT THROUGH Z UP C POSITIONS.
	PUSHJ P,INS1B		;INSERT STRING IN BAKTAB INTO DATA BUFFER AT PT.
	JRST RET

BAKSL4:	IDPB CH,T		;STORE DIGIT IN BAKTAB
	AOJA C,CPOPJ		;C:=C+1. RETURNS TO DPT CALL + 1 ON COMPLETION.

;NT	TYPE OUT THE STRING OF CHARACTERS STARTING AT THE RIGHT OF THE
;	POINTER AND CONTINUING THROUGH THE NTH LINE FEED ENCOUNTERED.
;	IF N IS NEGATIVE, N LINES TO THE LEFT OF THE POINTER ARE TYPED.
;T	SAME AS 1T.
;I,JT	TYPE OUT THE (I+1)TH THROUGH THE JTH CHARACTER OF THE BUFFER.

TYPE:
TYPE4:	MOVEI D,TYO		;D:=ADDRESS OF OUTPUT ROUTINE.

TYPE0:	PUSHJ P,GETARG		;C:=FIRST STRING ARGUMENT ADDRESS.
				;B:=SECOND STRING ARGUMENT ADDRESS.

TYPE1:	PUSHJ P,CHK1		;C:=MAX(C(C),BEG), B:=MIN(C(B),Z)
	MOVE I,C		;START GETTING CHARACTERS AT C.
TYPE3:	CAML I,B		;DONE?
	JRST TYPE5		;YES.
	MOVE TT,I	;NO. GET NEXT CHAR
	IDIVI TT,5	;THIS IS A COPY OF GETINC
	HLL TT,BTAB(TT1)	;..
	LDB CH,TT	;COPIED TO SPEED IT UP
	ADDI I,1	;..
	PUSHJ P,(D)		;OUTPUT IT
	JRST TYPE3		;LOOP
TYPE5:	MOVEI A,PPA
	MOVEI CH,14		;IF PUNCHING, APPEND FF.
	CAIE A,(D)		;D=PPA?
	POPJ P,			;NO
	TRNN FF,PCHFLG		;IS THIS AN "N" SEARCH?
	JRST	PPA		;NO, APPEND A FORM FEED
	TRNN  FF,FORM		;DID LAST Y,A TERMINATE ON A FORM FEED?
	POPJ	P,		;NO,DO NOT APPEND ONE
CPPA:	JRST PPA		;YES. APPEND FF.


PPA:	TLNN FF,UWRITE		;OUTPUT FILE OPEN?
	JRST PPA09		;NO.
	SOSLE OBF+2	;YES. IS OUTPUT BUFFER FULL?
	JRST PPA01		;NO.
	OUTPUT OUTCHN,0		;YES. WRITE IT
	STATZ OUTCHN,740000	;ERROR?
	JRST OUTERR		;YES.
PPA01:	IDPB CH,OBF+1	;NO. CH TO OUTPUT BUFFER.
	POPJ P,0		;RETURN

PPA09:	JSP A,ERRMES
	ASCIZ /NO FILE FOR OUTPUT
/
	ERROR ^D30

OUTERR:	JSP A,ERRMES
	ASCIZ /ERROR ON OUTPUT DEVICE; FILE CLOSED
/
	RELEAS OUTCHN,0		;CLOSE FILE AND RELEASE OUTPUT DEVICE.
	TLZ FF,UWRITE		;CLEAR OUTPUT FILE OPEN INDICATOR.
	JRST GOX		;CLEAR COMMAND BUFFER AND WAIT FOR NEXT COMMAND.


;PW	OUTPUT THE ENTIRE BUFFER, FOLLOWED BY A FORM FEED CHARACTER.
;	TO THE SELECTED OUTPUT DEVICE.  BUFFER IS UNCHANGED AND POINTER
;	IS UNMOVED.
;P	IS IDENTICAL TO PWY.
;NP	IS IDENTICAL TO PP...P (P PERFORMED N TIMES).
;I,JP	OUTPUTS (I+1)TH THROUGH JTH CHARACTERS OF BUFFER.  NO FORM
;	FEED IS PUT AT THE END.  BUFFER UNCHANGED; POINTER UNMOVED.

PUNCH:

PUNCHA:	MOVEI D,CPPA		;SELECT PPA FOR OUTPUT.
	TRNE FF,ARG2		;I,JP?
	JRST TYPE0		;YES. GET STRING ARGUMENTS AND OUTPUT.
	MOVE E,B		;NO. E:=N
	MOVE B,CPTR
	ILDB T,B		;T:=COMMAND CHARACTER FOLLOWING P.
	TRZ T,40		;FILTER L.C.
	JUMPL E,CPOPJ		;IF N<0, IGNORE P.
PUN1:	PUSHJ P,PUNCHR		;PUNCH OUT BUFFER
	TLNE	FF,FINF		;DONT TRY TO READ IF NO DATA LEFT
	POPJ	P,0		;PREVENTS ERROR IF NO INPUT FILE AND EB
	SKIPE COMCNT		;IF NO COMMANDS LEFT
	CAIE T,"W"		;OR COMMAND IS NOT W
	PUSHJ P,YANK1		;RENEW BUFFER
	MOVE C,Z
	CAMN C,BEG		;EMPTY BUFFER?
	TLNN FF,FINF		;NO. QUIT ON EOF
	SOJG E,PUN1		;YES. E:=E-1. DONE?
				;YES

CPOPJ:	POPJ P,0

PUNCHR:	MOVE C,BEG		;OUTPUT DATA BUFFER.
	MOVE B,Z
	MOVEI D,PPA
	JRST TYPE1

;NJ	MOVE THE POINTER TO THE RIGHT OF THE NTH CHARACTER IN THE
;	BUFFER. (I.E., GIVE "." THE VALUE N.)
;J	SAME AS 0J.

JMP:	ADD B,BEG		;PT:=N+BEG
	JRST JMP1



;NR	SAME AS .-NJ.

REVERS:	PUSHJ P,CHK2		;MAKE SURE THERE IS AN ARGUMENT
	MOVNS B			;B:=-C(B)
	SKIPA

;NC	SAME AS .+NJ.  NOTE THAT N MAY BE NEGATIVE.

CHARAC:	PUSHJ P,CHK2		;MAKE SURE THERE IS AN ARGUMENT
	ADD B,PT		;B:=PT+C(B)

;IF B LIES BETWEEN BEG AND Z, STORE IT IN PT.

JMP1:	PUSHJ P,CHK		;IS C(B) WITHIN DATA BUFFER?
	MOVEM B,PT		;YES. PT:=C(B)
	JRST RET

;NL	IF N>0:	MOVE POINTER TO THE RIGHT, STOPPING WHEN IT HAS
;		PASSED OVER N LINE FEEDS.
;	IF N<0:	MOVE POINTER TO THE LEFT; STOP WHEN IT HAS PASSED
;		OVER N+1 LINE FEEDS AND THEN MOVE IT TO THE RIGHT OF
;		THE LAST LINE FEED PASSED OVER.
;L	SAME AS 1L.

LINE:	TRNE FF,ARG2		;IS THERE A SECOND ARGUMENT?
	ERROR ^D31		;YES. TOUGH
	PUSHJ P,GETARG		;NO. C:=FIRST STRING ARGUMENT ADDRESS,
				;B:=SECOND STRING ARGUMENT ADDRESS.
	XOR B,C
	XORM B,PT
	JRST RET

;ROUTINE TO RETURN CURRENT ARGUMENT IN B
;ASSUMES A VALUE OF 1 WITH SIGN OF LAST OPERATOR IF THERE IS NO CURRENT ARGUMENT
;CALL	PUSHJ P,CHK2
;	RETURN WITH B:=CURRENT ARG.,+1 OR -1

CHK2:	TROE FF,ARG		;IS THERE AN ARGUMENT?
	POPJ P,			;YES. IT'S ALREADY IN B.
				;NO

CHK22:	LDB B,[XWD 340200,DLIM]	;B:=1 WITH SIGN OF LAST OPERATOR.
	MOVNS B
	AOJA B,CPOPJ

;CD9(K)
;NK	PERFORM NL BUT DELETE EVERYTHING THE POINTER MOVES OVER.
;M,NK	DELETE THE (M+1)TH THROUGH THE NTH CHARACTER FROM THE BUFFER.
;	THE POINTER IS THEN PUT WHERE THE DELETION TOOK PLACE.
;K	SAME AS 1K

KILL:	PUSHJ P,GETARG		;C:=FIRST STRING ARG. ADDRESS
				;B:=SECOND STRING ARG. ADDRESS
	PUSHJ P,CHK1		;C:=MAX(C(C),BEG), B:=MIN(C(B),Z)
	MOVEM C,PT		;PT:=C(C)
	SUB B,C		;B:=NO. OF CHARACTERS TO KILL.
	JUMPE B,RET		;IF NONE, RETURN. OTHERWISE, FALL INTO DELETE

;ND	DELETE N CHARACTERS FROM THE BUFFER: IF N IS POSITIVE, DELETE
;	THEM JUST TO THE RIGHT OF THE POINTER; IF N IS NEGATIVE, DELETE
;	THEM JUST TO ITS LEFT.
;D	SAME AS 1D

DELETE:	PUSHJ P,CHK2		;MAKE SURE B CONTAINS AN ARGUMENT
	MOVM C,B
	MOVNS C			;C:=-ABS(B)
	ADD B,PT		;B:=PT+B
	PUSHJ P,CHK		;STILL IN DATA BUFFER?
	CAMGE B,PT		;YES. IS N NEGATIVE?
	MOVEM B,PT		;YES. MOVE PT BACK FOR DELETION.
	PUSHJ P,NROOM		;MOVE FROM PT+ABS(C) THROUGH Z DOWN ABS(C) POSITIONS
DEL2:
JRET:	JRST RET



;ROUTINE TO CHECK DATA BUFFER POINTER
;CALL	MOVE B,POINTER
;	PUSHJ P,CHK
;	RETURN IF B LIES BETWEEN BEG AND Z

CHK:	CAMG B,Z
	CAMGE B,BEG
	ERROR ^D32
	POPJ P,

;ROUTINE TO PUT STRING ARGUMENT ADDRESSES WITHIN DATA BUFFER
;BOUNDS AND CHECK ORDER RELATION.
;CALL	MOVE C,FIRST STRING ARGUMENT ADDRESS
;	MOVE B,SECOND STRING ARGUMENT ADDRESS
;	PUSHJ P,CHK1
;	RETURN
;C:=MAX*_xC),BEG), B:=MIN(C(B),Z)
;IF C>B, DOES NOT RETURN.

CHK1:	CAMG C,BEG		;C:=MAX(C(C),BEG)
	MOVE C,BEG
	CAML B,Z		;B:=MIN(C(B),Z)
	MOVE B,Z
	CAMLE C,B		;C>B?
	ERROR ^D33		;YES.
	POPJ P,			;NO

LARR:	TROA FF,FINDR		;FINDR:=1 FOR LEFT ARROW SEARCH

SERCHP:	TRO FF,PCHFLG		;PCHFLG:=1 FOR N SEARCH

;CD9(S)

	JRST	SERCH
SQCB:	MOVE	TT,PT
	MOVEM	TT,Q1
	JRST	SQCBBB
SQCBB:	MOVE	TT,Q1
SQCBBB:	IDIVI	TT,5
	HLL	TT,BTAB(TT1)
	LDB	CH,TT
	AOS	Q1
	CAIE	CH,12
	JRST	SQCBB
	SOS	Q1
	MOVE	TT,Q1
	MOVEM	TT,QZ
	JRST	SERCH2
SQCC:	SETOM	QCCFLG
	JRST	SERCH2
SQCP:	MOVE	TT,PT
	ADDI	TT,1
	MOVEM	TT,QZ
	JRST	SERCH2
SERCH:	SETZM	QCCFLG
	MOVE	E,PT
	MOVEM	E,SQPT
	MOVE	E,Z
	MOVEM	E,QZ
	MOVE E,B		;E:=ARGUMENT (IF ANY)
	CLEARM NUM		;NUM:=0
	MOVEI CH,175		;USE ALT-MODE DELIMITER IF NO @ SEEN
	TRZE FF,SLSL		;@ SEEN?
	PUSHJ P,RCH		;YES. CH:=USER SPECIFIED DELIMITER.
	MOVEM CH,B		;B:=SEARCH STRING DELIMITER
	HRLZI F,STAB-STABP	;F:=XWD -LENGTH OF SEARCH TABLE,0

;SET UP SEARCH TABLE

SERCH2:	PUSHJ P,SKRCH		;CH:=NEXT COMMAND STRING CHARACTER.
	CAIN CH,(B)		;DELIMITER?
	JRST SERCH1		;YES. DONE.
	SKIPE	0,QED
	JRST	SERCHQ
	CAIN	CH,2
	JRST	SQCB
	CAIN	CH,3
	JRST	SQCC
	CAIN	CH,20
	JRST	SQCP
SERCHQ:	CAIN CH,30		;NO. ^X?
	JRST CNTRX		;YES
	CAIN CH,16		;NO. ^N?
	JRST CNTRN		;YES.
	CAIN CH,23		;NO. ^S?
	JRST CNTRB		;YES
	CAIN CH,21		;NO. ^Q?
	PUSHJ P,SKRCH		;YES. ^Q TAKES THE NEXT CHARACTER.
	HRLI CH,306000+CH*40	;CH:=CAIN CH,CHARACTER

SERCH4:	TRZE FF,NOTF		;SEARCH SENSE REVERSED?
	TLC CH,4000		;YES. CH:=CAIE CH,CHARACTER
				;PUSHJ P,CNTRB1, OR CAIA
	MOVEM CH,STAB(F)		;SAVE IN SEARCH TABLE
	AOBJN F,SERCH2		;GET NEXT CHARACTER
	ERROR ^D34		;SEARCH TABLE IS FULL

;START SEARCHING

SERCH1:	MOVE I,PT		;START SEARCHING AT PT
	MOVEM	I,QI
	TRNE FF,ARG		;IS THERE AN ARGUMENT?
	JUMPLE E,FND		;YES. SEEN STRING N TIMES?
	CAML I,QZ		;NO. REACHED TOP OF BUFFER?
	JRST NOFND		;YES.
	MOVEI D,STAB
SERCH3:	CAIN D,STAB(F)		;END OF SEARCH TABLE?
	JRST FND		;YES.
	MOVE TT,I		;NO. CH:=NEXT DATA BUFFER CHARACTER.
	IDIVI TT,5	;THIS IS COPY OF GETINC
	HLL TT,BTAB(TT1)	;COPIED FOR SPEED
	LDB CH,TT
	ADDI I,1
	XCT (D)

SERCH5:	AOJA D,SERCH3		;MATCH FOUND. GO TO NEXT TABLE ENTRY.


SRCH5A:	AOS PT		;NO MATCH. PT:=PT+1
	JRST SERCH1		;KEEP LOOKING


FND:	CAMLE I,QZ		;REACH TOP OF BUFFER?
	JRST NOFND		;YES. SEARCH FAILED.
	SETOM SFINDF		;NO. SFINDF:=-1
	SKIPE	QCCFLG
	MOVE	I,QI
	MOVEM I,PT		;MOVE PT PAST THE STRING
	SOJG E,SERCH1		;FIND IT N TIMES?
	TRZN FF,COLONF		;YES. COLON MODIFIER?
	JRST RET		;NO. DONE
FFOK:	MOVNI A,1		;YES. RETURN VALUE OF -1
	JRST VALRET

NOFND:	MOVE	I,SQPT
	SKIPE	0,QED
	MOVE I,BEG		;SEARCH FAILED
	MOVEM I,PT		;PT:=BEG
	CLEARM SFINDF		;SFINDF:=0
	TRNE FF,PCHFLG+FINDR	;S SEARCH?
	JRST NOFND1		;NO.


BEGIN1:	TRZN FF,COLONF		;YES. COLON MODIFIER?
	JRST NOFND2		;NO


BEGIN2:	TRZ FF,PCHFLG+FINDR	;YES.
	JRST BEGIN		;RETURN VALUE OF 0



NOFND1:	TLNN FF,UREAD		;INPUT FILE SELECTED?
	JRST BEGIN1		;NO. DONE.
	PUSH P,E		;YES. SAVE SEARCH COUNT
	MOVEI B,1		;PUNCH 1 PAGE ONLY
	TRNE FF,PCHFLG		;N SEARCH?
	PUSHJ P,PUNCHA		;YES. PUNCH THIS BUFFER AND REFILL IT.
	TRNE FF,FINDR		;LEFT ARROW SEARCH?
	PUSHJ P,YANK1		;YES. FILL BUFFER.
	POP P,E			;RESTORE SEARCH COUNT.
	JRST SERCH1		;RESUME SEARCH


NOFND2:	TRNE FF,ITERF		;IN AN ITERATION?
	JRST BEGIN2		;YES. RETURN VALUE OF 0
	JSP A,ERRMES
	ASCIZ /SEARCH/
	ERROR ^D35
			;NO. SEARCH FAILED.

;CNTR S MATCHES ANY SEPARATOR CHARACTER (I.E., ANY CHARACTER NOT
;A LETTER, NUMBER, PERIOD, DOLLAR SIGN OR PER CENT SYMBOL)

CNTRB:	SKIPA CH,[JSR P,CNTRB1]	;CH:=JSR P,CNTRB1

;CNTR X MATCHES ANY ARBITRARY CHARACTER

CNTRX:	MOVSI CH,300000		;CH:=CAI
	JRST SERCH4

;HERE ON CNTR N CNTR S
CNTRB2:	MOVE A,[JRST DQT2]	;CNTRB1:=JRST DQT2
	MOVEM A,CNTRB1
	PUSHJ P,DQT2		;IS CH A TERMINATOR?
	JRST SRCH5A		;NO
	JRST SERCH5		;YES

;CNTR N REVERSES THE SENSE OF THE SEARCH FOR THE NEXT CHARACTER

CNTRN:	TRO FF,NOTF
	JRST SERCH2

U CNTRB1,2			;INITIALIZE TO JRST DQT2
				;INITIALIZE TO JRST CNTRB2


COLON:	TRO FF,COLONF
	JRST RET

;MI	PERFORM NOW THE TEXT IN Q-REGISTER I AS A SERIES OF COMMANDS.

MAC:	PUSHJ P,QREGVI		;A:=C(Q-REG)
	PUSH P,COMAX		;SAVE CURRENT COMMAND STATE
	PUSH P,CPTR
	PUSH P,COMCNT
	TLZE A,400000		;MAKE SURE Q-REG CONTAINS TEXT
	TLZE A,377777
	ERROR ^D36		;Q-REG DOES NOT CONTAIN TEXT
	ADD A,QRBUF
	MOVE I,A
	PUSHJ P,GETINC		;GET FIRST CHARACTER OF MACRO
	CAIE CH,141		;IT SHOULD BE FLAG
	ERROR ^D37		;OOPS
	PUSHJ P,GETINC		;GET NUMBER OF CHARACTERS IN MACRO
	MOVE A,CH
	PUSHJ P,GET
	ROT CH,7
	IOR A,CH
	SUBI A,3		;-FLAG AND COUNT
	MOVEM A,COMCNT	;THAT MANY COMMANDS TO COUNT
	MOVEM A,COMAX	;AND MAX.
	IDIVI I,5
	MOVE OU,BTAB(OU)	;MAKE A BYTE POINTER
	HRR OU,I
	MOVEM OU,CPTR	;PUT IT IN CPTR
	JRST CD5		;DON'T FLUSH ANY ARGUMENTS
;<>	ITERATION BRACKETS.  COMMAND INTERPRETATION IS SENT
;	BACK TO THE < WHEN THE > IS ENCOUNTERED.

LSSTH:	AOS INTDPH
	PUSH P,ITERCT	;SAVE ITERATION COUNT
	PUSH P,CPTR		;SAVE COMMAND STATE
	PUSH P,COMCNT
	SETOM ITERCT		;ITERCT:=-1
	TRZE FF,ARG		;IS THERE AN ARGUMENT?
	MOVEM B,ITERCT	;YES. ITERCT:=ARGUMENT
	JRST LSSTH1


GRTH:	SKIPG INTDPH		;IS THERE A LEFT ANGLE BRACKET?
	ERROR ^D38		;NO.
	TRZ FF,ITERF		;YES
	SOSN ITERCT		;ITERCT:=ITERCT-1. DONE?
	JRST INCMA2		;YES
	MOVE A,-1(P)		;NO. RESTORE COMMAND STATE TO START OF ITERATION.
	MOVEM A,CPTR
	MOVE A,(P)
	MOVEM A,COMCNT
	TRNE FF,TRACEF		;TRACING?
	PUSHJ P,CRR		;YES. OUTPUT CRLF


LSSTH1:	TRO FF,ITERF
	JRST RET

U ITERCT,1
U INTDPH,1
U SFINDF,1
;;	IF NOT IN AN ITERATION, GIVES ERROR.  IF IN AN ITERATION AND
;	IF THE MOST RECENT SEARCH FAILED, SEND COMMAND TO FIRST UNMATCHED
;	> TO THE RIGHT.  OTHERWISE, NO EFFECT.

SEMICL:	TRNN FF,ITERF		;IN < > ?
	ERROR ^D39		;NO. LOSE.
	TRNN FF,ARG		;YES. IF NO ARG,
	MOVE B,SFINDF	;USE LAST SEARCH SWITCH (0 OR -1).
	SKIPN	0,QED
	MOVEI	B,0

INCMA:	JUMPL B,CD		;IF ARG <0, JUST RET + EXECUTE LOOP
	MOVEI A,0		;INIT COUNT OF <>
INCMA1:	PUSHJ P,SKRCH1		;GET A CHAR
	CAIN CH,"<"		;<?
	AOJA A,INCMA1		;YES. COUNT AND LOOP.
	CAIE CH,">"		;>?
	JRST INCMA1		;NO. LOOP.
	SOJGE A,INCMA1		;YES. LOOP IF MORE TO GO. COUNT.


INCMA2:	SOS INTDPH		;POP OUT A LEVEL
	SUB P,[XWD 2,2]
	POP P,ITERCT
	JRST RET



;!TAG!	TAG DEFINITION.  THE TAG IS A NAME FOR THE LOCATION IT
;	APPEARS IN IN A MACRO, ITERATION OR COMMAND STRING.

EXCLAM:	PUSHJ P,SKRCH		;EXCLAM JUST INCREMENTS PAST ANOTHER !
	CAIE CH,"!"
	JRST .-2
	JRST RET




;OTAG$	GO TO THE TAG NAMED TAG.  THE TAG MUST APPEAR IN THE 
;	CURRENT MACRO OR COMMAND STRING.

OG:	MOVE A,CPTR
	MOVE AA,A
	IDIVI AA,17
	CAMN A,SYMS(B)
	JRST OGFND
	SKIPN SYMS(B)
	JRST OGNF
	CAMN A,SYMS+1(B)

ES1:	AOJA B,OGFND
	SKIPN SYMS+1(B)
ES2:	AOJA B,OGNF
	CAMN A,SYMS+2(B)
	AOJA B,ES1
	SKIPN SYMS+2(B)
	ADDI B,2

OGNF:	PUSH P,CPTR
	PUSH P,B
	MOVEI D,STAB+1
	MOVEI A,41
	MOVEM A,-1(D)	;STAB_"!"
	PUSHJ P,SKRCH
	MOVEM CH,(D)	;STAB+1 ... _ TAG
	CAIE CH,175
	AOJA D,.-3
	MOVEM A,(D)	;ALTMODE: STAB+N_"!"
	MOVE B,COMCNT
	SUB B,COMAX	;# REMAINING COMMANDS
	IDIVI B,5
	ADD B,CPTR	;MAKE A COMMAND POINTER
	JUMPE E,OG2
	SOS B
	MOVMS E
	JRST .(E)
	IBP B
	IBP B
	IBP B
	IBP B
OG2:	MOVE AA,COMAX	;ALL COMMANDS
OG4:	MOVEM B,CPTR
	MOVEM AA,COMCNT
	MOVEI E,STAB	;INIT SEARCH STRING TO "!"
OG5:	CAIN E,1(D)	;OVER STRING?
	JRST OG3	;YES
	PUSHJ P,SKRCH1	;NO. GET A CHAR
	CAMN CH,(E)	;MATCH ?
	AOJA E,OG5	;YES. MOVE ON.
	IBP B	;NO. TRY A NEW STARTING PT
	SOJA AA,OG4	;COUNT DOWN COMMANDS




OG3:	POP P,A
	POP P,SYMS(A)
	MOVEM AA,CNTS(A)
	MOVEM B,VALS(A)
	JRST RET


OGFND:	MOVE A,VALS(B)
	MOVEM A,CPTR
	MOVE A,CNTS(B)
	MOVEM A,COMCNT
	JRST RET


;N"G	HAS NO EFFECT IF N IS GREATER THAT 0.  OTHERWISE,
;	SEND COMMAND INTERPRETATION TO NEXT MATCHING '.
;	THE " AND ' MATCH SIMILAR TO ( AND ).
;N"L	SEND COMMAND TO MATCHING ' UNLESS N<0.
;N"N	SEND COMMAND TO MATCHING ' UNLESS N NOT = 0.
;N"E	SEND COMMAND TO MATCHING ' UNLESS N=0.
;N"C	SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
;	CHARACTER IS A LETTER, NUMBER, PERIOD (.), DOLLAR SIGN ($),
;	OR PER CENT (%).

DQUOTE:	TRNN FF,ARG
DQE:	ERROR ^D40
	PUSHJ P,RCH
	TRZ CH,40
	MOVSI A,0
	CAIN CH,"G"
	MOVSI A,327000+B*40	;A:=JUMPG B,
	CAIN CH,"L"
	MOVSI A,321000+B*40	;A:=JUMPL B,
	CAIN CH,"N"
	MOVSI A,326000+B*40	;A:=JUMPN B,
	CAIN CH,"E"
	MOVSI A,322000+B*40	;A:=JUMPE B,
	CAIN CH,"C"
	JRST DQT1
	JUMPE A,DQE
	HRRI A,RET
	XCT A

NOGO:	MOVEI A,0		;NOGO INCREMENTS COMMAND POINTER OVER
				;A SINGLE QUOTE,SKIPPING PAIRS OF " & '.
	PUSHJ P,SKRCH1
	CAIN CH,42		;DOUBLE QUOTE
	AOJA A,.-2
	CAIN CH,"'"		;SINGLE QUOTE
	SOJL A,RET
	JRST .-5


DQT1:	PUSHJ P,DQT3
	JRST RET
	JRST NOGO

DQT2:	MOVE B,CH

;ROUTINE TO TEST CHARACTER FOR $,%,.,0-9,A-Z
;CALL	MOVE B,CHARACTER
;	PUSHJ P,DQT3
;	RETURN IF $,%,.,0-9,A-Z
;	RETURN ON ALL OTHER CHARACTERS

DQT3:	CAIE B,"$"		;$ OR %?
	CAIN B,"%"
	POPJ P,			;YES
	CAIN B,"."		;NO. POINT?
	POPJ P,			;YES.
	CAIGE B,"0"		;NO. DIGIT OR LETTER?
	JRST POPJ1		;NO
	CAIG B,"9"		;MAYBE. DIGIT?
	POPJ P,			;YES.
	CAIGE B,"A"		;NO. LETTER?
	JRST POPJ1		;NO.
	CAIG B,"Z"
	POPJ P,			;YES.
	CAIL B,141	;LOWER CSE LETTERS?
	CAIL B,173	;..
POPJ1:	AOS 0(P)		;NO.
	POPJ P,0

REPEAT 0,<

XIII.	ERRORS

	IT IS CONCEDED THAT TECO'S ERROR MESSAGES ARE NOT OVERLY
INFORMATIVE.  FOR ALL ILLEGAL OR MEANINGLESS COMMANDS TECO TYPES OUT
? AND IGNORES THE REMAINDER OF THE COMMAND STRING, RETURNING TO THE
IDLE STATE.  AT THIS POINT THE USER MAY TYPE ? BACK IN, AND TECO
WOULD THEN RESPOND BY TYPING OUT 10 CHARACTERS OF THE COMMAND STRING,
ENDING WITH THE BAD COMMAND.  SEARCH COMMANDS ARE "BAD" IF THEY FAIL AND
THE : MODIFIER WAS NOT USED.

>

 
ERRTYP:	MOVE AA,ERR2		;VALUE OF CPTR WHEN LAST ERROR OCCURRED.
	MOVEI B,12
	SUBI AA,2		;BACK POINTER UP 10 CHARACTERS.
	ILDB CH,AA		;GET CHARACTER
	CAMG B,ERR1		;WAS IT IN THE COMMAND BUFFER?
	PUSHJ P,TYO		;YES. TYPE IT.
	CAME AA,ERR2		;HAVE WE REACHED THE BAD COMMAND?
	SOJA B,.-4		;NO. DO IT AGAIN.
	ERROR ^D41	;YES. TYPE ? CRLF AND WAIT FOR NEXT COMMAND.

ERRP:	HRRZ B,40	;GET ERROR NUMBER
ERR:	MOVEI CH,"?"		;TYPE ? CRLF
	PUSHJ P,TYO
	PUSHJ P,PRNT9		;PRINT ERROR NUMBER
	TRO FF,QMFLG		;SET ? FLAG.
	MOVE A,COMAX
	SUB A,COMCNT
	MOVEM A,ERR1		;ERR1:=COMAX-COMCNT
	MOVE A,CPTR
	MOVEM A,ERR2		;ERR2:=CPTR
	JRST QEDDBT		;GET NEXT COMMAND



U ERR1,1
U ERR2,1

ERRA:	ERROR ^D42
;UUO HANDLER
;HALTS ON UNDEFINED UUO
;CALL	TYPR1	X
;PRINTS STRING AT X TERMINATED BY ! AND REINITIALIZES AT GOZ.

UUOH:	IFE <R>,<0>
	HLRZ B,40
	CAIN B,31000	;ERROR UUO?
	JRST ERRP	;YES
	CAIE B,30000		;TYPR1?
	JRST 4,.		;NO. OOPS
	HRLZI B,440700		;YES. ADDRESS POINTS TO MESSAGE TERMINATED BY !
	HRR B,40
	ILDB CH,B
	CAIN CH,"!"		;END OF MESSAGE?
	JRST GOX		;YES. REINITIALIZE
	PUSHJ P,TYO		;NO. PRINT A CHARACTER
	JRST .-4

U LISTF5,1			;OUTPUT DISPATCH



XXTY02:	ASCII /GC ERROR
!/
;COMMAND TO COMPLEMENT TRACE MODE. "?" AS A COMMAND

QUESTN:	MOVE A,[JRST TYO]
	TRCE FF,TRACEF
	MOVSI A,263000+P*40	;TRACS:=POPJ P,
	MOVEM A,TRACS
	JRST RET

COMMEN:	PUSHJ	P,SKRCH	;GET A COMMENT CHAR
	CAIN	CH,1		;^A
	POPJ	P,0		;DONE
	PUSHJ	P,TYO		;TYPE IT
	JRST COMMENT


CALDDT:	SKIPE T,.JBDDT
	JRST (T)
	ERROR ^D43

;ROUTINE TO RETURN STRING OPERATION STRING ARGUMENTS.
;ARGUMENTS ARE CHARACTER ADDRESSES IN THE DATA BUFFER.
;TRANSFORMS M,N OR N, WHERE THE LATTER SPECIFIES A NUMBER OF LINES,
;TO ARGUMENTS.
;CALL	PUSHJ P,GETARG
;	RETURN WITH FIRST ARGUMENT ADDRESS IN C, SECOND IN B.



GETARG:	TRNE FF,ARG2		;IS THERE A SECOND ARGUMENT?
	JRST GETAG6		;YES

;N	SIGN INDICATES DIRECTION RELATIVE TO PT.
	TRON FF,ARG		;NO. IS THERE AN ARGUMENT?
	PUSHJ P,CHK22		;NO. B:=1 IS LAST ARGUMENT FUNCTION WAS +,*,OR /
				;B:=-1, IF &,#, OR -
				;IE, ASSUME AN ARGUMENT OF 1 AND RETAIN SIGN
	MOVE I,PT		;IN:=PT
GETAG4:	JUMPLE B,GETAG2		;WAS LAST ARGUMENT FUNCTION -?
	CAMN I,Z		;NO. ARGUMENT IS LOCATION OF NTH LINE
				;FEED FORWARD FROM PT.
				;IS PT AT END OF BUFFER?
	JRST GETAG1		;YES.
	PUSHJ P,GETINC		;NO. CH:=NEXT DATA BUFFER CHARACTER, IN:=IN+1
	CAIE CH,12		;LINE FEED?
	JRST GETAG4		;NO. TRY AGAIN.
	SOJG B,GETAG4		;YES. NTH LINE FEED?


GETAG1:	MOVE B,I		;YES. RETURN FIRST ARGUMENT IN C
	MOVE C,PT		;SECOND IN B.
	POPJ P,

;M,N
GETAG6:	ADD B,BEG		;C:=M+BEG
	ADD C,BEG		;B:=N+BEG
	POPJ P,

GETAG2:	SOS I			;ARGUMENT IS POSITION OF NTH LINE FEED TO LEFT OF PT.
				;N:=N-1
	CAMG I,BEG		;PASSED BEGINNING OF BUFFER?
	JRST GETAG3		;YES. IN:=BEG
	PUSHJ P,GETINC		;NO. CH:=NEXT DATA BUFFER CHARACTER. IN:=IN+1
	CAIE CH,12		;LINE FEED?
	SOJA I,GETAG2		;NO. BACK UP ONE POSITION AND TRY AGAIN.
	AOJLE B,.-1		;YES. NTH LINE FEED?

GETAG3:	CAMGE I,BEG		;YES. PASSED BEGINNING OF BUFFER?
	MOVE I,BEG		;YES. RESET TO BEGINNING.
	MOVE C,I		;NO. RETURN FIRST ARGUMENT IN C.
	MOVE B,PT		;SECOND IN B
	POPJ P,
;ROUTINE TO RETURN IN CH THE CHARACTER TO THE RIGHT OF THE POINTER
;AND INCREMENT THE POINTER.
;CALL	MOVE I,POINTER (AS A CHARACTER ADDRESS)
;	PUSHJ P,GETINC
;	RETURN WITH CHARACTER IN CH AND POINTER TO CHARACTER IN IN.

GETINC:	PUSHJ P,GET
	AOJA I,CPOPJ

GET:	MOVE TT,I
	IDIVI TT,5
	HLL TT,BTAB(TT1)
	LDB CH,TT
	POPJ P,

PUT:	MOVE TT,OU
	IDIVI TT,5
	HLL TT,BTAB(TT1)
	DPB CH,TT
	POPJ P,

;CHARACTER TRANSLATION BYTE POINTER TABLE
;TRANSLATES 1 CHARACTER POSITION TO THE RIGHT OF A CHARACTER ADDRESS POINTER

BTAB:	XWD 350700,0
	XWD 260700,0
	XWD 170700,0
	XWD 100700,0
	XWD 10700,0




TYOM:	PUSH P,C	;TYO TO MEMORY
	PUSH P,OU
	PUSH P,TT
	PUSH P,TT1
	PUSHJ P,TAB2
	POP P,TT1
	POP P,TT
	POP P,OU
	POP P,C
	POPJ P,

NROOM:	MOVEM 17,AC2+15	;SAVE 17
	MOVEI	17,NROOM9	;ANTICIPATE GARBAGE COLLECTION
	MOVEM	17,GCRET		;THIS THE EXIT DISPATCH
	MOVE 17,PT
	CAMN 17,Z		;PT=Z? I.E., DATA BUFFER EXPANSION?
	JRST NROOM1		;YES.
NROOM0:	MOVE 17,[XWD 2,AC2]	;NO. SAVE ACS 2 THROUGH 16.
	BLT 17,AC2+14
	JUMPL C,NROOM6		;DELETION?
	SETOM GCFLG		;NO.
	CLEARM CRREL
	CLEARM RREL

;MOVE STRING STORAGE UP C CHARACTERS STARTING AT PT.

NROOM9:	MOVE 17,Z
	ADD 17,C
	CAML 17,MEMSIZ	;WILL REQUEST OVERFLOW MEMORY?
	JRST GC			;YES. GARBAGE COLLECT.
;MOVE FROM PT THROUGH Z UP C POSITIONS
	MOVE 14,C		;NO.
	IDIVI 14,5		;AC14:=Q(REQ/5), AC15:=REM(REQ/5)
	IMULI 15,7		;AC15:=(REM(REQ/5))*7
	MOVN 13,15		;AC13:=-(REM(REQ/5))*7
	MOVEI 15,-43(15)	;AC15:=(REM(REQ/5))*7-43
	MOVE 11,PT
	IDIVI 11,5		;AC11:=Q(PT/5), AC12:=REM(PT/5)
	MOVNI 16,-5(12)
	IMULI 16,7		;AC16:=-(REM(PT/5)-5)*7
	DPB 16,[XWD 300600,NROOM2]	;SET SIZE FIELD OF LAST PARTIAL WORD POINTER.
	ADDI 14,1(11)		;AC14:=Q(REQ/5)+Q(PT/5)+1
	MOVE 16,Z
	IDIVI 16,5		;AC16:=Q(Z/5)
	MOVEI B,1(16)
	SUB B,11		;B:=Q(Z/5)+1-Q(PT/5)=NO. OF WORDS TO MOVE.
;PUT MOVE ROUTINE IN FAST ACS
	HRLI 11,200000+B+A*40	;AC11:=MOVE A,[Q(PT/5)](B)
	HRLOI 12,241000+A*40	;AC12:=ROT A,-1
	HRLI 13,245000+A*40	;AC13:=ROTC A,-(REM(REQ/5))*7
	HRLI 14,202000+B+AA*40	;AC14:=MOVEM AA,[Q(PT/5)+1](B)
	HRLI 15,245000+A*40	;AC15:=ROTC A,(REM(REQ/5))*7-43
	MOVE 17,[JRST,NROOM7]	;AC16:=SOJGE B,11
	MOVE 16,.+1		;AC17:=JRST NROOM7
	SOJGE B,11		;B:=B-1. DONE?
NROOM7:	ROTC A,43(13)		;YES. STORE LAST PARTIAL WORD.
	DPB A,NROOM2
	ADDM C,Z		;Z:=Z+REQ

NROOM5:	MOVE 17,[XWD 2,AC2]	;RESTORE ACS AND RETURN.
	MOVSS 17
	BLT 17,17
	POPJ P,


U NROOM2,1			;POINTER TO LAST PARTIAL WORD ON UPWARD MOVE.
;A CALL FOR A BUFFER EXPANSION, WHERE PT=Z. IF
;THERE IS NOT ENOUGH ROOM, PERFORM THE GARBAGE COLLECTION ROUTINE
;IF THERE IS STILL NO ROOM, GET THE NECESSARY CORE FROM THE 
;MONITOR TO SATISFY THIS REQUEST

NROOM1:	ADD	17,C		;TOTAL SPACE REQUIREMENT
	CAMG	17,MEMSIZ	;IS THERE ENOUGH?
	JRST	.+4		;YES, THEREFORE, UPDATE Z AND EXIT
	MOVEI	17,GCRETA	;EXIT DISPATCH FOR THE
	MOVEM	17,GCRET	;GARBAGE COLLECTION ROUTINE
	JRST	NROOM0		;GO DO THE GARBAGE COLLECTION
	ADDM	C,Z		;UPDATE Z, SIZE IS OK
	MOVE	17,AC2+15	;RESTORE AC#17
	POPJ	P,		;EXIT OUT


;NOT ENOUGH ROOM FOR THE EXPANSION, GARBAGE COLLECTION HAS BEEN
;PERFORMED, IF NEED BE, GRAB A K FROM THE MONITOR (OR MORE)

GCRETA:	MOVE	17,Z		;GET TOTAL SO FAR
	ADD	17,C		;ADD IN THE REQUEST
	CAML	17,MEMSIZ	;STILL IN NEED OF CORE?
	PUSHJ	P,GRABAK	;YES, GET THE REQUIRED CORE FROM THE MONITOR
	ADDM	C,Z		;UPDATE Z AND EXIT
	JRST	NROOM5		;RESTORE ALL AC'S AND RETURN TO SEQUENCE

U GCRET,1	;GC EXIT DISPATCH
;MOVE FROM PT+ABS(C) THROUGH Z DOWN ABS(C) POSITIONS
NROOM6:	MOVE 14,PT		;INITIALIZE PARTIAL WORD POINTER.
	IDIVI 14,5		;AC14:=Q(PT/5), AC15:=REM(PT/5)
	MOVEM 14,B		;B:=Q(PT/5)
	HRRM 14,NROOM4
	IMULI 15,7
	DPB 15,[XWD 300600,NROOM4]	;SIZE:=(REM(PT/5))*7
	MOVNI 15,-44(15)
	DPB 15,[XWD 360600,NROOM4]	;POSITION:=44-(REM(PT/5))*7
	MOVE 11,Z
	IDIVI 11,5		;AC11:=Q(Z/5)+1, AC12:=REM(Z/5)
	ADDI 11,1
	MOVE 13,C
	IDIVI 13,5
	ADDI 13,-1(11)		;AC13:=Q(Z/5)-Q(REQ/5)
	MOVNM 14,12		;AC12:=(REM(REQ/5))*7
	IMULI 12,7
	MOVNI 15,-43(12)	;AC15:=43-(REM(REQ/5))*7
	SUBI B,1(13)		;B:=Q(PT/5)+Q(REQ/5)-Q(Z/5)-1:=# WORDS TO MOVE

NROOM8:	HRLI 11,200000+B+AA*40	;AC11:=MOVE AA,[Q(Z/5)+1](B)
	HRLI 12,245000+A*40	;AC12:=ROTC A,(REM(REQ/5))*7
	HRLI 13,202000+B+A*40	;AC13:=MOVEM A,[Q(Z/5)-Q(REQ/5)](B)
	MOVE 14,[ADDM A,@13]	;AC14:=ADDM A,@13
	HRLI 15,245000+A*40	;AC15:=ROTC A,43-(REM(REQ/5))*7
	MOVE 17,[JRST NROOM3]	;AC16:=AOJLE B,11
	ADDM C,Z		;AC17:=JRST NROOM3
	LDB C,NROOM4
	MOVE A,@11		;Z:=C(Z)-REQ
	ROT A,-1		;A:=Q(PT/5)+Q(REQ/5) RIGHT JUSTIFIED.
	MOVE 16,.+1
	AOJLE B,11		;B:=B+1.  DONE?

NROOM3:	DPB C,NROOM4		;YES. DEPOSIT PARTIAL WORD.
	JRST NROOM5

U NROOM4,1			;PARTIAL WORD POINTER FOR DOWNWARD MOVE
GC:	AOSE GCFLG		;FIRST ATTEMPT?

GC1:	JRST	PRENR9		;TRY TO EXPAND MEMORY

	SETOM GCPTR		;YES. GCPTR:=-1
	CLEARM SYMS		;CLEAR SYMS,VALS AND CNTS TABLES
	MOVE T,[XWD SYMS,SYMS+1]
	BLT T,SYMEND-1
	MOVEI T,CPTR		;COMMAND BUFFER
	PUSHJ P,GCMA
	HRRZ T,P
	SUBI T,
	CAIL T,PDL		;PUSHDOWN LIST EMPTY?
	PUSHJ P,GCMA		;NO. GARBAGE COLLECT ALL BYTE POINTERS ON IT.
	CAILE T,PDL
	SOJA T,.-2
	HRRZ T,AC2+PF-2	;GARBAGE COLLECT Q-REG PUSHDOWN LIST.
	CAIL T,PFL
	PUSHJ P,GCM
	CAILE T,PFL
	SOJA T,.-2
	MOVE T,[XWD -44,QTAB]	;GARBAGE COLLECT Q-REGISTERS.
	PUSHJ P,GCM
	AOBJN T,.-1
	SKIPGE GCPTR		;ANYTHING TO COLLECT?
	JRST @ GCRET		;NOPE.

GCS:	MOVE I,QRBUF
GCS1A:	MOVSI TT,1*5		;TT>MAX. NO. CHARACTERS IN WORLD
	MOVE OU,GCPTR	;GO BACKWARDS THROUGH GCTAB
GCS1:	HRRZI A,GCTAB(OU)	;RELOCATE
	HRRZ A,@A
	ADD A,QRBUF
	CAMGE A,I
	JRST GCS2
	CAMGE A,TT		;SET TT TO HIGHEST CHARACTER POSITION
	MOVE TT,A
GCS2:	SOJGE OU,GCS1
	TRNN TT,-1		;ANYTHING TO COLLECT?
	JRST @ GCRET		;NOPE.
	MOVE F,TT		;HIGHEST CHARACTER.
	IDIVI I,5		;C(QRBUF)/5
	IDIVI F,5		;HIGH CHAR/5
	AOS I			;C(QRBUF)/5+1
	MOVS OU,F
	MOVE T,F
	SUB T,I		;HIGH CHAR/5-C(QRBUF)/5+1
	JUMPLE T,GCS4A		;ANYTHING TO GET?
	HRR OU,I		;XWD HIGH CH/5,HIGH CH/5-C(QRBUF)/5+1=NREG
	MOVE B,Z
	IDIVI B,5
	SUB B,T			;Z/5-NREG
	HRLI B,0
	BLT OU,@B		;MOVE STUFF DOWN
	MOVNS OU,T
	IMULI OU,5		;OUT:=-5*NREG
	ADDM OU,BEG		;BEG:=C(BEG)-5*NREG
	ADDM OU,PT		;PT:=C(PT)-5*NREG
	ADDM OU,Z		;Z:=C(Z)-5*NREG
	ADDM OU,RREL	;RREL:=C(RREL)-5*NREG
	MOVE CH,GCPTR	;UPDATE INSERTER
GCS3:	HRRZI TT1,GCTAB(CH)
	HRRZ A,@TT1
	ADD A,QRBUF
	CAMGE A,TT
	JRST GCS4
	ADDM OU,@TT1
	HLRZ A,@TT1
	CAIN A,CPTR		;IN COMMAND BUFFER?
	ADDM OU,CRREL	;YES. UPDATE COMMAND POINTER RELOCATION
	HRLI A,0
	SKIPL @A		;Q-REG?
	ADDM T,@A		;NO
	SKIPGE @A		;Q-REG?
	ADDM OU,@A		;YES. RELOCATE BASE POINTER.

GCS4:	SOJGE CH,GCS3		;DONE?
	ADD TT,OU		;YES. IN:=C(TT)-5*NREG

GCS4A:	MOVE I,TT		;I SHOULD POINT TO AN END OF STRING FLAG (141)
	PUSHJ P,GETINC
	CAIE CH,141

GCERR:	TYPR1 XXTY02		;STRANGE LOSS

	PUSHJ P,GETINC
	MOVE A,CH
	PUSHJ P,GETINC
	ROT CH,7
	IOR A,CH
	ADDI I,-3(A)
	JRST GCS1A

GCM:	MOVE I,(T)
	TLZE I,400000		;DOES Q-REG CONTAIN TEXT?
	TLZE I,377777
	POPJ P,			;NO
	ADD I,QRBUF		;YES. ENTER POINTER IN GCTAB

GCM2:	CAML I,BEG		;REGION BEFORE TEXT BUFFER?
	POPJ P,			;NO. FORGET IT.
	PUSHJ P,GET		;YES. CHECK FOR MARK.
	CAIE CH,141		;END OF STRING?
	POPJ P,			;NO.
	SUB I,QRBUF		;YES. IN:=# CHARACTERS TO RETREIVE.
				; IN Q-REG BUFFER AREA?
	JUMPL I,CPOPJ		;NO. FORGET IT.
	AOS TT,GCPTR		;YES. TO BE GRABBED.
	CAIL TT,GCTBL		;AM I WINNING?
	JRST GCERR		;NO. VERY BAD.
	HRL I,T		;XWD ADDRESS OF BYTE POINTER,NO. CHARACTERS
	ADDI TT,GCTAB		;RELOCATE
	HRLI TT,0
	MOVEM I,@TT		;SAVE DATA
	POPJ P,			;DONE THIS POINTER

;IF T POINTS TO AN ASCII BYTE POINTER, IN:=CHARACTER ADDRESS OF TOP
;OF STRING - NO. OF CHARACTERS.
GCMA:	HRRZ TT1,T
	LDB TT,[XWD 221420,TT1]	;BYTE SIZE + XR
	TRC TT,700		;DOES T POINT TO A TEXT BYTE POINTER?
	TRCE TT,700
	POPJ P,			;NO
	SOS TT1
	MOVE I,@TT1		;MAYBE. GET WORD BEFORE POINTER. (MAX)
	ADDI TT1,2
	SUB I,@TT1		;MAX-CT
	SOS TT1
	LDB TT,[XWD 360620,TT1]	;BYTE POSITION
	IDIVI TT,7		;NO. OF CHARACTERS
	MOVEI TT1,4-3+1		;2
	SUB TT1,TT		;2-NO. OF CHARACTERS
	HRRZ TT,(T)		;POINTER WORD ADDRESS (UNRELOCATED)
	IMULI TT,5		;5*ADDRESS
	ADD TT,TT1
	SUBM TT,I		;5*ADDRESS-NO. CHARS+2+MAX-CT
	JRST GCM2



;**********AUTOMATIC MEMORY EXPANSION*********

;MEMORY WILL BE EXPANDED UNDER ONE OF THESE CONDITIONS.

;	1.AN INTERNAL BUFFER EXPANSION CANNOT BE PERFORMED,
;	  TO DO SO WOULD OVERFLOW THE PRESENT MEMORY
;	  CAPACITY. THE INTERNAL OPERATIONS WHICH DESCOVER
;	  THE NEED FOR EXPANSION ARE:

;	  A.COMMAND BUFFER EXPANDING
;	  B.THE Q-REG GET (GI)
;	  C.THE Q-REG LOAD (NXI)
;	  D.ANY OF THE INSERTS
;	  E.COMMAND ACCEPTANCE ROUTINE


;	2.THE DATA BUFFER WILL BE MAINTAINED AT A MINIMUM
;	  NUMBER OF 5000 CHARACTERS BEFORE NEW DATA IS LOADED
;	  FROM AN INPUT DEVICE OTHER THAN THE CONSOLE. Q-REG
;	  USAGE SHORTENS THE NUMBER OF AVAILABLE CHARACTERS
;	  DIRECTLY, AND NORMAL TECO COMMANDS ARE GREATLY IMPARED
;	  OTHERWISE.


;SAVE THE ACCUMULATORS


GRABAK:	TLOA FF,GKTLKF	;TALKATIVE GRAB
GRABKQ:	TLZ FF,GKTLKF	;GRAB A K QUIETLY
	MOVEM	CH,SAV16	;TO SAVE THE ACCUMULATORS
	MOVEI	CH,SAVE		;WHILE WE SCOOT ALL OVER THE
	BLT	CH,SAV16-1	;THE PLACE
;COUNT THE NUMBER OF BLOCKS NEEDED TO FILL THE REQUEST

	MOVEI	F,^D1024	;1 BLOCK OF CORE
	MOVEI	B,1		;WE WILL NEED AT LEAST ONE BLOCK
	ADDM	F,.JBFF		;UP THE FIRST FREE COUNT
	PUSHJ	P,CRE23		;COMPUTE A NEW MEMSIZ AND 2/3 VALUE
	CAML	17,MEMSIZ	;WILL THIS BE ENOUGH CORE?
	AOJA	B,.-3		;NO, COMPUTE ANOTHER BLOCK
;NUMBER OF BLOCKS HAVE BEEN FOUND
;OBTAIN THE NEEDED CORE FROM THE MONITOR

	MOVE	B,.JBFF		;TO HELP OUT THE MONITOR
	CALLI	B,CORE		;MAKE THE CALL TO THE MONITOR
	JRST	NOTANY		;NO CORE (OR NOT ENOUGH) AVAILABLE
	TLNN FF,GKTLKF		;MESSAGE DESIRABLE?
	JRST EXITZ	;NO
	MOVEI CH,"["
	PUSHJ P,TYO
	MOVEI A,TYO
	HRRM A,LISTF5	;SET OUTPUT TO TTY
	MOVE B,.JBREL	;SIZE OF CORE NOW
	ADDI B,1
	ASH B,-12
	PUSHJ P,DPT
	JSP A,CONMES
	ASCIZ / K CORE]
/

;RESTORE THE AC'S AND EXIT FROM THIS COR GET ROUTINE

EXITZ:	MOVSI	CH,SAVE		;FROM TO
	BLT	CH,CH		;ALL AC'S AS THEY WERE
	POPJ	P,0		;AND EXIT

;NO CORE AVAILABLE (OR NOT ENOUGH)

NOTANY:	JSP	A,CONMES	;INFORM THE OUTSIDE WORLD THAT THEY LOOSE
	ASCIZ	/STORAGE CAPACITY EXCEEDED
/
	HLRZ	A,.JBSA		;GET LAST FIGURE OF CORE BOUND
	MOVEM	A,.JBFF		;AND STORE IT
	PUSHJ	P,CRE23		;COMPUTE THE MEMSIZE VALUES AGAIN
	MOVSI	CH,SAVE		;RESTORE THE ACCUMULATORS AS THEY WERE
	BLT	CH,CH		;BEFORE THE ERROR EXIT
	ERROR ^D44	;TYPE THE ? MARK

;THIS IS AN AUXILARY SPOT FOR ENTRANCE FROM GC2
;GET THE REQUIRED CORE TO SAVE THE .JB IF POSSIBLE

PRENR9:	PUSHJ	P,GRABAK	;GET THE REQUIRED CORE
	JRST	NROOM9		;GO TRY THE INSERT AGAIN
	U QEDCNT,1		;QED MOD ******************
	U QED,1			;QED MOD *****************
	U QED1,1		;QED MOD *****************
	U QEDT,1		;QED MOD ***************
	U QCCFLG,1		;QED MOD ****************
	U Q1,1			;QED MOD ******************
	U QI,1			;QED MOD ********************
	U QZ,1			;QED MOD *******************
	U SQPT,1
U BEG,1
U PT,1
U Z,1
U QRBUF,1
;*** DO NOT SEPARATE ***
U COMAX,1
U CPTR,1
U COMCNT,1
;*** DO NOT SEPARATE ***
U CBUFH,1
U MEMSIZ,1
U GCPTR,1
U CRREL,1
U GCFLG,1
U RREL,1


;CORRECT FOR 2/3 BUFFER FILLING ERROR.M23 IS 2/3'S AND M23PL IS 2/3
;PLUS THE OTHER THIRD-128 CHARACTERS.

U M23,1
U M23PL,1
;COMMAND DISPATCH TABLE
;DISPATCH IS BY XCT DTB(CH)
;FORMAT:
;	MOVEI A,X	;IF X RETURNS A VALUE
;	HRROI A,X	;IF X DOES NOT RETURN A VALUE AND EXITS WITH POPJ
;	JRST X		;IF X DOES NOT RETURN A VALUE AND EXITS TO A
;			;FIXED LOCATION.

DTB:	
	HRROI A,ERRA	;^@
	HRROI A,COMMENT	;^A
	HRROI A,QEDIN		;QED MOD **************
	HRROI A,QEDOUT		;QED MOD ****************
	MOVEI A,CALDDT	;^D
	MOVEI A,FFEED	;^E
	MOVEI A,LAT	;^F
	MOVEI A,DECDMP	;^G
	MOVEI A,GTIME	;^H
	HRROI A,TAB	;^I
	MOVEI A,CD	;^J
	HRROI A,ERRA	;^K
	HRROI A,TYO	;^L
	MOVEI A,CD	;^M
	HRROI A,ERRA	;^N
	HRROI A,QEDTYP		;QED MOD ***************
	HRROI A,ERRA	;^P
	HRROI A,ERRA	;^Q
	HRROI A,ERRA	;^R
	HRROI A,ERRA	;^S
	MOVEI A,SPTYI	;^T
	HRROI A,ERRA	;^U
	HRROI A,ERRA	;^V
	HRROI A,ERRA	;^W
	HRROI A,ERRA	;^X
	HRROI A,ERRA	;^Y
	HRROI A,ERRA	;^Z
	HRROI A,ERRA	;^[
	HRROI A,ERRA	;^BACKSLASH
	HRROI A,ERRA	;^]
	MOVEI A,CNTRUP	;^^
	HRROI A,ERRA	;^LEFT ARROW


	MOVEI A,CD2	;SPACE
	MOVEI A,EXCLAM	;!
	MOVEI A,DQUOTE	;"
	MOVEI A,COR	;#
	HRROI A,ERRA	;$
	MOVEI A,PCNT	;%
	MOVEI A,CAND	;&
	MOVEI A,CD	;SINGLE QUOTE
	MOVEI A,OPEN	;(
	MOVEI A,CLOSE	;)
	MOVEI A,TIMES	;*
	MOVEI A,CD2	;+
	MOVEI A,COMMA	;,
	MOVEI A,MINUS	;-
	MOVEI A,PNT	;.
	MOVEI A,SLASH	;/
	JRST CDNUM	;0
	JRST CDNUM	;1
	JRST CDNUM	;2
	JRST CDNUM	;3
	JRST CDNUM	;4
	JRST CDNUM	;5
	JRST CDNUM	;6
	JRST CDNUM	;7
	JRST CDNUM	;8
	JRST CDNUM	;9
	MOVEI A,COLON	;:
	MOVEI A,SEMICL	;;
	MOVEI A,LSSTH	;<
	HRROI A,PRNT	;=
	MOVEI A,GRTH	;>
	MOVEI A,QUESTN	;?

	MOVEI A,ATSIGN	;@
	JRST	ACMD	;A
	MOVEI A,BEGIN	;B
	MOVEI A,CHARAC	;C
	MOVEI A,DELETE	;D
	HRROI A,ECMD	;E
	JRST RET	;F
	MOVEI A,QGET	;G
	MOVEI A,HOLE	;H
	HRROI A,INSERT	;I
	MOVEI A,JMP	;J
	MOVEI A,KILL	;K
	MOVEI A,LINE	;L
	JRST MAC	;M
	MOVEI A,SERCHP	;N
	MOVEI A,OG	;O
	HRROI A,PUNCH	;P
	MOVEI A,QREG	;Q
	MOVEI A,REVERS	;R
	MOVEI A,SERCH	;S
	HRROI A,TYPE	;T
	MOVEI A,USE	;U
	HRROI A,ERRA	;V
	MOVEI A,CD	;W
	MOVEI A,X	;X
	HRROI A,YANK	;Y
	MOVEI A,END1	;Z
	MOVEI A,OPENB	;[
	MOVEI A,BAKSL	;BACKSLASH
	MOVEI A,CLOSEB	;]
	MOVEI A,UAR	;^
	MOVEI A,LARR	;LEFT ARROW
;137-1  175 THESE THE LITTLE CHARACTERS ON THE MODEL 37

	MOVEI	A,CD	;IGNORE "LC AT"
	JRST	ACMD	;A
	MOVEI A,BEGIN	;B
	MOVEI A,CHARAC	;C
	MOVEI A,DELETE	;D
	HRROI A,ECMD	;E
	JRST RET	;F
	MOVEI A,QGET	;G
	MOVEI A,HOLE	;H
	HRROI A,INSERT	;I
	MOVEI A,JMP	;J
	MOVEI A,KILL	;K
	MOVEI A,LINE	;L
	JRST MAC	;M
	MOVEI A,SERCHP	;N
	MOVEI A,OG	;O
	HRROI A,PUNCH	;P
	MOVEI A,QREG	;Q
	MOVEI A,REVERS	;R
	MOVEI A,SERCH	;S
	HRROI A,TYPE	;T
	MOVEI A,USE	;U
	HRROI A,ERRA	;V
	MOVEI A,CD	;W
	MOVEI A,X	;X
	HRROI A,YANK	;Y
	MOVEI A,END1	;Z
	MOVEI A,OPENB	;[
	MOVEI A,BAKSL	;BACKSLASH
	MOVEI A,ALTMOD	;ALT MODE
	HRROI A,ERRA
	HRROI A,ERRA
U STAB,0		;SEARCH TABLE
			;SERCH4+2,OGNF+4,OGNF+6,OGFN+11
U AC2,16		;SAVE AC2-AC17 IN NROOM ROUTINE
			;NROOM,NROOM5
U BAKTAB,40-3-16	;RECEIVES ASCII CONVERSION OF NUMERICAL ARGUMENT
			;BAKSL4

CFIL1=STAB
CFIL2=STAB+1
U STABP,0
U SYMS,22		;LIS+4(0),OG3+1,GC+3(0)
U VALS,22		;LIS+4(0),OG3+3,GC+3(0)
U CNTS,22		;LIS+4(0),OG3+2,GC+3(0)
U SYMEND,0
U PFL,LPF
U GCTAB,GCTBL		;GCS3+4,GCM2+13
U QTAB,45		;Q-REGISTER TABLE
			;USEA+1,PCNT+1
U PDL,LPDL
U UAC,17
PATCH:	BLOCK 10

;HERE IS STORED THE AC'S FOR THE SAVE ROUTINE

U SAVE,16
U SAV16,1
U SAV17,1

LIT
U CBUF,0
U TOP,0

ZZZZZZ:	END STARTA