Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - utilities/teco.mid
There is 1 other file named teco.mid in the archive. Click here to see a list.
.SYMTAB 6000.,3000.	;-*-MIDAS-*-
TITLE TECO

.DECSAV

;ACCUMULATOR ASSIGNMENTS

FF=0		;CONTROL FLAGS
A=1		;MUST BE 1 FOR ERRMES, CONMES
AA=A+1		;BYTE POINTER TO COMMAND BUFFER
B=A+2		;COMMAND BUFFER END ADDRESS
E=B+1		;B MUST BE LESS THAN 11
C=5
D=6
PF=7
F=10
T=11
TT=12
TT1=TT+1
I=14
OU=I+1
CH=16
P=17

CALL=PUSHJ P,
RET=POPJ P,

;PAGES USED FOR WINDOWS TO INPUT AND OUTPUT DISK FILE

IBFPG==4
IBFPGA==<IBFPG>_9.
OBFPG==IBFPG+1
OBFPGA==<OBFPG>_9.
PROGPG==OBFPG+1
PROGRM==<PROGPG>_9.
;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
RUBCF==400	;RUBOUT IN OUTPUT TO FILE
FINDR==2000	;LEFT ARROW SEARCH
RPLFG==4000	;IN REPLACE COMMAND
NOTF==10000	;^N SEARCH MODIFIER
TRACEF==20000	;? SEEN
FSRCDF==100000	;FAST SEARCH DEFEAT
NFSRCF==200000	;FAST SEARCH NOT REQUESTED
FORM==400000	;FORM FEED TERMINATED LAST Y OR A

;LEFT HALF

FINF==100	;INPUT CLOSED BY EOF
UREAD==200	;INPUT FILE IS OPEN
UWRITE==400	;OUTPUT FILE IS OPEN
CISRCH==400000	;CASE INDEPENDENT SEARCH MODE

CISEQ=20_27.		;CASE INDEPENDENT SEARCH UUO'S
CISNE=24_27.		;EXACT OPCODES ARE CRITICAL!!!
ERROR1=30_27.
ERROR=31_27.

EOL=^_		;END OF LINE CHARACTER

;PARAMETERS

NFILNM==10		;LENGTH OF FILENAME BUFFER FOR E COMMANDS
LPDL==1200	;LENGTH OF MAIN PDL
GCTBL==200	;MAX NUMB OF STRINGS SAVED DURING A GC
LPF==600	;LENGTH OF Q-REG PDL
STABL==110	;LENGTH OF SEARCH TABLE
CBUF==20000	;MAIN CHARACTER BUFFER

CCLJFN=140	;JFN OF FILE FOR ;Y IN CCL MODE
INITF=141	;TECO IS INITIALIZING
MATFLG=142	;Q-REG @ HAS NEW CONTENTS
SAVP=143	;SAVED P
SAVPF=144	;SAVED PF
EOLF=145	;WHETHER THE BUFFER CONTAINS EOLS
FIRSTV==<ZZ==146>;FIRST VARIABLE TO GET CLEARED

DEFINE U A,B
 A=ZZ
 ZZ==ZZ+B
TERMIN
;ENTRY VECTOR

	LOC PROGRM

EVEC:	JRST TECO
	JRST REE
	JRST CCL
	JRST INFO
EVECL==.-EVEC
DEFSYM:	0		;SAVED SYMBOL POINTER
UDFSYM:	0		;AND UNDEFINED TABLE
VERSN:	0		;PUT VERSION NUMBER IN EASY TO FIND PLACE
PATVER:	0		;MAKE NON-ZERO IF PATCHED TECO
CRDATE:	0		;ASSEMBLY DATE
	BEG		;POINTER TO CELL WITH CHR ADDR OF BUFFER BEG
	Z Z		;AND END.
TENEXP:	0		;NON-ZERO IF TENEX
;TO BE EXECUTED TO CREATE THE SHARE FILE
; 116 IS TO BE CLEARED IF SAVE FILE IS NOT TO INCLUDE SYMBOLS

PRESHR:	SKIPGE 1,116		;IF SYMS EXIST,
	 SKIPE DEFSYM		;AND NOT ALREADY SAVED...
	  JRST PRESH1
	MOVEM 1,DEFSYM		;COPY POINTERS
	MOVE 1,117
	MOVEM 1,UDFSYM
PRESH1:	MOVEI 1,400000		;THIS FORK
	MOVE 2,[EVECL,,EVEC]
	SEVEC			;SET ENTRY VECTOR
	MOVE 1,[SIXBIT/LOADTB/]
	SYSGT
	MOVEM 2,TENEXP		; TENEXP becomes non-zero if Tenex
	SKIPE VERSN		; has a version been defined already?
	 JRST PRESH2		; yup, don't use source version
	MOVSI 1,(1_33.\1_18.)	; old, short string
	HRROI 2,[ASCIZ/TECO.MID/]
	GTJFN			; try for the source version
	 JRST PRESH2		; oh well.
	MOVE 2,[1,,7]		; get FDBVER
	MOVEI 3,3		; to AC 3
	GTFDB			; yum yum
	RLJFN			; give JFN back
	 JFCL			; ungrateful monitor!
	HLRZM 3,VERSN		; groovy, set version from source
PRESH2:	MOVSI 1,(1_33.\1_18.)	;OLD, SHORT, STRING
	SKIPE TENEXP
	 SKIPA 2,[-1,,[ASCIZ/<SUBSYS>TECO.SAV/]]
	  HRROI 2,[ASCIZ /<SUBSYS>TECO.EXE/]
	GTJFN
	 JRST PRESH3		;NONE, CANNOT SET PATCH VERSION
	MOVE 2,[1,,7]		;GET FDBVER
	MOVEI 3,3		;TO 3
	GTFDB
	RLJFN
	 JFCL
	HLRZS 3			;GET ACTUAL FILE VERSION NUMBER
	IDIVI 3,100.		;SEPARATE INTO VERSN AND PATVER
	ADDI 4,1
	CAMN 3,VERSN		;MAKING NEW VERSION OF SAME OLD PROGRAM?
	 MOVEM 4,PATVER		;YES, SAVE INCREMENTED PATVER
PRESH3:	GTAD
	MOVEM 1,CRDATE		;AND CREATION DATE, THIS ASSEMBLY
	MOVE 1,VERSN
	IMULI 1,100.
	ADD 1,PATVER		;DEFAULT VERSION NUMBER FOR FILE
	HRLI 1,(1_35.+1_18.)	;WRITING+SHORT FORM
	SKIPE TENEXP
	 SKIPA 2,[-1,,[ASCIZ/TECO.SAV/]]
	  HRROI 2,[ASCIZ/TECO.EXE/]
	GTJFN
	 JRST 4,.
	HRLI 1,400000		;THIS FORK
PRESH4:	HLRE 2,DEFSYM		;NEG. LENGTH OF SYMS
	MOVNS 2
	ADD 2,DEFSYM		; 1+TOP OF TABLE
	SUBI 2,EVEC-777+1	;NUMBER OF PAGES USED (WITH ROUNDING)
	LSH 2,-9.
	ANDI 2,777		;LEAVE JUST NUMBER OF PAGES
	MOVNS 2
	HRLZS 2			;IN PLACE FOR SSAVE
	MOVEI 3,EVEC
	LSH 3,-9.		;FIRST PAGE NUMBER
	HRRI 2,120000(3)	;WITH READ AND EXECUTE BITS
	SSAVE			;SHARE SAVE
	HALTF
;INFO ENTRY -- RETURN INFORMATION

INFO:	MOVEI 1,1		;CODE  1: BUFFER CONTAINS EOLS
	SKIPN EOLF		;CODE  2: BUFFER HAS CRLFS
	 MOVEI 1,2
	MOVE 2,BEG
	MOVE 3,Z
	HALTF
	JRST INFO

;CCL ENTRY.  AC1 HAS JFN TO DO ;Y ON.
CCL:	MOVEM 1,CCLJFN
	JRST TECO1
;STARTUP TIME INITIALIZATION - SUPPORTS TOPS-20 EXEC HAIR

TECO:	RESET
	SKIPE TENEXP		;ONLY FOR TOPS-20
	 JRST TECO0
	SETZ 1,			;GET RSCAN BUFFER
	RSCAN
	 JRST TECO0
	JUMPE 1,TECO0
	PBIN			;FIGURE OUT WHAT COMMAND IS
	CAIN 1,^J		;THIS SHOULDN'T EVER HAPPEN, BUT...
	 JRST TECO0
	CAIE 1,"E		;EDIT?
	 CAIN 1,"e
	  JRST TECO00		;DEFINITE WINNER
	CAIE 1,"C		;MAYBE CREATE?
	 CAIN 1,"c
	  JRST TECO01		;MAYBE...
TECO02:	PBIN			;CLEARLY A LOSER.  FLUSH COMMAND STRING
	CAIE 1,^J
	 JRST TECO02
	JRST TECO0

TECO01:	PBIN
	CAIN 1,^J		;DEFINITE LOSS?
	 JRST TECO0
	CAIE 1,"R		;LOOK LIKE CREATE?
	 CAIN 1,"r
	  JRST TECO00		;LOOKS GOOD, TAKE IT
	JRST TECO02

TECO00:	PBIN			;HUNT FOR SPACE - GET AN INPUT BYTE
	CAIN 1,^J		;END OF THE LINE?
	 JRST TECO0		;(A BAD, BUT NOT COMPLETELY INAPPROPRIATE, PUN)
	CAIE 1,<" >		;FOUND THE SPACE YET?
	 JRST TECO00		;NO, KEEP ON TRYING
	MOVSI 1,3		;SHORT FORM, FILENAME FROM TERMINAL
	MOVE 2,[100,,377777]	;NO OUTPUT
	GTJFN
	 JRST TECO0		;FAILED SOMEHOW
	HRRZM 1,CCLJFN
	MOVEI 1,100		;GET BREAK CHARACTER
	BKJFN			;SUCH CROCKISHNESS
	 JFCL			;???
	PBIN
	CAIE 1,^J		;LINE FEED YET?
	 JRST .-2
	JRST TECO1
; NON-CCL ENTRY

TECO0:	SETOM CCLJFN
	MOVEI 1,100
	SKIPE VERSN		; meaningless version?
	 SIBE			;ANYTHING TYPED AHEAD?
	  JRST TECO1		;YES, SKIP HEARLD
	MOVEI 1,101
	HRROI 2,[ASCIZ /TECO./]
	SETZ 3,
	SOUT
	MOVE 2,VERSN		;MAJOR VERSION NUMBER
	MOVEI 3,10.
	NOUT
	 JFCL
	SKIPN PATVER
	 JRST TECO1
	MOVEI 2,".
	BOUT
	MOVE 2,PATVER
	NOUT
	 JFCL
TECO1:	SETOM INITF		;SAY WE ARE STARTING
	SKIPGE MATFLG		;WAS THIS TECO SAVED WITH SOMETHING IN @
	 JRST GOX		;YES, DON'T CHANGE TECO'S STATE
	MOVE A,[FIRSTV,,FIRSTV+1]
	SETZM -1(A)		;CLEAR VARIABLES AREA
	BLT A,TOP		;NOT INCLUDING CCLJFN, MATFLG
	MOVE A,[JSYS [UUOHX,,UUOH]]
	MOVEM A,41
	SKIPE A,DEFSYM
	 MOVEM A,116		;JOBSYM
	SKIPE A,UDFSYM
	 MOVEM A,117		;JOBUSY
 	MOVE P,[-LPDL,,PDL-1]
	SETZM SFINDF
	MOVSI A,(RET)
	MOVEM A,TRACS	
	SETZM COMBUF		;SAY NO DEFAULT COMMENT STRING FOR ;D
	MOVEI A,CBUF+200	;ADR OF TEXT BUFFER
	IMULI A,5		;CHR ADDR OF BEGINNING
	MOVEM A,BEG	
	MOVEM A,PT
	MOVEM A,Z
	MOVEM A,QRBUF	
	MOVEI A,CBUF+77
	MOVEM A,CBUFH		
	MOVEI A,CBUF
	MOVEM A,LSTCB
	MOVEM A,LSTCE
	MOVEI A,SYL
	MOVEM A,DLIM	
	MOVE A,[10014,,-1]
	MOVEM A,NROOM2	
	MOVE A,[JRST CNTRS2]
	MOVEM A,CNTRS1+1
	SETZM PREV.F		;CANCEL DEFAULT FOR S$
	SETZM EOLF		;(DEFAULT) SAY BUFFER SHOULD HAVE CRLF'S
	MOVSI FF,CISRCH		; initialize flag register(just with
				; winning case searches)
	JRST GOX
REE:	SETOM CCLJFN		;REENTER POINT FROM EXEC
	SETZM INITF		;DONT CONSIDER DOING AN M@
GOX:	CALL CRR		;TYPE CR LF
	MOVEI 1,400000		;THIS FORK
	GPJFN
	HRRZS 2			;LOOK AT OUTJFN
	SETZ 3,
	CAIE 2,-1		;NOT REDIRECTED. GUESS TERM TYPE
	 JRST GOX5		;REDIRECTED, USE 0 FOR CONHFG
	MOVEI 1,101
	GTTYP
	CAIG 2,24.
	 MOVE 3,(2)[	0	; 0 TTY 33
			1	; 1 TTY 35
			1	; 2 TTY 37
			1	; 3 TI noisy
			2	; 4 ADM-3
			2	; 5 Datamedia
			2	; 6 HP 2645
			2	; 7 Hazeltine
			0	; 8 Terminet
			1	; 9 NVT
			2	;10 VT05
			2	;11 VT50
			1	;12 LA30
			2	;13 GT40
			1	;14 LA36
			2	;15 VT52
			2	;16 VT100
			1	;17 LA38
			1	;18 LA120
			1	;19 TTY 43
			2	;20 TEC
			2	;21 new Hazeltine
			2	;22 Teleray
			0	;23 Tektronix
			2]	;24 Ann Arbor
GOX5:	MOVEM 3,CONHFG		;SIMULATE A N^H$
	MOVEI 1,400000		;SETUP INTERRUPT STUFF FOR THIS FORK
	CIS
	MOVE 2,[LEVT,,CHNT]
	SIR
	MOVE 2,[1_35.\1_24.]
	AIC
	EIR
	MOVSI 1,7.		;bell
	ATI			;ASSIGN TO CHN 0
GO:	SETZM ABORTF		;CLEAR INTERRUPT FLAGS
	SETZM LISNF
	MOVEI 1,100		;ESTABLISH TTY MODES
	RFMOD			;READ EXISTING TTY MODES
	ANDCMI 2,17_12.+3_10.+17_6. ;WE WILL SPECIFY THESE BITS
	IORI 2,14_12.+2_10.+1_6.;AND LEAVE THE OTHERS THE SAME
	SFMOD
;			@ A B C D E F G H I J K L M N O P Q
	MOVE 2,[.BYTE 2?1?0?1?1?1?1?1?1?0?2?0?1?1?2?1?1?1?0]
;			R S T U V W X Y Z [ \ ] ^ _
	MOVE 3,[.BYTE 2?0?1?1?0?0?0?1?1?1?3?1?1?1?2]
	SFCOC
	MOVE P,SAVP		;GET OLD STACKS INCASE WE DO M@
	MOVE PF,SAVPF		;...
	SETZM LFFLG		;SAY NO SAVED LINE FEED FOR TYI
GO1:	SKIPGE INITF		;IF INITIALIZING, AND
	 SKIPL MATFLG		;ARE GOING TO DO AUTO M@,..
	  SKIPA
	   JRST CRST		;SKIP REST OF INITIALIZATION
	SETZM LEV
	MOVE PF,[-LPF,,PFL-1]
	MOVE P,[-LPDL,,PDL-1]	;INITIALIZE PUSHDOWN LIST
	MOVE T,[JRST SKPSEP]	;INITIALIZE CONTROL S DISPATCH
	MOVEM T,CNTRS1
	TRZ FF,777777-TRACEF-FORM
	JRST CLIS
;INTERRUPT HANDLING ROUTINES

TTYINT:	MOVEM 7,IAC+7		;TTY, I.E. BELL
	MOVEI 7,IAC
	BLT 7,IAC+6		;SAVE AC'S
	MOVEM 17,IAC17		;MIGHT HAVE COME OUT OF NROOM
	MOVE 17,[-10,,INTSK-1]	;GET LOCAL STACK
	MOVEI 1,101
	CFOBF			;CLEAR OUTPUT BUFFER ALWAYS
	CALL AWAKEN		;SO WE CAN TELL IF 2 BELLS IN A ROW
	SETZM INITF		;DON'T TRY TO DO AUTO M@
	SKIPN LISNF		;DOING COMMAND INPUT?
	 JRST TTYI1		;NO
	SKIPE ABORTF		;YES, FIRST INTERRUPT?
	 JRST [	MOVEI 1,CRST	;NO, RETURN SO AS TO FLUSH INPUT
		MOVEM 1,INTP3
		MOVEI 1,100
		CFIBF
		JRST IOER1]
	AOS ABORTF		;NOTE INTERRUPT REQUEST
	CALL DING
TTYI0:	MOVEI 1,100
	SIBE
	 CAIA			;NUMBER OF CHARACTERS OF UNSEEN
	  MOVEI 2,0		;TTY: INPUT IN 2
	MOVEM 2,TTYCNT		;LOOKED AT AT LI3 ...
	JRST IOER1		;RETURN

U TTYCNT,1

TTYI1:	MOVEI 1,100
	CFIBF			;CLEAR INPUT BUFFER
	SKIPE ABORTF		;FIRST REQUEST?
	 JRST TTYI2		;NO, STOP IMMEDIATELY
	AOS ABORTF		;YES, NOTE REQUEST
	JRST IOER1		;DEBREAK

ABORT:	HRROI 1,[ASCIZ /
^G Abort
/]				;WHEN COMMAND DECODED NOTICES REQUEST
	PSOUT
	JRST GO

TYOQT:	MOVEI 1,101		;QUIT FROM TYPEOUT, CLEAR OUTPUT BUFFER
	CFOBF
	CALL DING
	CALL CRR
	CALL CRR
	JRST GO

;IMMEDIATE STOP

TTYI2:	MOVEI 1,400000
	CIS
	JRST GO
;IO ERROR INTERRUPT

IOERR:	MOVEM 7,IAC+7		;SAVE AC'S
	MOVEI 7,IAC
	BLT 7,IAC+6
	MOVEM 17,IAC17
	MOVE 17,[-10,,INTSK-1]
	HRROI 1,[ASCIZ \
I/O data error, \]
	PSOUT
	MOVE 2,IAC+1		;ASSUME JFN IN 1
	CAMN 2,INJFN		;THE INPUT ONE?
	 JRST IOERI		;YES
	CAMN 2,OUTJFN		;THE OUTPUT ONE?
	 JRST IOERO		;YES
	HRROI 1,[ASCIZ /in random file
/]
	PSOUT
IOER1:	MOVSI 7,IAC		;RESTORE AC'S
	BLT 7,7
	MOVE 17,IAC17		;RESTORE 17
	DEBRK

IOERI:	HRROI 1,[ASCIZ /in input file /]
IOER2:	PSOUT
	MOVEI 1,101
	SETZ 3,
	JFNS			;TYPE FULL NAME OF FILE
	CALL CRR
	AOS ABORTF		;REQUEST ABORT
	JRST IOER1

IOERO:	HRROI 1,[ASCIZ /in output file /]
	JRST IOER2
;INTERRUPT TABLES

LEVT:	INTP1
	INTP2
	INTP3

CHNT:	3,,TTYINT		;TTY RUBOUT
	REPEAT 10.,0
	3,,IOERR		;CHANNEL 11, IO ERROR
	REPEAT 24.,0

U INTP1,1			;INTERRUPT PC'S
U INTP2,1
U INTP3,1

U IAC,10			;INTERRUPT AC'S
U IAC17,1

U INTSK,10			;INTERRUPT ROUTINE PDL

U ABORTF,1			;ABORT REQUESTED IF NOT 0
U LISNF,1			;DOING COMMAND INPUT IF NOT 0
;ROUTINE TO RETURN NON-NULL TTY CHARACTER IN CH.

TYI:	EXCH 1,CH
	SKIPN 1,LFFLG		;HAVE SAVED LF FROM PREVIOUS EOL CONVERT
	 PBIN			;ELSE GET ONE FROM TTY
	SKIPN EOLF		;EOL'S ALLOWED IN BUFFER?
	 CAIE 1,EOL		;OR NOT AN EOL?
	  JRST TYI9		;YES OR YES
	MOVEI 1,^J		;SAVE LF FOR NEXT TIME
	MOVEM 1,LFFLG
	TRCA 1,7		;RETURN A CR THIS TIME
TYI9:	 SETZM LFFLG		;CANCEL SAVED LF
	EXCH 1,CH
	RET

U LFFLG,1		;0 OR 12 DEPENDING IF EOL WAS CONVERTED

;TYPE CHARACTER FROM CH

TYO:	EXCH 1,CH
	PBOUT
	EXCH 1,CH
	RET

;DING THE BELL

DING:	MOVEI 1,101
	RFCOC
	PUSH P,2
	TLC 2,(3_20.)
	SFCOC			;SWITCH FROM ^G TO DING
	MOVEI 2,^G
	BOUT
	POP P,2
	SFCOC			;SWITCH BACK TO ^G
	RET

;CHANGE WAKE-UP SET TO INCLUDE EVERYTHING

AWAKEN:	PUSH P,1
	PUSH P,2
	MOVEI 1,100
	RFMOD
	TRO 2,17_12.
	SFMOD
	POP P,2
	POP P,1
	RET
;ROUTINE TO TYPE "MESSAGE"
;CALL JSP A,CONMES
;	ASCIZ /MESSAGE/
;	RETURN

CONMES:	HRROS A
	PSOUT
	JRST 1(A)

;ROUTINE TO TYPE CARRIAGE RETURN LINE FEED
;CALL	CALL CRR
;	RETURN
CRR:	PUSH P,1		; save AC 1
	MOVEI 1,^M		; CR...
	PBOUT
	MOVEI 1,^J		; then LF...
	PBOUT
	POP P,1			; restore AC 1
	RET			; and return
;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER AND ERROR IF EMPTY
;CALL	CALL SKRCH
;	RETURN WITH CHARACTER IN CH
;GOES TO ERR IF COMMAND BUFFER IS EMPTY

SKRCH:	SKIPN COMCNT		;COMMAND BUFFER EMPTY?
	 ERROR [ASCIZ/UTC Unterminated command/]

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

RCH:	SOSGE COMCNT		;NOW 1 LESS IN COMMAND
				;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 [ASCIZ/UTC Unterminated command/]
	ILDB CH,CPTR		;YES. GET A CHARACTER.
	RET			;RETURN.

; Delete character from screen

DELCH:	CAIN CH,^M		; no-op erasing ^M
	 RET
	CAIN CH,^[		; altmode is special
	 JRST .+3		; in that it prints one position
	  CAIGE CH,<" >		; other control?
	   PUSH P,[.+1]		; yes, cause extra delete to happen
	PUSH P,1
	PUSH P,2
	PUSH P,3
	MOVEI 1,101
	RFCOC
	PUSH P,2
	MOVSI 2,2
	SFCOC
	HRROI 1,[.BYTE 7 ? ^H ? <" > ? ^H]
	PSOUT
	MOVEI 1,101
	POP P,2
	SFCOC
	POP P,3
	POP P,2
	POP P,1
	RET
CLIS:	HRRZ A,LSTCB		;PREPARE TO SAVE LAST COMMAND STRING
	HRRZ AA,LSTCE
	CAIG A,CBUF
	 JRST CSAV1		;IS ALREADY IN RIGHT PLACE
	SUBI AA,0(A)		;NUMBER OF CHARACTERS
	CAIG AA,3
	 JRST CRST1		;NOT USEFULLY LONG
	ADDI AA,CBUF
	MOVEI A,CBUF
	HRL A,LSTCB
	BLT A,-1(AA)		;MOVE TO CBUF
CSAV1:	HLL AA,LSTCE
	MOVEM AA,LSTCB
	JRST CSAV2
CRST:	MOVEI 1,101
;			@ A B C D E F G H I J K L M N O P Q
	MOVE 2,[.BYTE 2?1?0?1?1?1?1?1?1?0?2?2?1?1?2?1?1?1?0]
;			R S T U V W X Y Z [ \ ] ^ _
	MOVE 3,[.BYTE 2?0?1?1?0?0?0?1?1?1?3?1?1?1?2]
	SFCOC			;BE SURE LF IS ON
	CALL CRR		;TYPE CR LF
CRST1:	MOVE AA,LSTCB		;RESET COMMAND STRING
CSAV2:	HRLI AA,440700		;MAKE BYTE POINTER
	MOVEM AA,CPTR
	SETOM LISNF		;NOTE NOW DOING COMMAND INPUT
	SETZM ABORTF		;CLEAR ABORT FLAG
	SETZM DUNFLG		;DON'T PUT OUT HEADING AGAIN
	SETZM SAVFLG		;SAY NOT IN ;S
	SKIPGE CCLJFN		;CCL?
	 JRST CSAV3		;NO
	MOVEI 1,101
;			@ A B C D E F G H I J K L M N O P Q
	MOVE 2,[.BYTE 2?1?1?1?1?1?1?1?1?0?2?2?1?1?2?1?1?1?1]
;			R S T U V W X Y Z [ \ ] ^ _
	MOVE 3,[.BYTE 2?1?1?1?1?1?1?1?1?1?3?1?1?1?2]
	SFCOC			;SET FOR COMMAND EXECUTION
	CALL YLOAD
	JRST GO			;SHOULD BE OK IF MATFLG AND INITF ARE ON
CSAV3:	SETZM COMCNT
	SETZM INTDPH
	SETZM SYMS
	MOVE T,[SYMS,,SYMS+1]
	BLT T,SYMEND-1
	CALL AWAKEN		;WAKE-UP ON EVERYTHING
	SKIPE INITF		;ARE WE INITIALIZING?
	 AOSE MATFLG		;MAYBE DO M@ ?
	  CAIA
	   JRST DOMAT		;YES
LI0:	MOVEM P,SAVP		;SAVE IN CASE ;H AND SSAVE HAPPEN
	MOVEM PF,SAVPF		;THESE ARE THE RESTART VALUES
	SETZM INITF		;DON'T CONSIDER DOING M@ ANYMORE
	MOVEI CH,"*
	CALL TYO		;TYPE READY CHARACTER
LI0A:	PUSH P,1
	PUSH P,2
	MOVEI 1,100
;			@ A B C D E F G H I J K L M N O P Q
	MOVE 2,[.BYTE 2?1?0?1?1?1?1?1?1?0?2?0?1?1?2?1?1?1?0]
;			R S T U V W X Y Z [ \ ] ^ _
	MOVE 3,[.BYTE 2?0?1?1?0?0?0?1?1?1?3?1?1?1?2]
	SFCOC
	POP P,2
	POP P,1
	MOVE B,CBUFH
LI1:	TRZ FF,ALTF
LI2:	CAIG B,(AA)		;COMMAND BUFFER EXCEEDED?
	 CALL LIXPND		; YES, EXPAND
	CALL TYI		;GET A NON-NULL CHARACTER IN CH
	CAIE CH,^[		; altmode?
	 TRZ FF,ALTF		; no, then clear "preceding alt seen"
	SOSGE TTYCNT		;READ TYPE AHEAD PLUS ONE CHR, THEN...
	 SETZM ABORTF		;CLEAR WAITING ABORT IF CHAR TYPED
	SKIPN COMCNT		;IS THIS FIRST CHR IN COMMAND?
	 JRST LI69		;YES, CHANGE WAKEUP, CHK FOR LF AND BS
LI79:	AOS COMCNT
	IDPB CH,AA		;NO. STORE CHARACTER IN COMMAND BUFFER.
	CAIN CH,^V		;^V, QUOTE NEXT CHAR
	 JRST LICV
	CAIN CH,^W
	 JRST CONT.W		;DELETE A WORD
	CAIE CH,^H
	 CAIN CH,^A
	  JRST LID0
	CAIN CH,177		; rubout also deletes a character
	 JRST LID0
	CAIE CH,^U		; ^U for Twenex fans
	 CAIN CH,^Q		;CONTROL-Q, DELETE LINE
	  JRST CONT.Q
	CAIN CH,^R		;CONTROL-R, RETYPE LINE
	 JRST LID3
	CAIN CH,^[		; altmode?
	 TRON FF,ALTF		; was preceding alt seen?(turn on anyway)
	  JRST LI2		; no, get next character
LI89:	MOVEI CH,177		;END OF COMMAND STRING MARKER
	AOS A,COMCNT		;MARK END OF COMMAND STRING RUBOUT
	IDPB CH,AA
	MOVEM A,COMAX
	MOVE C,AA		;SAVE END OF THIS COM STRING
	IBP C			; FOR POSSIBLE LATER USE
	IBP C			;POINTER BEFORE LAST THREE CHARS
	HRLI C,-3(A)
	MOVEM C,LSTCE
	SETZM LISNF		;NO LONGER DOING COMMAND INPUT
	CALL CRR		;TYPE CRLF
	JRST CD			;DECODE COMMAND
LIXPND:	ADDI B,100		;YES. EXPAND COMMAND BUFFER 100 WORDS.
	MOVEM B,CBUFH
	MOVE C,Z
	IDIVI C,5		;C:=DATA BUFFER END WORD ADDRESS.
	SKIPE C+1		;CHECK REMAINDER
	 AOS C			;PART IN NEXT WORD
	MOVE D,QRBUF
	IDIVI D,5		;D:=Q-REG BUFFER BASE WORD ADDRESS.
	SUBM C,D		;NO. OF WORDS IN Q-REG AND DATA BUFFER.
	MOVE CH,(C)
	MOVEM CH,100(C)		;MOVE Q-REG AND BUFFER 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
	RET
; ^V QUOTES NEXT CHARACTER (INTERRUPT CHRS IF POSSIBLE)

LICV:	PUSH P,1
	PUSH P,2		;AA
	PUSH P,3

LICV0:	MOVEI 1,400000
	RPCAP
	JUMPGE 2,LICV8		;^C NOT ALLOWED
	PUSH P,2
	PUSH P,3
	TLO 3,(1_35.)		;^C CAP
	EPCAP			;ENABLE CONTROL C
	CALL AWAKEN
	MOVEI 1,-5		;SAY JOB TIW
	RTIW
	PUSH P,2
	SETZ 2,
	STIW			;MAKE ALL CONT CHRS TYPE-IN-ABLE
	MOVEI 1,101
	RFCOC
	PUSH P,2
	PUSH P,3
;			@ A B C D E F G H I J K L M N O P Q
	MOVE 2,[.BYTE 2?1?1?1?1?1?1?1?1?1?1?1?1?1?1?1?1?1?1]
;			R S T U V W X Y Z [ \ ] ^ _
	MOVE 3,[.BYTE 2?1?1?1?1?1?1?1?1?1?3?1?1?1?1?1?1?1?1]
	SFCOC			;indicate all control characters EXCEPT altmode
	CALL TYI		;GET QUOTED CHAR
LICV4:	DPB CH,-6(P)		;REPLACE ^V
	POP P,3
	POP P,2
	MOVEI 1,101
	SFCOC
	MOVEI 1,-5
	POP P,2
	STIW
	POP P,3
	POP P,2
	MOVEI 1,400000
	EPCAP			;RESTORE CAPABITLITIES
LICV9:	POP P,3
	POP P,2
	POP P,1
	JRST LI1

LICV8:	CALL TYI
	DPB CH,-1(P)		;REPLACE ^V
	JRST LICV9
; Delete a character from the command buffer
; If 0^H (TTY, ugh!), handle as canonical printing console delete (echo back)
; If 1^H (TI, etc.), backspace if ^H, else canonical delete
; If 2^H (glass terminal), erase character from the screen

LID0:	ADD AA,[14._30.]	; back up two bytes
	TLNE AA,400000
	 SUB AA,[43_30.+1]
	MOVE D,AA
	SOSG COMCNT
	 JRST LIDERR		; NO CHARS TO DELETE
	SKIPN CONHFG		;IN 0^H MODE?
	 JRST LID1		;YES, HANDLE AS ^A
	CAIE CH,^H		; input BS?
	 JRST [	MOVE CH,CONHFG	; no, get terminal type
		CAIN CH,1	; is this a printing console?
		 JRST LID1	; yes, do old deletes
		SOS COMCNT	; zap command count
		JRST LID0A]	; use new deletes
	SOS COMCNT
	MOVE CH,CONHFG		; get terminal type
	CAIN CH,1		; printing console?
	 JRST LID0B		; yes, all done
LID0A:	ILDB CH,D		; get character we clobbered
	CAIN CH,^I		; tab?
	 JRST [	CALL WIPTAB
		JRST LID0B]
	CAIN CH,^J		; line feed?
	 JRST OLDLIN		; yes, do line hackery
	CALL DELCH		; zap character
LID0B:	SKIPG COMCNT
	 JRST LI0A
	JRST LI1

;DELETE A CHARACTER FROM THE COMMAND BUFFER.

LID1:	ILDB CH,D		;NO. TYPE DELETED CHARACTER
	CALL TYO
	SOS COMCNT		;REMOVE 2 CHARACTERS FROM COMMAND COUNT.
	JRST LID0B		;AND GET ANOTHER COMMAND CHARACTER

; DING IF NO MORE

LIDERR:	CALL DING
	HRLI AA,440700
	HRR AA,LSTCB
	MOVEM AA,CPTR
	SETZM COMCNT
	JRST LI0A
;DELETE WORD FROM COMMAND BUFFER

CONT.W:	CALL DECPTR		;DECREMENT COMMAND INPUT POINTER
	 JRST LIDERR		;NOTHING LEFT
	MOVEI CH,"_
	SKIPN CONHFG		;MODEL 33 EQUIVALENT?
	 CALL TYO		;YES. INDICATE THE WORD DELETION
CONTW0:	CALL DECPTR		;ALWAYS DELETE SOMETHING
	 JRST [	CALL WIPEIT
		SKIPN CONHFG
		 JRST CRST
		JRST LI0A]
	CALL WIPEIT		;AND GET IT OFF THE SCOPE
	MOVE CH,AA
	ILDB CH,CH		; get character that was flushed
	CALL SKPSEP		;WAS IT A SEPARATOR?
	 CAIA			; no, delete rest of the word
	  JRST CONTW0		; yes, keep on deleting

CONTW1:	LDB CH,AA		;GET THE CHARACTER ABOUT TO BE DELETED
	CALL SKPSEP		;SEE IF A SEPARATOR
	 CAIA			; no
	  JRST LID0B
CONTW2:	CALL DECPTR
	 JRST [	SKIPN CONHFG
		 JRST CRST
		CALL WIPEIT
		JRST LI0A]
	CALL WIPEIT
	JRST CONTW1

WIPEIT:	SKIPE TT,CONHFG		; TTY?
	 CAIN TT,1
	  RET			; printing console; no eraser
	MOVE CH,AA		; get a copy of BP
	ILDB CH,CH		; get character just deleted
	CAIN CH,^I		; tab?
	 JRST WIPTAB
	CAIN CH,^J		; line feed?
	 JRST OLDLIN		; yeah, do ^R hack...
	JRST DELCH		; zap character

DECPTR:	ADD AA,[7_30.]
	SKIPG AA
	 SUB AA,[43_30.+1]
	SOSLE COMCNT
	 AOS (P)
	RET
WIPTAB:	PUSH P,AA
	PUSH P,COMCNT
	PUSH P,A		; just in case
	IBP AA
	AOS COMCNT
	SETO D,
	CALL LIL2
	 SKIPA A,[1]
	  SETZ A,
	SETCA D,
	JUMPE D,WIPTB1
WIPTB2:	ILDB CH,AA
	ADDI A,1
	CAIN CH,^I
	 JRST [	TRZ A,7
		 ADDI A,8.
		SOJG D,WIPTB2
		JRST WIPTB1]
	CAIGE CH,<" >
	 CAIN CH,^[
	  CAIA
	   ADDI A,1		; other controls
	SOJG D,WIPTB2
WIPTB1:	MOVE D,A
	POP P,A
	POP P,COMCNT
	POP P,AA
	ANDI D,7
	SUBI D,8.
WPDL:	REPEAT 3,PUSH P,1+.RPCNT
	MOVEI 1,101
	RFCOC
	PUSH P,2
	MOVSI 2,2
	SFCOC
	MOVEI 1,^H		; just backspace
	PBOUT
	AOJL D,.-1
	MOVEI 1,101
	POP P,2
	SFCOC
	REPEAT 3,POP P,3-.RPCNT
	RET
;TRY FOR AUTOMATIC M@
DOMAT:	MOVE A,QTAB+"9+1-"0	;ENTRY FOR THE  @  QREG ("A"-1)
	TLNN A,377770
	 TLNN A,400000
	  JRST LI0		;Q@ HAS A NUMBER IN IT
	SETZM INITF		;DON'T CONSIDER DOING AUTO M@ AGAIN
	MOVE B,CBUFH
	MOVE CH,[ASCII / M@/]
	JRST LI71		;GO DO THAT FAKE TYPE-IN

;FIRST CHR IN COMMAND
LI69:	PUSH P,1
	PUSH P,2
	PUSH P,3
	MOVEI 1,100
	RFMOD
	ANDCMI 2,17_12.		;CHANGE WAKEUP SET
	IORI 2,16_12.		;TO ALL CONTROLS
	SFMOD
	MOVEI 1,101
	RFCOC
	PUSH P,3
	TRO 2,1_15.		;TURN ON LINE FEED AGAIN
	TLZ 2,(3_18.)		;ASSUME ^H SHOULD BE ECHOED AS NOTHING
	MOVE 3,CONHFG
	CAIN 3,1
	 TLO 2,(2_18.)
	POP P,3
	SFCOC
	CAIN CH,^M			; terpri?
	 CALL CRR			; make sure it is echoed
	POP P,3
	POP P,2
	POP P,1
	CAIN CH,^J		;LINE FEED?
	 JRST LI70		;YES
	CAIN CH,<" >		; space?
	 JRST [	MOVE CH,[ASCII /0TT/]
		JRST LI71]
	CAIN CH,177		; rubout?
	 JRST LI69A		; equivalent to BS (LOTS hack)
	CAIE CH,^H		;BACKSPACE (^H)?
	 JRST LI79		;NOT A SPECIAL, BACK TO MAINLOOP
LI69A:	SKIPA CH,[ASCII /-LT/]
LI70:	 MOVE CH,[ASCII /+LT/]
LI71:	MOVEM CH,@CPTR		;STORE FAKE COMMAND STRING
	MOVEI CH,5
	MOVEM CH,COMCNT		;UPDATE COUNT OF COMMAND CHRS
	AOJA AA,LI89		;MAKE BELIEVE ALTMODE SEEN.

U LSTCB,1			;BEG OF LAST COMMAND STRING
U LSTCE,1			;END OF LAST COMMAND STRING
;DELETE LINE

CONT.Q:	MOVE CH,CONHFG		;CONTROL H FLAG
	CAIL CH,2		;SCOPE?
	 JRST CONTQS		;YES, GO HANDLE AS SUCH
	CALL DECPTR
	 JRST LIDERR
LID2:	CALL DECPTR
	 JRST CRST
	LDB CH,AA
	CALL EOLP
	 JRST LID2
	MOVEI CH,"_
	CALL TYO
	CALL CRR
	JRST LID0B

CONTQS:	CALL DECPTR		;DECREMENT THE LINE POINTER
	 JRST LIDERR		;BACKED OFF THE BEGINNING
CONTQ1:	CALL DECPTR		;NOW DO REAL CHARACTERS
	 JRST [	CALL WIPEIT	; make last character go away
		JRST LI0A]	; and charge on
	CALL WIPEIT		; and erase character from screen.
	LDB CH,AA		;GET NEXT CHARACTER
	CALL EOLP		;END OF LINE IN CURRENT MODE?
	 JRST CONTQ1		;NO
	JRST LID0B		;YES. BACK TO MAIN LOOP.
OLDLIN:	LDB CH,AA		; get previous character
	MOVEI D,^R		; and a phony ^R
	CAIE CH,^M		; carriage return?
	 JRST [	IBP AA		; no, get the frob back
		AOS COMCNT	; restore the command counter
		JRST .+1]	; now attack.
	DPB D,AA		; yeah, shove in CR
LID3:	MOVEI CH,^M		; CR first
	CALL TYO
	MOVE CH,CONHFG		; get terminal type
	CAIN CH,2		; some kind of display?
	 JRST .+3		; yes, then overwrite this line
	  MOVEI CH,^J		; LF next
	  CALL TYO
	CALL LIL1		;FIND BEGINNING OF IT
	 JRST [	MOVEI CH,"*	; beginning of buffer,
		CALL TYO	; so do a fake prompt
		JRST .+1]	; and continue on
	MOVE D,AA
LID5:	ILDB CH,D
	CAIN CH,^R		;TYPE UNTIL CONTROL-R
	 JRST LID0B
	CALL TYO
	MOVE AA,D
	AOS COMCNT
	JRST LID5

LIL1:	MOVEI D,0
LIL2:	ADD AA,[14._30.]
	TLNE AA,400000
	 SUB AA,[43_30.+1]
	ILDB CH,AA
	SOSG COMCNT
	 RET
	CALL EOLP
	 CAIA			;NOT END OF LINE
	  JRST RSKP
	SOJA D,LIL2

RSKP:	AOS 0(P)
	RET
;COMMAND DECODER

CD:	MOVEI 1,101		;INDICATE ALL CONTROLS
;			@ A B C D E F G H I J K L M N O P Q
	MOVE 2,[.BYTE 2?1?1?1?1?1?1?1?1?1?2?2?1?1?2?1?1?1?1]
	MOVE 3,CONHFG		;CONTROL-H FLAG  (TERMINAL TYPE)
	CAIE 3,1		;CHECK TO SEE IF CODE 10 WILL CAUSE
	 CAIN 3,2		;PHYSICAL BACKSPACE (SEND IT) OR
	  TLC 2,(3_18.)		;NOT (INDICATE IT)
;			R S T U V W X Y Z [ \ ] ^ _
	MOVE 3,[.BYTE 2?1?1?1?1?1?1?1?1?1?3?1?1?1?2]
	SKIPN EOLF
	 TRC 3,3_8.		;MAKE 37'S INDICATE
	SFCOC

CRET:	TRZ FF,ARG2+ARG+FINDR+PCHFLG
CD1:	SETZM NUM
CD2:	MOVSI A,(ADD B,)
CD3:	HLLM A,DLIM
CD4:	SETZM SYL
CD5:	SKIPE ABORTF
	 JRST ABORT		;RUBOUT OR IO ERROR
	SETZM SAVFLG		; CLEAR ;S FLAG
	AOSN ESTYPE		; do an automatic V?
	 SKIPA CH,["V]		; yup
	  CALL RCH		;READ COMMAND CHAR AND CHECK
	CAIN CH,177
	 JRST GO		;END OF COMMAND STRING
	CAIE CH,140		;SOME CODES
	 CAILE CH,"z
	  ERROR [ASCIZ/UDC Undefined command/]
	CAIL CH,"a		;LOWER CASE IS CONVERTED TO UPPER CASE
	 SUBI CH,40
CD9:	XCT DTB(CH)		;A:=VALUE FLAG,,DISPATCH ADDRESS
				;OR DISPATCH DIRECTLY
CD6:	MOVE B,NUM
	TRZE FF,SYLF		;VALUE OR 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.
	CALL (A)		;DISPATCH FOR NON-VALUE RETURN COMMANDS.
	JRST CRET

SEMICL:	CALL RCH		;SEMICOLON COMMANDS
	CAIGE CH,<" >
	 MOVEI CH,<" >
	CAIL CH,140
	 SUBI CH,40
	ADDI CH,SEMTAB-DTB-40	;OFFSET TABLE
	JRST CD9		;AND DISPATCH

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

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

;SOME COMMANDS HAVE A NUMERIC VALUE

VALRET:	MOVEM A,SYL
CD7:	TRO FF,ARG+SYLF
	JRST CD5

;Some routines take an arg and return a value which can be used as an
; arg to the next command.   n;N and  n;B  are examples

VALARG:	SETZM NUM
	JRST VALRET

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

UAR:	CALL 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.

SEMI.H:	TLZ FF,UREAD+UWRITE+FINF	;INCASE SOMEONE REENTERS
	MOVEI 1,7.		;DEASSIGN TTY INTERRUPTS, BELL
	DTI
	HALTF
	JRST REE		;IN CASE A "CONTINUE" IS DONE
; COMMA SEPARATES ARGS

COMMA:	MOVEM B,SARG		;SAVE CURRENT ARGUMENT IN SARG.
	TRZE FF,ARG		;WAS THERE A CURRENT ARGUMENT?
	 TROE FF,ARG2		;ALREADY SEEN ONE ,?
	  ERROR [ASCIZ/WNA Wrong number of arguments/]
	JRST CD1		;YES. CLEAR CURRENT ARGUMENT.

;LOGICAL AND

CAND:	MOVSI A,(AND B,)
	JRST CD3

;LOGICAL OR

COR:	MOVSI A,(IOR B,)
	JRST CD3

;SUBTRACT TAKES ONE OR TWO ARGUMENTS

MINUS:	MOVSI A,(SUB B,)
	JRST CD3

;MULTIPLY TAKES TWO ARGUMENTS

TIMES:	MOVSI A,(IMUL B,)
	JRST CD3

;DIVIDE (TRUNCATES) TAKES TWO ARGUMENTS

SLASH:	MOVSI A,(IDIV B,)
	JRST CD3
; 0^H	SAYS THE TERMINAL LACKS MECHANICAL BACKSPACE
; 1^H	SAYS THE TERMINAL HAS MECHANICAL BACKSPACE
; 2^H	SAYS TERMINAL HAS ERASER

UP.H:	TRNN FF,ARG2
	 TRNN FF,ARG
	  ERROR [ASCIZ/WNA Wrong number of arguments/]
	CAIL B,0
	 CAILE B,2
	  ERROR [ASCIZ/ITT Invalid terminal type/]
	MOVEM B,CONHFG
	RET

U CONHFG,1
; ^D	OVERIDES THE DEFAULT COMMENT STRING USED BY ;D
;	^D NORMALLY PICKS THE COMMENT CHARACTER ON THE BASIS OF THE
;	FILE EXTENTION (;  FOR .MAC,  //  FOR .BCP  ETC.).
;	IF THE EXTENSION IS UNKNOWN, AND NONE WAS SPECIFIED BY ^D,
;	A SEMICOLON WILL BE USED.

;STRING MAY BE UP TO 24. CHARACTERS LONG

UP.D:	TRNE FF,ARG\ARG2
	 ERROR [ASCIZ/ANE Argument given when none expected/]
	MOVE A,[440700,,COMBUF]
	MOVEI I,5*5-1		;WILL END IN NULL
UP.D1:	SOJL I,UP.DR2
	CALL SKRCH
	IDPB CH,A
	CAIE CH,^[		;ALTMODE (IE, CONTROL-D)?
	 JRST UP.D1
UP.D2:	MOVEI CH,0
	DPB CH,A		;MAKE ASCIZ
	RET

UP.DR2:	MOVEI CH,0
	DPB CH,A
	JSP A,CONMES
	ASCIZ /^D string truncated to 24. characters/
	JRST UP.D2

U COMBUF,5
;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:	SETZM SARG		;SET SECOND ARGUMENT TO 0.
	TRZN FF,ARG		;ANY ARGS BEFORE H?
	 TRNE FF,ARG2		; ..
	  ERROR [ASCIZ/ANE Argument given when none expected/]
	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
; 0^F	CLEAR THE "EOL'S IN THE BUFFER" FORMAT FLAG
; 1^F	SET THE FLAG
;  ^F	(NO ARG) JUST RETURNS ITS VALUE (-1 IF SET, 0 OTHERWISE)


UP.F:	JUMPE B,.+2
	 SETO B,		;NORMALIZE THE VALUE
	TRNE FF,ARG		;BUT WAS THERE A VALUE?
	 CALL CVTBUF		;YES, CONVERT BUFFER IF NEEDED
	MOVE A,EOLF		;RETURN THE FLAG AS VALUE
	JRST VALARG

CVTBUF:	CAMN B,EOLF		;BUFFER IS ALREADY IN RIGHT FORMAT?
	 RET			;YES
	PUSH P,COMAX		;PUSH STUFF IN CASE GC HAPPENS
	PUSH P,CPTR
	PUSH P,COMCNT
	PUSH P,PT
	MOVE I,BEG
	MOVEM I,PT		;START AT BEGINNING OF BUFFER

CVTBU1:	MOVE I,PT		;CONTINUE FROM LAST FIND
CVTB11:	CAML I,Z		;AT END OF BUFFER?
	 JRST CVTBU9		;YES, DONE.
	CALL GETINC		;GET A CHARACTER, INCREMENT I
	CALL EOLP		;IS IT A PREVIOUS FORMAT EOL?
	 JRST CVTB11		;NO. NO CONVERSION NEEDED

CVTBU2:	SUBI I,1		;BACK UP OVER EOL OR LF
	SKIPE EOLF		;ADJUST PT BACK OVER CR IF NEEDED
	 JRST CVTB20		;EOLS CURRENTLY IN BUFFER
	CAMG I,BEG		;CAREFUL ABOUT LF AS 1ST CHR IN BUFFER
CVB201:	 AOJA I,CVTB11		;UNDO THE BACK UP, RESUME SEARCH
	SUBI I,1
	CALL GETCHR		;GET THE CHARACTER AT I
	CAIE CH,^M		;REALLY A CR?
	 AOJA I,CVB201		;NO. RESUME SEARCH AFTER LF
CVTB20:	MOVEM I,PT		;WHERE TO MAKE/TAKE SPACE

	MOVEI C,1		;NEED 1 MORE HOLE IF CONVERTING FROM EOL
	SKIPN EOLF		;TO CRLF.
	 MOVNI C,1		;ONE LESS IF GOING OTHER WAY
	CALL NROOM		;MAKE THAT MUCH ROOM
	MOVE OU,PT
	SKIPN EOLF
	 JRST CVTB23		;CONVERTING TO TENEX EOLS
	MOVEI CH,^M
	CALL PUTCHR
	ADDI OU,1
	TRCA CH,7
CVTB23:	 MOVEI CH,EOL
	CALL PUTCHR
	JRST CVTBU1		;LOOK AT REST OF BUFFER
CVTBU9:	POP P,PT
	SUB P,[3,,3]
	SETCMM EOLF		;BUFFER IS NOW IN THE OTHER FORMAT
	RET
; 0^S	TURN OFF CASE INDEPENDENT SEARCH MODE
; N^S	TURN ON CASE INDEPENDENT SEARCH MODE
;  ^S	(NO ARG) JUST RETURNS ITS VALUE (-1 IF CI SEARCH MODE ON, ELSE 0)

UP.S:	TRNN FF,ARG		;WAS AN ARG GIVEN?
	 JRST UPS1		;NO, JUST RETURN VALUE
	SKIPN B			;CHECK THE ARG
	 TLZA FF,CISRCH
	  TLO FF,CISRCH

UPS1:	SETZ A,
	TLNE FF,CISRCH
	 SETO A,
	JRST VALRET
;  ;B	has the value of point at the beginning of this page
; n;B	has the value of point at the beginning of the n-th page

SEM.B:	TRNE FF,ARG2		;Too many arg's?
	 ERROR [ASCIZ/TMA Too many arguments/]
	TRNN FF,ARG		;Was an arg supplied?
	 JRST SEM.B2		;No.  Search back on this page.

	JUMPLE B,SEM.X	;ERROR
	MOVE I,BEG
	SOSG B			;If page 1, we are done
	SOJA I,SEM.B4		;Compensate for AOS to follow
	CALL FINDFF		;Find the n-1 th form feed
	JRST SEM.B4

SEM.B2:	MOVE I,PT		;Start at .
	SUBI I,1
SEM.B3:	SKIPE ABORTF		;Aborting?
	 JRST TYOQT		;Yes
	CAMGE I,BEG		;Back to beg of buffer?
	 JRST SEM.B4		;Yes. Done.
	CALL GETCHR
	CAIE CH,^L		;Is it a FF?
	 SOJA I,SEM.B3		;No. Try previous char.
SEM.B4:	AOS A,I
	CAMLE A,Z		;IN THE BALL PARK?
SEM.X:	 ERROR [ASCIZ/PNF Page not found/]
	SUB A,BEG		;Make relative to beg of buffer
	JRST VALARG
;   ;Z	has the value of point at the bottom of the current page
;	This is the same as the top of the next page.

SEM.Z:	MOVE I,PT		;Where to start
	MOVEI B,1		;Find first formfeed
	CALL FINDFF
	AOS A,I			;Include the FF on this page
	CAMLE A,Z		;IN BUFFER?
	 MOVE A,Z		;FORCE IT TO BE SO
	SUB A,BEG
	JRST VALARG

;subroutine to find the n-th formfeed (in B) after the position in I.
FINDFF:	SKIPE ABORTF		;Rubout?
	 JRST TYOQT		;Yes
	CAML I,Z		;Still in buffer?
	 JRST [	MOVE I,Z
		RET]
	CALL GETCHR		;Get CHR to CH
	CAIE CH,^L
	 AOJA I, FINDFF		;Not a FF, Try next.
	SOJG B,.-1		;Found all we were told to?
	RET			;Yes
;() MAY BE USED TO OVERRIDE LEFT TO RIGHT OPERATOR SCAN

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
	PUSH P,A		;PUSH CURRENT OPERATOR.
	AOS LEV			;INCREMENT ( LEVEL.
	JRST CRET

CLOSE:	SOSGE LEV		;IS THERE A (?
	 ERROR [ASCIZ/UMP Unmatched right parenthesis/]
	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 ITER. 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 [ASCIZ/NAE No argument to =/]
PRNT9:	MOVEI A,101		; primary output JFN
	PUSH P,2		; save current ac 2
	MOVE 2,B		; get number for NOUT
	MOVEI 3,10.		; decimal base
	NOUT			; output number
	 JFCL			; too bad
	POP P,2			; restore AC 2
	JRST CRR		;CRLF AND RETURN TO CALLER

;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.

SPTYI:	TRNE FF,ARG		; given an argument?
	 JRST [	TDNE B,[-1,,777600] ; non ASCII?
		 ERROR [ASCIZ/NAC Not an ASCII character/]
		MOVE 1,B
		PBOUT		; n^T outputs on console
		JRST CRET]
	CALL AWAKEN		;CHANGE WAKE-UP SET TO ALL
	MOVEI 1,101
	RFCOC
	PUSH P,2
	PUSH P,3
;			@ A B C D E F G H I J K L M N O P Q
	MOVE 2,[.BYTE 2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2]
;			R S T U V W X Y Z [ \ ] ^ _
	MOVE 3,[.BYTE 2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2]
	SFCOC
	CALL TYI
	POP P,3
	POP P,2
	MOVEI 1,101
	SFCOC
	MOVE A,CH
	JRST VALRET

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

CNTRUP:	CALL 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
	CALL 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,10.
	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.
	CAML I,Z		;AT END OF BUFFER?
	 JRST BEGIN		;YES, RETURN 0 AS VALUE
PICK1:	CALL GETCHR		;CHARACTER TO THE RIGHT OF PT.
	MOVE A,CH		;RETURN CH AS VALUE.
	JRST VALRET

PICKUP:	MOVE I,PT		; ;P COMMAND, PICKUP CODE AND INC PNTR
	CAML I,Z
	 JRST BEGIN		;AT END OF BUFFER, RETURN 0
	AOS PT
	JRST PICK1
;	;N picks up a positive number from the data (base 10)
;	n;N picks it up in base n.  PT is left at first non-number.
PIKNUM:	TRNN FF,ARG
	 MOVEI B,10.
	JUMPLE B,[ERROR [ASCIZ/INB Invalid numeric base/]]
	SETZ A,
PIKNML:	MOVE I,PT
	CAML I,Z
	 JRST VALARG
	CALL GETCHR
	CAIGE CH,"0(B)
	 CAIGE CH,"0
	  JRST VALARG
	AOS PT
	IMUL A,B
	ADDI A,-"0(CH)
	JRST PIKNML
;NUI	PUTS THE NUMERIC VALUE N IN Q-REGISTER I.

USE:	TRZN FF,ARG		;DID AN ARGUMENT PRECEED U?
	 ERROR [ASCIZ/NAU No argument to U/]
	CALL QREGVI		;YES. CH:=Q-REGISTER INDEX.
	MOVEM B,QTAB-"0(CH)	;STORE ARGUMENT IN SELECTED Q-REG.
	JRST CLSBB

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

QREG:	CALL QREGVI
	JRST VALRET		;NUMBER CHECK WOULD MAKE ;T LOSE

;ROUTINE TO RETURN Q-REGISTER INDEX IN CH AND CONTENT IN A.
;CALL	CALL 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:	CALL RCH		;GET NEXT COMMAND STRING CHARACTER
	CAILE CH,140		;LC LETTER?
	 TRZ CH,40		;MAKE UC
	CAIL CH,"0
	 CAILE CH,"9
	  CAIA
	   JRST QREGV5		;DIGIT
	CAIL CH,"@
	 CAILE CH,"Z
	  ERROR [ASCIZ/IQN Illegal Q-register name/]
	SUBI CH,"@-"9-1	;TRANSLATE LETTERS DOWN BY NUMBER OF
				;CHARACTERS BETWEEN 9 AND @.
QREGV5:	MOVE A,QTAB-"0(CH)	;RETURN CONTENTS OF Q-REGISTER
	RET

;%I	INCREMENTS Q-REGISTER I

PCNT:	CALL QREGVI		;CH:=Q-REGISTER INDEX.
	TLNN A,377770
	 TLNN A,400000
	  CAIA
	   ERROR [ASCIZ/NUT Numeric use of Q-register containing text/]
	AOS A,QTAB-"0(CH)	;INCREMENT Q-REG.
	JRST VALRET		;RETURN NEW VALUE.
;M,NXI	MOVES CHARS M THRU N INTO Q-REGISTER I.
;NXI	CHRS FROM "." THRU N-TH LINE FEED ARE MOVED TO Q-REG I
X:	SOS GCCNT		;COUNT TO NEXT GC
	CALL GETARG		;1ST ARG TO C, 2ND TO B
	CAML C,BEG
	 CAMLE C,B		;1ST < 2ND AND BOTH INSIDE BUFFER?
	  ERROR [ASCIZ/ITP Invalid text pointer/]
	PUSH P,B		;MUST BE STACKED IN CASE GC HAPPENS
	PUSH P,C
	EXCH B,C		;YES.
	SUB C,B			;LENGTH OF STRING
	ADDI C,4		;PLUS 4 OVERHEAD CHARS
	MOVEM C,QLEN		;IS LENGTH OF Q-REGISTER
	CALL QREGVI		;GET Q-REG NOW TO BE SURE IT EXISTS
	MOVEM CH,XQREG		;SAVE FOR LATER
	ADDI C,4		;CAUSE IDIVI TO ROUND UP
	IDIVI C,5
	IMULI C,5		;NUMBER OF CHARACTERS TO MOVE
	MOVE D,BEG
	MOVEM D,PT		;PT:=BEG
X0:	CALL NROOM		;MOVE EVERYTHING UP INTEGRAL NUM OF WRDS
	MOVE OU,BEG		;CHR ADDRESS OF Q-REG
	ADDM C,BEG		;UPDATE BEG FOR MOVE
	ADDM C,(P)		;UPDATE ARGUMENTS TO REFLECT MOVE
	ADDM C,-1(P)
X1:	IDIVI OU,5		;WORD ADDR OF Q-REG
	MOVE I,QLEN		;LENGTH OF Q-REG, INC, OVRHD
	LSH I,10
	TLO I,(141_29.)		;INSERT MARK
	MOVEM I,0(OU)		;STORE OVERHEAD CHRS IN Q-REG
	HRLI OU,100700		;CONSTRUCT DESTINATION PTR
	MOVE C,QLEN		;LENGTH OF QREG
	SUBI C,4		;LENGTH OF CONTENTS
	MOVE TT,0(P)		;CONSTRUCT BYTE POINTER FOR SOURCE
	IDIVI TT,5		;GET WORD ADDR
	MOVE B,BTAB-1(TT1)	;NOTE: PTR IS INDEXED BY TT
X2:	ILDB CH,B		;MOVE STRING TO Q STORAGE
	IDPB CH,OU
	SOJG C,X2
	POP P,C
	POP P,B
	PUSH P,PT
	CALL KLBUF1
	POP P,B
	SUB B,QRBUF		;ADDRESS RELATIVE TO C(QRBUF)
	TLO B,400000
	MOVE CH,XQREG		;THE Q-REG WE ARE X-ING INTO
X3:	CAIN CH,"9+1		;X WAS INTO Q-REG "@"  ?
	 SETOM MATFLG		;PERMIT AUTO M@ AT NEXT STARTUP
	MOVEM B,QTAB-"0(CH)
	JRST CRET

U XQREG,1
U QLEN,1
; M,NG	INSERT N-M CHARACTERS, STARTING FROM M, AT THE CURRENT LOCATION
;	OF THE POINTER. THIS IS A COPY, NOT A MOVE OPERATION.
; NG	MAKES A COPY OF THE NEXT N LINES, LEAVING THE POINTER
;	 BETWEEN THE COPIES.

;GI	THE TEXT IN Q-REGISTER IN 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:	TRNN FF,ARG
	 JRST QGETA		;IF GET IS FROM A Q-REG
	CALL GETARG
	CAML C,BEG		;CHECK FOR VALID ARGS
				;(N>Z IS VALID,THO GARBAGE IS POSSIBLE)
	 CAMLE C,B
	  ERROR [ASCIZ/ITP Invalid text pointer/]
	PUSH P,C		;FOR THE GC
	SUBM B,C
	CALL NROOM
	POP P,I
	CAML I,PT		;ADJUST M IF IT WAS NOT BELOW POINT
	 ADD I,C
	JRST QGETB

QGETA:	CALL QREGVI		;A:=QTAB ENTRY, CH:=Q-REG INDEX
	MOVE B,A
	PUSH P,CH
	CALL QGET2		;GET NUMBER OF CHARS
	POP P,B			;Q-REG INDEX
	CALL NROOM		;MOVE FROM PT THROUGH Z UP C POSITIONS
	MOVE I,QTAB-"0(B)
	TLZ I,400000
	ADD I,QRBUF
	ADDI I,4
QGETB:	MOVE OU,PT
QGET1:	JUMPE C,CRET		;MOVE STRING INTO DATA BUFFER
	CALL GETINC
	CALL PUTCHR
	AOS OU,PT
	SOJA C,QGET1
; ;T - TYPE CONTENTS OF Q REG

TPREG:	TRNN FF,ARG
	 JRST COMM		;TYPE LITERAL STRING IF NO ARG
	CALL QGET2
	JUMPE C,CRET
	CALL GETINC
	CALL TYO
	SKIPE ABORTF		;ABORTING?
	 JRST TYOQT		;YES
	SOJA C,.-5

QGET2:	TLZN B,377770		;DOES Q-REG CONTAIN TEXT?
	 TLZN B,400000
	  ERROR [ASCIZ/NTQ No text in Q-register/]
	ADD B,QRBUF		;YES
	MOVE I,B		;Q-REG CHAR ADDRESS
	CALL GETINC		;IS FIRST CHARACTER IN Q-REG 141?
	CAIE CH,141
	 ERROR [ASCIZ/NTQ No text in Q-register/]
	CALL GETINC
	MOVEM CH,C
	CALL GETINC
	LSH C,7			;RECONSTRUCT CHAR COUNT,
	IOR C,CH		;MOST SIGNIFICANT CHARS FIRST
	CALL GETINC
	LSH C,7
	IOR C,CH
	SUBI C,4		; "141" AND 3 OF COUNT
	RET			;C HAS LEN., I HAS CHR ADDR OF CONTENT
;]I	POPS Q-REGISTER IN OFF THE Q-REGISTER PUSHDOWN LIST.
;	THE Q-REGISTER PUSHDOWN LIST IS CLEARED EACH TIME $$ IS TYPED.

CLOSEB:	CALL QREGVI
	POP PF,QTAB-"0(CH)	;POP THE Q-REG (OLD VALUE STILL IS IN A)
CLSBB:	TLNN A,377770
	 TLNN A,400000
	  CAIA			;IF OLD VALUE WAS A NUMBER, NO GARBAGE.
	 SOS GCCNT
	RET			;U AND ]  DO NOT RETURN VALUES

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

OPENB:	CALL QREGVI
	PUSH PF,QTAB-"0(CH)	;C:=Q-REGISTER INDEX.
	JRST CD5
;E COMMANDS SELECT AND CONTROL FILE INPUT-OUTPUT MEDIA

ECMD:	CALL RCH
	TRZ CH,40		;LC TO UC
	CAIN CH,"A
	 JRST OPNAP		;OPEN AN OUTPUT FILE FOR APPEND
	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,"D		;ED  ?
	 JRST DINISH		;EX with ;D(;S) not ;S
	CAIN CH,"X		;EX?
	 JRST FINISH		;YES. DO HPEF<DING>
	CAIN CH,"G
	 JRST GOCCL		;EG,  CALL CCL
	CAIN CH,"E		; hack error messages?
	 JRST [	TRNN FF,ARG	; have an argument?
		 SETZ B,	; default to normal messages
		MOVEM B,ERMSGL	; hack the messages
		RET]		; and return
	CAIN CH,"S		; hack autotypeout on searches?
	 JRST [	TRNN FF,ARG	; have an argument?
		 JRST [	MOVE A,ESFLAG
			POP P,(P); fix up stack
			JRST VALRET]; yes, return current value
		MOVEM B,ESFLAG	; else set ES flag
		RET]		; and return
	CAIN CH,"P		; EP => ENTER INFERIOR EXEC
	 JRST [	MOVSI 1,200000	; INFERIOR GETS THIS FORK'S CAPACITIES
		CFORK		; CREATE AN INFERIOR
		 ERROR [ASCIZ/FRK Can't create inferior fork/]
		HRL 1		; SAVE PROCESS HANDLE
		MOVSI 1,100001	; OLD FILE, SHORT FORM
		SKIPE TENEXP	; IS THIS ON TENEX?
		 SKIPA 2,[-1,,[ASCIZ/<SYSTEM>EXEC.SAV/]]
		  HRROI 2,[ASCIZ/<SYSTEM>EXEC.EXE/]
		GTJFN		; GET A JFN FOR THIS GUY
		 ERROR [ASCIZ/EXC Can't get at EXEC/]
		HLL 1,		; GET THE OLD PROCESS HANDLE
		HRR 1		; SAVE THE JFN
		GET		; STUFF THE INFERIOR FORK
		HLR 1,		; SELECT EXEC FORK
		SETZ 2,		; FIRST LOCATION IN ENTRY VECTOR
		SFRKV		; START FORK THERE
		WFORK		; WAIT FOR IT TO BE DONE
		KFORK		; KILL THE BLASTED THING
		MOVE 1,		; GET THE JFN WE USED
		RLJFN		; AND FREE IT UP
		 JFCL		; LOSEY
		RET]		; NOW RETURN
	ERROR [ASCIZ/IEC Invalid E command/]

GOCCL:	CALL UNLOAD		; dump out file first
	TLZ FF,UREAD+UWRITE+FINF;IN CASE REENTER HAPPENS
	MOVEI 1,7.
	DTI			;turn off bell
	SKIPN TENEXP
	 JRST [	MOVE 1,[.PRAST,,.FHSLF]
		MOVEI 2,[1 ? 400740,,2 ? 0]
		MOVEI 3,3
		PRARG		; magically tells Twenex EXEC to CCL
		HALTF
		JRST .-1]
	MOVE 1,[1,,['SYS,, ? 'CCL,, ? 0 ? 0 ? 0 ? 0]]
	047040,,35		; 10/50 "RUN" UUO
	ERROR [ASCIZ/CNA CCL not available/]

DINISH:	SETOM DUNFLG		;Almost like finish
	CAIA
FINISH:	 SETZM DUNFLG
	CALL BFSAVE
	JRST SEMI.H
; ;S	SAME AS ;U BUT DOES NOT CLEAR BUFFER

BFSAVE:	SETOM SAVFLG		;SUPPRESS BUFFER CLEARING
	JRST UNLD0

;  ;D	DATE AND UNLOAD

DNLOAD:	SETOM DUNFLG		;SAY ;D MODE
	SKIPA

; ;U	UNLOAD AND CLEAR BUFFER
UNLOAD:	 SETZM DUNFLG		;SAY ;U MODE
	SETZM SAVFLG		;PERMIT CLEARING BUFFER AFTER UNLOAD

UNLD0:	TRNE FF,ARG+ARG2	;ARGUMENT?
	 ERROR [ASCIZ/ANE Argument given when none expected/]
	TLNN FF,UWRITE		;FILE OPEN?
	 CALL UNLD1		;NO, GO OPEN ONE
	MOVSI B,1		;A LARGE NUMBER OF PAGES
	TRO FF,ARG		;MAKE BELIEVE IT WAS TYPED IN
	CALL PUNCH		;PUNCH THOSE PAGES
	CALL CLOSEF		;CLOSE AND RENAME FILES
	RET

UNLD2:	JSP A,CONMES
	ASCIZ / ?
/
UNLD1:	JSP A,CONMES
	ASCIZ /Output file: /
	MOVSI 1,(1_35.+1_32.+1_31.)	;OUTPUT+PRNT O/N+CONFIRM
	MOVEM 1,OJTB		;GOES IN FIRST WORD OF JFN TABLE
	MOVE 1,[100,,101]	;FROM/TO PRIMARY IO
	MOVEM 1,OJTB+1		;SECOND WORD
	MOVEI 1,OJTB		;ASSUME OTHERS CORRECT
	SETZ 2,
	GTJFN
	 JRST UNLD2
	SETZM ABORTF
	JRST OPNOUT		;OPEN FILE AND RETURN

U SAVFLG,1			;0 FOR ;D/;U,  -1 FOR ;S
U DUNFLG,1			;  ;D/;U FLAG
U OJTB,11			;JFN TABLE
U DEFNAM,20			;DEFAULT FILE NAME AND EXTENSION
;LOAD ENTIRE FILE COMMAND - ;Y

YLOAD:	TRNE FF,ARG+ARG2
	 ERROR [ASCIZ/ANE Argument given when none expected/]
	TLNN FF,UREAD		;FILE OPEN?
	 CALL YLD1		;NO, GO OPEN ONE
	SETZM YCRCNT		;COUNT UP UNMATCHED CR'S AND PRINT BELOW
YLD3:	MOVE OU,Z		;APPEND A PAGE
	MOVE CH,FBIN
	CAIN CH,FBIN1		;PMAP-ABLE INPUT FILE?
	 SKIPE EOLF		;AND BUFFER CAN HAVE CRLF'S IN IT?
	  JRST YLD32		;NO OR NO.
YLD31:	CALL PMAP.Y		;PMAP ALL PAGES INTO THE BUFFER
	 JRST YLD33
YLD32:	CALL YANK2		;OLD-STYLE INPUT ROUTINES
YLD33:	TRNE FF,FORM		;IF ^L WAS NOT READ (BUFFER FULL OR EOF)
	 SKIPE ABORTF		;ABORTED?
	  JRST YLD4		;YES
	TLNE FF,UREAD		;FILE STILL OPEN?
	 JRST YLD3		;YES, GET ANOTHER PAGE
YLD4:	MOVEI 1,101
	MOVE 2,Z		;NUMBER OF CHARS NOW IN BUFFER
	SUB 2,BEG
	MOVEI 3,10.
	NOUT			;PRINT IT
	 JFCL
	JSP A,CONMES
	ASCIZ / characters
/
	SKIPN 2,YCRCNT
	 RET
	MOVEI 1,101
	MOVEI 3,10.
	NOUT
	 JFCL
	JSP A,CONMES
	ASCIZ / isolated carriage returns
/
	RET
YLD2:	JSP A,CONMES
	ASCIZ / ?
/
YLD1:	SKIPL 1,CCLJFN		;IF CCL
	 JRST OPNIN		;WE ALREADY HAVE THE JFN
	JSP A,CONMES
	ASCIZ /Input file: /
	MOVSI 1,(1_33.+1_31.)	;OLD FILE+CONFIRM
	MOVEM 1,OJTB		;TO FIRST WORD OF JFN TABLE
	MOVE 1,[100,,101]	;PRIMARY
	MOVEM 1,OJTB+1		;TO SECOND WORD
	MOVEI 1,OJTB
	SETZ 2,
	GTJFN
	 JRST YLD2
	SETZM ABORTF
	JRST OPNIN		;OPEN FILE AND RETURN

U YCRCNT,1			;NUMBER OR CAR RET NOT CONVERTED TO EOL
;ER	PREPARE TO READ FILE

OPNRD:	TLNE FF,UREAD		;FILE NOW OPEN?
	 CALL CLSINF		;CLOSE INPUT FILE
	CALL FILSPC		;GET FILE SPEC
	MOVSI 1,(1_33.+1_18.)	;OLD FILE+SHORT FORM
	GTJFN
	 JRST TYINPT
OPNIN:	HRRZM 1,INJFN
	MOVE 2,[7_30.+1_16.]	;BYTE SIZE+READ
	OPENF
	 JRST TYNOPN
	SETOM CCLJFN		;NO LONGER IN CCL MODE
	TLO FF,UREAD		;FILE OPEN
	TLZ FF,FINF		;NOT EOF
	SETZM SAVFCH		;CLEAR SAVED CHARACTER
	MOVE 2,INJFN		;FOR POSSIBLE LATER USE AS DEFAULT
	CALL SETDEF
	MOVE 1,INJFN
	DVCHR
	TLNN 2,(1_31.)		;MULT DIR DEVICE?
	 JRST [	MOVEI 1,FBIN0	;NO, USE REGULAR BIN
		MOVEM 1,FBIN
		RET]
	MOVE 1,INJFN
	MOVE 2,[2,,11]
	MOVEI 3,3
	GTFDB			;GET BYTE SIZE AND COUNT
	LDB 3,[300600,,3]	;GET BYTE SIZE
	CAIN 3,7		;SIZE WE WANT?
	 JRST OPNT1		;YES, NO CONVERSIN
	MOVEI 2,36		;NO, MUST CONVERT TO 7-BIT EQUIV
	IDIVI 2,0(3)		;GIVES N-BIT BYTES PER WORD
	IDIVI 4,0(2)		;GIVES WORDS IN FILE
	IMULI 4,5		;GIVES 7-BIT BYTES IN FILE
OPNT1:	MOVEM 4,INBYC		;SETUP BYTE COUNT
	SETOM INFPG		;START WITH PAGE 0 AFTER AOS
	SETZM IBFRC
	MOVEI 1,FBIN1
	MOVEM 1,FBIN		;FIRST CALL WILL DO THE REST
	RET

;SET UP DEFAULTS

SETDEF:	HRROI 1,DEFNAM		;GET COMPLETE NAME OF FILE JUST OPENED
	MOVE 3,[001100,,1]	;GIVE FILE NAME AND EXTENSION ONLY
	JFNS			;GET THE NAME STRING
	MOVE 3,[440700,,DEFNAM]	;POINTER TO BEGINNING OF NAME
	MOVEM 3,OJTB+4		;DEFAULT NAME SLOT IN JFN TABLE
	ILDB 1,3		;SEARCH FOR PERIOD DELIMITING NAME
	CAIE 1,".
	 JUMPN 1,.-2		;STOP ALSO ON END OF STRING (NULL)
	MOVEM 3,OJTB+5		;POINTER TO BEGINNING OF EXTENSION
	SETZ 1,
	DPB 1,3			;PUT 0 AFTER END OF FILE NAME
	RET

;TYPE INPUT DEVICE ERROR
TYNOPN:	SKIPL 2,CCLJFN		;IF CALLED FROM CCL,
	 JRST [	SETOM CCLJFN	;NO LONGER IN CCL MODE
		POP P,(P)	;BUM THE STACK ONE DOWN (CAN'T USE ADJSP ON KA)
		HRROI 1,[ASCIZ/[New file]
/]
		PSOUT
		JRST SETDEF]	;SET DEFINITIONS AND RETURN
	MOVE 1,INJFN		;RELEASE JFN
	RLJFN
	 JFCL
TYINPT:	SETOM INJFN
	ERROR [ASCIZ/FNF File not found/]
;EA	OPEN OUTPUT FILE FOR APPEND

OPNAP:	TLNE FF,UWRITE		;FILE OPEN FOR OUTPUT NOW?
	CALL CLOSEF		;YES. CLOSE IT
	CALL FILSPC		;SET DEFAULT STRING
	MOVSI 1,(1_33.+1_32.+1_18.)	;OLD, CONFIRM, SHORT
	GTJFN
	 JRST OUTERR
	HRRZM 1,OUTJFN
	MOVE 2,[7_30.+1_13.]	;7-BIT, APPEND
	OPENF
 	 JRST OUTER1
	TLO FF,UWRITE		;SAY WE HAVE AN OUTPUT FILE
	JRST OPNOT2		;SETUP FOR BOUT'S, NOT PMAP'S
;EW	SELECTS THE OUTPUT DEVICE AND OPENS THE FILE SPECIFIED (IF ANY)

OPNWR:	TLNE FF,UWRITE		;OUTPUT FILE NOW OPEN?
	 CALL CLOSEF		;CLOSE IT
	CALL FILSPC
	MOVSI 1,(1_35.+1_32.+1_18.)	;WRITE+PRINT OLD/NEW+SHRT
	GTJFN
	 JRST OUTERR
OPNOUT:	HRRZM 1,OUTJFN
	DVCHR
	PUSH P,2		;SAVE FOR LATER TEST
	TLNN 2,(1_31.)		;PMAP-ABLE DEVICE?
	 SKIPA 2,[7_30.+1_15.]	;NO.  OPEN ONLY FOR WRITING
	  MOVE 2,[7_30.+3_15.]	;YES. BLT AND IDPB NEED READ ACCESS
	MOVE 1,OUTJFN
	OPENF
	 JRST OUTER1
	TLO FF,UWRITE		;SAY WE HAVE OUTPUT FILE OPEN
	POP P,2			;GET BACK DEVICE CHARACTERISTICS
	TLNN 2,(1_31.)		;MULT DIR DEVICE?
OPNOT2:	 JRST [	MOVE 1,OUTJFN
		SKIPE DUNFLG	;NO, USE REGULAR BOUT
		 CALL HEDING	;MAKE ;D HEADING
		MOVEI 1,FBOUT0
		MOVEM 1,FBOUT	;USE REGULAR BOUT
		RET]
	SETZM OBFRC		;YES, SETUP FOR PMAP
	SETOM OUFPG
	MOVNI 1,5*1000		;1 BUFFERLOAD OF CHARS
	MOVEM 1,OUBYC		;WILL BE SET TO 0 ON FIRST CALL
	MOVEI 1,FBOUT1
	MOVEM 1,FBOUT
	SKIPL DUNFLG		;  ;D COMMAND?
	 RET			;NO
	CALL FBO1		;MAKE 1ST FILE PAGE
	MOVE 1,OBFRP		;PTR
	CALL HEDING		;HEADING TO CORE
	MOVEM 1,OBFRP		;UPDATED PTR
	MOVE 1,[440700,,OBFPGA]	;INITIAL PTR
OPNOT3:	CAMN 1,OBFRP
	 RET
	SOS OBFRC		;SPACES LEFT
	IBP 1
	JRST OPNOT3
;THIS ROUTINE INSERTS THE ;D HEADING IN THE OUTPUT BUFFER

HEDING:	CALL HEDCOM		;PUT OUT THE COMMENT CHARACTER(S)
	HRRZ 2,OUTJFN
	MOVE 3,[1_30.+1_27.+1_24.+1_21.+1_0.]
	JFNS
	MOVEI 2,<" >
	MOVEI 3,4
	BOUT
	SOJG 3,.-1
	SETO 2,
	SETZ 3,
	ODTIM
	HRROI 2,[ASCIZ /    TECO'd by /]
	SOUT
	PUSH P,1		;SAVE STRING POINTER
	GJINF
	MOVE 2,1
	POP P,1
	DIRST
	 JFCL
	MOVEI 2,^M
	BOUT
	MOVEI 2,^J
	BOUT
	RET

OUTER1:	MOVE 1,OUTJFN
	RLJFN			;RELEASE JFN
	 JFCL
OUTERR:	SETOM OUTJFN
	ERROR [ASCIZ/OUT File output failure/]
;OUTPUT THE COMMENT CHARACTER(S) FOR THE HEADING

HEDCOM:	LDB 2,[350700,,COMBUF]	;IS THERE A ^D...$  DEFAULT?
	JUMPN 2,[	HRROI 2,COMBUF
			SETZ 3,
			SOUT		;OUTPUT THE DEFAULT
			RET]

	PUSH P,1
	SETOM EXTEN		;INCASE NO EXTENTION
	HRROI 1,EXTEN
	MOVE 2,OUTJFN
	MOVSI 3,(1_24.)		;EXT ONLY
	JFNS

HEDCO1:	MOVSI 3,-EXTL
HEDCO2:	MOVSI 2,440700
	HLR 2,EXTTAB(3)
	MOVE 1,[440700,,EXTEN]
	CALL STRCOM
	 JRST [	AOBJN 3,HEDCO2	;NOT EQUAL, TRY NEXT
		MOVEI 2,";	;USE ; IF NOTHING ELSE
		POP P,1
		BOUT
		RET]
	HRRO 2,EXTTAB(3)
	SETZ 3,
	POP P,1
	SOUT
	RET
;STRING COMPARE

STRCOM:	PUSH P,1
	PUSH P,2
STRCO1:	ILDB 1,-1(P)
	ILDB 2,0(P)
	CAME 1,2
	 JRST STRCO2
	JUMPN 1,STRCO1		;HAVEN'T HIT NULL AT END
	AOS -2(P)		;SKIP RETURN
STRCO2:	SUB P,[2,,2]		;FLUSH ARGS
	RET

DEFINE ETAB TRANS,COMCHR
 [ASCIZ \TRANS\],,[ASCIZ \COMCHR\]
TERMIN

EXTTAB:	ETAB MAC,[;]
	ETAB MID,[;]
	ETAB FAI,[;]
	ETAB PAL,[/]
	ETAB BCP,[//]
	ETAB B11,[//]
	ETAB F4,[C ]
	ETAB F40,[C ]
	ETAB FOR,[C ]
	ETAB F10,[C ]
	ETAB STG,[C ]
	ETAB P11,[;]
	ETAB BLI,[!]
	ETAB PPL,[... ]
	ETAB HEADBCP,[//]
	ETAB CBL,[*]
	ETAB COB,[*]
	ETAB LO,[.*  ]
	ETAB RNO,[.!]
	ETAB RNB,[.!]
	ETAB RNC,[.!]
	ETAB RND,[.!]
	ETAB RNE,[.!]
	ETAB RNH,[.!]
	ETAB RNL,[.!]
	ETAB RNM,[.!]
	ETAB RNP,[.!]
	ETAB RNS,[.!]
	ETAB CMD,[!]
	ETAB CTL,[!]
	EXTL==.-EXTTAB

U EXTEN,10			;EXTENSION BUFFER
;EF	FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT
;	SELECTING A NEW OUTPUT FILE.

CLOSEF:	TLZN FF,UWRITE
	 RET
	MOVE 1,FBOUT
	CAIE 1,FBOUT1		;PMAP CASE?
	 JRST CLOS2		;NO
	SETO 1,			;YES, CLEAR OUT LAST PAGE
	MOVE 2,[400000,,OBFPG]
	PMAP
	MOVE 1,OUTJFN
	HRLI 1,11
	MOVSI 2,(77_24.)		;SET FILE BYTE SIZE TO 7
	MOVSI 3,(7_24.)		;SEVEN COME ELEVEN ...
	CHFDB
	HRLI 1,12
	SETO 2,
	MOVE 3,OUBYC		;SET FILE BYTE COUNT
	ADDI 3,5000		;LAST BUFFER CONTAINS 5000-OBFRC CHARS
	SUB 3,OBFRC
	CHFDB
CLOS2:	MOVE 1,OUTJFN
	CLOSF
	 JFCL
	SETOM OUTJFN
	RET

;CLOSE INPUT FILE

CLSINF:	PUSH P,1
	PUSH P,2
	TLZN FF,UREAD
	 JRST CLSINX
	SETO 1,
	MOVE 2,[400000,,IBFPG]
	PMAP			;UNMAP LAST PAGE IF ANY
	MOVE 1,INJFN
	CLOSF
	 JFCL
	SETOM INJFN
CLSINX:	POP P,2
	POP P,1
	RET

U INJFN,1
U OUTJFN,1
;GATHER FILE NAME

FILSPC:	MOVEI 1,NFILNM*5-2	;LENGTH OF FILENAME BUFFER
	MOVE B,[440700,,FILNAM]
FILS2:	CALL SKRCH
	CAIN CH,^[		;ALTMODE?
	 JRST FILS1		;YES, END OF NAME
	IDPB CH,B		;PUT IN STRING FOR GTJFN
	SOJG 1,FILS2		;GET ANOTHER IF NOT FULL
	ERROR [ASCIZ/FTL File name too long/]

FILS1:	SETZ CH,		;DEPOSIT NULL BYTE TO MARK END OF STRING
	IDPB CH,B
	MOVE 2,[440700,,FILNAM]
	RET

U FILNAM,NFILNM
;Y	RENDER THE BUFFER EMPTY.  READ INTO THE BUFFER UNTIL
;	(A)  A FORM FEED CHARACTER IS READ, OR
;	(B)  THE BUFFER IS WITHIN ONE THIRTY-SECOND
;	     OF CAPACITY AND A LINE FEED IS READ, OR
;	(C)  AN END OF FILE IS READ, OR
;	(D)  THE BUFFER IS 63/64 FULL.
;THE FORM FEED (IF PRESENT) DOES ENTER THE BUFFER.

YANK:	SKIPE ABORTF		;ABORT REQUEST?
	 RET			;YES, DON'T CLOBBER BUFFER
	TLNN FF,UREAD		;IS THERE AN OPEN INPUT FILE?
	 ERROR [ASCIZ/NFI No file for input/]
	MOVE OU,BEG
	MOVEM OU,PT
	CALL YANK2
	RET

;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.
	CALL YANK2
	JRST CRET
YANK2:	TRZ FF,FORM		;RESET THE YANK,APPEND FORM FEED FLAG
YANK3:	TLNN FF,UREAD		;HAS AN INPUT FILE BEEN SPECIFIED?
	 ERROR [ASCIZ/NFI No file for input/]
	SETZ CH,
	EXCH CH,SAVFCH		;GET SAVED CHARACTER, IF ANY
	SKIPN CH
	 CALL @FBIN
	JUMPE CH,YANK3		;FLUSH NULLS
	SKIPE EOLF		;BUFFER IS SUPPOSED TO HAVE EOLS
	 CAIE CH,^M		;AND WE HAVE A CR?
	  CAIA
	   JRST YANCR		;YES, CONVERT TO EOL
YANCR2:	CALL PUTCHR		;NO. PUT CHARACTER IN DATA BUFFER.
	ADDI OU,1
	CAMGE OU,[760000*5]	;ALMOST(31/32) FULL?
	 JRST YANK4		;IF NOT FULL YET
	CAMGE OU,[770000*5]	;63/64 FULL?
	 CAIN CH,EOL		; OR EOL JUST READ?
	  JRST YANK51		;QUIT EARLY.
YANK4:	SKIPE ABORTF		;ABORT REQUEST?
	 JRST YANK51		;YES, QUIT WITH WHAT WE HAVE
	CAIE CH,^L		;FORM FEED?
	 JRST YANK3
	TRO FF,FORM		;Y OR A TERMINATED ON FORM FEED
YANK51:	MOVEM OU,Z		;YES. SET END OF DATA BUFFER AND RETURN
	RET

YANCR:	CALL @FBIN		;GET FOLLOWING CHARACTER
	CAIE CH,^J		;LINE FEED?
	 JRST [	MOVEM CH,SAVFCH	;NO, SAVE IT
		MOVEI CH,^M	;AND USE REAL CR
		AOS YCRCNT	;COUNT THIS CASE
		JRST YANCR2]
	MOVEI CH,EOL		;USE EOL
	JRST YANCR2

U SAVFCH,1
YANK59:	SUB P,[1,,1]		;FLUSH LOCAL RETURN
	TLO FF,FINF		;SAY WE ARE AT EOF
	CALL CLSINF		;CLOSE IT
	JRST YANK51		;END INPUT

FBIN0:	PUSH P,1
	MOVE 1,INJFN		;REGULAR BIN CASE
	MOVE CH,2
FBIN2:	BIN
	JUMPE 2,[	GTSTS	;POSSIBLE EOF
			TLNN 2,(1_27.)
			 JRST FBIN2 ;NULL, TRY AGAIN
			EXCH CH,2
			POP P,1
			JRST YANK59]
	EXCH CH,2
	POP P,1
	RET

FBI1:	SKIPG INBYC		;EOF?
	 JRST YANK59		;YES, EXIT FROM YANK
	MOVEI TT,5*IBFPG*1000	;WHERE TO MAP PAGE
	CALL MAPIN		;SETUP IBFRP, IBFRC, ETC.
FBIN1:	SOSGE IBFRC		;FAST CASE, ANY CHARS LEFT?
	 JRST FBI1		;NO, GO REFILL PAGE
	ILDB CH,IBFRP
	RET
;MAP IN A FILE PAGE
; TT HAS CHARACTER ADDRESS OF WHERE TO PUT IT
; INFPG HAS LAST PAGE NUMBER MAPPED
; SETS UP IBFRP AND IBFRC.  ADJUSTS INBYC AND INFPG.

MAPIN:	PUSH P,TT		;SAVE ARG
	PUSH P,1
	PUSH P,2
	PUSH P,3
	AOS 1,INFPG		;NO, MAP IN NEXT PAGE OF FILE
	HRL 1,INJFN
	MOVSI 2,400000		;THIS FORK
	IDIVI TT,5*1000		;GET PAGE NUMBER
	HRRI 2,0(TT)
	MOVSI 3,(1_33.\1_26.)	;READ, COPY ON WRITE
	PMAP
	LSH 2,9
	MOVES 0(2)		;MAKE PAGE PRIVATE
	HRLI 2,440700
	MOVEM 2,IBFRP		;FRESH BUFFER POINTER
	MOVEI 1,5*1000		;NO. CHARS IN BFR
	CAML 1,INBYC		;FULL BUFFER LEFT IN FILE?
	 MOVE 1,INBYC		;NO, USE ONLY WHATS LEFT
	MOVEM 1,IBFRC		;SETUP COUNT FOR THIS BUFFER
	MOVN 1,1
	ADDM 1,INBYC		;REDUCE REMAINDER IN FILE
	POP P,3
	POP P,2
	POP P,1
	POP P,TT
	RET

U IBFRC,1	;NO. CHARS IN BUFFER
U IBFRP,1	;BYTE PTR TO BUFFER
U INBYC,1	;REMAINING BYTES IN FILE
U INFPG,1	;PAGE NUMBER IN FILE
U FBIN,1	;DISPATCH ADDRESS
;PMAPPED YANK

; FOR EACH PAGE THE BUFFER IS MOVED UP TO THE NEXT PAGE BOUNDARY,
; THE FILE MAPPED IN, AND EXTRANEOUS NULLS REMOVED.

PMAP.Y:	SETZM GCDONE		;SENSE GC'S

PMAPY1:	SKIPG INBYC		;ANYTHING LEFT IN FILE?
	 JRST PMAPY9		;NO. GET OUT.
PMAY11:	SKIPE ABORTF
	 JRST PMAPY4
	MOVE C,Z		;CURRENT END OF BUFFER
	ADDI C,4777		;SET TO ROUND TO PAGE BOUNDARY
	IDIVI C,5000
	CAILE C,776		;ROOM TO MAP A PAGE AND DO EDITTING?
	 JRST PMAPY8		;NO. LEAVE WITH FILE OPEN
	IMULI C,5*1000		;1ST CHR ADDR IN NEXT PAGE
	SUB C,Z			;AMOUNT OF MOVE NEEDED
	JUMPLE C,PMAPY3		;IT'S ALREADY OK.

PMAPY2:	CALL MOVBUF		;MOVE BUFFER UP C CHRS
	JRST PMAY11		;MAKE SURE GC DID NOT CHANGE Z

PMAPY3:	MOVE TT,Z		;WHERE TO MAP IN THE PAGE
	CALL MAPIN		;DO IT
	SETZ TT,
	EXCH TT,IBFRC		;ABSORB ALL THE CURRENT PAGE
	ADDM TT,Z		;Z NOW INCLUDES NEW (PARTIAL) PAGE
	CALL NULFLS		;FLUSH DEC PADDING NULLS

PMAPY4:	MOVE I,Z
	SUBI I,1		;SET TO GET LAST CHARACTER IN BUFFER
	CALL GETCHR
	CAIE CH,^L		;BUFFER ENDS WITH FORMFEED?
	 TRZA FF,FORM		;NO
	  TRO FF,FORM		;YES
	SKIPE ABORTF
	 JRST PMAY95
	JRST PMAPY1		;GET MORE FROM FILE
PMAPY8:	SKIPE GCDONE		;HAS A GC BEEN CAUSED?
	 JRST PMAY95		;OH WELL.  FILE IS STILL OPEN.
	SETZB C,GCCNT		;CAUSE A GC
	CALL NROOM		;FAKE CALL TO PICK IT UP
	JRST PMAPY1

PMAPY9:	TLO FF,FINF		;EOF STOPPED THE INPUT
	CALL CLSINF		;CLOSE THE INPUT FILE
PMAY95:	MOVN A,BEG		;BE SURE BUFFER BEGINS ON WORD BOUNDARY
	IDIVI A,5
	MOVEI C,5(A+1)
	SKIPE A+1
	 CALL MOVBUF
	RET

;SUBR FOR ABOVE

MOVBUF:	PUSH P,PT		;SAVE "." IN UNMOVED BUFFER
	MOVE A,BEG		;SET TO MAKE SPACE AT BEGINNING
	MOVEM A,PT
	CALL NROOM
	POP P,PT		;RESTORE "."
	ADDM C,PT		;MOVE IT
	ADDM C,BEG		;AND CUT OFF THE HOLE
	SOS GCCNT		;THAT MADE SOME GARBAGE
	RET
;NULL FLUSHER ROUTINE
; USES:	IBFRP AS SETUP BY MAPIN, Z INCLUDING ALL OR PART OF NEW PAGE
; RETS:	NEW UPDATED Z

NULFLS:	PUSH P,PT
	PUSH P,IBFRP		;WHERE TO BEGIN NEXT WORD SCAN

NULFL1:	MOVE TT,Z
	IDIVI TT,5		;WORD CONTAINING LAST CHARACTER
	HRRZ I,0(P)		;WHERE THIS SCAN SHOULD START
	SUB I,TT		;NEGATIVE NUMBER OF WORDS LEFT
	SKIPL I			;HAVE SOME WORDS TO DO?
	 MOVE I,TT		;NO. ADJUST I
	JUMPGE I,NULFL3		;GO DO PARTIAL WORD AT END

NULFL2:	HRLZS I
	HRR I,0(P)		;FORM AOBJN PTR TO REST OF BUFFER
	CALL NULSRC		;POINT I AT WORD CONTAINING A NULL
	HRRZM I,0(P)		;WHERE TO RESUME NEXT TIME

NULFL3:	HRRZS A,I
	HRLI A,440700	;BYTE POINTER TO WORD WITH NULL
	IMULI I,5		;CORRESPONDING CHR ADDR
NULF33:	CAML I,Z		;OFF THE END OF THE BUFFER?
	 JRST NULFLX		;YES. DONE.
	ILDB CH,A
	SKIPE CH		;NULL?
	 AOJA I,NULF33		;NO. KEEP LOOKING

NULFL4:	MOVEM I,PT		;SAVE WHERE THE NULL WAS FOUND FOR NROOM
	ADDI I,1		;UPDATE TO MATCH A
	MOVNI C,1		;NEG NUMBER OF NULLS SEEN SO FAR
NULF41:	CAML I,Z		;STILL IN BUFFER?
	 JRST NULFL5		;NO. CHOP NULLS AND GET OUT EVENTUALLY
	ILDB CH,A
	ADDI I,1
	SKIPN CH			;IS THIS A NULL TOO?
	 SOJA C,NULF41		;YES. KEEP LOOKING

NULFL5:	CALL NROOM		;FLUSH NULLS. UPDATE Z
	JRST NULFL1		;AND LOOK FOR NEXT BLOCK OF THEM.

NULFLX:	SUB P,[1,,1]
	POP P,PT
	RET

;SUBR TO SEARCH FOR A WORD CONTAINING ONE OR MORE NULLS.
;USES I CONTAING AOBJN PTR TO AREA TO SEARCH. RETURNS I UPDATED

NULSRC:	JFCL 4,.+1
	MOVE C,[.BYTE 7 ?001?001?001?001?001]
NULSR1:	SETCM A,0(I)
	ADD A,C
	XOR A,0(I)
	JFCL 4,NULSRX
	TDNN A,C
	 AOBJN I,NULSR1
NULSRX:	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:	CALL TAB2		;INSERT TAB

;ITEXT$	INSERT, AT THE CURRENT POINTER LOCATION, THE TEXT FOLLOWING
;	THE IN 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 C,0		;COUNT # CHARACTERS TO INSERT IN C

;ENTER HERE FROM REPLACE -- C MAY HAVE NEG. NUM. (DELETION)
RPINS:	SKIPE ABORTF		;ABORT REQUEST?
	 RET			;YES, DON'T START INSERT
	MOVE A,S.TERM		;TERMINATOR SET IN REPLACE
	TRNE FF,RPLFG
	 JRST RPINS1		;USE TERM FROM REPLACE
	MOVEI CH,^[		;USE ALTMODE FOR TERM. UNLESS @I
	TRZE FF,SLSL		;DID @ PRECEED I?
	 CALL SKRCH		;GET TERMINATOR FROM COMMAND STRING
	MOVEM CH,A		;SAVE TERMINATOR
				;EITHER ALT-MODE OR USER CHOICE.
RPINS1:	PUSH P,COMAX
	PUSH P,CPTR		;SAVE CURRENT POSITION OF CPTR.
	PUSH P,COMCNT
	CALL SKRCH		;GET NEXT CHARACTER
	CAME CH,A		;IS IT THE TERMINATOR?
	 AOJA C,.-2		;NO. TRY AGAIN.
	SKIPE C			;SKIP IF NO ROOM NEEDED
	 CALL NROOM		;MOVE FROM PT THROUGH Z UP C POSITIONS.
	MOVE B,-1(P)		;RETRIEVE INPUT POINTER
	SUB P,[3,,3]

;MOVE INSERTION INTO DATA BUFFER

INS1B:	MOVE OU,PT
INS1C:	ILDB CH,B		;CHARACTER FROM COMMAND STRING.
	CAMN CH,A		;IS IT THE TERMINATOR?
	 RET			;YES. DON'T STORE IT.
	CALL PUTCHR		;NO. STORE CHAR IN BUFFER
	AOS OU,PT
	JRST INS1C
; ;G  INSERT LAST COMMAND STRING (OF >15 CHARS) INTO BUFFER

GETOB:	HLRZ C,LSTCB		;NUMBER OF CHARS
	JUMPE C,CRET		;NO SAVED STRING
	CALL NROOM
	MOVE A,[440700,,CBUF]
GETOB1:	MOVE OU,PT
	ILDB CH,A
	CALL PUTCHR
	AOS PT
	SOJG C,GETOB1
	JRST CRET
;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:	MOVE CH,NUM
	TDNE CH,[-1,,777600]	;STRAY BITS?
	 ERROR [ASCIZ/NAC Not an ASCII character/]

;INSERT CH IN DATA BUFFER AT PT

TAB2:	MOVEI C,1		;MOVE FROM PT THROUGH Z UP 1 POSITION.
	CALL NROOM
	AOS OU,PT
	SOJA OU,PUTCHR		;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		;SAY @ SEEN
	JRST CD5

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

BAKSL1:	MOVE T,[700,,BAKTAB-1]
	MOVEI C,0		;COUNT # DIGITS IN C.
	CALL DPT		;CONVERT C(B) TO ASCII, STORE IN BAKTAB.
	MOVEI A,141		;MARK END OF STRING 
	IDPB A,T
	CALL NROOM		;MOVE FROM PT THROUGH Z UP C POSITIONS.
	MOVE B,[700,,BAKTAB-1]
	CALL INS1B		;INSERT STRING INTO DATA BUFFER AT PT.
	JRST CRET

;ROUTINE TO OUTPUT DECIMAL INTEGER
;CALL	MOVE B, DECIMAL INTEGER
;	CALL DPT
;	RETURN

DPT:	JUMPGE B,DPT1		;NUMBER > 0?
	MOVEI CH,"-		;NO. OUTPUT -
	IDPB CH,T		; save - in buffer
	ADDI C,1		; and advance pointer
DPT1:	MOVMS B			;B:=ABSOLUTE VALUE OF B
	IDIVI B,10.		;E:=DIGIT
	HRLM E,(P)		;PUT DIGIT ON LEFT HALF OF TOP OF PDL
	JUMPE B,.+2		;DONE?
	CALL .-3		;NO.
	HLRZ CH,(P)		;YES. CH:=DIGIT
	ADDI CH,60		;CONVERT IT TO ASCII.
	IDPB CH,T		; save digit in buffer
	ADDI C,1		; save digit in buffer
	RET			; and return
;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:	MOVEI D,TYO		;ADDRESS OF OUTPUT ROUTINE.

TYPE0:	CALL GETARG		;C:=FIRST STRING ARGUMENT ADDRESS.
				;B:=SECOND STRING ARGUMENT ADDRESS.

TYPE1:	CALL 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 CPOPJ
	MOVE TT,I		;NO. GET NEXT CHAR
	IDIVI TT,5		;THIS IS A COPY OF GETINC
	LDB CH,BTAB(TT1)	;COPIED TO SPEED IT UP
	ADDI I,1
	CAIN CH,^H
	 CAIE D,TYO
	  CAIA
	   JRST [	HRROI 1,[ASCIZ/^H/]
			PSOUT
			JRST .+2]
	CALL (D)		;OUTPUT IT
	SKIPLE ESFLAG		; ES flag set?
	 JRST [	CAIN D,TYO	; typing?
		 CAME I,PT	; I = . ?
		  JRST .+1	; no, flush this
		REPEAT 2,PUSH P,1+.RPCNT
		MOVEI 1,101	; primary output JFN
		RFMOD		; get terminal mode
		PUSH P,2
		ANDCMI 2,300	; enter binary mode
		SFMOD		; hack the mode
		MOVEI 1,^J	; output a line feed
		PBOUT
		MOVEI 1,101
		POP P,2
		SFMOD
		REPEAT 2,POP P,2-.RPCNT
		JRST .+1]
	SKIPN ABORTF		;ABORT REQUEST?
	 JRST TYPE3		;LOOP
	CAIN D,TYO		;YES, DOING TTY OUTPUT?
	 JRST TYOQT		;YES, QUIT
	RET			;NO, STOP BUT JUST RETURN
; V  --  View lines surrounding  "."
; V  types the current line  (0tt)
;nV types n-1 lines before "." , the current line, and the n-1 following
;m,nV types m before (including the current line), and n-1 after

VIEW:	TRNN FF,ARG		; n specified?
	 MOVEI B,1		;No. Default to 1
	TRNN FF,ARG2		; m,n ??
	 MOVE C,B		;No, default to same as first arg
	JUMPL B,VIEWX		;NEG. NOT ALLOWED
	JUMPL C,VIEWX		;NEG. NOT ALLOWED

	MOVE I,PT		;Start at "."
VIEW1:	CAMN I,Z		;At end of buffer?
	 JRST VIEW2		;Yes
	CALL GETINC		;Get next chr, increment i
	CALL EOLP		;END OF LINE IN CURRENT FORMAT?
	 JRST VIEW1		;No, keep looking
	SOJG B,VIEW1		;Yes, count it

VIEW2:	MOVE B,I		;Save end point of view
	MOVE I,PT		;Start at "." again

VIEW3:	SOS I			;Back up
	CAMGE I,BEG		;At beginning of buffer?
	 JRST VIEW4		;Yes
	CALL GETINC		;Load CH and bump I
	CALL EOLP		;END OF LINE?
	SOJA I,VIEW3		;No. Unbump I and look at previous chr
	SOJG C,.-1		;Yes. Count this line.

VIEW4:	MOVE C,I		;Save start of view
	CAMGE C,BEG		;Tried to back off beginning?
	 MOVE C,BEG		;Yes, default to beginning
	MOVEI D,TYO		;Select TTY:
	JRST TYPE1

VIEWX:	ERROR [ASCIZ/MVS Meaningless viewspecs/]
PPA:	TLNN FF,UWRITE		;OUTPUT FILE OPEN?
	ERROR [ASCIZ/NFO No file for output/]
	TRZE FF,RUBCF		;RUBOUT PRECEEDED?
	 JRST PPA1		;YES, OUTPUT THIS CHAR LITERALLY
	CAIN CH,177		;THIS A RUBOUT?
	 TRO FF,RUBCF		;YES, REMEMBER FOR NEXT CHAR
	SKIPE EOLF		;BUFFER HAS 037 MEANING EOL?
	 CAIE CH,EOL		;AND HAVE A TENEX EOL?
PPA1:	  JRST @FBOUT		;NO, SEND DIRECTLY

PPAEOL:	MOVEI CH,^M		;CONVERT TENEX EOL TO CRLF
	CALL @FBOUT
	MOVEI CH,^J
	CALL @FBOUT
	MOVEI CH,EOL
	RET

FBOUT0:	PUSH P,1		;REGULAR BOUT CASE
	MOVE 1,OUTJFN
	EXCH CH,2
	BOUT
	EXCH CH,2
	POP P,1
	RET
FBOU1A:	CALL FBO1
FBOUT1:	SOSGE OBFRC		;FAST CASE, CHAR LEFT?
	 JRST FBOU1A		;NO, REFILL BUFFER PAGE
	IDPB CH,OBFRP
	RET

FBO1:	PUSH P,1
	PUSH P,2
	PUSH P,3
	AOS 1,OUFPG		;MAP NEXT FILE PAGE
	HRL 1,OUTJFN
	MOVE 2,[400000,,OBFPG]
	MOVSI 3,160000
	PMAP
	MOVE 1,[OBFPGA,,OBFPGA+1]
	SETZM -1(1)		;CLEAR PAGE SO NO GARBAGE AT END
	BLT 1,OBFPGA+777
	MOVEI 1,5*1000		;FULL PAGE OF CHARACTERS
	MOVEM 1,OBFRC		;ROOM COUNT
	ADDM 1,OUBYC		;TOTAL BYTES OUTPUT SO FAR
	MOVE 1,[440700,,OBFPGA]
	MOVEM 1,OBFRP		;FRESH PTR
	POP P,3
	POP P,2
	POP P,1
	RET

U OBFRC,1
U OBFRP,1
U OUBYC,1
U OUFPG,1
U FBOUT,1
;P	PUNCH THIS BUFFER, YANK THE NEXT
;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:	MOVEI D,PPA		;SELECT PPA FOR OUTPUT.
	TRZ FF,RUBCF
	TRNE FF,ARG2		;I,JP?
	 JRST TYPE0		;YES. GET STRING ARGUMENTS AND OUTPUT.
	TRNN FF,ARG
	 MOVEI B,1
	MOVE E,B		;NO. E:=N
	JUMPL E,CPOPJ		;IF N<0, IGNORE P.
PUN1:	CALL PUNCHR		;PUNCH OUT BUFFER
	SKIPE ABORTF		;ABORT?
	 RET			;YES, DON'T CLOBBER BUFFER
	SKIPE SAVFLG		;0 EXCEPT FOR  ;S  COMMAND
	 JRST PUN15
	MOVE B,BEG		;MAKE BUFFER EMPTY
	MOVEM B,PT
	MOVEM B,Z
PUN15:	TLNE FF,UREAD
	 TLNE FF,FINF
	  RET
PUN2:	JUMPE E,CPOPJ
	CALL YANK		;RENEW BUFFER
	SKIPE ABORTF		;ABORT?
	 RET			;YES
	MOVE C,Z
	CAMN C,BEG		;EMPTY BUFFER?
	 TLNN FF,FINF		;YES. QUIT ON EOF
	  SOJG E,PUN1		;NO. E:=E-1. DONE?
CPOPJ:	RET

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

; ;W - WRITE OUT BUFFER AND DELETE

WRBUF:	TRNE FF,ARG\ARG2
	 JRST WRBF1
	CALL PUNCHR
	JRST KLBUF

WRBF1:	CALL GETARG
	CALL WRBF2
	JRST KLBUF
; R - REPLACE ... BY ...

REPLAC:	CALL CHK2
	TRO FF,RPLFG
	TRZ FF,ARG+ARG2		;SO AS NOT TO CONFUSE S K AND I
	JUMPE B,RPLC5		;REPETITION COUNT=0,  VERY SPECIAL
RPLC3:	PUSH P,COMAX		;NEEDED BY GC
	PUSH P,CPTR
	PUSH P,COMCNT
	SKIPE ABORTF		;ABORT?
	 JRST RPLC4		;YES, STOP
	PUSH P,B		;SAVE ITERATION COUNT
	MOVEI B,1		;WANT 1ST OCCURENCE
	SKIPGE 0(P)		;REVERSE REPLACE?
	 MOVNS B		;YES, SEARCH BACKWARDS
	CALL SERCH		;SEARCH AND ADVANCE PT
	MOVNI C,0(F)		;GET - NUM OF CHRS IN SEARCH STRING
	ADDM C,PT		;BACKUP PT TO BEG OF SEARCH STRING
	CALL RPINS
	POP P,B			;GET BACK ITERATION COUNT
	SKIPL B			;COUNT IT TOWARS 0
	 SOSA B
	  AOS B
	JUMPE B,RPLC4		;DONE
	POP P,COMCNT		;MORE TO DO, RESTORE COMMAND STRING
	POP P,CPTR
	POP P,COMAX
	JRST RPLC3

RPLC4:	SUB P,[3,,3]		;FLUSH JUNK
	TRZ FF,RPLFG
	JRST CRET

RPLC5:	MOVEI CH,^[		;ALT MODE
	TRZE FF,SLSL		;@ SEEN?
	 CALL SKRCH		;YES, READ THE TERMINATOR
	MOVE CH,S.TERM		;SAVE IN GOOD PLACE
	CALL SKRCH		;LOOK FOR END OF SEARCH STRING
	CAME CH,S.TERM
	 JRST .-2
	CALL SKRCH		;LOOK FOR END OF REPLACEMENT
	CAME CH,S.TERM
	 JRST .-2
	TRZ FF,RPLFG
	JRST CRET
;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

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

CHARAC:	CALL 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:	CALL CHK		;IS C(B) WITHIN DATA BUFFER?
	MOVEM B,PT		;YES. PT:=C(B)
	JRST CRET

;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 [ASCIZ/TMA Too many arguments/]
	CALL GETARG		;NO. C:=FIRST STRING ARGUMENT ADDRESS,
				;B:=SECOND STRING ARGUMENT ADDRESS.
	XOR B,C
	XORM B,PT
	JRST CRET
;ROUTINE TO RETURN CURRENT ARGUMENT IN B
;ASSUMES A VALUE OF 1 WITH SIGN OF LAST OPERATOR
;IF THERE IS NO CURRENT ARGUMENT
;CALL	CALL CHK2
;	RETURN WITH B:=CURRENT ARG.,+1 OR -1

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

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

;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:	CALL GETARG		;C:=FIRST STRING ARG. ADDRESS
				;B:=SECOND STRING ARG. ADDRESS
	CALL CHK1		;C:=MAX(C(C),BEG), B:=MIN(C(B),Z)
KLBUF:	MOVEM C,PT		;PT:=C(C)
	SUB B,C			;B:=NO. OF CHARACTERS TO KILL.
	JUMPE B,DEL2		;NONE
	JRST KLB1

KLBUF1:	TRO FF,RPLFG
	CALL KLBUF
	TRZ FF,RPLFG
	RET
;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:	TRNE FF,ARG2
	 ERROR [ASCIZ/TMA Too many arguments/]
	CALL CHK2		;MAKE SURE B CONTAINS AN ARGUMENT
KLB1:	SKIPE ABORTF		;ABORT?
	 JRST DEL2		;YES
	MOVM C,B
	MOVNS C			;C:=-ABS(B)
	ADD B,PT		;B:=PT+B
	CALL CHK		;STILL IN DATA BUFFER?
	CAMGE B,PT		;YES. IS N NEGATIVE?
	 MOVEM B,PT		;YES. MOVE PT BACK FOR DELETION.
	CALL NROOM		;MOVE FROM PT+ABS(C) THROUGH Z
				;DOWN ABS(C) POSITIONS
DEL2:	TRNE FF,RPLFG
	 RET
	JRST CRET

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

CHK:	CAMG B,Z
	 CAMGE B,BEG
	  ERROR [ASCIZ/NIB Addressing character not in the buffer/]
	RET

;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
;	CALL 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 [ASCIZ/ITP Invalid text pointer/]
	RET			;NO
U ESFLAG,1
U ESTYPE,1

LARR:	TROA FF,FINDR		;SAY LEFT ARROW SEARCH

SERCHP:	 TRO FF,PCHFLG		;SAY N SEARCH
	TRNE FF,ARG
	 JUMPL B,[ERROR [ASCIZ/BSI Backward N and _ searches illegal/]]

SERCH:	TRNE FF,ARG2		;2 ARGS?
	 ERROR [ASCIZ/TMA Too many arguments/]
	TRON FF,ARG		;WAS THERE AN ARG?
	 CALL CHK22		;DEFAULT TO + OR - ONE
	SKIPN ESFLAG		; in ES mode?
	 JRST .+3
	  TRNN FF,COLONF+ITERF	; never if in a colon search
	   SETOM ESTYPE		; ES and normal search; remember to V
	MOVE E,B
	SETZM NUM
	PUSH P,PT		;SAVE CURRENT . IN CASE S FAILS
	TRNE FF,RPLFG+ITERF+PCHFLG+COLONF+FINDR
	 JRST SERCHW
	MOVE CH,PT		;NOTHING FUNNY GOING ON, ...
	JUMPL E,[CAMN CH,BEG
		  MOVE CH,Z	;RING TO END IF BACKWARD SEARCH FROM BEG
		JRST SERCHV]
	CAMN CH,Z		;. AT END?
	 MOVE CH,BEG		;YES, RING TO BEG
SERCHV:	MOVEM CH,PT
SERCHW:	MOVEI CH,^[		;USE ALT-MODE DELIMITER IF NO @ SEEN
	TRZE FF,SLSL		;@ SEEN?
	 CALL SKRCH		;YES. CH:=USER SPECIFIED DELIMITER.
	MOVEM CH,B		;B:=SEARCH STRING DELIMITER
	MOVEM CH,S.TERM		;FOR USE IN INSERT PART OF REPLACE
;SET UP SEARCH TABLE

	HRLZI F,STAB-STABP	;F:=-LENGTH OF SEARCH TABLE,,0
SERCH2:	CALL SKRCH		;CH:=NEXT COMMAND STRING CHARACTER.
	CAIN CH,(B)		;DELIMITER?
	 JRST SERCH0		;YES. DONE.
	CAIN CH,^X
	 JRST CNTRX
	CAIN CH,^N
	 JRST CNTRN
	CAIN CH,^S
	 JRST CNTRS
	CAIN CH,^Q
	 CALL SKRCH		;^Q TAKES THE NEXT CHARACTER.
	CAIL CH,"A
	 CAILE CH,"Z
	  CAIA
	   JRST SERC21		;UPPER CASE LETTER.
	CAIL CH,"a
	 CAILE CH,"z
	  JRST SERC23
SERC21:	TLNE FF,CISRCH		;IN CASE INDEPENDENT MODE?
	 TLOA CH,(CISNE)	;YES. SET OPCODE.
SERC23:	HRLI CH,(CAIN CH,)
SERC22:	TRZE FF,NOTF		;SEARCH SENSE REVERSED?
	 TLC CH,4000		;YES. CH:=CAIE CH,CHARACTER
				;CALL CNTRS1, JSR CNTRS1, OR CAIA
	MOVEM CH,STAB(F)	;SAVE IN SEARCH TABLE
	AOBJN F,SERCH2		;GET NEXT CHARACTER
	ERROR [ASCIZ/STL Search string too long/]

U S.TERM,1
;START SEARCHING

SERCH0:	TRNE F,-1		;ANYTHING IN SEARCH TABLE?
	 JRST SERC02		;YES, USE IT

SERC01:	MOVE I,0(P)		;OLD "PT"  FOR FND
	SKIPN F,PREV.F		;"F" FOR DEFAULT
	 JRST FND		;SEARCH FOR NULL STRING WINS
	MOVS B,[STAB,,SVSTAB]
	BLT B,STAB+STABL-1

SERC02:	MOVEM F,PREV.F		;SETUP DEFAULT TABLE FOR NEXT TIME
	MOVE B,[STAB,,SVSTAB]
	BLT B,SVSTAB+STABL-1

SERC03:	HLRZ B,STAB		;SETUP FAST SEARCH STUFF
	CAIE B,(CAIN CH,)	;SINGLE CHR EQ COMPARE?
	 CAIN B,(CISNE)		;FOR EITHER SEARCH MODE.
	  TRZA FF,FSRCDF	;YES, ENABLE FAST SEARCH
	TRO FF,FSRCDF		;NO, DEFEAT FAST SEARCH
	HRRZ AA,STAB		;GET THE CHARACTER
	IMUL AA,[<.BYTE 7 ?001?001?001?001?001>_-1]	;SPREAD ACROSS WORD
	LSH AA,1

	MOVE I,PT		;START SEARCHING AT PT
SERC05:	JUMPG E,SERCH1		;SEARCH BACKWARD?
	SUBI I,0(F)		;YES, BACKUP BY LENGTH OF KEY STRING
	MOVEM I,PT		;SAVE STARTING POINT FOR SRCH5A
SERCH1:	SKIPE ABORTF		;ABORT?
	 JRST NOFND		;YES, MAKE LIKE NO FIND
	JUMPE E,FND0		;STRING SEEN N TIMES?
	MOVEI D,STAB
	TRZA FF,NFSRCF		;THIS REQUESTS FAST SEARCH

SERCH3:	 TRO FF,NFSRCF		;NO FAST SEARCH AFTER FIRST CHR
	CAIN D,STAB(F)		;END OF SEARCH TABLE?
	 JRST FND		;YES.
	CAML I,BEG		;NO. BACKED OUT OF BUFFER?
	 CAML I,Z		;OR REACHED TOP OF BUFFER?
	  JRST NOFND		;YES.
	MOVE TT,I		;NO. CH:=NEXT DATA BUFFER CHARACTER.
	IDIVI TT,5		;THIS IS COPY OF GETINC
	JUMPL E,[CAIN TT1,4
		  JRST SERCH7	;REV: AT WORD BOUNDARY. TRY FAST MODE
		JRST SERCH6]
	JUMPE TT1,SERCH7	;FWD: AT WORD BOUNDARY. TRY FAST MODE
SERCH6:	LDB CH,BTAB(TT1)
	ADDI I,1
	XCT (D)			;SKIP IF NO MATCH ON THIS CHR
SERCH5:	AOJA D,SERCH3		;MATCH FOUND. GO TO NEXT TABLE ENTRY.
SRCH5A:	SKIPG E			;SEARCH DIRECTION?
	 SOSA I,PT		;BACKWARDS
	  AOS I,PT		;FORWARDS
	JRST SERCH1		;KEEP LOOKING
U PREV.F,1		;AOBJN PTR FOR SAVED SEARCH TABLE
SERCH7:	TRNE FF,FSRCDF\NFSRCF	;FAST SEARCH DEFEATED OR NOT REQUESTED?
	 JRST SERCH6		;DO IT SLOW WAY
	MOVE B,[.BYTE 7 ?001?001?001?001?001]	;OFTEN-USED LITERAL IN FAST S.
	TLNE FF,CISRCH		;IN CASE INDEPENDENT SEARCH MODE?
	 JRST SERCH8		;YES. GO USE THAT ROUTINE

SERC70:	JFCL 4,.+1
SERC71:	MOVE C,AA		;CHR SPREAD ACROSS WORD
	MOVE T,0(TT)		;5 CHRS FROM BUFFER
	EQVB C,T		;MATCHES BECOME 177'S
	ADD C,B			;CARRY INTO BYTE TO LEFT ON MATCH
	JFCL 4,SERC79		;FOUND IN LEFTMOST BYTE CHECK REST
	EQV C,T			;CARRY AND ADD 1 LEAVE LOW BITS SAME
	TDNE C,B		;HAVE FINDS ELSEWHERE IN THIS WORD?
	 JRST SERC79		;GO CHECK MORE CAREFULLY
	JUMPL E,SERC76		;BACKWARD SEARCH

SEAR74:	ADDI I,5
	CAML I,Z
	 JRST NOFND
	AOJA TT,SERC71		;TRY NEXT WORD

SERC76:	SUBI I,5		;SETS CRY0
	CAMGE I,BEG
	 JRST NOFND
	SOJA TT,SERC70		;CLEAR CRY0 AND TRY NEXT WORD

SERC79:	MOVEM I,PT		;OUTSIDE LOOP FOR SPEED
	JRST SERCH6		;BACK TO SLOW MODE FOR EXACT FIND
;CASE INDEPENDENT WORD-AT-A-TIME SEARCH ROUTINE

SERCH8:	MOVE A,AA
	XOR A,[.BYTE 7 ?040?040?040?040?040]	;CASE FLIPPED EQUIVALENT
	MOVEM TT1,TT1SAV
SERC80:	JFCL 4,.+1
SERC81:	MOVE C,AA		;COPY OF UNFLIPPED CHRS SPREAD OVER WORD
	MOVE OU,A		;COPY OF FLIPPED VERSION
	MOVE CH,0(TT)		;WORD FROM BUFFER
	MOVE TT1,CH		;ANOTHER COPY TOO
SERC82:	EQVB CH,C		;MATCHING BYTES BECOME 177'S
	EQVB OU,TT1		;SAME FOR OTHER CASE
	ADD CH,B		;GENERATE CARRIES OUT OF MATCHING BYTES
	ADD TT1,B
	JFCL 4,SERC89		;MATCH IN HIGH BYTE, GO GET EXACT FIND
	EQV CH,C		;FIND WHICH LOW BITS GOT FLIPPED TWICE
	EQV TT1,OU
	TDNN CH,B
	 TDNE TT1,B
	  JRST SERC89		;MATCH IN ONE OF THE OTHERS
	JUMPL E,SERC86		;BACKWARD SEARCH. BACKUP A WORD.

SERC84:	ADDI I,5		;ADVANCE TO NEXT WORD IN BUFFER
	CAML I,Z
	 JRST NOFND
	AOJA TT,SERC81

SERC86:	SUBI I,5		;SETS CRY0
	CAMGE I,BEG
	 JRST NOFND
	SOJA TT,SERC80		;BACKUP BUFFER POINTER AND LOOK AGAIN

SERC89:	MOVEM I,PT		;LEFT BYTE OF WORD CONTAINING A FIND
	MOVE TT1,TT1SAV		; restore old TT1
	JRST SERCH6		;DO SLOW, PRECISE COMPARE.

U TT1SAV,1
FND:	SETOM SFINDF		;VALUE TESTED BY SEMICOLON-SPACE
	MOVEM I,PT		;MOVE PT PAST THE STRING
	AOJGE E,FND1		;BUMP REPEAT COUNT TOWARDS 0
	SUBI I,1(F)		;BACK OVER STRING JUST FOUND
	MOVEM I,PT
	JRST SERCH1
FND1:	SUBI E,1		;COMPENSATE FOR THE AOJ ABOVE
	SOJG E,SERC05		;FOUND IT N TIMES?

FND0:	SUB P,[1,,1]		;JUNK (OLD .)
	TRNE FF,RPLFG
	 RET
	TRZN FF,COLONF		;YES. COLON MODIFIER?
	 JRST CRET		;NO. DONE
FFOK:	MOVNI A,1		;YES. RETURN VALUE OF -1
	JRST VALRET
NOFND:	SETZM SFINDF		;SFINDF:=0
	TRNE FF,PCHFLG+FINDR	;S SEARCH?
	 JRST NOFND1		;NO.

BEGIN1:	POP P,PT		;RETURN TO STARTING POINT
	TRZN FF,COLONF		;YES. COLON MODIFIER?
	 JRST NOFND2		;NO

BEGIN2:	TRZ FF,PCHFLG+FINDR	;YES.
	TRZN FF,RPLFG		;ARE WE IN A REPLACE?
	 JRST BEGIN		;NO, RETURN VALUE OF 0
	CALL SKRCH		;GET A CHR FROM COMMAND STRING
	CAME CH,S.TERM		;REACHED THE END OF THE REPLACEMENT?
	 JRST .-2		;NO, KEEP LOOKINT
	SUB P,[5,,5]		;FAKE RETFROM RPLAC
	JRST BEGIN		;RETURN VALUE OF 0

NOFND1:	SKIPN ABORTF		;ABORT?
	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?
	 CALL PUNCH		;YES. PUNCH THIS BUFFER AND REFILL IT.
	TRNE FF,FINDR		;LEFT ARROW SEARCH?
	 CALL YANK		;YES. FILL BUFFER.
	POP P,E			;RESTORE SEARCH COUNT.
	MOVE I,BEG
	MOVEM I,(P)		;CAN'T GO BACK ANYMORE.
	MOVE B,[.BYTE 7 ?001?001?001?001?001];RESTORE OFTEN USED LITERAL
	JRST SERCH1		;RESUME SEARCH

NOFND2:	TRNN FF,ITERF		;IF INSIDE ITERATION
	 ERROR [ASCIZ/SFL Search failed/]
	TRNE FF,RPLFG
	 SUB P,[5,,5]		;RET FROM SERCH, ITER CT, + 3 CMD STATE
	CALL SR.END
	JRST CRET		;CONTINUE ALONG, SFINDF MAY BE TESTED

SR.END:	TRNN FF,ITERF		;IF INSIDE <>'S
	 JRST SR.EN1
	MOVSI CH,(1_34.)		; (PLUS INFINITY OVER 2)
	TDNE CH,ITERCT		;AND INDEFINITE ITERATE (NO ARG),
	 SETZM ITERCT		;STOP ITERATING
SR.EN1:	TRZN FF,RPLFG		;GET OUT OF REPLACE COMMAND IF NEEDED
	 RET			;JUST S, NOT R
SR.EN2:	CALL SKRCH
	CAME CH,S.TERM
	 JRST SR.EN2
	RET
;CNTR S MATCHES ANY SEPARATOR CHARACTER (I.E., ANY CHARACTER NOT
;A LETTER, NUMBER, PERIOD, DOLLAR SIGN OR PER CENT SYMBOL)

CNTRS:	SKIPA CH,[JSR P,CNTRS1]

;CNTR X MATCHES ANY ARBITRARY CHARACTER

CNTRX:	 MOVSI CH,(CAI)
	JRST SERC22

;HERE ON CNTR S
CNTRS2:	MOVE A,[JRST SKPSEP]
	MOVEM A,CNTRS1
	CALL SKPSEP		;IS CH A SEPARATOR?
	 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 CNTRS1,2			;INITIALIZED TO JRST SKPSEP (^N^S)
				;INITIALIZED TO JRST CNTRS2 (^S)

;UUO FOR FAST SEARCH TO SKIP IF NOT CASE INDEPENDENT MATCH
;(LIKE A CAIN CH,X IN THE CASE-DEPENDENT ROUTINE)

UCISNE:	HRRZ B,40		;GET THE CHARACTER
	XORI B,0(CH)
	TRNE B,177-40		;TEST ALL BUT CASE BIT
	 AOS UUOHX		;MATCHES. SKIP.
	JRST @UUOHX

;REVERSE SKIP FROM ABOVE

UCISEQ:	HRRZ B,40
	XORI B,0(CH)
	TRNN B,177-40
	 AOS UUOHX
	JRST @UUOHX

;SKIP IF SEPARATOR, PRESERVE B FOR FAST SERCH LOOP

SKPSEP:	PUSH P,B
	CALL DQT2
	 CAIA
	  AOS -1(P)		;GIVE SKIP RETURN
	POP P,B
	RET

COLON:	TRO FF,COLONF		;SET COLON FLAG
	JRST CD5
;MI	PERFORM NOW THE TEXT IN Q-REGISTER IN AS A SERIES OF COMMANDS.

MAC:	CALL 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,377770
	  ERROR [ASCIZ/NTQ No text in Q-register/]
	ADD A,QRBUF
	MOVE I,A
	CALL GETINC		;GET FIRST CHARACTER OF MACRO
	CAIE CH,141		;IT SHOULD BE FLAG
	 ERROR [ASCIZ/NTQ No text in Q-register/]
	CALL GETINC		;GET NUMBER OF CHARACTERS IN MACRO
	MOVE A,CH
	CALL GETINC
	LSH A,7
	IOR A,CH
	CALL GETCHR
	LSH A,7
	IOR A,CH
	SUBI A,4		;-FLAG AND COUNT
	MOVEM A,COMCNT		;THAT MANY COMMANDS TO COUNT
	MOVEM A,COMAX		;AND MAX.
	IDIVI I,5
	HLL OU,BTAB(OU)		;MAKE A BYTE POINTER
	TLZ OU,(17_18.)		;FLUSH XR BITS
	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:	TRNE FF,ARG
	 JUMPL B,[ERROR [ASCIZ/NIC Negative iteration count/]]
	AOS INTDPH
	PUSH P,ITERCT		;SAVE PREVIOUS ITERATION COUNT
	PUSH P,COMAX		;NEEDED BY GARBAGE COLLECTOR
	PUSH P,CPTR		;SAVE COMMAND STATE
	PUSH P,COMCNT
	TRZN FF,ARG		;IS THERE AN ARGUMENT?
	 HRLOI B,377777		;NO, USE PLUS INFINITY
	MOVEM B,ITERCT		;SETUP ITERATION COUNT
	JUMPE B,INCMA		; 0<...> DOES NOTHING FEATURE.
	JRST LSSTH1

GRTH:	SKIPG INTDPH		;IS THERE A LEFT ANGLE BRACKET?
	 ERROR [ASCIZ/UAB Unmatched right angle bracket/]
	SOSG ITERCT		;ITERATION DONE?
	 JRST INCMA2		;YES
	MOVE A,-1(P)		;NO. RESTORE COMMAND STATE
	MOVEM A,CPTR
	MOVE A,(P)
	MOVEM A,COMCNT
	TRNE FF,TRACEF		;TRACING?
	 CALL CRR		;YES. OUTPUT CRLF

LSSTH1:	TRO FF,ITERF
	JRST CRET

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.

TCOND:	TRNN FF,ITERF		;IN < > ?
	 ERROR [ASCIZ/SNI Semicolon not in iteration/]
	TRNN FF,ARG		;YES. IF NO ARG,
	 MOVE B,SFINDF		;LAST SEARCH SWITCH

INCMA:	JUMPL B,CRET		;IF ARG <0, JUST RET + EXECUTE LOOP
	MOVEI A,0		;INIT COUNT OF <>
INCMA1:	CALL 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:	SOSN INTDPH		;POP OUT A LEVEL
	 TRZ FF,ITERF
	SUB P,[3,,3]
	POP P,ITERCT
	JRST CRET

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

EXCLAM:	CALL SKRCH		;EXCLAM JUST INCREMENTS PAST ANOTHER !
	CAIE CH,"!
	 JRST .-2
	JRST CRET
;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		;GC CAN'T HAPPEN
	PUSH P,B
	MOVEI D,STAB+1
	MOVEI A,41
	MOVEM A,-1(D)		;STAB_"!"
OGNF1:	CALL SKRCH
	MOVEM CH,(D)		;STAB+1 ... _ TAG
	CAIL D,STAB+STABL	;FILLED BUFFER?
	 ERROR [ASCIZ/TTL Tag too long/]
	CAIE CH,^[
	 AOJA D,OGNF1
	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
	CALL 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 CRET

OGFND:	MOVE A,VALS(B)
	MOVEM A,CPTR
	MOVE A,CNTS(B)
	MOVEM A,COMCNT
	JRST CRET
;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
	 ERROR [ASCIZ/NAC No argument before conditional/]
	CALL RCH
	TRZ CH,40
	MOVSI A,0
	CAIN CH,"G
	 MOVSI A,(JUMPG B,)
	CAIN CH,"L
	 MOVSI A,(JUMPL B,)
	CAIN CH,"N
	 MOVSI A,(JUMPN B,)
	CAIN CH,"E
	 MOVSI A,(JUMPE B,)
	CAIN CH,"C
	 JRST DQT1
	JUMPE A,[ERROR [ASCIZ/UCC Undefined character after conditional/]]
	HRRI A,CRET
	XCT A

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

DQT2:	MOVE B,CH

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

DQT3:	CAIE B,"$		;$ OR %?
	 CAIN B,"%
	  RET			;YES
	CAIN B,".		;NO. POINT?
	 RET			;YES.
	CAIGE B,"0		;NO. DIGIT OR LETTER?
	 JRST POPJ1		;NO
	CAIG B,"9		;MAYBE. DIGIT?
	 RET			;YES.
	CAIGE B,"A		;NO. LETTER?
	 JRST POPJ1		;NO.
	CAIG B,"Z
	 RET			;YES.
	CAIL B,"a		;LOWER CASE LETTERS?
	 CAILE B,"z		;..
POPJ1:	  AOS 0(P)		;NO.
	RET
; Error handler

ERRP:	SETZM ESTYPE		; cancel automatic V
	CALL DING		; feep!
	SKIPE ERMSGL		; long error messages?
	 JRST [	MOVE B,@40	; get first word
		ANDCMI B,77777	; mask out last two characters
		HRROI 1,B	; load up a pointer to it
		JRST .+2]	; and continue
	HRRO A,40		; get error message
	PSOUT			; type error message
	MOVEI CH,"?
	CALL TYO
	CALL CRR
	MOVE A,COMAX
	SKIPLE COMCNT		;COMCNT could have gone negative!
	 SUB A,COMCNT
	MOVEM A,ERR1		;ERR1:=COMAX-COMCNT
	MOVE AA,CPTR		;VALUE OF CPTR WHEN LAST ERROR OCCURRED.
	MOVEI B,10.
	SUBI AA,2		;BACK POINTER UP 10 CHARACTERS.
	ILDB CH,AA		;GET CHARACTER
	CAMG B,ERR1		;WAS IT IN THE COMMAND BUFFER?
	 CALL TYO		;YES. TYPE IT.
	CAME AA,CPTR		;HAVE WE REACHED THE BAD COMMAND?
	 SOJA B,.-4		;NO. DO IT AGAIN.
	CALL CRR
	JRST GO

U ERMSGL,1
U ERR1,1

ERRA:	ERROR [ASCIZ/UDC Undefined command/]
;UUO HANDLER
;HALTS ON UNDEFINED UUO

UUOH:	HLRZ B,40
	CAIN B,(CISNE)
	 JRST UCISNE
	CAIN B,(CISEQ)
	 JRST UCISEQ
	CAIN B,(ERROR)
	 JRST ERRP		;YES
	CAIE B,(ERROR1)
	 JRST [	CALL DING
		HRROI 1,[ASCIZ/DSI Damn screw infinite/]
		PSOUT
		CALL CRR
		HALTF
		JRST GOX]
	CALL DING
	HRRO 1,40
	PSOUT
	CALL CRR
	JRST GOX

U LISTF5,1			;OUTPUT DISPATCH
U UUOHX,1
;COMMAND TO COMPLEMENT TRACE MODE. "?" AS A COMMAND

QUESTN:	MOVE A,[JRST TYO]
	TRCE FF,TRACEF
	 MOVSI A,(RET)
	MOVEM A,TRACS
	JRST CRET

COMM:	CALL SKRCH		;GET A COMMENT CHAR
	SKIPE ABORTF		;ABORT?
	 JRST TYOQT		;YES, QUIT TYPEOUT
	CAIE CH,4		;IN CASE HE DID A 4I$
	 CAIN CH,^[		;ALTMODE
	  JRST CRET
	CALL TYO		;TYPE IT
	JRST COMM
;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	CALL 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?
	 CALL CHK22		;B:=1 IF LAST ARG FUNCTION WAS +,*,OR /
				;B:=-1, IF &,#, OR -
				;IE, ASSUME AN ARG OF 1 AND RETAIN SIGN
	MOVE I,PT		;I:=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 GETAG7		;YES.
	CALL GETINC		;NO.
	CALL EOLP		;SOME SORT OF END OF LINE?
	 JRST GETAG4		;NO. TRY AGAIN.
	SOJG B,GETAG4		;YES. NTH LINE FEED?

GETAG1:	TRZN FF,COLONF		;WAS : MODIFIER INCLUDED?
	 JRST GETAG9		;NO, DONT CONSIDER BACKING UP
	SUBI I,1		;DO -C IF BUFFER HAS EOL'S IN IT
	SKIPN EOLF
	 SUBI I,1		;DO -2C IF IT HAS CRLF'S
GETAG9:	CAMGE I,BEG		;MUST STAY IN BUFFER, HOWEVER
GETAG5:	 MOVE I,BEG
GETAG7:	TRZ FF,COLONF		;TURN OFF THE FLAG IN ANY CASE
	MOVE B,I		;YES. RETURN FIRST ARGUMENT IN C
	MOVE C,PT		;SECOND IN B.
	CAMLE C,B		;ARGS ARE REVERSED IF INPUT WAS <1
	 EXCH C,B
	RET
;M,N
GETAG6:	ADD B,BEG		;C:=M+BEG
	ADD C,BEG		;B:=N+BEG
	RET

;ARG IS POS OF NTH LINE FEED LEFT OF PT.
GETAG0:	CAMGE I,BEG		;PASSED BEGINNING OF BUFFER?
	 JRST GETAG5		;YES. I:=BEG
	CALL GETCHR		;NO.
	CALL EOLP		;SOME SORT OF END OF LINE?
GETAG2:	SOJA I,GETAG0		;NO, BACK UP ONE POSITION AND TRY AGAIN.
	AOJLE B,GETAG2		;NTH LINE FEED?
	AOJA I,GETAG1		;CHECK FOR COLON FLAG


;SKIP IF "END OF LINE" IN CURRENT BUFFER FORMAT (EOLF)

EOLP:	SKIPN EOLF
	 JRST EOLP4
	CAIN CH,EOL
	 AOS 0(P)
	RET

EOLP4:	CAIN CH,^J
	 AOS 0(P)
	RET
;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)
;	CALL GETINC
;	RETURN WITH CHARACTER IN CH AND POINTER TO CHARACTER IN I.

GETINC:	CALL GETCHR
	AOJA I,CPOPJ

GETCHR:	MOVE TT,I
	IDIVI TT,5
	TLNE TT,-1
	 ERROR [ASCIZ/URK TECO grabbing infinite core/]
	LDB CH,BTAB(TT1)
	RET

PUTCHR:	MOVE TT,OU
	IDIVI TT,5
	TLNE TT,-1
	 ERROR [ASCIZ/URK TECO grabbing infinite core/]
	DPB CH,BTAB(TT1)
	RET

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

	440700,,(TT)
BTAB:	350700,,(TT)
	260700,,(TT)
	170700,,(TT)
	100700,,(TT)
	010700,,(TT)
NROOM:	MOVEM 17,AC2+15		;SAVE 17
	MOVEI 17,NROOM9		;ANTICIPATE GARBAGE COLLECTION
	MOVEM 17,GCRET		;THIS THE EXIT DISPATCH
NROOM0:	MOVE 17,[1,,AC1]	;NO. SAVE ACS 1 THROUGH 16.
	BLT 17,AC2+14
	JUMPL C,NROOM6		;MOVE TOP DOWN
	SETZM GCDONE		;SAY GC NOT CALLED

U GCRET,1			;RETURN ADDR FOR GARBAGE COLLECTOR
U GCDONE,1			;SET NON-ZERO BY GC

;SEE IF GARBAGE COLLECTOR SHOULD BE CALLED

NROOM9:	MOVE 16,Z		;GC RETURNS HERE
	MOVE C,AC1-1+C		;IN CASE GC CLOBBERED C
	ADD 16,C		;NEW END OF BUFFER
	IDIVI 16,5		;WORD WHICH WILL CONTAIN NEW END
	TLNE 16,-1		;IF BIGGER THAN 256K,..
	 SKIPE GCDONE		;AND GC NOT CALLED..
	  CAIA
	   JRST GC		;CALL IT TO GET SPACE BACK
	TLNE 16,-1		;IF STILL OVERFLOW MEMORY,...
	 ERROR [ASCIZ/URK TECO grabbing infinite core/]
	SKIPG GCCNT		;LOTS OF ]'S AND  X'S DONE?
	 JRST GC		;YES. GARBAGE COLLECT.
;MOVE "." THROUGH Z UP C CHARACTERS

	MOVE 14,C
	JUMPE 14,NROOM5		;NO MOVEMENT NEEDED
	IDIVI 14,5		;NUMBER OF WORDS TO MOVE UP
	IMULI 15,7		;NUMBER OF BITS IN PARTIAL WORD
	MOVN 13,15
	MOVEI 15,-43(15)	;NUMBER OF BITS TO MOVE FROM A TO AA

	MOVE 11,PT
	CAMN 11,Z		;DATA BUFFER EXPANSION?
	 JRST NROOM1		;YES, NO MOVING REQUIRED.
	IDIVI 11,5		;WORD ADDR CONTAINING "."
	JUMPN 13,NRUM2		;NOT EVEN NUMBER OF WORDS

NRUM1:	MOVE 12,Z
	IDIVI 12,5		;FIRST WORD TO MOVE
	MOVE B,12
	SKIPN 13		;Z ON A WORD BOUNDARY?
	 SOSA 12		;YES. START XFR WITH LAST FULL WORD
	  AOS B			;NO. ONE MORE WORD MUST BE MOVED.
	SUB B,11		;PT/5 ROUNDED DOWN
	HRLZI 13,(MOVE A,0(12))	;FETCH A SOURCE WORD
	HRLI 14,(MOVEM A,.-.(12))	;STORE IT MOVED
	MOVE 15,[SUBI 12,1]	;MOVE TO NEXT WORD
	MOVE 16,[SOJG B,13]	;COUNT DOWN NUMBER MOVED
	MOVE 17,[JRST NROOM1]	;RETURN
	JRST 13			;OFF TO AC'S

NRUM2:	MOVNI 16,-5(12)		;A WORD'S WORTH OF CHRS MINUS THE EXTRAS
	IMULI 16,7		;NUMBER OF BITS IN PART TO SAVE
	DPB 16,[300600,,NROOM2]	;SET SIZE FIELD
	ADDI 14,1(11)
	MOVE 16,Z
	IDIVI 16,5		;WORD CONTAINING Z
	MOVEI B,1(16)
	SUB B,11		;NO. OF WORDS TO MOVE.

NRUM21:	HRLI 11,(MOVE A,.-.(B))	;GET NEXT SOURCE WORD
	HRLOI 12,(ROT A,)	;FLUSH BIT-35
	HRLI 13,(ROTC A,.-.)	;MOVE N BYTES FROM A TO AA
	HRLI 14,(MOVEM AA,.-.(B))	;STORE TARGET WORD
	HRLI 15,(ROTC A,.-.)	;MOVE REMAINING BYTES IN A TO AA
	MOVE 16,[SOJGE B,11]	;LOOP IF MORE WORDS TO DO
	MOVE 17,[JRST NROOM7]	;RETURN FROM AC'S
	SOJGE B,11		;GO TO AC'S IF ANYTHING TO DO
NROOM7:	ROTC A,43(13)		;STORE LAST PARTIAL WORD.
	DPB A,NROOM2
NROOM1:	ADDM C,Z		;ADJUST Z TO REFLECT MOVE
NROOM5:	MOVS 17,[1,,AC1]	;RESTORE ACS AND RETURN.
	BLT 17,17
	RET

U NROOM2,1		;POINTER TO LAST PARTIAL WORD ON UPWARD MOVE.
;MOVE "." THROUGH Z DOWN C BYTES (C IS NEGATIVE)

NROOM6:	MOVE 14,PT		;INITIALIZE PARTIAL WORD POINTER.
	IDIVI 14,5		;FIRST SOURCE WORD ADDR
	MOVEM 14,B		;SAVE FOR LATER

	HRRM 14,NROOM4		;SET ADDR OF HUNK THAT MUST BE SAVED
	IMULI 15,7		;GET NUMBER OF BITS IN THAT HUNK
	DPB 15,[300600,,NROOM4] ;PUT INTO POINTER BEING ASSEMBLED
	MOVNI 15,-44(15)		;NUMBER OF BITS TO RIGHT OF HUNK
	DPB 15,[360600,,NROOM4]	;THATS THE POSTION FOR PTR

	MOVE 11,Z		;CHR ADDR OF BUF END
	ADDI 11,4		;ROUND UP
	IDIVI 11,5		;WORD ADDR OF TOP OF BUFFER

	MOVE 13,C		;GET NUMBER OF CHRS TO MOVE (NEG. NUM)
	IDIVI 13,5		;NEG. NUM. OF WORDS TO MOVE

	JUMPN 14,NRUM66		;NOT AN EVEN NUMBER OF WORDS TO CRUNCH

NRUM6:	ADDM C,Z		;UPDATE Z TO REFLECT MOVE
	LDB C,NROOM4		;SAVE PARTIAL WORD
	HRRZ A,NROOM4		;DESTINATION ADDRESS
	HRLI A,0(A)		;TO BOTH HALVES
	SUB A,13		;ADD WORD SIZE OF CRUNCH
	MOVSS A			;FORM FROM,,TO  FOR BLT
	ADDI 13,0(11)		;LAST WORD OF BLT
	BLT A,0(13)		;CRUNCH
	JRST NROOM3		;RESTORE PARTIAL WORD AND GET OUT

NRUM66:	ADDI 13,-1(11)		;WORD WHERE Z WILL WIND UP
	MOVNM 14,12		;NUM CHRS MOVED FROM AA TO A
	IMULI 12,7		;NUM OF BITS TO SHIFT TO DO IT
	MOVNI 15,-43(12)	;NUM. OF SHIFTS TO MOVE REST OF AA TO A
	SUBI B,1(13)		;NUMBER OF WORDS TO BE MOVED

NROOM8:	HRLI 11,(MOVE AA,.-.(B))	;GET NEXT FULL SOURCE WORD
	HRLI 12,(ROTC A,.-.)	;MOVE N CHRS FROM AA TO A
	HRLI 13,(MOVEM A,.-.(B));STORE FULL TARGET WORD
	MOVE 14,[ADDM A,@13]	;SHIFT LEFT 1 IN MEMORY
	HRLI 15,(ROTC A,.-.)	;MOVE REMAIN BYTES FROM AA TO A
	MOVE 16,[AOJLE B,11]	;DO NEXT WORD IF ANY
	MOVE 17,[JRST NROOM3]	;DONE.
	ADDM C,Z		;ADJUST Z DOWN BY C CHRS
	LDB C,NROOM4		;PICKUP HUNK OF 1ST WRD TARGET TO SAVE
	MOVE A,@11		;GET FIRST SOURCE WORD
	ROT A,-1		;FLUSH GARBAGE BIT
	AOJLE B,11		;OFF TO AC'S IF ANYTHING TO MOVE

NROOM3:	DPB C,NROOM4		;RESTORE SAVED HUNK
	JRST NROOM5		;RESTORE AC'S AND RETURN

U NROOM4,1			;PARTIAL WORD POINTER FOR DOWNWARD MOVE
GC:	MOVE 17,AC2+15		;RESTORE 17 (PDL)
	SETOM GCDONE		;SAY A GC HAS BEEN DONE
	MOVEI T,100
	MOVEM T,GCCNT		;NUMBER OF X'S TO DO BEFORE NEXT GC
	SETOM GCPTR		;YES. GCPTR:=-1
	SETZM SYMS		;CLEAR SYMS,VALS AND CNTS TABLES
	MOVE T,[SYMS,,SYMS+1]
	BLT T,SYMEND-1
	MOVEI T,CPTR		;COMMAND STRING, MAYBE A Q-REG
	CALL GCMA
	HRRZ T,P
	CAIL T,PDL		;PUSHDOWN LIST EMPTY?
	 CALL GCMA		;NO. GARBAGE COLLECT ALL BYTE POINTERS
	  CAILE T,PDL		;USUALLY THESE ARE PUSHED CPTR'S
	   SOJA T,.-2
	HRRZ T,AC2+PF-2	;GARBAGE COLLECT Q-REG PUSHDOWN LIST.
	CAIL T,PFL
	 CALL GCM
	CAILE T,PFL
	 SOJA T,.-2
	MOVE T,[-45,,QTAB]	;GARBAGE COLLECT Q-REGISTERS.
	CALL GCM
	AOBJN T,.-1
	SKIPGE GCPTR		;ANYTHING TO COLLECT?
	 JRST @GCRET		;NOPE.
GCS:	MOVE I,QRBUF		;BOTTOM OF POSSIBLE GARBAGE
GCS1A:	MOVE TT,BEG		;TOP OF GARBAGE+1
	MOVE OU,GCPTR		;GO BACKWARDS THROUGH GCTAB
GCS1:	MOVE A,GCTAB(OU)	;GET AN ENTRY
	ADD A,QRBUF		;FORM ABSOLUTE CHR ADDR
	CAMGE A,I		;I HAS CHR ADDR OF UNCOMPACTED AREA STRT
	 JRST GCS2		;THIS ONE IS OK
	CAMGE A,TT		;SET TT TO CHR ADDR OF
	 MOVE TT,A		;LOWEST STRING TO SAVE
GCS2:	SOJGE OU,GCS1
	CAML TT,BEG		;EVERYTHING BELOW TEXT BUFFER DONE?
	 JRST @GCRET		;YES. GC IS DONE
	IDIVI I,5		;WORD ADDR OF START OF AVAIL. AREA
	MOVE F,TT		;CHR ADDR OF LOWEST STRING TO SAVE
	IDIVI F,5		;WORD ADDR OF START OF STRING TO SAVE
	MOVS OU,F		;"FROM" ADDR FOR BLT
	MOVE T,F		;WORD ADDR OF STRING TO SAVE
	SUB T,I			;MINUS WORD ADDR OF GARBAGE
	JUMPLE T,GCS4A		;ALREADY IN PLACE
	HRR OU,I		;"TO" ADDR FOR BLT
	MOVE B,Z		;CHR ADDR OF END OF TEXT
	ADDI B,5		;BE SURE TO TAKE LAST WORD
	IDIVI B,5		;FORM WORD ADDR OF END
	SUB B,T			;WHAT NEW END WILL BE
	BLT OU,0(B)		;MOVE STUFF DOWN
	MOVNS OU,T		;NUMBER OF WORDS FLUSHED
	IMULI OU,5		;NUMBER OF CHRS FLUSHED
	ADDM OU,BEG		;ADJUST TO REFLECT MOVE
	ADDM OU,PT
	ADDM OU,Z
	MOVE CH,GCPTR		;UPDATE INSERTER
GCS3:	MOVE A,GCTAB(CH)		;CHR ADDR REL TO QRBUF
	ADD A,QRBUF		;ABSOLUTE CHR ADDR BEFORE MOVE
	CAMGE A,TT		;NEEDS UPDATING??
	 JRST GCS4		;NO

	ADDM OU,GCTAB(CH)	;ADJUST GCTAB ENTRY FOR BLT
	SKIPL TT1,@GCTABA(CH)	;40000N,,N  IS Q-REG
	 TLNN TT1,777770		;NUMS UP TO 7,,777777 ARE CHR ADDRS
	  JRST GCS5		;GO RELOCATE Q-REG OR CHAR POINTER
	ADDM T,@GCTABA(CH)	;MAKE BYTE POINTER SEE BLT'D STRING
GCS4:	SOJGE CH,GCS3		;DONE?
	ADD TT,OU		;YES. I:=C(TT)-5*NREG

GCS4A:	MOVE I,TT		;SHOULD POINT TO BEGINNING
	CALL GETINC		;OF Q-REGISTER STRING.
	CAIE CH,141		;DOES IT??

GCERR:	 JRST [	ERROR1 [ASCIZ/GCE Garbage collector error/]
		HALTF]
	CALL GETINC
	MOVE A,CH
	CALL GETINC
	LSH A,7			;GET COUNT OF STRING
	IOR A,CH
	CALL GETINC
	LSH A,7
	IOR A,CH
	ADD I,A			; A INCLUDES THE +4 NEEDED TO ROUND UP
	IDIVI I,5		;FORCE IT TO POINT AT NEXT WRD BOUNDARY
	IMULI I,5		;I NOW CHR ADDR OF BEG OF NEXT STRING
	JRST GCS1A		;OR GARBAGE AREA

GCS5:	ADDM OU,@GCTABA(CH)	;MAKE CHR ADDR POINT TO MOVED STRING
	JRST GCS4		;DO NEXT GCTAB ENTRY
;COLLECT STRINGS POINTED TO BY Q-REG POINTERS

GCM:	MOVE I,(T)
	TLZE I,400000		;DOES Q-REG CONTAIN TEXT?
	 TLZE I,377770
	  RET			;NO. NUMERIC CONTENTS
	ADD I,QRBUF		;YES. MAKE ABSOLUTE CHR ADDR

GCM2:	CAML I,BEG		;REGION BEFORE TEXT BUFFER?
	 RET			;NO. (ERROR???)
	CALL GETCHR		;YES. CHECK FOR MARK.
	CAIE CH,141		;BEGINNING OF STRING?
	 RET			;NO. (ERROR IF NOT MAIN COMMAND STRING?)
GCM3:	SUB I,QRBUF		;GET RELATIVE ADDR OF STRING TO SAVE
	AOS TT,GCPTR		;GET NEXT TABLE SLOT
	CAIL TT,GCTBL		;STILL SPACE LEFT?
	 JRST GCERR		;NO. VERY BAD.
	HRRZM T,GCTABA(TT)	;SAVE ADDRESS OF PTR.
	MOVEM I,GCTAB(TT)	;PUT IN TABLE
	RET			;DONE THIS POINTER

;COLLECT STRINGS UNDER PARTIAL EXECUTION (BYTE POINTERS), RANDOMLY
; PUSHED BYTE POINTERS AND PUSHED CHARACTER ADDRS.
;NOTE:	THIS LOSES FOR BYTE POINTERS OF THE FORM 440700,,XXXXXX  AND
; 	FOR NUMBERS LARGE ENOUGH TO BE CONFUSED WITH CHR ADDR.
;	FOR INSTANCE 17000<200<X0%A>>  WILL FORCE GC'S WHICH WILL FIND
;	WHAT'S LEFT OF THE 17000 ON THE PDL AND RELOCATE IT, NOT TO
;	MENTION WHAT IT POINTS AT.

GCMA:	MOVE I,0(T)		;GET THE POINTER
	CAMGE I,BEG
	 RET		;THIS REJECTS ALL BUT CHR PTRS, BYTE PTRS, & JNK

	TLNN I,777770		;IF ANY BITS ON, NOT CHAR POINTER
	 JRST GCM3		;ASSUME IT IS CHR ADDR
	LDB TT,[221400,,I]	;BYTE SIZE + XR
	CAIE TT,700		;DOES T PT TO A 7-BIT TEXT BYTE PTR?
	 RET			;NO. ASSUME IT IS JUNK
	HRRZ TT,I
	CAMG TT,CBUFH		;MAIN COMMAND STRING??
	 RET			;YES, FORGET IT.
	LDB TT,[360600,,I]	;BYTE POSITION
	IDIVI TT,7		;NO. OF CHARACTERS
	HRRZI I,1(I)		;BYTE PTR ADDR +1
	IMULI I,5		;NUM CHRS BELOW THIS IN ALL MEMORY
	SUBI I,4(TT)		;MINUS CHRS IN PREVIOUS WRD & 4 OVERHEAD
	ADD I,1(T)		;CT (WE HOPE)
	SUB I,-1(T)		;MAX
	JRST GCM2		;I HAS CHR ADDR OF BEG OF STRING
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 GCPTR,1
U GCCNT,1		;COUNT OF X'S TO DO BETWEEN GC'S
;COMMAND DISPATCH TABLE
;DISPATCH IS BY XCT DTB(CH)
;FORMAT:
;	MOVEI A,X	;IF X RETURNS A VALUE
;	HRROI A,X	;IF X DOESN'T 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,ERRA	;^A
	HRROI A,ERRA	;^B
	HRROI A,ERRA	;^C
	HRROI A,UP.D	;^D
	MOVEI A,FFEED	;^E
	MOVEI A,UP.F	;^F
	HRROI A,ERRA	;^G
	HRROI A,UP.H	;^H
	HRROI A,TAB	;^I
	JRST CD		;^J
	HRROI A,ERRA	;^K
	HRROI A,ERRA	;^L
	JRST CD		;^M
	HRROI A,ERRA	;^N
	HRROI A,ERRA	;^O
	HRROI A,ERRA	;^P
	HRROI A,ERRA	;^Q
	HRROI A,ERRA	;^R
	MOVEI A,UP.S	;^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
	JRST CD		;^[
	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	;#
	MOVEI A,CRET	;$
	MOVEI A,PCNT	;%
	MOVEI A,CAND	;&
	MOVEI A,CRET	;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	;:
	JRST 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
	MOVEI A,SERCHP	;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,REPLAC	;R
	MOVEI A,SERCH	;S
	HRROI A,TYPE	;T
	HRROI A,USE	;U
	HRROI A,VIEW	;V
	MOVEI A,WRBUF	;W
	MOVEI A,X	;X
	HRROI A,YANK	;Y
	MOVEI A,END1	;Z
	MOVEI A,OPENB	;[
	MOVEI A,BAKSL	;BACKSLASH
	HRROI A,CLOSEB	;]
	MOVEI A,UAR	;^
	MOVEI A,LARR	;LEFT ARROW
;SEMICOLON COMMAND TABLE

SEMTAB:	MOVEI A,TCOND	;SPACE
	REPEAT 37,JRST ERRA
	JRST ERRA	;@
	JRST ERRA	;A
	MOVEI A,SEM.B	;B
	HRROI A,CLOSEF	;C
	HRROI A,DNLOAD	;D
	JRST ERRA	;E
	MOVEI A,LARR	;F
	MOVEI A,GETOB	;G
	MOVEI A,SEMI.H	;H
	JRST ERRA	;I
	JRST ERRA	;J
	JRST ERRA	;K
	JRST ERRA	;L
	JRST ERRA	;M
	MOVEI A,PIKNUM	;N
	JRST ERRA	;O
	MOVEI A,PICKUP	;P
	JRST ERRA	;Q
	HRROI A,OPNRD	;R
	HRROI A,BFSAVE	;S
	MOVEI A,TPREG	;T
	HRROI A,UNLOAD	;U
	JRST ERRA	;V
	HRROI A,OPNWR	;W
	JRST ERRA	;X
	HRROI A,YLOAD	;Y
	MOVEI A,SEM.Z	;Z
	JRST ERRA	;[
	JRST ERRA	;\
	JRST ERRA	;]
	JRST ERRA	;^
	JRST ERRA	;_
...LIT:
...VAR:	VARIAB
IFN .-...VAR,.FATAL If you think you can have variables are you ever going to lose
	CONSTA		;LITERALS GO AFTER END OF PROGRAM

;PAGE 0 VARIABLES AREA
U STAB,0		;SEARCH TABLE
			;SERC22+2,OGNF+4,OGNF+6,OGFN+11
U AC1,1
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


;CHECK OVERLAP OF STAB AND OTHER STUFF
	IFG STAB+STABL-ZZ,<ZZ==STAB+STABL>
U STABP,0
U SVSTAB,STABL		;SAVED DEFAULT FOR S$
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 GCTABA,GCTBL		;PTR ARRAY PARALLEL TO GCTAB
U QTAB,45		;Q-REGISTER TABLE
			;USEA+1,PCNT+1
U PDL,LPDL
U UAC,17

U TOP,0

IFGE TOP-IBFPGA,.FATAL STAB too long.  Make STABL smaller

END EVECL,,EVEC