Google
 

Trailing-Edge - PDP-10 Archives - bb-d549g-sb - teco.mac
There are 5 other files named teco.mac in the archive. Click here to see a list.
TITLE	TECO   VERSION 24
SUBTTL	TEXT EDITOR AND CORRECTOR	RC CLEMENTS/PMH/CAM/EAR/DML/JNG/BGS/DCE

EDIT==202
VERSION==XWD 2400,EDIT


;COPYRIGHT 1970,1971,1972,1975,1976,1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.



	SEARCH	UUOSYM,MACTEN		;[175]
	  F%FDAE==3,,1B30		;[175] 8/8/76, NOT YET IN UUOSYM


IFDEF .TEXT,<.TEXT	"/SYMSEG:HIGH">	;[175] STORE SYMBOLS IN
					;[175] HI SEG IF DEBUGGING
; . . . EDIT HISTORY . . .
;*** CHANGES FROM VERSION 23 TO 23B ***

; EDIT 114- REMOVES CODE WHICH CHANGED BAK FILE PROTECTION TO
;           STANDARD. CHANGES SEARCH COMMAND TO ACCEPT LOWER CASE
;           FS AND FN. PROVIDES FOR $ IN Q REGISTER BY RETURNING
;           TO NEXT LEVEL WHEN $ SEEN RATHER THAN REINITIALIZING.
;           AREAS AFFECTED: GO, RCH2, ALTMOD, MAC, BKCLS2,
;                           FILSP2, FCMD, EQM

; EDIT 115- FIXES PERTAIN TO LINE SEQUENCE NUMBER PROCESSING
;           CHANGES INSERTION OF 5 SPACES TO 5 SPACES AND TAB
;           CHANGES SEQ# CHECK SO THAT 5 SPACES AND TAB ARE
;            ACCEPTED AS LINE SEQ# (THIS ELIMINATES THE INSERTION
;            AFTER THE FIRST TIME AND ALLOWS THEM TO BE REMOVED
;            USING THE /SUPLSN SWITCH)
;           AREAS AFFECTED:PPA06, PPA08,

; EDIT 116- CHANGES GARBAGE COLLCETION ROUTINE TO CHECK FOR
;           ANYTHING TO SAVE PRIOR TO ATTEMPTING A BLT.
;           AREAS AFFEDTED: GCS2


; EDIT 117- CHANGES SEARCH ROUTINE TO PROVIDE PROPER OPERATION
;           OF ^S, TECO'S "WILD DELIMITER", WHEN THE DELIMITER
;           IS THE FIRST BUFFER CHARACTER.
;           AREAS AFFECTED: S1, S4A, BCOUNT 

; EDIT 120- CHANGES OPERATION OF ET COMMAND TO CONFORM TO 
;           DOCUMENTATION. ET SHOULD SUPPRESS CASE FLAGGING.
;           AREAS AFFECTED: TYO

; EDIT 121- PROVIDES WARNING MESSAGE WHEN TECO
;           DETECTS SEQUENCED FILE WITH NO LSN SWITCHES.
;           ADDS CLEAR OF OUTPUT BUFFER PRIOR TO PACKING
;           TO INSURE AGAINST SPURIOUS BIT35 SETTING.
;           AREAS AFFECTED: YNKSEQ,PPA05

; EDIT 122- FIXES HP COMMAND TO SET BIT 35 FOR FIRST
;           LINE NUMBER IN THE BUFFER.
;           AREAS AFFECTED: HOLE

; EDIT 123- REDEFINES OUTPUT BUFFERS AFTER SECOND OPEN FOR
;           FILES WHICH ARE SUPERSEDED. THIS FIXES THE "ADDRESS
;           CHECK FOR DEVICE DSK" PROBLEM.
;           AREAS AFFECTED: OPNW3

; EDIT 124- REMOVES THE %SUPERSEDING EXISTING FILE MESSAGE
;           FOR NON-DIRECTORY DEVICES AND LIB: FILES.
;           AREAS AFFECTED: OPNW2, OPNW3

; EDIT 125- CORRECTS "ILL MEM REF AT USER PC 403647" BY ADDING
;           A CHECK FOR SHORT ERROR MESSAGES USED PRIOR TO
;           PERFORMING CORE CONTRACTION.
;           AREAS AFFECTED: ERRP7

; EDIT 126- CHANGES RENAME PROCESSING TO CONFORM TO DATE75
;           STANDARD.
;            AREAS AFFECTED: EBAKU1, OPNW33, BKCLS3, BKCLS5

; EDIT 127- CORRECTS EDIT#114 WHICH FAILED TO KEEP PROTECTION
;           OF INPUT FILE AS PROT FOR BAK FILE.
;           AREAS AFFECTED: BKCLS2

; EDIT 130- CORRECTS PROBLEM CAUSED BY EDIT 121. PW COMMAND
;           DID NOT WORK SINCE REGISTER "T" WAS NOT SAVED
;           CAUSING THE COMMAND TO BE INTERPRETED AS A P COMMAND.
;            AREAS AFFECTED: PPA05

; EDIT 131- CORRECTS PORTION OF EDIT 124 WHICH CHECKED WRONG STATUS
;           BIT. AREAS AFFECTED: OPNW3B

; EDIT 132- ADDS CHECK FOR DATA IN Q REGISTER PRIOR TO ALLOWING
;           INCREMENT (% COMMAND) AND GENERATES ERROR MESSAGE IF
;           ATTEMPTED WITH TEXT.  AREAS AFFECTED: PCNT

; EDIT 133- MAKES EB WORK PROPERLY FOR FILES OUTSIDE OF
;           USER'S PPN. SHOULD JUST DO ER/EW UNDER THIS
;           CONDITION INSTEAD OF TRYING TO RENAME FILES.
;           AREAS AFFECTED: EBAKUP

; EDIT 134- CHANGES CALLI AND TTCALL UUO'S TO STANDARD FORMAT

; EDIT 135- REPLACES EDIT 132 TO PUT ERROR MESSAGE IN STANDARD FORM
;           AND PROVIDE FOR CHECK ON Q COMMAND AS WELL AS %
;           ALSO PROVIDES PROPER OPERATION WITH NEGATIVE INTEGER.
;            AREAS AFFECTED: PCNT, QREG

; EDIT 136- GENERAL CLEAN-UP TO MAKE EDIT 123 MORE EFFICIENT,
;           REMOVE ROUTINE NOT NEEDED WITH EDIT 133, AND MAKE
;           DEVICE DTA WORK PROPERLY.
;           AREAS AFFECTED: OPNRD, EBAKUP, OPNWR, BAKCLS, EBS1

; EDIT 137- ELIMINATES THE CONVERSION OF OLD ALTMODES TO CODE 033
;           IN COMMAND STRINGS IF TTY NO ALTMOD IS SET.
;           AREAS AFFECTED: ALTIN, TYI

; EDIT 140- ADDS DEBUG SWITCH WHICH SAVES SYMBOLS, MAKES YANK
;           MORE EFFICIENT FOR NNN<Y> COMMANDS, AND CLEANS UP
;           THE %LINE NUMBER DETECTED MESSAGE
;           AREAS AFFECTED: TECO, LIS03, YANK2, YNKSEQ, CMDBFR

; EDIT 141- REMOVE UNNECESSARY PORTION OF EDIT 121 AND
;           EDIT 130.  WORK ON LINE SEQUENCE NUMBER PROCESSING.
;           AREAS AFFECTED:PPA04,PPA05

; EDIT 142- FIXES COMMAND DISPATCH TABLE ENTRIES FOR CR AND
;           LF TO PRESERVE NUMERIC ARGUMENTS.
;           AREAS AFFECTED: DTB

; EDIT 143- MAKE CODE FOR Q-REG MORE EFFICIENT.
;           AREAS AFFECTED: QREG, QTXTST

; EDIT 144- MAKES EH COMMAND USE STACK PROPERLY.
;           AREAS AFFECTED: ERRSET

; EDIT 145- FIXES EW TO OTHER PPN'S.
;           AREAS AFFECTED: OPNW33

; EDIT 146- MAKES EB WORK PROPERLY FOR ERSATZ DEVICES.  RENAMES
;	    DEVICE TO DSK FOR OUTPUT.  AREAS AFFECTED: EBAKU2

; EDIT 147- CHANGES OPEN FOR EB COMMAND TO PHYSICAL ONLY SINCE
;           PHYS DEVICE NAME IS IN OPEN BLOCK.  THIS IS NECESSARY
;           TO ALLOW PROPER OPERATION OF RENAME SEQUENCE.
;           AREAS AFFECTED: OPNW4, BKCLS4

; EDIT 150- MODIFY LSN PROCESSING TO HANDLE SOS PAGE MARKS.
;           AREAS AFFECTED: PPA08, PPA13, YANK5

; EDIT 151- GENERAL CLEANUP OF COMMENTS, ETC.

; EDIT 152- CORRECTS CCL PROCESSING TO ACCEPT SPACES FROM COMPIL
;           TO MAKE TECO FOO. COMMANDS WORK.
;           AREAS AFFECTED: CCLTM1, CCLIL

; EDIT 153- ADDS SPECIAL CHECK FOR ERSATZ PPN TO INSURE SUPERSEDING
;           MESSAGE WORKS FOR SYS:, NEW:, ETC.
;            AREA AFFECTED: FILSP7

; EDIT 154- MAKE EDIT 147 MORE EFFICIENT
;           AREAS AFFECTED: OPNW44

; EDIT 155- DELAY CLEARING EB AND OUTPUT OPEN FLAGS ON EX
;           COMMAND IN CASE ERROR OCCURS IN PROCESSING.
;            AREAS AFFECTED: CLOSEF

; EDIT 156- ADD ERROR CHECK AND MESSAGE FOR TAG TOO LONG.
;           AREAS AFFECTED: OG1

; EDIT 157- NOT USED (RESERVED)

; EDIT 160- PREVENTS TECO FROM GOING INTO INFINITE LOOP IF
;           ERROR FILE IS NOT FOUND AND USER HAS SET 3EH.
;           AREA AFFECTED: ERRP5

; EDIT 161- CHANGES THE WAY <> USE THE STACK TO INSURE PROPER
;           GARBAGE COLLECTIOM.
;            AREAS AFFECTED: LSSTH, INCMA2


; EDIT 162- FIXES PROBLEM CAUSED BY EDITS 147, 154, AND 160.
;            AREAS AFFECTED: ERRP5, OPNW44, BKCLS4
;*** CHANGES FROM VERSION 23B TO 24 ***


; EDIT 163- CORRECT OPERATION OF EB WHEN USER HAS CHANGED PATH
;           AREAS AFFECTED: EBAKU2

; EDIT 164- CORRECTS ERROR PRINTOUT PROBLEM WHICH CAN CAUSE RANDOM
;           CORE UUO'S TO BE EXECUTED.
;            AREAS AFFECTED: ERRP, ERRP0

; EDIT 165- PROVIDES PRINTING OF LOOKUP ERROR CODE DURING EB
;            AREAS AFFECTED: LKUPER

; EDIT 166- CORRECTS PROBLEMS WITH ?NCS ERROR
;           AREAS AFFECTED: LIS01, ERRTYP

; EDIT 167- CAUSES SPACES IN ARITHMETIC STRINGS TO BE IGNORED
;           EXCEPT AS A + OPERATOR
;           AREAS AFFECTED: CD93

; EDIT 170- CORRECTS TYPEOUT OF Q-REG NAME ON AN IQN ERROR FROM
;           AN * COMMAND
;           AREAS AFFECTED: LIS03

; EDIT 171- CORRECTS OPERATION OF EW COMMAND WHEN PPN IS SPECIFIED
;           PRIOR TO FILE.EXT
;           AREAS AFFECTED: FILSP6

; EDIT 172- CORRECTLY PUTS BOTH ARGUMENTS, IN A TWO ARGUMENT
;	    COMMAND (M,N T; M,N X; M,N K), WITHIN BUFFER BOUNDS
;	     AREA AFFECTED: CHK1

;EDIT 173- FIXES TWO ARGUMENT P COMMAND TO SET BIT 35 WHEN
;	   FIRST ARGUMENT IS BEG OF BUFFER OR BEG OF LINE
;	    AREAS AFFECTED: CHK1, PUNCHR, PUNCH1(DELETED)

;EDIT 174- CORRECTS UIN ERROR CAUSED BY A NULL REPLACEMENT
;	   ALTMODE DELIMITED F SEARCH FOLLOWED BY AN *
;	   COMMAND
;	    AREAS AFFECTED:NOALT; LIS03; LIS02; FND3-1
;EDIT 175- RE-DO ER,EW,EB,EZ,EM,EF,EX,EG COMMANDS TO UNDERSTAND
;	   DEFAULT PATHS, SFD'S, ERSATZ DEVICES, LIBRARIES,
;	   THE /SCAN PATH SETTING, THE FILE DAEMON, ETC. ETC.
;	   TECO WILL NOW EDIT THE FILE SPECIFIED BY AN EB
;	   COMMAND IN PLACE, I.E. BOTH THE BAK FILE AND THE EDITED
;	   SOURCE FILE WILL APPEAR IN THE DIRECTORY THAT THE USER
;	   SPECIFIED IN THE EB COMMAND. EXCEPTION: IF THE FILE TO
;	   BE EDITED IS NOT FOUND IN THE AREA SPECIFIED, BUT RATHER
;	   IN SOME LIBRARY AREA (LIB:, A HIGHER-LEVEL SFD, ON [1,4]
;	   WHEN NEW: WAS SPECIFIED, ETC.), THEN TECO WILL PRINT THE
;	   MESSAGE %FILE WAS FOUND IN [P,PN,SFD,SFD...] AND THEN
;	   TURN THE COMMAND INTO AN ER FROM THE AREA WHERE THE FILE
;	   WAS ACTUALLY FOUND AND AN EW INTO THE AREA THAT THE USER
;	   SPECIFIED. AN EB IN PLACE IS OBVIOUSLY NOT REASONABLE FOR
;	   FILES FOUND IN LIBRARY AREAS, AND THIS ACTION IS THOUGHT TO
;	   BE MORE REASONABLE THAN A ?FNF-0 ERROR. TECO WILL NOW ALSO
;	   RESPECT .RBSPL AND .RBNCA (NOT .RBVER - EDITING CHANGES THE
;	   VERSION) WHEN EDITING A FILE AS A RESULT OF AN EB COMMAND.
;	   THIS EDIT WAS CAREFUL NOT TO BREAK DECTAPES.
;		AREAS: LOTS

;EDIT 176- CORRECTS PROBLEM OF /SUPLSN SWITCH AND NULL CHARACTERS
;	   IN OUTPUT FILES.  CORRECTES PROBLEM OF /GENLSN 
;	   WITH THE M,NP COMMAND AND EX COMMAND.  EX PROBLEM CAUSED BY
;	   EDIT 174.
;	     AREAS AFFECTED: PPA02; PPA06; PPA13; CHK1

;EDIT 177- PREVENTS RANDOM CORE UUO CAUSED BY EDIT 164.
;		AREAS AFFECTED: ERRP0

;EDIT 200- CORRECTS SOME MINOR PROBLEMS WITH EDIT 175. TECO.ERR WAS
;	   SOMETIMES BEING PRINTED INCORRECTLY. REMOVES ERDONE FLAG.
;	AREAS AFFECTED: ERDONE,OPNRD,EBAKUP,WTFIL,BAKCLS,EPATH,CCLIL

;EDIT 201- MAKE FS SEARCH FASTER FOR SAME LENGTH ARGUMENTS.
;		AREAS AFFECTED: FND

;EDIT 202- CLEAR THE OCTAL NUMBER FLAG ON ILLEGAL OCTAL DIGITS.
;		AREAS AFFECTED: CDNUM

;[END OF REVISION HISTORY]
;DEFAULT DEFINITIONS FOR ASSEMBLY SWITCHES & PARAMETERS:

IFNDEF CCL,	<CCL==	 1>		;CCL CAPABILITY
IFNDEF TEMP,	<TEMP==	 1>		;TMPCOR UUO CAPABILITY
IFNDEF PDP6,	<PDP6==  0>		;PDP-10 VERSION
IFNDEF ERRMSG,	<ERRMSG==2>		;MEDIUM LENGTH ERROR MESSAGES
IFNDEF NORUNS,	<NORUNS==0>		;RUN UUO CAPABILITY
IFNDEF AUTOFS,	<AUTOFS==0>		;DEFAULT IS NON-AUTOTYPE AFTER SEARCHES
IFNDEF TYCASW,	<TYCASW==0>		;DEFAULT TYPE-OUT MODE CAUSES FLAGGING OF
					;CHARACTERS IN THE LOWER CASE RANGE WITH '
IFNDEF SRCHSW,	<SRCHSW==0>		;DEFAULT PREVAILING SEARCH MODE IS ACCEPT
					;EITHER LC OR UC ALPHABETICS AS A MATCH
IFNDEF BUFSIZ,	<BUFSIZ==^D128>		;128 WORD I/O BUFFERS
IFNDEF LPDL,	<LPDL==	 120>		;80 WORD PDL
IFNDEF LPF,	<LPF==	 40>		;32 WORD Q-REGISTER PDL
IFNDEF VC,	<VC==	0>		;V COMMAND NOT IMPLEMENTED
IFNDEF EOVAL,	<EOVAL== 2>		;THE STANDARD SETTING OF THE EO FLAG FOR
					;THIS VERSION IS 2
IFNDEF BUGSW,	<BUGSW==0>		;[140] STANDARD IS DON'T SAVE SYMBOLS


;FOR ANY OTHER VERSION ASSEMBLE AS FOLLOWS:
;.R MACRO
;*TECO_TTY:,DSK:TECO.MAC
;CCL=0				(IF CCL NOT WANTED)
;TEMP=0				(IF TMPCOR UUO NOT WANTED)
;PDP6=1				(IF PDP-6 VERSION WANTED)
;ERRMSG=1			(IF SHORT ERROR MESSAGES WANTED OR
;				 =3 IF EXTRA LONG ERROR MESSAGES WANTED)
;NORUNS=1			(IF RUN UUO SIMULATION WANTED)
;AUTOFS=-1			(IF DEFAULT = AUTOTYPE AFTER SEARCHES WANTED)
;TYCASW=1			(IF TYPE-OUT CASE FLAGGING DEFAULT VALUE
;				 TO FLAG UPPER CASE INSTEAD OF LOWER CASE
;				 CHARS. WANTED)
;TYCASW=-1			(IF TYPE-OUT CASE FLAGGING DEFAULT VALUE
;				 FOR NO FLAGGING WANTED)
;SRCHSW=1			(IF EXACT MODE WANTED AS THE DEFAULT VALUE
;				 OF THE PREVAILING SEARCH MODE)
;BUFSIZ=^D256			(IF 256-WORD I/O BUFFERS WANTED. ANY
;				 OTHER CONSTANT BESIDES 256 MAY BE USED.
;				 TECO USES STANDARD MONITOR BUFFERING,
;				 BUT IF THE MONITOR PROVIDES BUFFERS
;				 LARGER THAN 128 WORDS, BUFSIZ MUST BE
;				 CHANGED SO THAT SUFFICIENT SPACE IS
;				 RESERVED.
;LPDL=N				(WHERE N>120, IF LARGER PDL WANTED)
;LPF=N				(WHERE N>40, IF LARGER Q-REGISTER PDL WANTED)
;EOVAL=N			(WHERE 0<N<2, IF EO-CONTROLLED FEATURES ADDED
;				 SINCE EO=N WAS STANDARD ARE NOT WANTED)
;BUGSW=1			(IF SAVE OF SYMBOL TABLE IS DESIRED)
;^Z
;^Z
;ACCUMULATOR ASSIGNMENTS

FF=	0	;CONTROL FLAGS
P=	1	;PUSH DOWN POINTER
		;*** A, AA AND B MUST BE CONTIGUOUS AND IN THAT ORDER ***
A=	2
AA=	3	;TYPE-IN POINTER TO COMMAND BUFFER & SEARCH TABLE INDEX
		;*** B AND E MUST BE ADJACENT AND B<11 ***
B=	4	;COMMAND BUFFER END ADDRESS
E=	5
C=	6
D=	7
F2=	10	;MORE CONTROL FLAGS
T=	11
		;*** TT AND TT1 MUST BE ADJACENT ***
TT=	12
TT1=	13
I=	14
OU=	15
CH=	16	;CHARACTER AC
PF=	17	;Q-REGISTER PDL PTR
;CONTROL FLAGS
;RIGHT HALF - AC FF

ALTF==	1		;ALT-MODE SEEN
ARG2==	2		;THERE IS A SECOND ARGUMENT
ARG==	4		;THERE IS AN ARGUMENT
FSRCH==	10		;REPLACEMENT SEARCH
SLSL==	20		;@ SEEN
PCHFLG==40		;N SEARCH
COLONF==100		;COLON SEEN
SYLF==	200		;SYLLABLE FLAG
XPLNFL==400		;HAVE TYPED EXTENSION OF ERROR MESSAGE ALREADY
EMFLAG==1000		;HAVE TYPED 1ST LINE OF ERROR MESSAGE
FINDR==	2000		;LEFT ARROW SEARCH
QMFLG==	4000		;PROSESSING ERROR MESSAGE
SEQUIN==10000		;OUTPUT: AFTER EOL NEXT 5 CHARS ARE SEQ #
			;INPUT:  IGNORE CHAR AFTER SEQ# IF IT'S TAB
TRACEF==20000		;? SEEN
SEQF==	40000		;SEQUENCE NUMBER SEEN ON INPUT
BELLF==	100000		;^G SEEN
DDTMF==	200000		;NEED TO TYI IN DDT MODE
FORM==	400000		;A FORM FEED TERMINATED THE LAST YANK OR APPEND COMMAND

;LEFT HALF - AC FF

PMATCH==2		;PREVAILING MATCH MODE
IFN VC,<
TABSRT==4		;TAB CORRECTION FOR VVAL
	>
TMPFLG==40		;TMPCOR UUO ALLOWED
FINF==	100		;INPUT CLOSED BY EOF
UREAD==	200		;INPUT FILE IS OPEN
UWRITE==400		;OUTPUT FILE IS OPEN
;********* FREE BIT **********
EZTMP== 2000		;[175] THIS COMMAND IS EZ, NOT EW
FEXTF==	4000		;FILE EXT EXPECTED (.TYPED).
UBAK==	20000		;EB IN EFFECT
GKTLKF==40000		;MESSAGE TYPE OUT IN GRABAK?
TYOF==	100000		;NEED TO OUTPUT A BUFFER
TYOCTF==200000		;ALLOW CONTROL CHARS TYPED WITHOUT "^"
CCLFLG==400000		;TECO COMMAND REQUESTS Y AFTER EB
;CONTROL FLAGS
;RIGHT HALF - AC F2

CTLV==	1		;^V SEEN INSIDE TEXT
CTLVV==	2		;DOUBLE ^V SEEN INSIDE TEXT
CTLW==	4		;^W SEEN INSIDE TEXT
CTLWW== 10		;DOUBLE ^W SEEN INSIDE TEXT
XMATCH==20		;EXACT MATCH SEARCH MODE
EMATCH==40		;TEMPORARILY ACCEPT EITHER UPPER OR LOWER CASE
LINCHR==100		;TTY LINE HAS LC BIT ON
TYMSGF==200		;TYPE MESSAGE WITH NO CASE FLAGGING
OCTALF==400		;OCTAL RADIX
CTLR==	1000		;^R SEEN AT INPUT TIME
SKIMRF==2000		;WATCH FOR ^R WHEN SKIMMING
SKIMQF==4000		;WATCH FOR ^Q WHEN SKIMMING
NOTRAC==10000		;DISABLE TRACING
TYSPCL==20000		;TYPE <CR>, ETC INSTEAD OF PRINTER CONTROLS
SKANFS==40000		;SKANNING FS OR FN
TXTCTL==100000		;NO CONTROL COMMANDS IN TEXT EXCEPT ^T, ^R
LCASE==	200000		;CONVERT UPPER CASE TO LOWER CASE BY DEFAULT
UCASE==	400000		;CONVERT LOWER CASE TO UPPER CASE BY DEFAULT

;LEFT HALF - AC F2

GOING== 1		;A COMMAND STRING HAS BEEN SEEN
CTLN==	2		;^N IN SEARCH ARGUMENT
NOALT== 4		;[137] DON'T CONVERT OLD ALTMODES TO 033
NALTFS==10		;[174] NULL REPLACEMENT ALTMODE DELIMITED
			;[174]  F SEARCH
;I-O CHANNELS

INCHN==	2
OUTCHN==3
TTY==	4	;CHANNEL FOR TTY IO
CCLCHN==5	;CHANNEL FOR THE CCL TMP FILE
ERRCHN==6	;CHANNEL FOR ERROR MESSAGE FILE
;MISC PARAMETERS

ALT==	033	;TECO'S ALTMODE
BEGPAG==200	;FAKE ASCII CHAR = BEGINNING OF BUFFER
ENDPAG==201	;FAKE ASCII CHAR = END OF BUFFER IF NO EOL AT END
SPCTAB==202	;FAKE ASCII CHAR = SIGNAL TO SEARCH FOR A STRING OF SPACE/TABS
STABLN==^D131	;LENGTH OF SEARCH TABLE
IOEOT==	2000
DVDIR==4	;[136] DIRECTORY DEVICE CHAR. BIT
DVMTA== 20	;MTA DEVICE CHARACTERISTIC BIT
DVDTA== 100	;DTA DEVICE CHARACTERISTIC BIT
DVDSK==200000	;[136] DSK DEVICE CHARACTERISTIC BIT
CNFTBL==11	;FOR GETTAB UUO
STATES==17	;DITTO
SERES5==3400	;DITTO
JBTPRG==3	;JOBNAME TABLE
LVDTBL==16	;LEVEL D PARAMETERS TABLE
STNPRT==12	;SYSTEM STANDARD PROTECTION WORD
GCTBL==	100
SAVEXT=='SAV'	;PDP-10 SAVE FILE EXTENSION
IFN PDP6,<SAVEXT=='DMP'>	;PDP-6 SAVE FILE EXTENSION
EE1==1B12	;PRINT UUO ERROR CODE AFTER ?XXX
EE2==2B12	;PRINT I/O ERROR CODE AFTER ?XXX
EE3==3B12	;PRINT NOTHING AFTER ?XXX BECAUSE NO CORE FOR ERROR FILE

EO21==	1	;TURN OFF SPECIAL VERSION 22+ FEATURES IF EO VALUE = 1
;OPERATORS

;CHECK EO FLAG: CHKEO	EO#,ADDR
;IF EOFLAG > EO#, RETURN AT CALL+1
;OTHERWISE GO TO ADDR

DEFINE	CHKEO(E,A)
	<1B22+<E>B30,,A>

;TYPE ERROR MSG: ERROR	E.XXX
;TYPE MESSAGE CORRESPONDING TO 'XXX'
;THEN GO TO GO

DEFINE	ERROR(X)
	<1B8+'X'
	'X'=<''X''>&777777>

OPDEF	TYPR1 [2B8]
EXTERN	.JBREL,.JBFF,.JB41,.JBSA,.JBUUO

JOBREN==124
JOBVER==137

LOC JOBVER
	EXP	VERSION		;VERSION #

LOC JOBREN
	EXP	REE		;REENTRY ADDRESS


;MACRO TO DEFINE DATA LOCATIONS

DEFINE U(A,B)<
RELOC
A:	BLOCK	B
RELOC
>


TWOSEG

RELOC	0
RELOC	400000

U LOCORE,0			;START OF DATA AREA

SALL
;PSEUDO RUN UUO IF NEEDED

IFN NORUNS,<
IFN CCL,<
NORUN1:	IOWD	.-.,INHERE	;MODIFIED FOR LENGTH
	0
NORUN2:	CALLI	15,11
	CALLI	12		;NOT ENOUGH CORE TO GET COMPIL
	IN	CCLCHN,NORUN1	;READ THE FILE
	JRST	NORBLT		;TO THE ACS
	CALLI	12		;NO GOOD.

INHERE:				;WHERE CODE APPEARS
NORAC:				;WHERE TO READ AC DATA FROM
	PHASE	0
NORBLT:	BLT	NORTOP,.-.	;ADR MODIFIED
	CALLI	0
	AOS	1,.JBSA		;ADR + 1
	JRST	(1)		;START COMPIL
NORTOP:	XWD	INHERE+1,75	;MOVE COMPIL DOWN
	DEPHASE
	>>
;STARTUP TIME INITIALIZATION

TECO:
IFN CCL,<
	TDZA	B,B
	MOVNI	B,1		;THE CCL ENTRY
	>
	RESET			;INITIALIZE ALL IO
	SETZM	LOCORE		;CLR DATA IN CASE OF ^C,ST
	MOVE	A,[XWD LOCORE,LOCORE+1]
IFE BUGSW,<BLT	A,@.JBREL>
IFN BUGSW,<BLT	A,LOWEND-1>
IFN CCL,<MOVEM	B,CCLSW>
IFE PDP6,<MOVE A,[PUSHJ P,UUOH]>	;SET UUO TRAP
IFN PDP6,<MOVE A,[JSR UUOH]>	;PDP-6 ASSUMES TRAP SET WITH JSR
	MOVEM	A,.JB41
	MOVE	P,[XWD -LPDL,PDL]	;START ONE WORD DOWN
	HRRZ	A,.JBREL	;.JBFF=.JBREL-202
IFN TEMP,<SUBI	A,10>		;SUBTRACT ENOUGH FOR A TMPCOR READ
	EXCH	A,.JBFF
IFN BUGSW,<MOVEM A,CMDBFR>
	ADD	A,[677,,-1]	;CBUF=[000700,,FF-1]
	MOVEM	A,CBUF
	MOVEI	A,201(A)
	IMULI	A,5
	MOVEM	A,BEG		;BEG:=(CBUF+200)*5
	MOVEM	A,PT		;PT:=(CBUF+200)*5
	MOVEM	A,Z		;Z:=(CBUF+200)*5
	MOVEM	A,QRBUF		;QRBUF:=(CBUF+200)*5
	GETPPN	A,		;GET USER'S PROJ-PROG #
	  JFCL			;[175] SOMETIMES SKIPS
	MOVEM	A,USRPPN
	SETOM	MONITR		;GET MONITOR SERIES NUMBER
	MOVE	A,[XWD STATES,CNFTBL]
	GETTAB	A,		;WHICH MONITOR?
	JRST	TECO2		;3 SERIES (MONITR=-1)
	TLNE	A,SERES5
	AOS	MONITR		;5 SERIES (MONITR=+1)
	AOS	MONITR		;4 SERIES (MONITR=0)


;FALL THROUGH TO NEXT PAGE
TECO2:	MOVE	A,[F%FDAE&<-1,,0>!.GTFET]	;[175] GETTAB FTFDAE
	GETTAB	A,		;[175] NEED TO KNOW IF FILE DAEMON
	  SETZ	A,		;[175] MONITOR FOR EB STUFF
	SETZM	FDAEM		;[175] ASSUME NOT
	TRNE	A,F%FDAE&<0,,-1>	;[175] FILE DAEMON MONITOR?
	SETOM	FDAEM		;[175] YES, SIGN BIT OF .RBPRV CHANGED
	SETZM	DEFPTH		;[175] NOW DETERMINE JOB'S DEFAULT
	MOVE	A,[DEFPTH,,DEFPTH+1]	;[175]  PATH
	BLT	A,DEFPTH+10	;[175] FIRST, ZERO PATH BLOCK
	SETOM	DEFPTH		;[175] FUNCTION -1 IS READ PATH
	MOVE	C,USRPPN	;[175] DEFAULT PATH IF NO PATH UUO
	MOVE	A,[10,,DEFPTH]	;[175] POINT TO ARG BLOCK
	PATH.	A,		;[175] READ JOB'S DEFAULT PATH
	  MOVEM	C,DEFPPN	;[175] POOR SUBSTITUTE
	PJOB	A,		;GET JOB #
	MOVEM	A,JOBN
	MOVEI	C,3		;SET CTR
JOBLUP:	IDIVI	A,12		;CONVERT JOB# TO DECIMAL ASCII IN LEFT HALF
	ADDI	AA,20
	LSHC	AA,-6
	SOJG	C,JOBLUP
	HRRI	B,(SIXBIT /TEC/)	;FORM NAME ###TEC
	MOVEM	B,TMPTEC	;SAVE
	HRREI	A,TYCASW	;GET WHATEVER IS DEFAULT TYPE-OUT CASE FLAGGING MODE
	MOVEM	A,TYCASF	;AND MAKE IT CURRENT
	HRRZI	A,EOVAL		;INITIALIZE EO FLAG
	MOVEM	A,EOFLAG
	HRREI	A,ERRMSG-2	;SET ERROR MESSAGE TYPE INDICATOR
	MOVEM	A,ERRLEN	;-1=SHORT, 0=MEDIUM, +1=LONG
	HRREI	A,AUTOFS	;INIT AUTOTYPE-AFTER-SEARCHES FLAG
	MOVEM	A,AUTOF



U	DEFPTH,1
U	DEFFLG,1
U	DEFPPN,1
U	DEFSFD,6


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

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

	PUSH	P,INITG		;FOR IN LINE CODING POPJ
CRE23:	MOVE	A,.JBFF		;LATEST VALUE OF FF
	IMULI	A,5		;5 CHARACTERS PER MEM WORD
	MOVEM	A,MEMSIZ	;MEMSIZ:=C(.JBFF)*5
INITG:	POPJ	P,.+1		;EXIT OR CONTINUE

	MOVE	A,CBUF
	MOVEI	A,100(A)
	MOVEM	A,CBUFH		;CBUFH:=CBUF+77
	MOVEI	A,SYL
	MOVEM	A,DLIM		;DLIM:=SYL
	MOVE	A,[XWD 10014,-1]
	MOVEM	A,NROOM2	;NROOM2:=XWD 10014,-1
	MOVEI	FF,0		;CLEAR FLAG REGISTER
	SKIPE	SRHMOD		;IF DEFAULT SEARCH MODE IS NOT 0,
	TLOA	FF,PMATCH	;MAKE EXACT MODE CURRENT
GOE:	TRZA	FF,777777-TRACEF-QMFLG-FORM-SEQF
GO:	TRZ	FF,777777-TRACEF-FORM-SEQF
	TLZ	FF,CCLFLG	;[175] CLEAR "Y" REQUESTED FLAG
	TRZ	F2,NOTRAC
	MOVE	P,[XWD -LPDL,PDL]	;INITIALIZE PUSHDOWN LIST
	SETZM	PDL		;FLAG PDL TOP - NOTE: PDL FLAGS ARE
				;0 = TOP OF PDL
				;-1= LAST ITEM IS AN ITERATION
				;+1= LAST ITEM IS A PARENTHESIS
				;>1= LAST ITEM IS A MACRO
	SETZM	EQM		;[114] CLEAR MACRO LEVEL COUNT	
	MOVE	PF,[XWD -LPF-1,PFL-1]
	JRST	CLIS

;FROM REE COMMAND DISTRIBUTION IN THE MONITOR

REE:	CLRBFO			;STOP TYPEOUT
	JRST	GO		;GO AND LISTEN FOR INPUT
;THIS PAGE CONTAINS THE COMMAND READER FOR THE CCL SYSTEM

IFN CCL,<
TTYPT:	XWD	440700,TTYBFS	;CCL COMMAND BUFFER PTR
TTYPT2:	XWD	260700,TTYBFS	;TO INSERT FILE NAME AFTER EW OR EB

U CCLB,3			;THE HEADER FOR CCL FILE IO

CCLIN:
IFN TEMP,<
	MOVE	A,[XWD 2,TT]	;SET UP FOR TMPCOR READ & DELETE
	HRLI	TT,'EDT'	;SET UP READ BLOCK FOR TMPCOR UUO
	HRRZ	TT1,.JBFF	;[175] GET FIRST FREE
	ADDI	TT1,46		;[175] LAST LOC USED IN TMPCOR
	CAML	TT1,.JBREL	;[175] ENOUGH ROOM?
	CORE	TT1,		;[175] NO, EXPAND
	  JFCL			;[175] DOESN'T MATER
	HRLZI	TT1,-46		;[175] GET IT ALL
	HRR	TT1,.JBFF
	SOJ	TT1,		;MAKE IT AN IOWD
	TMPCOR	A,		;READ AND DELETE FILE EDT
	JRST	CCLTMP		;NO FILE EDT OR NO TMPCOR UUO
	HRRZ	AA,.JBFF	;GET START OF BUFFER AREA
	HRLI	AA,350700	;PICK UP EDT CHARACTERS, SKIP LINED "S"
	TLO	FF,TMPFLG	;[175] SET TMPCOR FLAG
	JRST	CCLTM1		;[175] FINISH PROCESSING COMMAND
CCLTMP:	>
;HERE IF TMPCOR FAILED OR FEATURE TEST OFF. READ NNNEDT.TMP FROM DSK:

	HLLZ	B,TMPTEC	;GET SIXBIT JOB #
	HRRI	B,(SIXBIT /EDT/)	;REST OF NAME
	MOVE	T,[-XFILEN,,XFILNM-1]	;[175] PDL INTO LOOKUP BLOCK
	PUSH	T,[XFILEN]	;[175] FIRST WORD IS CNT OF ARGS
	PUSH	T,[0]		;[175] LOOK ON DEFAULT PATH
	PUSH	T,B		;[175] STORE FILENAME
	PUSH	T,['TMP   ']	;[175] EXTENSION
	MOVE	T,.JBFF		;USE BUFFER SPACE BRIEFLY
	INIT	CCLCHN,0
	SIXBIT	/DSK/		;TO READ THE FILE
	EXP	CCLB		;INPUT BUFFER
	JRST	TECO		;IF NO DSK, SAY "*"
	INBUF	CCLCHN,1	;DONT ADR CHECK
	LOOKUP	CCLCHN,XFILNM	;[175] OPEN THE FILE
	JRST	TECO		;IT WASNT THERE?
	INPUT	CCLCHN,0
	MOVEM	T,.JBFF		;GIVE BACK SPACE
	IBP	CCLB+1		;SKIP THE LINED S
	MOVE	AA,CCLB+1	;[175] SETUP BYTE POINTER TO INPUT
CCLTM1:	MOVE	T,TTYPT2	;[175] OUTPUT CHARS
	MOVEI	C,2		;INIT CHAR CTR
	MOVEI	A,"="		;[175] FLAG NO EQUALS SIGN SEEN


;FALL INTO LOOP ON NEXT PAGE
;LOOP BACK HERE ON EACH NEW CHARACTER IN THE TMP FILE
CCLIL:	ILDB	B,AA		;[175] INPUT THE FILE NAME & EXT
	CAMN	B,A		;[175] FIRST EQUALS SIGN SEEN?
	JRST	CCLEQL		;[175] YES
	JUMPE	B,CCLNUL	;[175] QUIT ON END OF STRING
	IDPB	B,T		;[175] ELSE STORE CHAR
	AOJA	C,CCLIL		;[175] AND LOOP FOR ALL CHARS

;HERE ON THE FIRST "=" IN THE COMMAND STRING
CCLEQL:	MOVEI	B,ALT		;[175] REPLACE FIRST EQUALS SIGN
	IDPB	B,T		;[175]   WITH <ALT>ER
	ADDI	C,1		;[200] COUNT THE ALT
	MOVE	D,T		;[200] SAVE C & T
	MOVE	E,C		;[200] INCASE .TE A=B
	MOVEI	B,"E"		;[175]   SINCE WE EXPECT
	IDPB	B,T		;[175]   AN INPUT FILE
	MOVEI	B,"R"		;[175]   SPEC TO FOLLOW
	IDPB	B,T		;[175]   THE FIRST ONE
	ADDI	C,2		;[175] COUNT THE CHARS STORED
	SETO	A,		;[175] PREVENT FINDING LATER EQUALS
	TLO	FF,CCLFLG	;[175] DO A Y IN ANY CASE
	JRST	CCLIL		;[175] AND LOOP BACK FOR NEXT CHAR

;HERE ON A NUL (END OF COMMAND). SEE IF IT WAS MAKE OR TECO
CCLNUL:	LDB	B,T		;[175] RETRIEVE LAST CHAR
	MOVEI	TT,"W"		;[200] PREPARE FOR EW COMMAND
	CAILE	B,15		;WAS BREAK A CRLF?
	JRST	CCLDUN		;NO. ALTMODE ASSUMED
	TLO	FF,CCLFLG	;REQUEST Y AFTER EB
	MOVEI	TT,"B"		;[200] NOW PREPARE FOR EB
	AOJN	A,CCLDUN	;[200] CONTINUE UNLESS EB & "=" WAS SEEN
	MOVE	T,D		;[200] IF .TE A=B,  WE NEVER SAW THE "="
	MOVE	C,E		;[200] IN CASE .MA A=B, THEN .TE<CRLF>
CCLDUN:	MOVEI	B,ALT
	DPB	B,T		;TERMINATING TWO ALT'S
	IDPB	B,T		;LAST ALT
	ADDI	C,2		;COUNT 2ND ALT & ADD 1 TO FOOL TYI0
	MOVEI	B,"E"		;NOW FILL IN THE EB OR EW
	MOVE	T,TTYPT		;AT THE BEGINNING OF STRING
	MOVEM	T,TIB+1		;ALSO INITIALIZE TO READ THIS
	IDPB	B,T		;STORE "E"
	IDPB	TT,T		;[200] AND EITHER W OR B
	MOVEM	C,TIB+2		;SET BUFR CTR
IFN TEMP,<TLZE	FF,TMPFLG	;TMPCOR UUO IN PROGRESS?
	JRST	CCLDU2>		;YES, DONT CLOSE DSK
	SETZM	XNAM		;[175] NOW FLUSH FILE
	RENAME	CCLCHN,XFILNM	;[175] BY RENAME TO ZERO
	  JFCL			;[175] PROTECTED?
CCLDU2:	RELEAS	CCLCHN,
	POPJ	P,
	>
;ROUTINE TO RETURN NON-NULL TTY CHARACTER IN CH.
;CALL	PUSHJ PDP,TYI 
;	RETURN

TYI:	TLZE	FF,TYOF		;NEED A TYO?
	OUTPUT	TTY,0		;YES. DO SO.
TYI0:	SOSG	TIB+2		;CHARS IN NORMAL MODE?
	JRST	TYI1		;NONE LEFT
TYI2:	ILDB	CH,TIB+1	;YES. GET ONE
	JUMPE	CH,TYI0		;FLUSH NULLS
TYI3:	TRZ	FF,DDTMF	;CLR TTCALL REQUEST FLAG
IFN RUBSW,<
	SETO	A,		;AIM AT THIS TTY
	TTCALL	6,A		;GETSTS
	TLNN	A,4		;SUPPRESS ECHO?
	>
	CAIE	CH,7		;BELL?
	JRST ALTLIN		;CHECK FOR ALTMODE
	JSP	A,CONMES	;ECHO AN "^G" TOO
	ASCIZ	/^G/
	MOVEI	CH,7		;GET BACK BELL
	POPJ	P,

TYI1:	TRNE	FF,DDTMF	;SHOULD TYI BE TTCALL?
	JRST	TYIDDT		;YES
	INPUT	TTY,0		;NO. ORDINARY.
	STATO	TTY,20000	;END OF FILE?
	JRST	TYI2
	PUSHJ	P,TTOPEN	;CLEAR EOF THE HARD WAY
	JRST	TYI0		;^Z WAS SEEN ALREADY. GET ANOTHER CH

;CONVERT 175 & 176 TO ALTMODE (033) UNLESS TTY NOALT IS ON

ALTLIN:	CAIL	CH,175		;OLD ALTMODE?
	CAILE	CH,176
	POPJ	P,		;NO
	TLNN	F2,NOALT	;[137] TEST TTY NOALT BIT
ALTX:	MOVEI	CH,ALT		; CONVERT TO 033
	POPJ	P,

;CONVERT 175 & 176 TO ALTMODE (033) IF EO = 1

ALTEO:	CAIE	CH,175		;OLD ALTMODE?
	CAIN	CH,176
	CHKEO	EO21,ALTX	;RUNNING OLD MACRO? IF SO, CONVERT
	POPJ	P,		;NO, 175=RIGHT BRACE, 176=TILDE
TYIDDT:	TLZE	FF,TYOF		;CHARACTERS WAITING FOR OUTPUT?
	OUTPUT	TTY,0		;YES, FORCE THEM OUT
	TTCALL	0,CH		;WAIT FOR A SINGLE CHARACTER
	JRST	TYI3

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

TYOS:	TROA	F2,TYSPCL	;TYPE <CR>, ETC INSTEAD OF PRINTER CONTROLS
TYOM:	TRZ	F2,TYSPCL	;CLR SPECIAL TYPEOUT FLAG
	TROA	F2,TYMSGF	;SET NO-CASE-FLAGGING FLAG
TYO:	TRZ	F2,TYMSGF+TYSPCL	;CLR NO-CASE-FLAGGING FLAG & SPECIAL FLAG
	PUSH	P,CH		;SAVE CHAR IN CASE ^ OR ' NEEDED
	TLNE	FF,TYOCTF	;ET IN EFFECT?
	JRST	TYOB		;[120] YES, TYPE ALL CHARACTERS AS IS	
	PUSHJ	P,ALTEO		;CONVERT OLD ALTMODES IF EO=1
	CAIGE	CH,11
	JRST	TYO1		;BELOW TAB
	TRZN	F2,TYSPCL	;WANT <CR>, ETC INSTEAD OF PRINTER CONTROLS?
	JRST	TYOJ		;NO
	CAIG	CH,15		;IS IT A PRINTER CONTROL?
	JRST	TYOH		;YES
	CAIE	CH,ALT		;OR AN ALTMODE?
	JRST	TYOG		;NO, DO NORMAL THING
	MOVEI	CH,16		;ADJUST INDEX FOR ALTMODE
TYOH:	MOVEI	A,5		;5 CHAR. CTR
	MOVE	AA,[POINT 7,TSPTAB-11]	;& PTR TO RIGHT COMBINATION
	ADDI	AA,(CH)
TYOI:	ILDB	CH,AA		;TYPE <CR> OR WHATEVER
	SOJLE	A,TYOB		;LAST CHAR GOES OUT VIA TYOB (TO POP CH)
	PUSHJ	P,TYOA
	JRST	TYOI
TYOJ:	CAIG	CH,15		;NO, TAB, LF, VT, FF, OR CR?
	JRST	TYOB		;YES. TYPE IT AND RETURN
	CAIN	CH,ALT
	MOVEI	CH,"$"		;YES TYPE DOLLAR SIGN
TYOG:	CAIGE	CH,40		;NO. ANY OTHER CONTROL CHARACTER?
	JRST	TYO1		;YES.
TYOC:	TRNE	F2,LINCHR+TYMSGF	;TTY LC ON? OR TYPING A MESSAGE?
	JRST	TYOB		;YES, NO CASE FLAGGING
	MOVE	A,TYCASF	;WHAT SHOULD BE FLAGGED?
	JUMPL	A,TYOB		;NOTHING
	JUMPG	A,TYOD		;UPPER CASE RANGE
	CAIGE	CH,140		;LOWER CASE. IS THIS LC?
	JRST	TYOB		;NO, SO DON'T FLAG IT
TYOE:	MOVEI	CH,47		;YES, FLAG IT WITH '
	PUSHJ	P,TYOA
	MOVE	CH,(P)		;GET BACK THE CHARACTER
	TRZ	CH,40		;MAKE IT UPPER CASE
TYOB:	PUSHJ	P,TYOA		;TYPE CH.
	POP	P,CH		;RESTORE CH
	CAIN	CH,7		;IF BELL AND ET IS OFF, WE MUST
	TLNE	FF,TYOCTF	;FALL INTO TYOA TO GET A DING
	POPJ	P,		;RETURN
TYOA:	TLO	FF,TYOF		;MARK WILL NEED TO OUTPUT
	SOSG	TOB+2		;OUTPUT SPACE AVAIL?
	OUTPUT	TTY,0		;NO. OUTPUT.
	IDPB	CH,TOB+1
	CAILE	CH,14		;FORCE OUTPUT ON LF,FF ETC
	POPJ	P,		;NO
	OUTPUT	TTY,0
	TLZ	FF,TYOF		;NO LONGER NEED TO OUTPUT
	POPJ	P,

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

TYOD:	CAIL	CH,100		;IS THIS UPPER CASE?
	CAILE	CH,137
	JRST	TYOB		;NO
	JRST	TYOE		;YES, FLAG IT WITH '

IFN CCL,<U TYIPT,1>		;
U TTYBFS,46			;100 MODE TTY BFRS
U TIB,3				;BUFFER HEADER
U TOB,3				;DITTO
U JOBN,1			;JOB #
U USRPPN,1			;USER PROJ-PROG #
U MONITR,1			;MONITOR LEVEL: 0=3,1=4,2=5
U IBUF,3			;
U OBF,3				;
U IBUF1,2*<BUFSIZ+3>		;
U OBUF1,2*<BUFSIZ+3>		;

;PRINT THESE INSTEAD OF PRINTER CONTROLS IF TYSPCL FLAG IS ON

TSPTAB:	ASCII	/<TAB>/
	ASCII	/<LF>/
	ASCII	/<VT>/
	ASCII	/<FF>/
	ASCII	/<CR>/
	ASCII	/<ALT>/
;MESSAGE TYPE-OUT
;CALL	JSP A,CONMES
;	ASCIZ /MESSAGE/
;	RETURN

CONMES:	HRLI	A,440700	;A=POINT 7,MESSAGE-ADDR
	ILDB	CH,A		;GET MSG CHAR
	JUMPE	CH,1(A)		;RETURN WHEN 0 FOUND
	PUSHJ	P,TYOM		;TYPE WITH NO CASE FLAGGING
	JRST	.-3

;ROUTINE TO OUTPUT DECIMAL (OCTAL IF OCTALF IS ON) INTEGER
;CALL	MOVE B,INTEGER
;	MOVEI A,ADDRESS OF OUTPUT ROUTINE
;	PUSHJ P,DPT
;	RETURN

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

;ROUTINE TO TYPE CARRIAGE RETURN LINE FEED
;CALL	PUSHJ P,CRR
;	RETURN
CRR:	JSP	A,CONMES	;OUTPUT CRLF
	ASCIZ	/
/
	POPJ	P,
;RETURN NEXT COMMAND CHAR AT CURRENT LEVEL
;CALL:	PUSHJ	P,SKRCH
;	ERROR RETURN IF NO MORE CHARS AT THIS LEVEL
;	NORMAL RETURN WITH CHAR IN CH

SKRCH:	SKIPG	COMCNT		;ANY CHARS LEFT?
	POPJ	P,		;NO, TAKE ERROR RETURN
	PUSHJ	P,RCH		;YES, GET NEXT
CPOPJ1:	AOS	(P)		;SKIP RETURN
	POPJ	P,

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

RCH:	SOSGE	COMCNT		;DECREMENT COMMAND BUFFER CHARACTER COUNT
				;IS COMMAND BUFFER EMPTY?
	JRST	RCH2		;YES. POP UP TO HIGHER MACRO LEVEL.
	ILDB	CH,CPTR		;NO. GET COMMAND CHARACTER IN CH
	PUSHJ	P,ALTEO		;CONVERT OLD ALTMODES IF EO = 1
	TRNE	FF,TRACEF	;IN TRACE MODE?
	TRNE	F2,NOTRAC	;TRACE ENABLED?
	POPJ	P,		;NO, RETURN
	JRST	TYO		;YES, TYPE THE COMMAND

RCH2:	POP	P,CH		;SAVE RETURN FOR POPJ IN CH
	POP	P,COMCNT	;GET RID OF FLAG
	SKIPE	EQM		;[114] DON'T ALLOW NEG MACRO COUNT	
	SOS	EQM		;[114] DECREMENT THE MACRO LEVEL	
	SOSG	COMCNT		;IF ANG BRAK ON PDL, ITS A INCOMPLETE MACRO
	ERROR	E.IAB
	POP	P,COMCNT	;GET COUNT FROM NEXT MACRO LEVEL
	POP	P,CPTR		;CURRENT POINTER TOO
	POP	P,COMAX		;NUMBER OF COMMANDS
	PUSH	P,CH		;GET RETURN BACK ON PDL.
	JRST	RCH		;TRY AGAIN.

;GET NEXT CHAR FROM CURRENT COMMAND LEVEL WHERE A CHAR IS
;KNOWN TO BE THERE, AND NO TRACING IS WANTED

GCH:	SOS	COMCNT		;REDUCE CHAR COUNT
	ILDB	CH,CPTR		;GET CHAR.
	JRST	ALTEO		;CONVERT OLD ALTMODES AND RETURN
;SCAN COMMAND STRING FOR CHARACTER IN TT
;IGNORING PAIRS STARTING WITH CHAR. IN TT1 AND ENDING WITH (TT)
;ASSUMED THAT CPTR IS SET
;NON-SKIP RETURN IF (TT) CAN'T BE FOUND
;SKIP RETURN IF FOUND
;CPTR LEFT SET FOR NEXT CHAR. IN COMMAND STRING

SKAN:	TRO	F2,NOTRAC	;INHIBIT TRACE ACTION WHILE SKANNING
	MOVEI	C,0		;CTR FOR <> AND "...' PAIRS
SKAN0:	TRZ	F2,SKIMQF+SKIMRF+SKANFS	;CLR SKIM FLAGS
	PUSHJ	P,SKRCH2	;GET COMMAND CHAR.
	CAIN	CH,(TT1)	;SECONDARY CHARACTER?
	AOJA	C,SKAN1		;YES, COUNT IT
	CAIN	CH,(TT)		;PRIMARY CHAR?
	JRST	SKAN10		;YES!
SKAN1:	CHKEO	EO21,SKAN0	;OLD STYLE SKAN IF EO = 1
	MOVEI	T,SKNTAB	;NO, WATCH OUT FOR TEXT STRINGS
SKAN00:	PUSHJ	P,DISPAT
	JRST	SKAN0		;NOT A TEXT-ARG COMMAND, IGNORE IT
SKAN2:	PUSHJ	P,SKRCH2	;GET CHAR AFTER "^"
	CAIN	CH,"A"
	JRST	SKAN7		;^A COMMAND
	CAIN	CH,"^"
	JRST	SKAN11		;^^ COMMAND
	JRST	SKAN0		;ORDINARY CTRL-COMMAND, FORGET IT
SKAN3:	PUSHJ	P,SKRCH2
	MOVEI	T,SK3TAB	;WHICH E COMMAND?
	JRST	SKAN00
SKAN4:	PUSHJ	P,SKRCH2	;WHAT FOLLOWS @?
	MOVEI	T,SK4TAB
	PUSHJ	P,DISPAT
	JRST	SKAN4		;MUST BE 1 OF THESE 4
SKAN9:	PUSHJ	P,SKIM		;IGNORE TO $
	JRST	SKAN0
SKAN7:	MOVEI	T,1		;IGNORE TO ^A
	JRST	SKAN5
SKAN8:	MOVEI	T,"!"		;IGNORE TO !
SKAN5:	PUSHJ	P,SKIM1		;IGNORE TO CHAR IN T
	JRST	SKAN0
SKAN6:	PUSHJ	P,SKRCH2	;GET SEARCH DELIMITER
	SKIPA	T,CH		;IGNORE TO NEXT OCCURRENCE
SKAN12:	MOVEI	T,ALT		;DELIMITER IS ALTMODE
	PUSHJ	P,SKIMRQ	;SKIP TO DELIMITER & WATCH OUT FOR ^Q,^R
	JRST	SKAN0
SKAN13:	PUSHJ	P,SKRCH2	;GET INSERT DELIMITER
	SKIPA	T,CH		;IGNORE TO NEXT OCCURRENCE
SKAN14:	MOVEI	T,ALT		;DELIMITER IS ALTMODE
	PUSHJ	P,SKIM.R	;SKIP TO DELIMITER & WATCH OUT FOR ^R
	JRST	SKAN0
SKAN11:	PUSHJ	P,SKRCH2	;IGNORE NEXT CHAR.
	JRST	SKAN0
SKAN16:	MOVEI	T,SK5TAB	;TABLE FOR @F
	JRST	SKAN17
SKAN15:	MOVEI	T,SK1TAB	;TABLE FOR F COMMANDS
SKAN17:	TRO	F2,SKANFS	;SIGNAL FS OR FN IN PROGRESS
	PUSHJ	P,SKRCH2	;GET CHAR AFTER F
	JRST	SKAN00
SKAN10:	SOJGE	C,SKAN0		;IF MATCH JUST ENDS A PAIR, LOOP BACK
	TRZ	F2,NOTRAC	;ENABLE TRACING
	JRST	CPOPJ1		;OTHERWISE, WE HAVE WHAT WE WANT

;SKIM OVER TEXT
;ENTER AT SKIM TO SKIP TO NEXT ALTMODE, GIVING ^R & ^Q NO SPECIAL TREATMENT
;ENTER AT SKIM1 TO SKIP OVER ARBITRARY CHAR IN T, GIVING ^R & ^Q NO SPECIAL TREATMENT
;ENTER AT SKIM.R TO SKIP TO ARBITRARY CHAR IN T, UNLESS IT IS AFTER ^R
;ENTER AT SKIMRQ TO SKIP TO ARBITRARY CHAR IN T, UNLESS IT IS AFTER EITHER ^R OR ^Q

SKIMRQ:	TRO	F2,SKIMQF	;CK FOR ^Q AND ^R
SKIM.R:	TROA	F2,SKIMRF	;CK FOR ^R
SKIM:	MOVEI	T,ALT		;SKIP TO NEXT ALTMODE
SKIM1:	PUSHJ	P,SKRCH		;GET NEXT TEXT CHAR.
	JRST	APOPJ		;ERROR RETURN FROM SKAN ROUTINE
	CAIN	CH,(T)		;CHARACTER WE WANT?
	JRST	SKIM3		;YES
	CAIN	CH,21		;^Q?
	TRNN	F2,SKIMQF	;YES, CK FLAG ON?
	JRST	.+2		;NO
	JRST	SKIM2		;YES
	CAIN	CH,22		;^R?
	TRNN	F2,SKIMRF	;YES, CK FLAG ON?
	JRST	SKIM1		;NO, KEEP LOOKING
SKIM2:	PUSHJ	P,SKRCH		;GOBBLE UP NEXT CHARACTER
	JRST	APOPJ		;ERROR RETURN FROM SKAN
	JRST	SKIM1		;CONTINUE SKIMMING
SKIM3:	TRZE	F2,SKANFS	;SKIMMING OVER FS OR FN?
	JRST	SKIM1		;YES, IGNORE 1ST DELIMITER
	POPJ	P,

;GET A SINGLE CHARACTER FROM COMMAND STRING
;TAKE ERROR RETURN FROM SKAN IF THERE ARE NO MORE

SKRCH2:	PUSHJ	P,SKRCH		;GET A COMMAND CHAR.
APOPJ:	POP	P,A		;ERROR RETURN FROM SKAN IF NO MORE CHARS.
	POPJ	P,
;SKAN ROUTINE DISPATCH TABLES

SKNTAB:	XWD	SKAN15,"F"
	XWD	SKAN14,"I"
	XWD	SKAN14,11	;TAB
	XWD	SKAN12,"_"
	XWD	SKAN9,"O"
	XWD	SKAN8,"!"
	XWD	SKAN7,1		;^A
	XWD	SKAN11,36	;^^
	XWD	SKAN2,"^"
	XWD	SKAN3,"E"
	XWD	SKAN11,"U"
	XWD	SKAN11,"Q"
	XWD	SKAN11,"X"
	XWD	SKAN11,"G"
	XWD	SKAN11,"M"
	XWD	SKAN11,"%"
	XWD	SKAN11,"["
	XWD	SKAN11,"]"
	XWD	SKAN4,"@"
	XWD	SKAN11,42	;"
SK1TAB:	XWD	SKAN12,"S"	;S OR FS
	XWD	SKAN12,"N"	;N OR FN
	XWD	0,0		;LIST TERMINATOR

SK3TAB:	XWD	SKAN9,"B"	;EB
	XWD	SKAN9,"R"	;ER
	XWD	SKAN9,"W"	;EW
	XWD	SKAN9,"Z"	;EZ
	XWD	0,0

SK4TAB:	XWD	SKAN16,"F"	;@F
	XWD	SKAN13,"I"	;@I
	XWD	SKAN6,"_"	;@_
SK5TAB:	XWD	SKAN6,"S"	;@S OR @FS
	XWD	SKAN6,"N"	;@N OR @FN
	XWD	0,0
CLIS1:	PUSHJ	P,CRR		;TYPE CRLF
CLIS:
IFN CCL,<
	SKIPN	CCLSW		;NEED CCL COMMAND?
	JRST	LIS0		;NO
	PUSHJ	P,CCLIN		;GET THE CCL COMMAND TO TYI BUFFER
	JRST	LIS02		;AND DONT SAY STAR
	>
LIS0:	PUSHJ	P,TTOPEN	;GET TELETYPE
	TRNE	FF,QMFLG	;1ST CHARACTER IN ALREADY?
	JRST	LIS01		;YES
	MOVEI	CH,"*"
	TRZ	F2,LINCHR	;CLR TTY LC BIT
	SETO	A,		;GETLCH ON THIS LINE
	TTCALL	6,A
	TLNE	A,20		;TTY LC ON?
	TRO	F2,LINCHR	;YES, SET TTY LC BIT
	HRRZ	TT1,A		;[137] GET UNIVERSAL I/O INDEX
	MOVEI	TT,1026		;[137] CODE FOR ALT TESTING
	MOVE	A,[XWD 2,TT]	;[137] SET UP FOR TRMOP
	TRMOP.	A,		;[137] GET ALTMODE INFO FROM MONITOR
	 LDB	A,[POINT 1,F2,29] ;[137] IF THIS FAILS USE LC BIT
	SKIPE	A		;[137] SHOULD WE CHANGE OLD ALTMODES?
	TLOA	F2,NOALT	;[137] DON'T CONVERT
	TLZ	F2,NOALT	;[137] DO CONVERT
	PUSHJ	P,TYOM		;TYPE *
LIS01:	TRON	FF,QMFLG	;UNLESS ONE ALREADY IN
	PUSHJ	P,TYI
	CAIE	CH,"*"		;1ST CHAR AN ASTERISK?
	JRST	LIS02		;NO, CONTINUE NORMALLY

;SAVE PREVIOUS COMMAND STRING IN NAMED Q-REGISTER

	TLNE	F2,GOING	;ANY CMD STRG SEEN YET? IF NOT, * IS ILLEGAL
	JRST	LIS03		;OK
	PUSHJ	P,CRR		;MUST PUT CR/LF BEFORE ?NCS
;LIS01+6 1/2 [166] SPR#17205
	PUSHJ	P,TYI		;[166] FIND NEXT CHARACTER TYPED
	MOVE	A,TIB+1		;[166] PICK UP ITS POINTER
	MOVEM	A,CPTR		;[166] STORE FOR ERROR MESSAGE
	ERROR	E.NCS
LIS03:	MOVE	C,COMLEN	;LENGTH OF STRING
	TLNE	F2,NALTFS	;[174] NULL REPLACEMENT ALTMODE DELIMITED
				;[174]  F SEARCH?
	ADDI	C,1		;[174] YES, DONT OMIT LAST ALTMODE
	ADDI	C,2		;OMIT LAST ALTMODE
	MOVEI	B,CMDBFR	;POSITION OF FIRST CHAR. IN BYTES
IFN BUGSW,<MOVE	B,CMDBFR>
	IMULI	B,5
	PUSHJ	P,X3		;TRANSFER STRING TO Q-REG
	PUSHJ	P,TYI		;GET Q-REG NAME FOR * COMMAND
;LIS03+5 1/2 INSERT [170] SPR#17404
	MOVE	A,TIB+1		;[170] GET POINTER TO CURRENT CHARACTED
	MOVEM	A,CPTR		;[170] STORE FOR POSSIBLE ERROR MESSAGE
	PUSHJ	P,QREGV2	;STORE 400000 IN QTAB
	MOVEM	B,QTAB-"0"(CH)
	TRZ	FF,QMFLG	;NEXT INPUT CHAR NOT IN
LIS02:	SETZM	COMCNT		;COMCNT:=0
	TLZ	F2,NALTFS	;[174] CLEAR FLAG
	SETZM	SYMS
	MOVE	T,[XWD SYMS,SYMS+1]
	BLT	T,SYMEND-1
	MOVE	AA,CBUF
	MOVE	B,CBUFH

LI1:	TRZ	FF,ALTF+BELLF+XPLNFL+EMFLAG
LI2:	CAILE	B,(AA)		;COMMAND BUFFER EXCEEDED?
	JRST	LI3		;NO


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

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

	ADDI	B,100		;YES. EXPAND COMMAND BUFFER 100 WORDS.
	MOVE	C,Z
	IDIVI	C,5		;C:=DATA BUFFER END WORD ADDRESS.
	MOVE	D,QRBUF
	PUSH	P,F2		;KLUDGE TO PROTECT F2 UNTIL AC'S ARE REORDERED
	IDIVI	D,5		;D:=Q-REG BUFFER BASE WORD ADDRESS.
	POP	P,F2		;RESTORE FLAGS
	SUBM	C,D		;D:=NO. OF WORDS IN Q-REG BUFFER AND DATA BUFFER.
	MOVE	CH,(C)
	MOVEM	CH,100(C)	;MOVE Q-REG AND DATA BUFFERS UP 100 WORDS.
	SOS	C
	SOJGE	D,.-3
	MOVEI	C,500
	ADDM	C,BEG		;BEG:=C(BEG)+500
	ADDM	C,PT		;PT:=C(PT)+500
	ADDM	C,Z		;Z:=C(Z)+500
	ADDM	C,QRBUF		;QRBUF:=C(QRBUF)+500
	MOVE	D,Z
LI3:	MOVEM	B,CBUFH		;NO. RESET HIGH END OF COMMAND BUFFER.
	TRZN	FF,QMFLG	;1ST CHAR IN ALREADY?
	PUSHJ	P,TYI		;GET A NON-NULL CHARACTER IN CH
	CAIN	CH,177		;RUBOUT?
	JRST	RUBOUT		;YES
LI3A:	AOS	A,COMCNT	;NO. INCREMENT COMMAND CHARACTER COUNT
	IDPB	CH,AA		;STORE CHARACTER IN COMMAND BUFFER.
LI4:	CAIE	CH,ALT		;ALT-MODE?
	JRST	LI5		;NO
	TRZN	F2,CTLR		;PREVIOUS CHAR. A ^R?
	JRST	LI7		;NO
	CHKEO	EO21,LI7	;IF EO=1, NEVERMIND ^R
LI9:	TRZ	FF,BELLF	;ALTMODE CLEARS BELL FLAG
	JRST	LI2

LI7:	TRON	FF,ALTF		;YES. SET ALT-MODE FLAG. WAS IT ON?
	JRST	LI9		;NO
	MOVEM	A,COMAX		;SET COMMAND CHARACTER ADDRESS UPPER BOUND
	MOVEM	A,COMLEN	;SAVE IN CASE OF * COMMAND NEXT
	MOVE	AA,CBUF		;INIT COMMAND BYTE PTR
	MOVEM	AA,CPTR
	SKIPE	CCLSW		;READING CCL CMD?
	PUSHJ	P,TTOPEN	;YES, INIT TTY
	PUSHJ	P,CRR		;TYPE CRLF
	SETZM	CCLSW		;FINISHED WITH CCL READ
	JRST	CD		;DECODE COMMAND
LI5:	CAIN	CH,22		;^R?
	JRST	CNTRLR		;YES
	TRZ	F2,CTLR		;NO, CLR FLAG IN CASE PRECEDING CHAR WAS
	CAIN	CH,25		;^U?
	JRST	CNTRLU		;YES
	CAIN	CH,7		;BELL?
	JRST	LI6		;YES
	TRZN	FF,BELLF	;NO, PREVIOUS CHAR A BELL?
	JRST	LI1		;NO, GET NEXT CHARACTER
	CAIE	CH," "		;YES, IS THIS A SPACE?
	JRST	LI2
RETYPE:	PUSHJ	P,BACKUP	;BACK OFF ^G<SPACE>
	SOS	D,COMCNT	;MARK CURRENT POSITION
	PUSHJ	P,BACKLN	;BACK UP TO BEG OF LINE
	JRST	RETYP3		;HIT BEG OF COMMAND STRING
RETYP1:	SKIPL	COMCNT		;[151] SEE IF ANY COMMANDS
	PUSHJ	P,TYOM		;TYPE A CHAR OF COMMAND LINE
RETYP4:	AOS	C,COMCNT	;ADVANCE COMMAND CTR
	CAIL	C,(D)		;BACK IN PLACE?
	JRST	RETYP2		;YES
	ILDB	CH,AA		;NO, GET NEXT CHAR
	JRST	RETYP1

RETYP2:	CAIN	CH,ALT		;LOOKING AT AN ALTMODE?
	TRO	FF,ALTF		;YES, BETTER SET FLAG
	JRST	LI2

RETYP3:	PUSH	P,CH		;SAVE 1ST CHAR
	PUSHJ	P,CRR		;TYPE CR-LF BEFORE COMMAND LINE
	POP	P,CH		;RETRIEVE 1ST CHARACTER
	JUMPE	CH,RETYP4	;DON'T PRINT ^@ IF NULL COMMAND STRING
	JRST	RETYP1

LI6:	TROE	FF,BELLF	;YES. SET BELL FLAG. TWO SUCCESSIVE BELLS?
	JRST	LI8		;YES, REJECT COMMAND
	TRO	FF,DDTMF	;GET ANOTHER CHAR WITH TTCALL 0
	JRST	LI2

LI8:	SUBI	A,1		;SAVE COMCNT-1 IN CASE * COMMAND FOLLOWS
	MOVEM	A,COMLEN
	TLO	F2,GOING	;SO YOU CAN DO *I AFTER ^G^G
	PUSHJ	P,CRR		;YES. TYPE A CRLF
	JRST	GO		;AND CLEAR COMMAND BUFFER.
;BACK UP BYTE POINTER IN AA, LOAD APPROPRIATE CHARACTER IN CH,
;AND ADJUST COMCNT

BACKUP:	ADD	AA,[7B5]	;BACK UP CHAR PTR
	JUMPG	AA,.+3		;OK NOW?
	SUBI	AA,1		;NO, NEEDS FURTHER FIXING
	HRLI	AA,010700
	LDB	CH,AA		;LOAD CHAR
	SOS	C,COMCNT	;DECREMENT COMMAND COUNT
	POPJ	P,

;BACKUP TO BEGINNING OF CURRENT LINE
;CALL:	PUSHJ	P,BACKLN
;	RETURN IF BACKUP WENT TO BEGINNING OF COMMAND STRING
;	RETURN IF CR-EOL COMBINATION FOUND

BACKLN:	PUSHJ	P,BACKUP	;BACK UP ONE CHAR
	JUMPLE	C,CPOPJ		;RETURN IF NOTHING LEFT
BACKL1:	PUSHJ	P,CKEOL		;IS THIS AN EOL CHAR?
	JRST	BACKLN		;NO, KEEP BACKING UP
	PUSHJ	P,BACKUP	;YES, BACK UP ONE MORE
	CAIE	CH,15		;IS THIS A CR?
	JRST	BACKL1		;NO, MAYBE ANOTHER EOL?
	JRST	CPOPJ1		;YES, TAKE SKIP RETURN

;PROCESS CONTROL-U

CNTRLU:	PUSHJ	P,TYOM		;ECHO THE ^U
	PUSHJ	P,BACKLN	;BACK UP TO BEG OF LINE
	JUMPLE	C,CLIS1		;IF NOTHING LEFT, RETYPE *
	AOS	COMCNT		;KEEP CRLF
	IBP	AA
	PUSHJ	P,CRR		;CR-LF AFTER ^U
	JRST	LI1		;CONTINUE TYPE-IN

;CONTROL-R IN COMMAND MODE PREVENTS AN ALTMODE AFTER IT
;FROM BEING A TERMINATOR

CNTRLR:	TRZN	F2,CTLR		;^R ON ALREADY?
	TRO	F2,CTLR		;NO, SET FLAG
	JRST	LI1
;PROCESS RUBOUTS

RUBSW==0

RUBOUT:	SKIPG	COMCNT		;ANYTHING TYPED IN?
	JRST	CLIS1		;NO, RETYPE *
IFN RUBSW,<
	SETO	A,		;GETLCH ON THIS TTY
	TTCALL	6,A		;SET TO SUPPRESS ECHOING
	TLO	A,4
	TTCALL	7,A
	PUSHJ	P,SPLAT		;ACT LIKE THE MONITOR
	JRST	RUB4
RUB1:	SKIPGE	COMCNT		;PAST BEGINNING OF COMMAND STRING YET?
	JRST	RUB3		;YES
	PUSHJ	P,TYIDDT	;GET ONE CHARACTER
	CAIE	CH,177		;RUBOUT?
	JRST	RUB2		;NO
RUB4:	>
	LDB	CH,AA		;RELOAD THE CHAR.
	SKIPE	COMCNT		;UNLESS AT BEGINNING OF COMMAND STRING,
	PUSHJ	P,TYOM		;ECHO THE DELETED CHAR.
	PUSHJ	P,BACKUP	;BACK OVER THE CHAR.
IFE RUBSW,<JRST LI1>		;RESUME TYPE-IN
IFN RUBSW,<
	JRST	RUB1		;TRY NEXT INPUT CHAR.
RUB2:	PUSH	P,CH		;SAVE THIS GOOD GUY
	PUSHJ	P,SPLAT		;TYPE THE SECOND \
	POP	P,CH		;GET THAT CHAR. BACK
	CAIE	CH,25		;CTRL-U?
	PUSHJ	P,TYOM		;NO, ECHO IT
	PUSHJ	P,TTCREE	;RESET TTCALL FOR ECHOING
	JRST	LI3A		;PROCESS THIS CHAR.
RUB3:	PUSHJ	P,SPLAT		;SECOND \
	PUSHJ	P,TTCREE	;RESET TTCALL MODE TO NORMAL
	JRST	CLIS1		;START A NEW COMMAND STRING
	>

;TYPE BACKSLASH

IFN RUBSW,<
SPLAT:	MOVEI	CH,"\"
	JRST	TYOM
	>

;RESET TTCALL FOR ECHOING

IFN RUBSW,<
TTCREE:	SETO	A,		;GETLCH ON THIS TTY
	TTCALL	6,A
	TLZ	A,4		;TURN OFF NO ECHO BIT
	TTCALL	7,A
	POPJ	P,
	>
CD:
RET:	TRZ	FF,ARG2+ARG+FINDR+PCHFLG+SEQUIN+FSRCH
	TLO	F2,GOING	;A COMMAND STRING IS IN
CD1:	SETZM	NUM		;NO ARGUMENT STRING SEEN
	SETZM	SYL
	MOVSI	A,(MOVE B,)	;STANDARD ARG OPERATOR IS MOVE B,SYL
CD3:	HLLM	A,DLIM
CD5:	PUSHJ	P,RCH
CD9:	MOVE	A,CH		;GET COMMAND CHARACTER
	CAIL	CH,"0"		;IS IT A DIGIT?
	CAILE	CH,"9"
	TRZ	F2,OCTALF	;NO, CLEAR OCTAL RADIX FLAG
	CAIE	A,140		;140 IS ILLEGAL
	CAILE	A,172		;ALSO 173-177 ARE ILLEGAL
	MOVEI	A,0
	CAILE	A,137		;REDUCE LOWER CASE TO UPPER
	SUBI	A,40
	ROT	A,-1		;DIV BY 2
	JUMPL	A,CD92		;ODD CHARACTER
	HLRZ	A,DTB(A)	;GET CODE & ADDR FOR EVEN CHAR.
	JRST	CD93
CD92:	HRRZ	A,DTB(A)	;GET CODE & ADDR FOR ODD CHAR.
CD93:	TRNN	A,300000	;IS IT A JRST DISPATCH WITH NO ARG PROCESSING?
	JRST	(A)		;YES, DO IT
	MOVE	B,NUM		;NO, TAKE CARE OF ARGUMENTS
	XCT	DLIM		;NUM:=NUM (DLIM OPERATOR) SYL
	MOVEM	B,NUM
;cd93+4 1/2 insert [167] spr#18215
	setzm	syl		;[167] clear old operand
	MOVE	C,SARG		;SAVE SECOND ARGUMENT IN C.
	TRZ	FF,SYLF		;CLR DIGIT STRING BIT
	TRZ	F2,CTLV+CTLVV+CTLW+CTLWW+XMATCH+EMATCH+TXTCTL
	TRZ	A,100000	;CLR PUSHJ DISPATCH BIT
	TRZE	A,200000	;JRST OR PUSHJ DISPATCH?
	JRST	(A)
	PUSHJ	P,(A)
	JRST	RET


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

CDNUM:	TRON	FF,SYLF		;DIGIT STRING ALREADY STARTED?
	SETZM	SYL		;NO, INIT TO ZERO
	MOVEI	A,12		;RADIX 10
	TRNN	F2,OCTALF	;OCTAL FLAG ON?
	JRST	CDNUM1		;NO
	MOVEI	A,10		;YES, RADIX 8
	CAIG	CH,"7"		;[202] 8 OR 9 IN OCTAL STRING?
	JRST	CDNUM1		;[202] NO, PROCEED
	TRZ	F2,OCTALF	;[202] YES, CLEAR OCTAL FLAG
	ERROR	E.OCT;;		;[202] AND COMPLAIN TO THE USER
CDNUM1:	IMUL	A,SYL		;SCALE PREVIOUS VALUE
	ADDI	A,-60(CH)	;ADD IN NEW DIGIT

;SOME COMMANDS HAVE A NUMERIC VALUE
VALRET:	MOVEM	A,SYL
CD7:	TRO	FF,ARG
	JRST	CD5

ALTMOD:	SKIPN	COMCNT		;ANY COMMANDS LEFT?
	JRST	ALTM2		;[114] NO				
	MOVE	T,CPTR		;IF NEXT COMMAND CHARACTER IS ALT-MODE, GO
	ILDB	CH,T
	CAIE	CH,ALT
	JRST	CD
ALTM1:	TRNE	FF,TRACEF	;TRACING?
	PUSHJ	P,CRR		;YES, TYPE CR/LF BEFORE *
	JRST	GO
ALTM2:	SKIPN	EQM		;[114] WITHIN A MACRO?		
	JRST	GO		;[114] NO				
	JRST	CD		;[114] MACRO RETURN			

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

UAR:	PUSHJ	P,SKRCH		;GET NEXT COMMAND CHARACTER.
	ERROR	E.MEU
	TRZ	CH,140		;CHANGE IT TO CONTROL CHARACTER
	JRST	CD9		;DISPATCH
;IF A COMMAND TAKES TWO NUMERIC ARGUMENTS, COMMA IS USED TO SEPARATE THEM

COMMA:	MOVEM	B,SARG		;SAVE CURRENT ARGUMENT IN SARG.
	TRZE	FF,ARG		;WAS THERE A CURRENT ARGUMENT?
	TROE	FF,ARG2		;YES. WAS THERE ALREADY A SECOND ARGUMENT?
	ERROR	E.ARG
	JRST	CD1		;YES. CLEAR CURRENT ARGUMENT.

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

OPENP:	PUSH	P,NUM		;PUSH CURRENT ARGUMENT.
	PUSH	P,DLIM		;CURRENT OPERATOR
	PUSH	P,[1]		;SET PAREN FLAG ON PDL
	JRST	CD1

CLOSEP:	POP	P,T		;LAST THING ON PDL A LEFT PAREN?
	JUMPL	T,CLOSE1	;SOMETHING LIKE (...<...)
	SOJN	T,CLOSE2	;MISSING (
	MOVEM	B,SYL		;YES. SAVE CURRENT ARGUMENT.
	POP	P,DLIM		;RESTORE OPERATOR
	POP	P,NUM		;RESTORE ARGUMENT.
	JRST	CD7

CLOSE1:	ERROR E.PAR
CLOSE2:	ERROR E.MLP

;^O SETS FLAG FOR OCTAL RADIX INPUT

OCTIN:	TRO	F2,OCTALF
	JRST	CD5		;RETURN WITHOUT MESSING UP ARGUMENTS
;LOGICAL AND

CAND:	MOVSI	A,(AND B,)	;DLIM = AND B,SYL
	JRST	CD3

;LOGICAL OR

COR:	MOVSI	A,(OR B,)	;DLIM = OR B,SYL
	JRST	CD3

;ADD TAKES ONE OR TWO ARGUMENTS

PLUS:	MOVSI	A,(ADD B,)	;DLIM = ADD B,SYL
	JRST 	CD3

;SUBTRACT TAKES ONE OR TWO ARGUMENTS

MINUS:	MOVSI	A,(SUB B,)	;DLIM = SUB B,SYL
	JRST	CD3

;MULTIPLY TAKES TWO ARGUMENTS

TIMES:	MOVSI	A,(IMUL B,)	;DLIM = IMUL B,SYL
	JRST	CD3

;DIVIDE (TRUNCATES) TAKES TWO ARGUMENTS

SLASH:	MOVSI	A,(IDIV B,)	;DLIM = IDIV B,SYL
	JRST	CD3
;RETURNS THE VALUE OF THE FORM FEED FLAG

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

BEGIN:	MOVEI	A,0
	JRST	VALRET

;^N RETURNS VALUE OF EOF FLAG

EOF:	TLNN	FF,FINF		;EOF SEEN?
	JRST	BEGIN		;NO, RETURN 0
	JRST	FFOK		;YES, RETURN -1

;AN ABBREVIATION FOR B,Z

HOLE:	SETZM	SARG		;SET SECOND ARGUMENT TO 0.
	TRO	FF,SEQUIN	;[122] INITIALIZE AS NEW LINE	
	TRNE	FF,ARG2		;FLAG ANY ARGS BEFORE H
	ERROR	E.ARG
	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

;RETURN LENGTH OF LAST TEXT STRING PROCESSED

IFN VC,<
VCMD:	MOVE	A,VVAL		;LENGTH OF LAST TEXT
	JRST	VALRET
	>

U VVAL,1			;LENGTH OF LAST TEXT STRING PROCESSED
;N=	CAUSES THE VALUE OF N TO BE TYPED OUT.

PRNT:	TRNN	FF,ARG		;INSIST ON ARG BEFORE =
	ERROR	E.NAE
	MOVE	A,CPTR		;SNEAK A LOOK AT NEXT COMMAND CHAR.
	ILDB	CH,A
	CAIE	CH,"="		;ANOTHER = SIGN?
	JRST	PRNT9		;NO
	TRO	F2,OCTALF	;YES, THAT MEANS OCTAL RADIX TYPE-OUT
	PUSHJ	P,SKRCH		;SWALLOW THE EXTRA =
	TRZ	F2,OCTALF	;AT END OF MACRO
PRNT9:	PUSHJ	P,PRNT9S	;PRINT NUMBER
	JRST	CRR		;CRLF AND RETURN TO CALLER

;TYPE C(B) IN OCTAL

OCTMS:	TROA	F2,OCTALF	;SET OCTAL RADIX

;TYPE C(B) IN DECIMAL

DECMS:	TRZ	F2,OCTALF	;DECIMAL RADIX
PRNT9S:	MOVEI	A,TYO		;OUTPUT ON TTY
	PUSHJ	P,DPT		;TYPE NUMBER
	TRZ	F2,OCTALF	;CLR RADIX FLAG
	POPJ	P,



;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:	TRO	FF,DDTMF
	PUSHJ	P,TYI		;GET A SINGLE CHAR.
	SKIPA	A,CH


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

GTIME:	TIMER	A,	
	JRST	VALRET


;HAS THE VALUE OF THE CONSOLE DATA SWITCHES.

LAT:	SWITCH	A,
	JRST	VALRET

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

CNTRUP:	PUSHJ	P,SKRCH		;^^ HAS VALUE OF CHAR FOLLOWING IT
	ERROR	E.MUU
	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
	CAML	I,Z		;CAN WE READ ANOTHER?
	JRST	BAKSL3		;NO
	PUSHJ	P,GETINC	;CK FOR +,- SIGN
	CAIN	CH,"+"
	JRST	BAKSLA		;IGNORE +
	CAIE	CH,"-"
	JRST	BAKSL0		;NO SIGN
	TRO	FF,ARG		;NEGATION FLAG
BAKSLA:	CAML	I,Z		;OVERDID IT ?
	JRST	BAKSL3		;YES. EXIT
	PUSHJ	P,GETINC	;NO. GET A CHAR
BAKSL0:	CAIG	CH,"9"		;DIGIT?
	CAIGE	CH,"0"		;DIGIT?
	SOJA	I,BAKSL2	;NOT A DIGIT. BACKUP AND LEAVE LOOP
	SUBI	CH,"0"		;CONVERT TO NUMBER
	EXCH	CH,SYL
	IMULI	CH,12
	ADDM	CH,SYL		;SYL:= 10.*SYL+CH
	JRST	BAKSLA		;LOOP

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


;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	A,Z		;IF POINTER IS AT END OF
	SUB	A,PT		; BUFFER OR IF BUFFER EMPTY,
	JUMPE	A,VALRET	; MUST GIVE 1A=0
	MOVE	I,PT		;YES.
	PUSHJ	P,GET		;CH:=CHARACTER TO THE RIGHT OF PT.
	MOVE	A,CH		;RETURN CH AS VALUE.
	JRST	VALRET
;NUI	PUTS THE NUMERIC VALUE N IN Q-REGISTER I.

USE:	TRNN	FF,ARG		;INSIST ON ARG BEFORE U
	ERROR	E.NAU
USEA:	PUSHJ	P,QREGVI	;YES. CH:=Q-REGISTER INDEX.
	MOVEM	B,QTAB-"0"(CH)	;STORE ARGUMENT IN SELECTED Q-REG.
	JRST	RET

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

QREG:	PUSHJ	P,QTXTST	;[135] GET Q-REG & CHECK FOR TEXT
	JRST	VALRET

;ROUTINE TO RETURN Q-REGISTER INDEX IN CH AND CONTENT IN A.

QREGVI:	PUSHJ	P,SKRCH		;CH:=NEXT COMMAND STRING CHARACTER.
	ERROR	E.MIQ
QREGV2:	CAIL	CH,140		;LC LETTER?
	TRZ	CH,40		;MAKE UC
	CAIGE	CH,"0"		;DIGIT?
	ERROR	E.IQN
	CAIG	CH,"9"
	POPJ	P,		;YES
	CAIL	CH,"A"		;LETTER?
	CAILE	CH,"Z"
	ERROR	E.IQN
	SUBI	CH,"A"-"9"-1	;TRANSLATE LETTERS DOWN BY NUMBER OF
	POPJ	P,		;CHARACTERS BETWEEN 9 AND A. ONLY 36 Q-REG'S


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

PCNT:	PUSHJ	P,QTXTST	;[135] GET Q-REG & CHECK FOR TEXT
	AOS	A,QTAB-"0"(CH)	;INCREMENT THE Q REG
	JRST	VALRET		;RETURN NEW VALUE.
QTXTST:	PUSHJ	P,QREGVI	;[135] GET Q-REG INDEX
	MOVE	A,QTAB-"0"(CH)	;[135] GET Q-REG CONTENTS
	TLNE	A,400000	;[143] DOES IT CONTAIN TEXT?
	TLNE	A,377777	;[143]
	POPJ	P,		;[135] NO,RETURN
	ERROR	E.NNQ
;M,NXI	COPIES A PORTION OF THE BUFFER INTO Q-REGISTER I.
;	IT SETS Q-REGISTER I TO A DUPLICATE OF THE (M+1)TH
;	THROUGH NTH CHARACTERS IN THE BUFFER.  THE BUFFER IS UNCHANGED.
;NXI	INTO Q-REGISTER I IS COPIED THE STRING OF CHARACTERS STARTING
;	IMMEDIATELY TO THE RIGHT OF THE POINTER AND PROCEEDING THROUGH
;	THE NTH LINE FEED.

X:
IFN VC,<SETZM	VVAL>		;CLR STRING LENGTH HOLD
	PUSHJ	P,GETARG	;C:=FIRST STRING ARGUMENT ADDRESS
				;B:=SECOND STRING ARGUMENT ADDRESS.
	PUSHJ	P,CHK1		;IS SECOND ARG. ADDR. > FIRST ARG. ADDR.?
	EXCH	B,C		;YES.
	SUBI	C,-3(B)		;C:=LENGTH OF STRING+3.
	MOVEI	A,-3(C)		;STORE LENGTH OF STRING SAVED
IFN VC,<MOVEM	A,VVAL>
	ADD	B,C		;B:=FIRST ARG ADDR + LENGTH OF STRING + 3
	PUSHJ	P,X3		;MOVE DATA TO Q-REG BUFR
	JRST	USEA		;NO, MAKE QTAB ENTRY NORMALLY.

;TRANSFER DATA TO Q-REGISTER BUFR

X3:	PUSH	P,PT
	ADDM	C,(P)		;(P):=PT + LENGTH OF STRING + 3.
	MOVE	D,BEG
	MOVEM	D,PT		;PT:=BEG
	PUSHJ	P,NROOM		;INSERT STRING AT BEG
	MOVE	OU,RREL		;RREL CONTAINS RELOCATION CONSTANT IF
				;GARBAGE COL. OCCURRED.
	ADDM	OU,(P)		;RELOCATE TOP OF STRING POINTER.
	ADD	B,OU		;B:=FIRST ARG ADDR + LENGTH OF STRING + 3 + RREL
	MOVE	OU,BEG		;OU:=ADDRESS OF Q-REG BUFFER
	ADDM	C,BEG		;BEG:=C(BEG)+LENGTH OF STRING + 3
	MOVE	CH,C		;FIRST CHAR OF BUFFER :=LEAST SIGNIFICANT 7 BITS
	PUSHJ	P,PUT		;OF LENGTH OF STRING + 3
	AOS	OU		;SECOND CHAR = MIDDLE 7 BITS OF LENGTH
	ROT	CH,-7
	PUSHJ	P,PUT
	ROT	CH,-7
	MOVE	I,B		;THIRD CHAR OF BUFFER := MOST SIGNIFICANT 7 BITS
				;OF LENGTH OF STRING + 3
	AOS	OU
X1:	PUSHJ	P,PUT		;MOVE STRING TO Q-REG BUFFER.
	AOS	OU
	CAIN	C,3
	JRST	X2
	PUSHJ	P,GETINC
	SOJA	C,X1
X2:	MOVE	B,PT		;QTAB ENTRY :=XWD 400000,Q-REG BUFFER
				;ADDRESS RELATIVE TO C(QRBUF)
	SUB	B,QRBUF
	TLO	B,400000
	POP	P,PT		;MOVE PT PAST STRING.
	POPJ	P,
;GI	THE TEXT IN Q-REGISTER I IS INSERTED INTO THE BUFFER AT THE
;	CURRENT LOCATION OF THE POINTER.  THE POINTER IS THEN PUT JUST
;	TO THE RIGHT OF THE INSERTION.  THE Q-REGISTER IS NOT CHANGED.

QGET:
IFN VC,<SETZM	VVAL>		;CLR STRING LENGTH HOLD
	PUSHJ	P,QTEXT		;INIT Q-REG ACCESS
	MOVE	B,CH		;SAVE INDEX
	PUSHJ	P,GTQCNT	;C:=LENGTH OF STRING
	PUSHJ	P,NROOMC	;MOVE FROM PT THROUGH Z UP C POSITIONS
	MOVE	OU,PT
	HRRZ	I,QTAB-"0"(B)
	ADD	I,QRBUF
	ADDI	I,3
QGET1:	JUMPE	C,RET		;MOVE STRING INTO DATA BUFFER
	PUSHJ	P,GETINC
	PUSHJ	P,PUT
	AOS	OU,PT
	SOJA	C,QGET1

;GET 21 BIT Q-REGISTER CHARACTER COUNT

GTQCNT:	PUSHJ	P,GETINC	;LOW ORDER 7 BITS
	MOVEM	CH,C
	PUSHJ	P,GETINC	;MIDDLE 7 BITS
	ROT	CH,7
	IORM	CH,C
	PUSHJ	P,GETINC	;HIGH 7 BITS
	ROT	CH,^D14
	IORM	CH,C
	SUBI	C,3		;LESS 3 WORDS USED TO STORE THIS COUNT
	POPJ	P,

;INITIALIZE ACCESS OF TEXT FROM A Q-REGISTER

QTEXT:	PUSHJ	P,QREGVI	;A=QTAB ENTRY, CH=Q-REG INDEX
	MOVE	A,QTAB-"0"(CH)
	TLZE	A,400000	;MAKE SURE IT CONTAINS TEXT
	TLZE	A,377777
	ERROR	E.NTQ
	ADD	A,QRBUF
	MOVE	I,A		;I=Q-REG BUFFER ADDRESS
	POPJ	P,
;MI	PERFORM NOW THE TEXT IN Q-REGISTER I AS A SERIES OF COMMANDS.

MAC:	PUSHJ	P,QTEXT		;INIT Q-REG ACCESS
	PUSH	P,COMAX		;SAVE CURRENT COMMAND STATE
	PUSH	P,CPTR
	PUSH	P,COMCNT
	PUSH	P,.		;FLAG MACRO ON PDL (LARGE POS. NO.)
	PUSHJ	P,GTQCNT	;GET NUMBER OF CHARACTERS IN MACRO
	MOVEM	C,COMCNT	;THAT MANY COMMANDS TO COUNT
	MOVEM	C,COMAX		;AND MAX.
	SUBI	I,1		;ADJUST TO SUIT BTAB
	IDIVI	I,5
	MOVE	OU,BTAB(OU)	;MAKE A BYTE POINTER
	HRR	OU,I
	MOVEM	OU,CPTR		;PUT IT IN CPTR
	AOS	EQM		;[114] INCREMENT THE MACRO LEVEL	
	JRST	CD5		;DON'T FLUSH ANY ARGUMENTS


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

CLOSEB:	SKIPA	C,[POP PF,]

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

OPENB:	MOVSI	C,261000+PF*40
	PUSHJ	P,QREGVI
	HRRI	C,QTAB-"0"(CH)	;C:=Q-REGISTER INDEX.
	XCT	C		;PUSH OR POP Q-REGISTER.
	JRST	RET
;E COMMANDS SELECT AND CONTROL FILE INPUT-OUTPUT MEDIA

ECMD:	PUSHJ	P,SKRCH		;GET CHAR AFTER E
	ERROR	E.MEE
	MOVEI	T,ECTABL	;INDEX DISPATCH TABLE
	PUSHJ	P,DISPAT
	ERROR	E.IEC

;E-COMMAND DISPATCH TABLE

ECTABL:	XWD	TYOCTL,"T"
	XWD	OPNRD,"R"
	XWD	OPNWR,"W"
	XWD	CLOSEF,"F"
	XWD	ZERDIR,"Z"
	XWD	EMTAPE,"M"
	XWD	EBAKUP,"B"
	XWD	FINISH,"X"
IFN CCL,<XWD	CCLFIN,"G">
	XWD	OLDMOD,"O"
	XWD	TYCASE,"U"
	XWD	ERRSET,"H"
	XWD	AUTOTY,"S"
	XWD	0,0		;MARKS END OF LIST
;MISCELLANEOUS CHARACTER DISPATCHER
;CALL:	MOVE	CH,CHARCATER
;	MOVEI	T,TABLE ADDR
;	PUSHJ	P,DISPAT
;	NOT FOUND RETURN
;ENTER AT DISP1 TO AVOID CONVERTING LC TO UC

DISPAT:	CAIG	CH,172		;CONVERT LC TO UC
	CAIG	CH,137
	JRST	DISP1
	TRZ	CH,40
DISP1:	PUSH	P,A		;SAVE AC A WHILE WE USE IT
DISP2:	MOVE	A,(T)		;GET TABLE ENTRY
	TRNN	A,777777	;ANYTHING LEFT?
	JRST	APOPJ		;NO -- RESTORE AC A & RETURN
	SUBI	A,(CH)		;COMPARE
	MOVSS	A
	TLNE	A,777777
	AOJA	T,DISP2		;NOT A MATCH
	MOVEM	A,-1(P)		;GOT IT -- PUT DISPATCH ADDR ON PDL
	JRST	APOPJ		;RESTORE AC A & DISPATCH
;EX -- FINISH OUTPUT AND RETURN TO THE TIME-SHARING EXEC.

FINIS1:	SETSTS	TTY,0		;RETURN TO NORMAL TTY MODE
	OUTPUT	TTY,0		;DUMMY OUTPUT TO LET SCNSER IN ON THE NEW MODE
	TRO	FF,PCHFLG	;NO FREE FORM FEEDS
	MOVSI	E,1		;A LARGE NUMBER OF PAGES
	PUSHJ	P,PUN1		;PUNCH THOSE PAGES
	JRST	CLOSEF		;CLOSE AND RENAME FILES

FINISH:	PUSHJ	P,FINIS1	;FINISH UP.

;^Z -- RETURN TO THE MONITOR (SAME AS THE OLD ^G)

DECDMP:	RELEAS	TTY,0
	RELEAS	INCHN,0
	RELEAS	OUTCHN,0
	TLZ	FF,UREAD+UWRITE+FINF+UBAK	;IN CASE OF A CONTINUE
	RESET
	EXIT	1,
	JRST	GO		;IF HE CONTINUES

IFN CCL,<
CCLFIN:	PUSHJ	P,FINIS1	;FINISH FILE IO
IFN NORUNS,<
	SKIPGE	MONITR		;CHECK FOR 4 SERIES MONITOR
	JRST	NORUN		;3 SERIES - SIMULATE RUN UUO
	>
	MOVEI	A,CCLBLK	;RUN COMPIL
	HRLI	A,1		;AT START ADR PLUS ONE
	CALLI	A,35		;RUN UUO
	JRST	DECDMP		;JUST EXIT IF NO RUN.

CCLBLK:	SIXBIT	/SYS/
	SIXBIT	/COMPIL/	;RUN SYS:COMPIL
	REPEAT	4,<0>
	>
IFN NORUNS,<
IFN CCL,<
NORUN:	MOVE	1,[SIXBIT /COMPIL/]
	MOVSI	2,SAVEXT	;SIXBIT FOR SAV OR DMP
	SETZB	3,4
	INIT	CCLCHN,17
	SIXBIT	/SYS/
	0
	CALLI	12
	LOOKUP	CCLCHN,1
	CALLI	12
	CALL	1,[SIXBIT /SETNAM/]
	HLRO	15,4
	HRLM	15,NORUN1
	MOVNS	15
	MOVEI	16,73(15)
	ADDI	15,INHERE
	TRO	15,1777
	MOVSI	NORTOP,NORAC
	BLT	NORTOP,NORTOP
	HRR	NORBLT,16
	JRST	NORUN2
	>>
;ET COMMAND

TYOCTL:	POP	P,CH		;CLR RET. ADDR. FROM PDL
	TRNE	FF,ARG		;ARGUMENT?
	JRST	TYOCT1		;YES.
	TLNE	FF,TYOCTF	;NO, FLAG ON?
	JRST	FFOK		;YES, RETURN -1
	JRST	BEGIN		;NO, RETURN 0

TYOCT1:	TLZ	FF,TYOCTF	;CLEAR ET FLAG
	JUMPE	B,RET		;ARGUMENT NON-ZERO?
	TLO	FF,TYOCTF	;YES. SET ET FLAG
	JRST	RET		;RETURN

;EO COMMAND

OLDMOD:	POP	P,CH		;CLR RET. ADDR. FROM PDL
	TRNE	FF,ARG		;ARGUMENT?
	JRST	OLD1		;YES, SET FLAG
	MOVE	A,EOFLAG	;NO, RETURN VALUE OF EOFLAG
	JRST	VALRET

OLD1:	CAIG	B,0		;N <= 0?
	MOVEI	B,EOVAL		;YES, SET TO STANDARD
	CAILE	B,EOVAL		;N > STANDARD FOR THIS VERSION?
	ERROR	E.EOA
	MOVEM	B,EOFLAG	;SET EOFLAG
	JRST	RET		

U EOFLAG,1			;EDIT OLD FLAG

;EU COMMAND

TYCASE:	POP	P,CH		;CLR RET. ADDR. FROM PDL
	TRNE	FF,ARG		;ARGUMENT?
	JRST	TYCAS1		;YES
	MOVE	A,TYCASF	;NO, RETURN VALUE OF TYPE-OUT CASE FLAG
	JRST	VALRET

TYCAS1:	MOVEM	B,TYCASF	;SET TYPE-OUT CASE FLAG
	JRST	RET

U TYCASF,1			;TYPE-OUT CASE FLAG: 0 = TYPE ' BEFORE LC
				;+ = TYPE ' BEFORE UC; - = DON'T TYPE FLAGS
;ES COMMAND

AUTOTY:	POP	P,CH		;CLR RET ADDR FROM PDL
	TRNE	FF,ARG		;ARG?
	JRST	AUTOT1		;YES
	MOVE	A,AUTOF		;NO, RETURN VALUE OF FLAG
	JRST	VALRET

AUTOT1:	MOVEI	A,12		;USE LF FOR FLAG IF ARG = 1 TO 37
	CAIL	B,1
	CAILE	B,37
	MOVE	A,B		;OTHERWISE USE WHAT HE GAVE
	MOVEM	A,AUTOF		;SET NEW VALUE IN FLAG
	JRST	RET

U AUTOF,1			;NON-ZERO IMPLIES AUTOTYPE AFTER SEARCHES
				;POSITIVE IMPLIES TYPE AUTOF AS A PTR MARKER
;^V COMMAND

LOWCAS:	TRNE	FF,ARG		;ARG SEEN?
	JUMPE	B,CLRCAS	;YES, IF 0 CLEAR ALL PREVAILING CASE FLAGS
	TRZ	F2,UCASE	;CLEAR ^W FLAG
	TRO	F2,LCASE	;& SET ^V FLAG
	JRST	RET

;^W COMMAND

STDCAS:	TRNE	FF,ARG		;ARG SEEN?
	JUMPE	B,CLRCAS	;YES, IF 0 CLEAR ALL PREVAILING CASE FLAGS
	TRZ	F2,LCASE	;CLEAR ^V FLAG
	TROA	F2,UCASE	;& SET ^W FLAG

CLRCAS:	TRZ	F2,LCASE+UCASE	;0^V OR 0^W CLEARS BOTH FLAGS
	JRST	RET

;^X COMMAND

SETMCH:	TRNE	FF,ARG		;ANY ARGUMENT?
	JRST	SETMC1		;YES
	TLNE	FF,PMATCH	;NO, FORCED EXACT MATCH FLAG ON?
	JRST	FFOK		;YES, RETURN -1
	JRST	BEGIN		;NO, RETURN 0

SETMC1:	TLZ	FF,PMATCH	;CLR ^X FLAG
	JUMPE	B,RET		;IF ARG = 0, FLAG = 0
	TLO	FF,PMATCH	;OTHERWISE, SET FLAG
	JRST	RET

;EH COMMAND -- CHANGE ERROR MESSAGE DEFAULT

ERRSET:	POP	P,CH		;[144] ADJUST STACK POINTER.
	TRNE	FF,ARG		;ARG SEEN?
	JRST	ERRSE1		;YES, RESET INDICATOR
	MOVE	A,ERRLEN	;NO, RETURN CURRENT VALUE OF FLAG
	ADDI	A,2		;CONVERT TO EXTERNAL VALUE
	JRST	VALRET

ERRSE1:	JUMPG	B,.+2		;TRANSLATE AS FOLLOWS:
	MOVEI	B,ERRMSG	;-N,0 IS SET TO STANDARD (ERRMSG)
	SUBI	B,2		;1 BECOMES -1 = SHORT MESSAGE
	MOVEM	B,ERRLEN	;2 BECOMES 0  = MEDIUM
	JRST	RET		;3 BECOMES +1 = LONG
;ER	PREPARE TO READ FILE

OPNRD:	TLZ	FF,FINF+UREAD	;NOT EOF & CLOSE PREVIOUS INPUT
	RELEAS	INCHN,0		;[175] RELEASE INPUT BEVICE
	SETZM	SWITC		;[175] NO FILE SWITCHES TYPED YET
	PUSHJ	P,FILSPC	;GET FILE SPEC
	PUSHJ	P,RDFIL		;[175] LOOKUP FILE, IF POSSIBLE
	  PUSHJ	P,TYPFFI	;[175] FOUND ON LIBRARY
	MOVE	E,SWITC		;[175] PICKUP USER'S SWITCHES
	TLC	E,GENLSN!SUPLSN	;[175] SEE IF BOTH ARE SET
	TLCN	E,GENLSN!SUPLSN	;[175] ARE THEY?
	ERROR	E.COS;;		;[175] YES, CONTRADICTORY SWITCHES
	MOVEM	E,INSWIT	;STORE SETTING FOR INPUT
	TRZ	FF,SEQF		;CLR SEQUENCE NUMBER FLAG
	TLZE	FF,CCLFLG	;[175] YANK REQUESTED?
	PUSHJ	P,YANK		;[175] YES, DO IT
	POPJ	P,

U	INDEV,1
U	INBUF,1
U	INCHR,1
U	INPTH,2
U	INPPN,1
U	INSFD,6
U	INNAM,1
U	INEXT,1
;SUBROUTINE TO OPEN THE INPUT DEVICE, SET UP BUFFERS, AND LOOKUP
;THE INPUT FILE. DOES NOT RETURN IF AN OPEN OR LOOKUP FAILURE OCCURS.
;NON-SKIP RETURN IF FILE FOUND IN LIB:, SKIP IF FILE IS OK.

RDFIL:	SETZM	OPNSTS		;[175] ASCII MODE
	MOVEI	E,IBUF
	MOVEM	E,OPNBUF	;[175]
	MOVE	E,OPNDEV	;[175] PICKUP INPUT DEVICE
	MOVEM	E,INDEV		;[175] SAVE FOR ERRORS
	MOVE	E,OPNCHR	;[175] DEVCHR WORD, TOO
	MOVEM	E,INCHR		;[175] ERROR PROCESSOR NEEDS IT
	OPEN	INCHN,OPNBLK	;[175] OPEN INPUT FILE
	ERROR	E.IDV
	MOVEI	T,IBUF1		;[175] GET INPUT BUFFERS
	EXCH	T,.JBFF		;[175]
	INBUF	INCHN,2		;[175]
	MOVEM	T,.JBFF		;[175]
	MOVE	A,[XNAM,,INNAM]	;[175] COPY INPUT FILE NAME
	BLT	A,INEXT		;[175] FOR ERROR MESSAGES
	TXNN	E,DV.DIR	;[175] LOOKUP UUO NEEDED?
	JRST	RDFIL2		;[175] NO, DON'T DO ONE
	TLNE	E,DVDTA		;[136] IS IT DECTAPE?
	JRST	RDFIL1		;[136] YES, DO SHORT LOOKUP
	LOOKUP	INCHN,XFILNM	;EXTENDED LOOKUP
	JRST	LKUPER		;ERROR
	TLO	FF,UREAD	;[175] INPUT FILE NOW OPEN
	MOVEI	E,INCHN		;[175] INPUT CHANNEL
	MOVEM	E,PTHBLK	;[175] PUT INTO PATH BLOCK
	MOVE	E,[PTHLEN,,PTHBLK]	;[175] DO PATH UUO
	PATH.	E,		;[175] TO DETERMINE WHERE FILE WAS FOUND
	  JRST	CPOPJ1		;[175] PROBABLY A TTY: OR TSK:
	MOVE	E,[PTHPPN,,INPPN]	;[175] COPY PATH TO FILE
	BLT	E,INSFD+5	;[175] FOR ERROR MESSAGE PROCESSOR
	PUSHJ	P,CHKPTH	;[175] WAS IT FOUND WHERE SAID IT WAS?
	  POPJ	P,		;[175] NO, NON-SKIP RETURN
	JRST	CPOPJ1		;[175] YES, ALL IS WELL
RDFIL1:	LOOKUP	INCHN,SFILNM	;[175] SHORT LOOKUP
	JRST	LKUPER		;LOOKUP FAILURE
RDFIL2:	TLO	FF,UREAD	;[175] INPUT FILE NOW OPEN
	AOS	(P)		;[175] DECTAPES DON'T HAVE LIB'S
	POPJ	P,		;[175] RETURN
EBAKUP:	TLNE	FF,UBAK		;[175] IS EB ALREADY IN PROGRESS?
	ERROR	E.EBO;;		;[175] YES, NEW ONE ILLEGAL TILL EF
	TLZ	FF,UBAK!UREAD!FINF	;[175] INPUT FILE CLOSED
	RELEAS	INCHN,		;[175] (AS SOON AS WE CLOSE IT)
	PUSHJ	P,CLOSEF	;[175] CLOSE OUTPUT FILE IF ANY
	SETZM	SWITC		;[175] NO I/O SWITCHES TYPED YET
	PUSHJ	P,FILSPC	;[175] PARSE USER'S FILE SPEC
	MOVE	E,SWITC		;[175] GET SWITCHES USER TYPED
	TLC	E,GENLSN!SUPLSN	;[175] CHECK FOR CONFLICTING SWITCHES
	TLCN	E,GENLSN!SUPLSN	;[175] DID HE GIVE BOTH?
	ERROR	E.COS;;		;[175] YES, ERROR
	MOVEM	E,INSWIT	;[175] NO, STORE BOTH AS INPUT...
	MOVEM	E,OUTSWT	;[175] AND AS OUTPUT SWITCHES
	SKIPE	E,OPNCHR	;[175] GET CHARACTERISTICS OF HIS DEVICE
	TXNE	E,DV.DSK!DV.DTA	;[175] IF DEVICE EXISTS BUT ISN'T RIGHT
	CAIA			;[175] DOESN'T EXIST (GET BETTER MESSAGE
				;[175] WHEN OPEN FAILS) OR IS OK
	ERROR	E.EBD;;		;[175] ILLEGAL EB DEVICE
	HLRZ	A,XEXT		;[175] GET PROPOSED EXTENSION
	TLC	E,-1-<(DV.TTA)>	;[175] CONTRARY TO POPULAR BELIEF,
	TLCE	E,-1-<(DV.TTA)>	;[175] NUL: DOESN'T PROHIBIT UFD/SFD!
	TXNN	E,DV.DSK	;[175] IS EB DEVICE A DISK?
	JRST	EBAKU0		;[175] NO, DIRECTORY NAMES LEGAL
	CAIE	A,'SFD'		;[175] CAN'T DO EB TO DIRECTORIES,
	CAIN	A,'UFD'		;[175]   SINCE RENAMES WOULD FAIL AT EF
	ERROR	E.EBF;;		;[175] ILLEGAL EB FILE
EBAKU0:	CAIN	A,'BAK'		;[175] IS IT BAK?
	ERROR	E.EBF;;		;[175] CAN'T DO EB TO BAK FILES
	CAIE	A,'TMP'		;[175] USER'S EXTENSION .TMP?
	JRST	EBAKU1		;[175] NO, FILENAME IS OK TO USE
	MOVE	A,XNAM		;[175] CAN'T ALLOW NNNTEC.TMP,
	CAMN	A,TMPTEC	;[175] SINCE THAT'S OUR TEMP OUTPUT FILE
	ERROR	E.EBF;;		;[175] IT WAS NNNTEC.TMP, ILLEGAL FILE
EBAKU1:	PUSHJ	P,RDFIL		;[175] OPEN DEVICE & LOOKUP FILE
	  JRST	FAKERW		;[175] ON LIB:, CAN'T DO EB, DO ER/EW
	SETZM	PTHBLK		;[175] CLEAR RETURNED JUNK
	SETZM	PTHFLG		;[175]  IN CASE MONITOR LOOKS AT IT
	MOVE	E,OPNCHR	;[175] GET DEVCHR OF EB DEVICE
	MOVEM	E,EBCHR		;[175] STORE FOR BAKCLS
	SETZM	OPNSTS		;[175] ASCII MODE FOR OPNOU
	MOVE	E,[XNAM,,EBNAM]	;[175] SAVE EB FILE & EXT FOR BAKCLS
	BLT	E,EBEXT		;[175] ..
	MOVE	E,[PTHPPN,,EBPPN]	;[175] SAVE EB PATH TOO
	BLT	E,EBSFD+4	;[175] ..
	MOVE	E,OPNCHR	;[175] GET EB DEVICE
	TXNN	E,DV.DSK	;[175] IS IT A DSK: ?
	JRST	EBAKU4		;[175] NO, DON'T BOTHER WITH PROTECTIONS

;FALL THROUGH TO NEXT PAGE
;HERE IF EB TO A DISK. CHECK THAT THE INPUT FILE ISN'T TOO PROTECTED TO
;ALLOW ALL THE RENAMES TO HAPPEN AT END OF EDITING. NOTE THAT OTHER
;PROTECTION FAILURES CAN OCCUR (.BAK FILE PROTECTED ETC.), BUT WE ARE
;ONLY CHECKING THIS CASE BECAUSE IT IS BY FAR THE MOST COMMON ERROR.
;WE WILL ALLOW AN EB IF 1) WE ARE THE OWNER OF THE FILE (HAVE CHANGE
;PROTECTION RIGHTS) AND CAN WRITE THE FILE (PROTECTION 0,1, OR 2 IN
;5.07) (NOTE THAT WE COULD ALWAYS EDIT A <777> FILE IN THE USER'S AREA
;WITH ENOUGH RENAMES TO CHANGE THE PROTECTION, BUT WE WILL ARBITRARILY
;DISALLOW EDITING IF THE USER CAN'T EVEN WRITE THE FILE WITHOUT CHANGING
;ITS PROTECTION) OR 2) WE HAVE RENAME ACCESS TO THE FILE (PROTECTED 0
;OR 1 IN 5.07).

	LDB	A,[POINT 9,XPRV,8]	;[175] PICKUP FILE PROTECTION
	MOVEM	A,EBPROT	;[175] SAVE FOR BAKCLS
	HRLI	A,.ACREN	;[175] CHECK NEEDED RENAME ACCESS
	MOVE	AA,PTHPPN	;[175] FILE'S PPN IN LOC + 1
	MOVE	B,USRPPN	;[175] USER'S IN LOC + 2
	MOVEI	E,A		;[175] POINT TO 3 CONTIGUOUS ACS
	CHKACC	E,		;[175] SEE IF WE CAN RENAME IT
	  SETZ	E,		;[175] DON'T KNOW, ASSUME OK
	JUMPE	E,EBAKU3	;[175] IF CHKACC WON, GO EDIT FILE

;HERE IF WE CAN'T RENAME THE FILE. CAN STILL EDIT IT IF WE CAN BOTH
;CHANGE THE PROTECTION & WRITE THE FILE. OTHERWISE, GIVE AN ERROR.
	HRROS	EBPROT		;[175] SET LH=-1 AS FLAG FOR BAKCLS
				;[175] THAT 2 RENAMES WILL BE NEEDED
	HRLI	A,.ACCPR	;[175] CHECK .ACCPR TO SEE IF WE OWN IT
	MOVEI	E,A		;[175] POINT TO THE ARG BLOCK
	CHKACC	E,		;[175] CHECK IF WE CAN CHANGE PROTECTION
	  SETZ	E,		;[175] PATH UUO BUT NO CHKACC?
	JUMPE	E,EBAKU2	;[175] OK, NOW CHECK WRITE ACCESS
	ERROR	E.EBP;;		;[175] EB FILE IS TOO PROTECTED

EBAKU2:	HRLI	A,.ACWRI	;[175] WE OWN IT, BUT CAN WE WRITE IT?
	MOVEI	E,A		;[175] (MIGHT BE <555>)
	CHKACC	E,		;[175] ASK FILSER
	  SETZ	E,		;[175] NEVER BOMB USER HERE
	JUMPE	E,EBAKU3	;[175] OK, GO EDIT IT
	ERROR	E.EBP;;		;[175] PROTECTED FILE

;HERE IF OK TO EDIT A DISK FILE. SETUP THE PROPER STRUCTURE FROM
;THE INPUT CHANNEL SO THAT THE NEW FILE WILL BE ON THE SAME STR.
EBAKU3:	MOVE	E,XDEV		;[175] GET REAL INPUT FILE UNIT
	MOVEM	E,DCBLK		;[175] STORE FOR DSKCHR
	MOVE	E,[DCLEN,,DCBLK]	;[175] DO DSKCHR TO GET STR
	DSKCHR	E,		;[175]  THAT FILE WAS FOUND ON
	  JRST	EBAKU4		;[175] FAILED, USE WHAT WE HAVE
	MOVE	E,DCSNM		;[175] OK, PICKUP STR NAME
	MOVEM	E,OPNDEV	;[175] STORE IN NEW OPEN BLOCK
	MOVX	E,UU.PHS	;[175] USE PHYSICAL ONLY OPEN
	MOVEM	E,OPNSTS	;[175] SINCE WE HAVE PHYSICAL STR NAME


;FALL THROUGH TO NEXT PAGE
;ENTER HERE IF GOING TO A DECTAPE.
EBAKU4:	MOVE	E,[OPNBLK,,EBSTS]	;[175] SAVE STS & DEV FOR BAKCLS
	BLT	E,EBDEV		;[175] ..
	PUSHJ	P,OPNOU		;[175] OPEN EB DEVICE
	MOVE	E,[-XFILEN+1,,XFILNM]	;[175] PDL TO LOOKUP BLOCK
	PUSH	E,[PTHBLK]	;[175] SETUP .RBPPN
	PUSH	E,TMPTEC	;[175] FILE NAME IS NNNTEC
	PUSH	E,['TMP   ']	;[175] EXTENSION IS TMP (WIPE DATES)
	MOVX	E,<777>B8	;[175] CLEAR ALL DATES FOR ENTER
	ANDM	E,XPRV		;[175]  BUT KEEP ORIGINAL PROTECTION
	MOVX	E,<100>B8	;[175] GET LOWEST NON-ZERO PROTECTION
	SKIPN	XPRV		;[175] IF EDITING A <000> FILE,
	MOVEM	E,XPRV		;[175]   DO ENTER WITH <100> SO WON'T
				;[175]   GET SYSTEM DEFAULT PROTECTION
	SETZM	XVER		;[175] EDITING CHANGES FILE VERSIONS!
	MOVE	E,XSIZ		;[175] NOW SETUP OUTPUT ESTIMATE
	ADDI	E,777		;[175] ROUND UP INPUT + 2 RIBS + 1
	LSH	E,-7		;[175] CONVERT TO BLOCKS
	MOVEM	E,XEST		;[175] STORE FOR OUTPUT ENTER
	SETZM	XALC		;[175] NO NEED FOR CONTIGUITY
	SETZM	XPOS		;[175] CERTAINLY NO SPECIFIC PLACE!
	PUSHJ	P,WTFIL		;[175] DO ENTER ON .TMP FILE
	TLO	FF,UWRITE+UBAK	;[175] IT ALL WORKED! TURN ON FLAGS
EBAKU5:	TLZE	FF,CCLFLG	;[175] CALLED FROM TECO COMMAND?
	PUSHJ	P,YANK		;[175] YES, DO A Y
	POPJ	P,		;[175] DONE


;HERE IF THE EB FILE WAS FOUND ON SOME LIBRARY AREA. TURN THE EB
;INTO AN ER/EW, SO THAT THE FILE ON THE LIBRARY WON'T BE MODIFIED.

FAKERW:	PUSHJ	P,TYPFFI	;[175] TELL WHAT WE'RE DOING
	PUSHJ	P,FILALT	;[175] PUT OUTPUT FILE EXACTLY WHERE
	SETZM	OPNSTS		;[175]  THE USER SPECIFIED. ITS KNOWN
	PUSHJ	P,OPNOU		;[175]  NOT TO EXIST, SINCE A LOOKUP
	PUSHJ	P,WTFIL		;[175]  FOUND IT ONLY ON LIB
	TLO	FF,UWRITE	;[175] EW SUCCESSFULLY INITIATED
	PJRST	EBAKU5		;[175] DO A Y IF FROM A TECO COMMAND


U TMPTEC,1			;SAVE FOR ###TEC. FILE NAME
U FDAEM,1			;[175] NON-ZERO MEANS FTFDAE ON IN MON.
U EBSTS,1			;[175] SAVED MODE FOR EB DEVICE
  EBOPN==EBSTS			;[175] ALTERNATE NAME
U EBDEV,1			;[175] DEVICE FOR EB
U EBBUF,1			;[175] BUFFER ADDR (NOT USED)
U EBCHR,1			;[175] EB DEVICE DEVCHR
U EBPTH,2			;[175] PATH BLOCK HEADER (NOT USED)
U EBPPN,1			;[175] PPN THAT EB FILE CAME FROM
U EBSFD,5			;[175] SFD'S IN EB FILE'S PATH
U EBNAM,1			;[175] EB FILE NAME
U EBEXT,1			;[175] EB EXTENSION
U EBPROT,1			;[175] LH=-1 IF EDITING OWNER'S <2XX>
				;[175]  FILE, RH=ORIGINAL FILE'S PROT
;INPUT FILE LOOKUP ERROR

LKUPER:	RELEAS	INCHN,0
	TLZ	FF,UREAD+FINF	;[175] LET GO OF INPUT DEVICE
	EE1+ERROR E.FNF

;TYPE OUTPUT ERROR

ENTERR:	RELEAS	OUTCHN,0
	TLZ	FF,UWRITE+UBAK	;LET GO OF OUTPUT DEVICE & EB FLAG
	LDB	E,[POINT 15,XEXT,35]	;[175] ERROR CODE
	CAIE	E,ERPRT%	;[175] MAYBE DTA FULL?
	JRST	ENTER2		;[175] NO
	MOVE	A,OUCHR		;[175] YES
	TXNE	A,DV.DTA	;[175] IF DTA ITS FULL, ELSE ENTER ERROR
	ERROR	E.FUL
ENTER2:	EE1+ERROR E.ENT
;EZ	SELECTS THE OUTPUT DEVICE, ISSUES A REWIND COMMAND TO IT,
;	ISSUES A COMMAND TO ZERO ITS DIRECTORY, AND OPENS THE FILE
;	SPECIFIED (IF ANY).

;EW	SELECTS THE OUTPUT DEVICE AND OPENS THE FILE SPECIFIED (IF ANY)

ZERDIR:	TLOA	FF,EZTMP	;[175] FLAG EZ COMMAND, NOT EW
OPNWR:	TLZ	FF,EZTMP	;[175] THIS IS A REAL EW COMMAND
	TLNE	FF,UBAK		;[175] EB IN PROGRESS?
	ERROR	E.EBO;;		;[175] YES, EW IS A NO-NO
	PUSHJ	P,CLOSEF	;[175] GIVE HIM A FREE EF ON OLD FILE
	SETZM	SWITC		;[175] NO I/O SWITCHES TYPED YET
	PUSHJ	P,FILSPC	;[175] PARSE NEW FILE SPEC, SET UP X???
	MOVE	E,SWITC		;[175] GET SWITCHES HE TYPED
	TLC	E,GENLSN+SUPLSN	;[175] CHECK FOR BOTH BEING ON
	TLCN	E,GENLSN+SUPLSN	;[175] WITH TRIED & TRUE TLC, TLCN TRICK
	ERROR	E.COS;;		;[175] CONFLICTING OUTPUT SWITCHES
	MOVEM	E,OUTSWT	;[175] OK, STORE WHAT HE TYPED
	MOVE	E,[<"00000">B34+1]	;[175] SETUP INITIAL LSN
	MOVEM	E,LSNCTR	;[175] FOR OUTPUT FILE
	SETZM	OPNSTS		;[175] ASCII MODE
	PUSHJ	P,OPNOU		;[175] OPEN OUTPUT DEVICE, SETUP BUFFERS
	TLZN	FF,EZTMP	;[175] WAS THIS AN EZ COMMAND?
	JRST	OPNWR0		;[175] NO, CONTINUE
	UTPCLR	OUTCHN,		;[175] YES, ZERO DIRECTORY
	MTREW.	OUTCHN,		;[175] AND REWIND THE "DECTAPE"
	MTWAT.	OUTCHN,		;[175] WAIT FOR IT IN CASE MTA
OPNWR0:	MOVE	E,OPNCHR	;[175] DEVCHR OF DEVICE WE JUST OPENED
	TXNN	E,DV.DIR	;[175] A DIRECTORY DEVICE?
	JRST	OPNWR3		;[175] NO, CAN'T SUPERSEDE EXISTING FILE
	TLC	E,-1-<(DV.TTA)>	;[175] CAN NEVER SUPERCEDE
	TLCN	E,-1-<(DV.TTA)>	;[175]  ON DEVICE NUL:
	JRST	OPNWR3		;[175] YUP, IT'S NUL:. DON'T CHECK.
	TXNE	E,DV.DTA	;[175] IF A DECTAPE..
	JRST	OPNWR1		;[175] MUST GO DO SHORT LOOKUP
	LOOKUP	OUTCHN,XFILNM	;[175] SEE IF HE'S GOING TO SUPERSEDE
	  JRST	OPNWR3		;[175] NOT A CHANCE
	MOVEI	E,OUTCHN	;[175] MAYBE, SEE IF THE FILE
	MOVEM	E,PTHBLK	;[175] IS REALLY WHERE HE SAID IT WAS
	MOVE	E,[PTHLEN,,PTHBLK]	;[175] OR ON SOME LIB
	PATH.	E,		;[175] BY DOING A PATH UUO & COMPARING
	  JRST	OPNWR3		;[175] ?? OH WELL, MESSAGE NOT CRITICAL
	PUSHJ	P,CHKPTH	;[175] COMPARE FOUND WITH SOUGHT
	  JRST	OPNWR3		;[175] FOUND IN A LIB, IGNORE IT
	JRST	OPNWR2		;[175] WILL SUPERSEDE, WARN USER
;HERE IF WRITING TO A DECTAPE
OPNWR1:	LOOKUP	OUTCHN,SFILNM	;[175] DO SHORT LOOKUP
	  JRST	OPNWR3		;[175] NOT THERE
OPNWR2:	JSP	A,CONMES	;[175] TYPE FATEFUL MESSAGE
	ASCIZ	\%Superseding existing file
\
OPNWR3:	CLOSE	OUTCHN,		;[175] WE DON'T WANT UPDATE MODE (!!)
	PUSHJ	P,FILALT	;[175] RE-SET UP THE ENTER BLOCK
	PUSHJ	P,WTFIL		;[175] DO ENTER ON OUTPUT FILE
	TLO	FF,UWRITE	;[175] OUTPUT FILE NOW OPEN
	POPJ	P,		;[175] DONE
;SUBROUTINE TO OPEN THE OUTPUT DEVICE AND SETUP THE OUTPUT BUFFERS
;USES E,T

OPNOU:	MOVSI	E,OBF		;[175] SETUP ADDR OF OUTPUT HEADER
	MOVEM	E,OPNBUF		;[175] IN OPEN BLOCK
	OPEN	OUTCHN,OPNBLK	;[175] FIND THE DEVICE
	  ERROR	E.ODV;;		;[175] NONE SUCH OR IN USE
	MOVE	E,OPNDEV	;[175] GET DEVICE WE JUST OPENED
	MOVEM	E,OUDEV		;[175] SAVE FOR ERRORS
	MOVE	E,OPNCHR	;[175] NEED DEVCHR, TOO
	MOVEM	E,OUCHR		;[175] (SEE ENTERR)
	MOVEI	T,OBUF1		;[175] NOW SET UP BUFFERS
	EXCH	T,.JBFF		;[175] TWO OF THEM,
	OUTBUF	OUTCHN,2	;[175] IN OUR SPECIFIED PLACE
	MOVEM	T,.JBFF		;[175] THEN RESTORE REAL .JBFF
	POPJ	P,		;[175] DONE


;SUBROUTINE TO ENTER OUTPUT FILE. DOES SHORT ENTER IF DTA. USES E.

WTFIL:	MOVE	E,[XNAM,,OUNAM]	;[175] SAVE FILENAME & EXTENSION
	BLT	E,OUEXT		;[175] FOR PRETTY ERROR MESSAGES
	MOVE	E,OPNCHR	;[175] SHORT ENTER IF DTA
	TXNE	E,DV.DTA	;[175] IS IT?
	JRST	WTFIL1		;[175] YES
	ENTER	OUTCHN,XFILNM	;[175] NO, DO EXTENDED ENTER
	  JRST	ENTERR		;[175] WARN OF FAILURE
	MOVEI	E,OUTCHN	;[175] DETERMINE PATH TO FILE CREATED
	MOVEM	E,PTHBLK	;[175] BY DOING PATH UUO ON CHANNEL
	MOVE	E,[10,,PTHBLK]	;[175] POINT TO PATH BLOCK
	PATH.	E,		;[175] READ THE PATH TO THE FILE
	 POPJ	P,		;[175] NOT A DIRECTORY DEVICE
	MOVE	E,[PTHPPN,,OUPPN]	;[175] NOW SAVE PATH AWAY
	BLT	E,OUPPN+5	;[175] IN CASE OF OUTPUT ERRORS
	POPJ	P,		;[175] SUCCESS
;HERE IF DTA
WTFIL1:	ENTER	OUTCHN,SFILNM	;[175] SHORT ENTER FOR DTA
	  JRST	ENTERR		;[175] FULL?
	POPJ	P,		;[175] OK, RETURN



U	OUDEV,1
U	OUBUF,1
U	OUCHR,1
U	OUPTH,2
U	OUPPN,1
U	OUSFD,6
U	OUNAM,1
U	OUEXT,1
;EF	FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT
;	SELECTING A NEW OUTPUT FILE.

CLOSEF:	TLNN	FF,UWRITE	;[155]
	POPJ	P,
	CLOSE	OUTCHN,		;[175] CLOSE OUTPUT COMPLETELY
	STATZ	OUTCHN,740000
	JRST	OUTERR
	TLZ	FF,UWRITE	;[175] CLEAR NOW IN CASE ERROR IN BAKCLS
	TLNE	FF,UBAK		;[155] EB IN PROGRESS?
	PUSHJ	P,BAKCLS	;[175] YES
	RELEAS	OUTCHN,0
	TLZ	FF,UBAK		;[175] CLEAR WRITE AND EB FLAGS
	POPJ	P,



;EM	EXECUTE MTAPE UUO.

EMTAPE:	TLNN	FF,UREAD
	ERROR	E.EMD
	PUSHJ	P,CHK2
	CAIGE	B,1
	ERROR	E.EMA
	WAIT	INCHN,		;[175] WAIT FOR BUFFERS TO FILL
	MTAPE	INCHN,0(B)
	HRRZ	A,IBUF		;[175] GET ADDR OF FIRST BUFFER
	MOVE	E,A		;[175] COPY TO TEMP AC
	MOVX	T,BF.IOU	;[175] GET "BUFFER IN USE" BIT
EMTAP1:	ANDCAM	T,0(E)		;[175] CLEAR IT IN CURRENT BUFFER
	HRRZ	E,0(E)		;[175] PICKUP ADDRESS OF NEXT
	CAME	E,A		;[175] DONE WITH ALL BUFFERS IN RING?
	JRST	EMTAP1		;[175] NO, LOOP
	SETOM	IBUF+2		;[175] INSURE NEXT IN GETS NEW RECORD
	MTWAT.	INCHN,		;[175] MAKE SURE SPACING COMPLETES
	POPJ	P,		;[175] END OF COMMAND
;THIS ROUTINE IS CALLED AT EF IF AN EB WAS DONE. IT DOES
;THE WORK OF MAKING THE INPUT FILE HAVE THE EXTENSION .BAK ,
;DELETING ANY PREVIOUS FILE.BAK, AND RENAMING THE NEW OUTPUT
;FILE AS THE ORIGINAL FILE.EXT

BAKCLS:	TLZ	FF,UREAD+FINF	;[175] AN EB EF WIPES INPUT CHANNEL, TOO
	RELEAS	INCHN,		;[175] GET RID OF OLD DEVICE
	MOVE	E,[EBOPN,,OPNBLK]	;[175] RETRIEVE EB DEVICE
	BLT	E,OPNDEV	;[175] FROM EB SAVE AREA
	SETZM	OPNBUF		;[175] NO BUFFERS NEEDED FOR RENAMES
	OPEN	INCHN,OPNBLK	;[175] RE-GRAB DEVICE
	  ERROR	E.IRN;;		;[175] IT WENT AWAY??
	SETZM	XFILNM		;[175] SETUP LOOKUP BLOCK
	MOVE	E,[XFILNM,,XFILNM+1]	;[175]  TO DELETE OLD BAK FILE
	BLT	E,XFILNM+XFILEN-1	;[175] FIRST, BLT TO ZERO
	MOVE	E,[-XFILEN,,XFILNM-1]	;[175] SET UP PDL TO XFILNM
	PUSH	E,[XFILEN-1]	;[175] SETUP LENGTH OF BLOCK
	PUSH	E,[PTHBLK]	;[175] SET .RBPPN TO EXTENDED PATH
	PUSH	E,EBNAM		;[175] SET .RBNAM TO ORIG FILE NAME
	PUSH	E,['BAK   ']	;[175] EXTENSION IS BAK
	MOVE	E,EBCHR		;[175] GET EB DEV CHARACTERISTICS
	TXNE	E,DV.DTA	;[175] IS IT A DECTAPE?
	JRST	BKCLS2		;[175] YES, GO DO DTA'ISH THINGS
	SETZM	PTHBLK		;[175] NO, CLEAR OUT PATH BLOCK
	SETZM	PTHFLG		;[175] SINCE MONITOR LOOKS AT FLAGS
	MOVE	E,[EBPPN,,PTHPPN]	;[175] RESTORE PATH FROM EB SAVE
	BLT	E,PTHBLK+PTHLEN-2	;[175] EBPPN IS ONLY 5 WORDS
	SETZM	PTHBLK+PTHLEN-1	;[175] PTHBLK HAS XTRA 0 ON END
	HRRZ	B,EBPROT	;[175] SETUP AC B TO BE PROTECTION THAT
	ANDCMI	B,300		;[175]   WE WILL GIVE .BAK FILE IF NONE
	SKIPN	FDAEM		;[175]   NOW EXISTS
	ANDCMI	B,400		;[175]   (I.E <0XX> OR <4XX> IF FDAEM)
	LOOKUP	INCHN,XFILNM	;[175] FIND OLD .BAK FILE
	  JRST	BKCLS3		;[175] NONE THERE, GO MAKE ONE
	LDB	B,[POINT 9,XPRV,8]	;[175] MAKE NEW .BAK HAVE SAME
				;[175] PROTECTION AS OLD ONE DID
	SETZM	XNAM		;[175] DELETE OLD .BAK FILE
	RENAME	INCHN,XFILNM	;[175] BY RENAMING TO 0 . . .
	  EE1+ERROR E.BAK;;	;[175] TOO PROTECTED TO GET RID OF
	JRST	BKCLS3		;[175] OK, GO RENAME SOURCE TO BAK

;HERE IF OLD BAK FILE SOUGHT ON A DECTAPE. USE SHORT LOOKUP/RENAME
BKCLS2:	LOOKUP	INCHN,SFILNM	;[175] LOOK FOR THE FILE
	  JRST	BKCLS3		;[175] NONE, DON'T SWEAT IT
	SETZM	XNAM		;[175] DELETE BY RENAMING TO ZERO
	RENAME	INCHN,SFILNM	;[175] ..
	  EE1+ERROR E.BAK;;	;[175] HOW CAN IT FAIL ON MY DTA??
;HERE TO RENAME THE OLD SOURCE FILE TO FILE.BAK

BKCLS3:	MOVE	E,[-XFILEN+1,,XFILNM]	;[200] RESET THINGS TO EB FILE
	PUSH	E,[PTHBLK]	;[175] LAST LOOKUP MIGHT HAVE WIPED PPN
	PUSH	E,EBNAM		;[175] WE WIPED XNAM
	PUSH	E,EBEXT		;[175] EXTENSION DEFINITELY ISN'T BAK
	MOVE	E,EBCHR		;[175] GET ORIGINAL EB DEVICE DEVCHR
	TXNE	E,DV.DTA	;[175] DECTAPE?
	JRST	BKCLS5		;[175] YES, DO SHORT LOOKUP/RENAME
	SETZM	PTHBLK		;[175] NO, MAKE SURE PTHBLK SETUP RIGHT
	SETZM	PTHFLG		;[175] MONITOR RETURNS STUFF ON LOOKUP
	LOOKUP	INCHN,XFILNM	;[175] FIND ORIGINAL SOURCE FILE
	  EE1+ERROR E.ILR;;	;[175] I'M EXTREMELY OFFENDED
	SKIPL	EBPROT		;[175] NEED TO LOWER PROTECTION?
	JRST	BKCLS4		;[175] NO, JUST RENAME IT TO .BAK
	MOVX	E,<300>B8	;[175] CLEAR THESE BITS
	ANDCAM	E,XPRV		;[175] TO MAKE PROTECTION REASONABLE
	RENAME	INCHN,XFILNM	;[175] DOWN GOES THE PROTECTION
	  EE1+ERROR E.IRB;;	;[175] FILE DAEMON WON'T LET US?
BKCLS4:	MOVE	A,XEXT		;[175] SAVE DATES FOR ERROR RECOVERY
	MOVSI	E,'BAK'		;[175] NEW FILE NAME IS FILE.BAK
	HLLM	E,XEXT		;[175] KEEP SAME DATES ETC.
	DPB	B,[POINT 9,XPRV,8]	;[175] STORE BAK FILE PROTECTION
	RENAME	INCHN,XFILNM	;[175] MAKE OLD SOURCE INTO BAK
	  CAIA			;[175] TRY TO RECOVER
	JRST	BKCLS6		;[175] NOW GO MAKE .TMP FILE NEW SOURCE

;HERE IF RENAMING THE OLD SOURCE FILE TO FILE.BAK WITH A LOWER
;PROTECTION FAILED. IT COULD BE THAT THE FILE IS PROTECTED RENAME
;BUT NO CHANGE PROTECTION AGAINST US. IF THIS IS THE CASE, WE WILL
;GO AHEAD AND CHANGE THE EXTENSION TO BAK, BUT LEAVE THE PROTECTION
;ALONE.
	LDB	E,[POINT 15,XEXT,35]	;[175] PICKUP RENAME ERROR CODE
	CAIE	E,ERPRT%	;[175] PROTECTION FAILURE?
	  EE1+ERROR E.IRB;;	;[175] NO, STOP NOW
	MOVEM	A,XEXT		;[175] YES, RESTORE DATES WIPED BY ERROR
	LOOKUP	INCHN,XFILNM	;[175] LOOKUP OLD SOURCE AGAIN
	  EE1+ERROR E.ILR;;	;[175] GONE??
	MOVSI	E,'BAK'		;[175] NEW EXTENSION
	HLLM	E,XEXT		;[175] CHANGE ONLY EXTENSION
	RENAME	INCHN,XFILNM	;[175] TRY IT AGAIN
	  EE1+ERROR E.IRB;;	;[175] SOME OTHER ERROR?
	JRST	BKCLS6		;[175] WON, GO MAKE .TMP NEW SOURCE

;HERE TO MAKE FILE.SRC BE FILE.BAK IF ON A DTA
BKCLS5:	LOOKUP	INCHN,SFILNM	;[175] FIND OLD SOURCE FILE
	  EE1+ERROR E.ILR;;	;[175] HOW CAN THIS BE?
	MOVSI	E,'BAK'		;[175] NEW EXTENSION IS .BAK
	HLLM	E,XEXT		;[175] KEEP DATES ETC.
	RENAME	INCHN,SFILNM	;[175] CHANGE NAME TO FILE.BAK
	  EE1+ERROR E.IRB;;	;[175] JUST NOT MY LUCKY DAY


;FALL THROUGH TO NEXT PAGE
;HERE TO FIND OUTPUT NNNTEC.TMP FILE, AND RENAME IT TO NEW SOURCE FILE.
BKCLS6:	RELEAS	INCHN,		;[175] MAKE SURE INPUT DEVICE FINISHED
	SETZM	XFILNM		;[175] CAN'T BE TOO CAREFUL
	MOVE	E,[XFILNM,,XFILNM+1]	;[175] SO BLT LOOKUP BLOCK TO 0
	BLT	E,XFILNM+XFILEN-1	;[175] ..
	MOVE	E,[-XFILEN,,XFILNM-1]	;[175] SETUP PDL TO LOOKUP BLOCK
	PUSH	E,[XFILEN-1]	;[175] RESET LENGTH WORD
	PUSH	E,[PTHBLK]	;[175] RESET .RBPPN
	PUSH	E,TMPTEC	;[175] SET .RBNAM TO NNNTEC
	PUSH	E,['TMP   ']	;[175] EXTENSION IS TMP
	MOVE	E,EBCHR		;[175] DEVCHR OF EB DEVICE
	TXNE	E,DV.DTA	;[175] DECTAPE?
	JRST	BKCLS8		;[175] YES, DO SHORT LOOKUPS
	SETZM	PTHBLK		;[175] ZAP BITS MONITOR RETURNS
	SETZM	PTHFLG		;[175] ON LOOKUPS OR RENAMES
	LOOKUP	OUTCHN,XFILNM	;[175] FIND THE .TMP FILE
	  EE1+ERROR E.OLR;;	;[175] WENT AWAY??
	SKIPL	EBPROT		;[175] NEED TO LOWER PROTECTION?
	JRST	BKCLS7		;[175] NO, GO CHANGE NAME
	SKIPN	FDAEM		;[175] FILE DAEMON MONITOR?
	SKIPA	A,[POINT 3,XPRV,2]	;[175] NO, OWNER FIELD 3 BITS
	MOVE	A,[POINT 2,XPRV,2]	;[175] YES, ONLY 2 BITS
	SETZ	E,		;[175] LOWEST POSSIBLE PROTECTION
	DPB	E,A		;[175] STORE IN OWNER FIELD
	RENAME	OUTCHN,XFILNM	;[175] LOWER PROTECTION OF FILE
	  EE1+ERROR E.RNO;;	;[175] CANT?
BKCLS7:	MOVE	E,EBNAM		;[175] GET SOURCE FILE NAME
	MOVEM	E,XNAM		;[175] STORE FOR RENAME
	MOVE	E,EBEXT		;[175] GET SOURCE EXTENSION
	HLLM	E,XEXT		;[175] STORE WITHOUT TOUCHING DATES
	MOVE	E,EBPROT	;[175] MAKE PROTECTION SAME AS OLD
	DPB	E,[POINT 9,XPRV,8]	;[175] ..
	RENAME	OUTCHN,XFILNM	;[175] TURN TMP FILE INTO NEW SOURCE
	  EE1+ERROR E.RNO;;	;[175] FILE DAEMON DOESN'T KNOW US
	POPJ	P,		;[175] ALL DONE

;HERE TO RENAME TMP FILE TO NEW SOURCE FILE ON A DTA
BKCLS8:	LOOKUP	OUTCHN,SFILNM	;[175] DO SHORT LOOKUP TO FIND FILE
	  EE1+ERROR E.OLR;;	;[175] GONE!
	MOVE	E,EBNAM		;[175] GET SOURCE FILE NAME
	MOVEM	E,XNAM		;[175] STORE FOR RENAME
	MOVE	E,EBEXT		;[175] PICKUP EB EXTENSION
	HLLM	E,XEXT		;[175] STORE WITHOUT TOUCHING DATES
	RENAME	OUTCHN,SFILNM	;[175] LAST RENAME OF THE JOB
	  EE1+ERROR E.RNO;;	;[175] HOW CAN WE LOSE NOW?
	POPJ	P,		;[175] DONE
;ROUTINE TO DETERMINE IF THE FILE FOUND BY A LOOKUP UUO WAS
;ACTUALLY FOUND WHERE THE USER SPECIFIED, OR ON SOME LIBRARY
;AREA. IT EXPECTS THE USER'S LAST COMMAND TO STILL BE IN COM???,
;THE FILE TO HAVE BEEN LOOKED UP USING THE XFILNM BLOCK, AND A PATH
;UUO ON THE CHANNEL TO HAVE BEEN DONE INTO THE PTHBLK BLOCK.
;CALL:
;	PUSHJ	P,CHKPTH
;	 HERE IF FOUND ON A LIBRARY AREA
;	HERE IF FOUND WHERE SOUGHT
;USES AC'S A AND E.


;HERE WHEN CPATH & PTHBLK SET UP. COMPARE THE PATHS.
CHKPTH:	SKIPN	E,COMDEV	;[175] GET DEVICE USER TYPED
	MOVSI	E,'DSK'		;[175] BLANK DEFAULTS TO DSK:
	MOVEM	E,CPATH		;[175] STORE IN OUR PATH BLOCK
	MOVE	E,[CPTLEN,,CPATH]	;[175] DO A PATH UUO ON IT
	PATH.	E,		;[175] TO SEE IF USER MEANT HIS PPN
	  JFCL			;[175] PROBABLY MTA: OR TSK:
	MOVE	E,CFLG		;[175] PICKUP FLAGS WORD
	TXNN	E,PT.IPP	;[175] IS THIS AN ERSATZ DEVICE?
	JRST	CMPDSK		;[175] NO, MUST BE DSK: OF SOME SORT

;HERE IF AN ERSATZ DEVICE. COPY SFD'S FROM USER SPECIFICATION, SINCE
;AN ERSATZ DEVICE OVERRIDES ONLY THE PPN PORTION OF THE PATH.
	MOVE	E,[COMSFD,,CSFD]	;[175] COPY SFD'S ONLY
	BLT	E,CPATH+CPTLEN-1	;[175] ..
	JRST	CMPPTH		;[175] NOW GO COMPARE PATHS

;HERE IF DEVICE DOES NOT IMPLY A PPN. PATH BLOCK IS OK IF USER
;DIDN'T SPECIFY A PPN, OTHERWISE WE MUST COPY OVER WHAT HE TYPED.
CMPDSK:	SKIPG	COMPPN		;[175] IS DEFAULT PATH OK?
	JRST	CMPPTH		;[175] YES, GO COMPARE WITH FOUND
	MOVE	E,[COMPPN,,CPPN]	;[175] NO, GET WHAT USER SAID
	BLT	E,CPATH+CPTLEN-1	;[175] ONLY PPN & SFD'S
CMPPTH:	SETZ	A,		;[175] SETUP TO LOOP OVER PATH
CMPLUP:	MOVE	E,CPPN(A)	;[175] GET NEXT WORD OF PATH
	CAME	E,PTHPPN(A)	;[175] MATCH WHERE IT WAS FOUND?
	POPJ	P,		;[175] NO, IN A LIBRARY
	SKIPE	E		;[175] DONE IF ZERO
	AOJA	A,CMPLUP	;[175] ELSE COMPARE MORE SFD'S
	AOS	(P)		;[175] PATHS WERE THE SAME
	POPJ	P,		;[175] SO GIVE SKIP RETURN
;ROUTINE TO TYPE THE "%FILE FOUND IN ..." MESSAGE. EXPECTS
;THE PATH TO BE IN PTHBLK. USES A,B,C,CH,TT

TYPFFI:	JSP	A,CONMES	;[175] TYPE FIRST PART
	ASCIZ	\%File found in [\	;[175]
	MOVEI	C,PTHBLK	;[175] POINT TO PATH BLOCK
	PUSHJ	P,TYPATH	;[175] TYPE IT
	JSP	A,CONMES	;[175] NOW FINISH MESSAGE
	ASCIZ	\]
\
	POPJ	P,


;ROUTINE TO TYPE A PATH IN THE PATH BLOCK POINTED TO BY AC C.
;USES AC'S B,CH,TT

TYPATH:	HLRZ	B,2(C)		;[175] GET PROJECT
	PUSHJ	P,OCTMS		;[175] TYPE IT
	MOVEI	CH,","		;[175] SEPARATOR
	PUSHJ	P,TYOM		;[175] TYPE
	HRRZ	B,2(C)		;[175] PROGRAMMER
	PUSHJ	P,OCTMS		;[175] PUT IT OUT IN OCTAL
TYPTH1:	SKIPN	TT,3(C)		;[175] MORE SFD'S?
	POPJ	P,		;[175] NO
	MOVEI	CH,","		;[175] YES, END LAST ONE
	PUSHJ	P,TYOM		;[175] WITH A COMMA
	PUSHJ	P,SIXBMS	;[175] TYPE THIS ONE
	AOJA	C,TYPTH1	;[175] LOOP
;ROUTINE TO PARSE FILE DESIGNATOR
;STORES WHAT USER TYPED IN COM???, AND COPIES IT INTO X????,
;READY TO DO A LOOKUP OR ENTER. NULL DEVICE DEFAULTS TO DSK:
;ENTER AT FILALT TO COPY COM??? AREA TO X???? AREA.
;USES AC'S A,B,E,CH

FILSPC:	TLZ	FF,FEXTF	;[175] INITIALIZE FILE SCANNING FLAGS
	SETZM	COMZR		;[175] ZERO AREA THAT WE USE
	MOVE	A,[COMZR,,COMZR+1]	;[175] INCLUDES COM???, X????
	BLT	A,COMEZR	;[175] ..

;BACK HERE TO PARSE A NEW FIELD OF THE FILE SPECIFICATION
NEWFLD:	PUSHJ	P,FILWRD	;[175] ACCUMULATE SIXBIT INTO AC E
	CAIN	CH,":"		;[175] WAS TERMINATOR A COLON?
	JRST	FILDEV		;[175] YES, GO PROCESS DEVICE
	CAIN	CH,"."		;[175] A PERIOD?
	JRST	FILNAM		;[175] YES, STORE FILENAME & FLAG EXT.
	PUSHJ	P,STRFLD	;[175] ALL OTHER TERMINATORS START A
				;[175] FIELD, SO STORE END OF LAST ONE
	CAIN	CH,"["		;[175] PATH DESIGNATOR?
	JRST	FILPTH		;[175] YES, GO READ IN PATH
	CAIN	CH,"/"		;[175] A SWITCH?
	JRST	FILSWT		;[175] YES, GO READ IT
	CAIE	CH,ALT		;[175] ONLY OTHER DELIMITER AN ALT
	ERROR	E.IFN;;		;[175] NO, SO ILLEGAL CHARACTER

;HERE WHEN FILESPEC FINISHED (ALTMODE SEEN). COPY COM??? TO X??? & POPJ.
FILALT:	SETZM	XFILNM		;[175] ZERO LOOKUP BLOCK AGAIN
	MOVE	E,[XFILNM,,XFILNM+1]	;[175] INCASE ENTRY AT FILALT
	BLT	E,XFILNM+XFILEN-1	;[175] BUT NOT TOO FAR
	SKIPN	E,COMDEV	;[175] PICKUP USER DEVICE IF ANY
	MOVSI	E,'DSK'		;[175] NONE, SO USE DSK:
	MOVEM	E,OPNDEV	;[175] STORE FOR OPEN
	DEVCHR	E,		;[175] ALSO NEED CHARACTERISTICS
	MOVEM	E,OPNCHR	;[175] SO WE CAN TELL DECTAPES FROM DSK:
	TXNE	E,DV.TTY	;[175] IS IT A TTY?
	TXNN	E,DV.TTA	;[175] YES, CONTROLLING A JOB (OURS)?
	CAIA			;[175] NO TO EITHER
	ERROR	E.TTY;;		;[175] ILLEGAL TTY I/O DEVICE
	MOVE	A,[-XFILEN,,XFILNM-1]	;[175] SETUP PDL INTO LOOKUP BLK
	PUSH	A,[XFILEN-1]	;[175] FIRST WORD IS LENGTH
	SKIPG	COMPPN		;[175] DID USER SPECIFY A PATH?
	TDZA	E,E		;[175] NO, USE A ZERO FOR DEFAULT
	MOVEI	E,PTHBLK	;[175] YES, POINT TO PATH BLOCK
	PUSH	A,E		;[175] STORE PATH POINTER OR ZERO
	PUSH	A,COMNAM	;[175] STORE FILE NAME
	PUSH	A,COMEXT	;[175] EXTENSION
	SETZM	PTHBLK		;[175] SETUP PTHBLK FROM COMPPN
	SETZM	PTHFLG		;[175] ZERO 1ST 2 WORDS FOR MONITOR
	MOVE	A,[COMPPN,,PTHPPN]	;[175] COPY REST FROM COMMAND
	BLT	A,PTHBLK+PTHLEN-2	;[175] ..
	SETZM	PTHBLK+PTHLEN-1	;[175] MAKE SURE IT TERMINATES WITH A 0
	POPJ	P,
;HERE WHEN ":" TYPED. STORE THE DEVICE NAME.
FILDEV:	SKIPE	E		;[175] USER TYPE A DEVICE?
	TLNE	FF,FEXTF	;[175] MAYBE, REALLY AN EXTENSION?
	ERROR	E.NDV;;		;[175] NO OR YES, NULL DEVICE ILLEGAL
	MOVEM	E,COMDEV	;[175] YES, STORE IT
	JRST	NEWFLD		;[175] AND GO PARSE THE NEXT FIELD

;HERE WHEN "." TYPED. STORE ANY FILE NAME THAT'S BEEN ACCUMULATING
;ALSO, SET FLAG SO NEXT FIELD SEEN WILL BE STORED AS EXTENSION
FILNAM:	TLOE	FF,FEXTF	;[175] SET EXTENSION FLAG
	ERROR	E.DEX;;		;[175] DOUBLE EXTENSION ILLEGAL
	JUMPE	E,NEWFLD	;[175] MAYBE NO FILENAME (FOO[,].BAR)
	SKIPE	COMNAM		;[175] THERE IS, DUPLICATE?
	ERROR	E.DFN;;		;[175] YES, ERROR
	MOVEM	E,COMNAM	;[175] NO, STORE THE FILE NAME
	JRST	NEWFLD		;[175] READY FOR THE NEXT FIELD

;HERE WHEN "/" OR "[" OR <ALT> TYPED. STORE FILE OR EXT. FIRST
STRFLD:	TLZE	FF,FEXTF	;[175] WAITING FOR AN EXTENSION?
	JRST	STREXT		;[175] YES, GO STORE IT
	JUMPE	E,CPOPJ		;[175] DON'T STORE IF NOTHING THERE
	SKIPE	COMNAM		;[175] FILE NAME ALREADY SEEN?
	ERROR	E.DFN;;		;[175] YES, ERROR
	MOVEM	E,COMNAM	;[175] NO, STORE THE FILE NAME
	POPJ	P,		;[175] RETURN
;HERE IF WE SHOULD STORE AN EXTENSION
STREXT:	JUMPE	E,CPOPJ		;[175] DON'T STORE IF NOT TYPED
	SKIPE	COMEXT		;[175] DOUBLE EXTENSION?
	ERROR	E.DEX;;		;[175] YES, ILLEGAL
	HLLZM	E,COMEXT	;[175] NO, STORE EXTENSION
	POPJ	P,		;[175] DONE
;HERE WHEN "[" TYPED. READ IN A PATH SPECIFICATION.
FILPTH:	SKIPE	COMPPN		;[175] ONLY ONE PER CUSTOMER
	ERROR	E.DDI;;		;[175] DOUBLE DIRECTORY ILLEGAL
	PUSHJ	P,FILOCT	;[175] READ THE PROJECT
	CAIN	CH,"-"		;[175] [-] MEANS DEFAULT PATH
	JUMPE	E,FILDFP	;[175] BUT [123-] DOESN'T
	CAIN	CH,","		;[175] ONLY LEGAL TERMINATOR IS ","
	TDNE	E,[-1,,400000]	;[175] AND PROJECT MUST BE .LE. 377777
	ERROR	E.IPJ;;		;[175] ILLEGAL PPN
	SKIPN	E		;[175] [, ???
	HLRZ	E,USRPPN	;[175] YES, USE LOGGED-IN PROJECT
	MOVSM	E,COMPPN	;[175] STORE FOR RETURN
	PUSHJ	P,FILOCT	;[175] GET PROGRAMMER
	TLNE	E,-1		;[175] ONLY HALF WORD ALLOWED
	ERROR	E.IPG;;		;[175] ERROR
	SKIPN	E		;[175] [FOO,]??
	HRRZ	E,USRPPN	;[175] YES, USE LOGGED IN PROGRAMMER
	HRRM	E,COMPPN	;[175] STORE ANSWER
	CAIN	CH,ALT		;[175] ALLOW X:Y.Z[,<ALT>
	JRST	FILALT		;[175]
	CAIN	CH,"]"		;[175] END OF SPEC?
	JRST	NEWFLD		;[175] YES, GO READ MORE
	CAIE	CH,","		;[175] LAST CHANCE
	ERROR	E.IFN;;		;[175] ILLEGAL CHARACTER
;HERE TO COLLECT SFD'S FROM THE COMMAND STRING
	MOVE	B,[XWD -5,COMSFD]	;[175] MAX SFD'S ALLOWED
FILSFD:	PUSHJ	P,FILWRD	;[175] PARSE SFD NAME
	SKIPN	E		;[175] MUST BE ONE
	ERROR	E.NSF;;		;[175] NULL SFD ILLEGAL
	MOVEM	E,(B)		;[175] OK, STORE IT
	CAIN	CH,ALT		;[175] END OF IT ALL?
	JRST	FILALT		;[175] FINISH UP
	CAIN	CH,"]"		;[175] NO, END OF PATH?
	JRST	NEWFLD		;[175] YES, LOOK FOR SWITCHES ETC
	CAIE	CH,","		;[175] MORE SFD'S?
	ERROR	E.IFN;;		;[175] NO, JUNK
	AOBJN	B,FILSFD	;[175] GO AFTER MORE SFD'S
	ERROR	E.SFD;;		;[175] SPEC NESTED TOO DEEPLY

;HERE ON "[-". SET COMPPN TO -1 TO INDICATE DEFAULT PATH.
FILDFP:	SETOM	COMPPN		;[175] DEFAULT PATH
	PUSHJ	P,FILCHR	;[175] NEXT CHARACTER
	CAIN	CH,ALT		;[175] ALLOW IT TO END HERE
	JRST	FILALT		;[175] FINISH UP
	CAIE	CH,"]"		;[175] ELSE MUST FINISH RIGHT
	ERROR	E.IFN;;		;[175] DON'T LIKE IT
	JRST	NEWFLD		;[175] GO GET MORE
;HERE ON A "/". READ IN THE SWITCH.
FILSWT:	PUSHJ	P,FILWRD	;[175] READ THE SWITCH NAME
	MOVEM	E,SWITHL	;[175] STORE FOR ERROR MSGS
	MOVEI	B,SWITAB	;[175] POINT TO SWITCH TABLE
FILSWL:	SKIPN	(B)		;[175] DONE?
	ERROR	E.UIS;;		;[175] UNKNOWN I/O SWITCH
	CAME	E,(B)		;[175] MATCH?
	AOJA	B,FILSWL	;[175] NO, TRY NEXT
	SUBI	B,SWITAB	;[175] CONVERT SWITCH TO OFFSET
	MOVNS	B		;[175] NEED NEGATIVE FOR LSH
	MOVSI	E,(1B0)		;[175] 1B0 IS 1ST SWITCH, 1B1 IS SECOND
	LSH	E,(B)		;[175] CONVERT TO RIGHT BIT
	IORM	E,SWITC		;[175] STORE FOR RETURN
	CAIN	CH,"/"		;[175] ANOTHER SWITCH COMING?
	JRST	FILSWT		;[175] YES, PROCESS IT
	CAIN	CH,ALT		;[175] END OF IT ALL?
	JRST	FILALT		;[175] YES, GO FINISH UP
	ERROR	E.IFN;;		;[175] NOTHING ELSE LEGAL ANYMORE



;FILE SELECTION COMMAND SWITCH TABLE

SWITAB:	SIXBIT	/GENLSN/	;GENERATE LINE SEQ#'S ON OUTPUT
	SIXBIT	/SUPLSN/	;SUPPRESS LSN (INPUT OR OUTPUT)
	0

U INSWIT,1			;INPUT SWITCHES
U OUTSWT,1			;OUTPUT SWITCHES
U LSNCTR,1			;LSN GENERATION CTR

;SWITCH BITS -- LEFT HALF

GENLSN==1B18
SUPLSN==1B19
;HERE TO READ AN ALFAMERIC WORD INTO E IN SIXBIT. USES A.
FILWRD:	SETZ	E,		;[175] INITIALIZE ACCUMULATOR AC
	MOVE	A,[POINT 6,E]	;[175] SETUP TO STORE IN IT
FILWRL:	PUSHJ	P,FILCHR	;[175] GET NEXT CHAR
	CAIL	CH,"A"		;[175] A LETTER?
	CAILE	CH,"Z"		;[175] MAYBE, IS IT?
	CAIA			;[175] NO, COULD BE A DIGIT
	JRST	FILWR1		;[175] IT IS A LETTER. STORE IT.
	CAIL	CH,"0"		;[175] DIGIT?
	CAILE	CH,"9"		;[175] IS IT?
	POPJ	P,		;[175] NOPE, END OF WORD
FILWR1:	SUBI	CH,"A"-'A'	;[175] CONVERT TO SIXBIT
	TLNE	A,770000	;[175] AC E FULL YET?
	IDPB	CH,A		;[175] NO, STORE THE CHARACTER
	JRST	FILWRL		;[175] LOOP FOR ENTIRE WORD

;HERE TO READ AN OCTAL NUMBER INTO E.
FILOCT:	SETZ	E,		;[175] INITIALIZE ANSWER
FILOCL:	PUSHJ	P,FILCHR	;[175] GET NEXT DIGIT
	CAIL	CH,"0"		;[175] A DIGIT?
	CAILE	CH,"7"		;[175] (OCTAL, THAT IS)
	POPJ	P,		;[175] NO, END OF OCTAL NUMBER
	LSH	E,3		;[175] YES, MAKE ROOM
	ADDI	E,-"0"(CH)	;[175] ADD IN NEXT DIGIT
	JRST	FILOCL		;[175] LOOP FOR ENTIRE NUMBER

;GET A CHAR FOR FILEPSPECIFICATION
;IGNORE SPACE, TAB, LF, VT, FF, CR; CONVERT LC TO UC

FILCHR:	PUSHJ	P,SKRCH
	ERROR	E.UFS
	CAIL	CH,141
	CAILE	CH,172
	JRST	.+2
	TRZ	CH,40
	CAIN	CH,40
	JRST	FILCHR
	CAIL	CH,11
	CAILE	CH,15
	POPJ	P,
	JRST	FILCHR
;Y	RENDER THE BUFFER EMPTY.  READ INTO THE BUFFER UNTIL
;	(A)  A FORM FEED CHARACTER IS READ, OR
;	(B)  THE BUFFER IS WITHIN ONE THIRD OR
;128 CHARACTERS OF CAPACITY AND A LINE FEED IS READ, OR
;	(C)  AN END OF FILE IS READ, OR
;	(D)  THE BUFFER IS COMPLETELY FULL.
;THE FORM FEED (IF PRESENT) DOES NOT ENTER THE BUFFER.

YANK:

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

YANK2:	TLNE	FF,FINF		;[140] IF WE FINISHED ALREADY
	JRST	YANK51		;[140] THEN GET OUT
	TRZ	FF,FORM		;RESET THE YANK,APPEND FORM FEED FLAG
	TLNN	FF,UREAD	;ERROR IF INPUT NOT SPECIFIED
	ERROR	E.NFI

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

	MOVE	C,PT		;GET .
	MOVEM	C,Z		;TELL NROOM IT'S AN EXPAND
	SUBM	OU,C		;BUT EXPAND WITH REAL Z IN MIND
	ADDI	C,^D3000	;NEED 3000 ABOVE Z
	PUSHJ	P,NROOM
YANK6:	ADD	OU,RREL		;RELOCATE IN CASE GARBAGE COLLECTION DONE
	MOVE	TT,MEMSIZ	;TOP OF BUFFER
	MOVE	CH,TT
	SUB	TT,OU
	IDIVI	TT,3
	SUBM	CH,TT
	MOVEM	TT,M23		;M23 HAS 2/3 PT
	SUBI	CH,200
	MOVEM	CH,M23PL	;M23PL HAS 200 BELOW TOP
YANK4:	CAMGE	OU,M23		;2/3 FULL YET?
	JRST	YANK3		;NO, KEEP GOING
	CAMG	OU,M23PL	;YES, GETTING NEAR TOP?
	CAIN	CH,12		;NO. LINE FEED?
	JRST	YANK51		;YES. THAT'S ALL.
				;NO. GET MORE.

YANK3:	SOSLE	IBUF+2		;IS DEVICE BUFFER EMPTY?
	JRST	YANK5		;NO.
	INPUT	INCHN,0		;YES. FILL IT.
	STATZ	INCHN,740000	;ERROR?
	JRST	INERR		;YES.
	STATO	INCHN,20000	;NO. END OF FILE?
	JRST	YANK5		;NO.
	TLO	FF,FINF
	JRST	YANK51		;CLEAR BUFFER AND RETURN.
YANK5:	ILDB	CH,IBUF+1	;CH:=NEXT CHARACTER.
	TRZN	FF,SEQUIN	;WAS LAST THING A SUPPRESSED SEQ #?
	JRST	YANK52		;NO
	CAIE	CH,15		;[150] YES, IGNORE THE NEXT CHARACTER
	CAIN	CH,11		;[150] IF IT'S A CR (FOR SOS) OR A TAB
	JRST	YANK3		; IGNORE IT
YANK52:	JUMPE	CH,YANK3	;IF NULL, IGNORE IT.
	MOVE	T,@IBUF+1
	TRNE	T,1		;SEQUENCE NUMBER?
	JRST	YNKSEQ		;YES
YANK50:	PUSHJ	P,PUT		;NO. PUT CHARACTER IN DATA BUFFER.
	CAIE	CH,14		;FORM FEED?
	AOJA	OU,YANK4	;NO. UPDATE DATA BUFFER PTR AND CHECK FOR OVERFLOW.
	TRO	FF,FORM		;YANK AND/OR APPEND TERMINATED ON A LFORM FEED
YANK51:	MOVEM	OU,Z		;YES. SET END OF DATA BUFFER AND RETURN
	POPJ	P,

YNKSEQ:	MOVE	T,INSWIT	;SUPPRESS SEQ# FLAG ON?
	TLNE	T,SUPLSN
	JRST	YNKSEZ		;YES, STRIP THEM OFF AS IN DAYS OF YORE
	TRON	FF,SEQF		;SET SEQ FILE AND	[121]
				;JRST IF ALREADY SEEN	[121]
	TLNE	T,GENLSN	;DOES USER WANT LSN'S?	[121]
	JRST	YANK50		;IF SO DON'T BOTHER HIM	[121]
	;HERE IF NO LSN SWITCH AND SEQUENCED FILE
	; TELL USER WHAT'S ABOUT TO HAPPEN		[121]
	MOVE	T,CH		;SAVE THE CHARACTER	[121]
	JSP	A,CONMES	;OUTPUT THE MESSAGE	[121]
	ASCIZ	/%LINE NUMBER DETECTED IN INPUT FILE
/
	MOVE	CH,T		;RESTORE CHARACTER	[121]
	JRST	YANK50		;			[121]

YNKSEZ:	MOVEI	T,4		;CTR FOR REST OF SEQ #
	IBP	IBUF+1		;MOVE PTR OVER THIS CHAR
	SOS	IBUF+2		;& CTR TOO
	SOJG	T,.-2
	TRO	FF,SEQUIN	;IGNORE NEXT CHAR IF IT IS A TAB
	JRST	YANK3

INERR:	GETSTS	INCHN,B		;SAVE ERROR FLAGS
	RELEAS	INCHN,0
	TLZ	FF,UREAD
	EE2+ERROR E.INP



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

APPEND:	MOVE	OU,Z		;STORE DATA AT END OF BUFFER.
	PUSHJ	P,YANK2
	JRST	RET
;^ITEXT$	INSERTS AT THE CURRENT POINTER LOCATION THE ^I (TAB)
;	AND THE TEXT FOLLOWING THE ^I UP TO BUT NOT INCLUDING THE
;	ALT MODE.  THE POINTER IS PUT TO THE RIGHT OF THE INSERTED
;	MATERIAL.

TAB:	TRZ	FF,ARG		;NO ARGUMENT WANTED
	PUSHJ	P,TAB2		;INSERT TAB
IFN VC,<TLO	FF,TABSRT>	;ADJUST VVAL

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

INSERT:	TRNE	FF,ARG		;IS THERE AN ARGUMENT?
	JRST	INS1A		;YES. NI COMMAND.
	MOVEI	CH,ALT		;NORMAL TERMINATOR
	TRZN	FF,SLSL		;DID @ PRECEED I?
	JRST	INSERA		;NO, TERMINATOR = ALTMODE
	PUSHJ	P,SKRCH		;YES. CH:=USER SELECTED TERMINATOR.
	ERROR	E.UIN
INSERA:	MOVEI	B,(CH)		;B=INSERTION TERMINATOR.
	PUSH	P,CPTR		;SAVE CURRENT POSITION IN CMD STRING
	PUSH	P,COMCNT
	MOVEI	C,0		;COUNT # CHARACTERS TO INSERT IN C AND
				;MOVE CPTR TO END OF STRING.
INSER0:	PUSHJ	P,SKRCH		;GET NEXT CHARACTER
	ERROR	E.UIN
	CAIN	CH,(B)		;IS IT THE TERMINATOR?
	JRST	INSER2		;YES, END OF 1ST PASS
	CHKEO	EO21,INSER1	;IF EO=1, CTRL-CHARS ARE JUST TEXT
	MOVEI	T,IN1TAB	;CK FOR ^V, ^W, ^R, ^T, ^^
	TRNE	F2,TXTCTL	;^T FLAG ON?
	MOVEI	T,IN2TAB	;YES, USE RESTRICTED TABLE
	PUSHJ	P,DISP1
	TRNN	F2,TXTCTL	;IF ^T ON, ALL OTHER CTL-CHARS LEGAL TEXT
	PUSHJ	P,CKNCC		;CHECK FOR OTHER CTRL-CHARS (THEY ARE ILLEGAL)
INSER1:	AOJA	C,INSER0	;COUNT TEXT CHARACTERS
INSER2:	MOVEM	C,VVAL		;SAVE LENGTH OF STRING
IFN VC,<
	TLZE	FF,TABSRT	;TAB INSERTED?
	AOS	VVAL		;YES, COUNT IT
	>
	TRZ	F2,TXTCTL	;REFRESH ^T FLAG
	TRNE	FF,FSRCH	;DOING FS OR FN?
	JRST	SERCHJ		;YES
	POP	P,COMCNT	;RESET TO BEGINNING OF INSERT TEXT
	POP	P,CPTR
	PUSHJ	P,NROOM		;YES. MOVE FROM PT THROUGH Z UP C POSITIONS.
;MOVE INSERTION INTO DATA BUFFER

INS1B:	MOVE	OU,PT
INS1C:	PUSHJ	P,GCH		;CH:=CHARACTER FROM COMMAND STRING.
INS1F:	CAIN	CH,(B)		;IS IT THE TERMINATOR?
	POPJ	P,		;YES. DON'T STORE IT.
	CHKEO	EO21,INS1D	;IF EO=1, THERE ARE NO CTL-CHAR. COMMANDS
	MOVEI	T,INSTAB	;CK FOR CONTROL CHARACTERS
	TRNE	F2,TXTCTL	;^T FLAG ON?
	MOVEI	T,INTTAB	;YES, ONLY ^T AND ^R ARE SPECIAL
	PUSHJ	P,DISP1
INS1E:	PUSHJ	P,CASE		;CONVERT UC TO LC IF FLAGS WARRANT
INS1D:	PUSHJ	P,PUT		;NO. STORE CHARACTER IN DATA BUFFER TO RIGHT OF PT.
	AOS	PT		;PT:=PT+1
	JRST	INS1B		;LOOP
;DISPATCH TABLE FOR INSERT STRING CONTROL CHARACTERS (COUNT PASS)

IN1TAB:	XWD	INSER0,26	;^V
	XWD	INSER0,27	;^W
	XWD	INSER0,36	;^^
IN2TAB:	XWD	INSER4,24	;^T
	XWD	INSER3,22	;^R
	XWD	0,0		;END OF LIST

;GET CHARACTER AFTER ^R

INSER3:	PUSHJ	P,SKRCH		;DON'T COUNT ^R & DON'T DO CHECKS ON CHAR AFTER IT
	ERROR	E.UIN
	JRST	INSER1

;CHANGE NO-CONTROL-COMMANDS FLAG

INSER4:	TRC	F2,TXTCTL
	JRST	INSER0		;DON'T COUNT ^T
;DISPATCH TABLE FOR INSERT STRING CONTROL CHARACTERS (INSERT PASS)

INSTAB:	XWD	INSLOW,26	;^V
	XWD	INSSTD,27	;^W
	XWD	INSSPC,36	;^^
INTTAB:	XWD	INSMAC,24	;^T
	XWD	INSIGR,22	;^R
	XWD	0,0		;END OF LIST

;^V CAUSES THE NEXT CHARACTER TO BE CONVERTED TO LOWER CASE (IF UPPER CASE)
;^V^V SETS LOWER CASE MODE UNTIL THE END OF THE TEXT STRING (OR FURTHER NOTICE)

INSLOW:	PUSHJ	P,C.V		;SET ^V FLAGS
	JRST	INS1C		;CONTINUE TO NEXT CHAR.

;^W CAUSES NEXT CHAR. TO BE TAKEN AS IS (STANDARD MODE)
;^W^W SETS STANDARD MODE UNTIL END OF TEXT STRING (OR FURTHER NOTICE)

INSSTD:	PUSHJ	P,C.W		;SET ^W FLAGS
	JRST	INS1C		;CONTINUE TO NEXT CHAR.

;^R CAUSES NEXT CHAR. TO BE TAKEN AS TEXT
;EVEN IF IT IS A CONTROL CHAR. OR THE TEXT TERMINATOR

INSIGR:	PUSHJ	P,GCH		;GET NEXT CHAR.
	JRST	INS1E		;TREAT AS TEXT

;^^ -- IF NEXT CHAR IS @,[,\,],^, OR _, CONVERT IT TO LC RANGE

INSSPC:	PUSHJ	P,GCH		;GET NEXT CHAR
	PUSHJ	P,CVTSPC	;CONVERT IF WARRANTED
	JRST	INS1F

;CHANGE NO-CONTROL-COMMANDS MODE

INSMAC:	TRC	F2,TXTCTL	;COMPLEMENT ^T FLAG
	JRST	INS1C		;GO ON TO NEXT CHAR
;SET ^V FLAGS

C.V:	TRON	F2,CTLV		;SET ^V FLAG -- WAS IT ON BEFORE?
	POPJ	P,		;NO
	TRZ	F2,CTLV+CTLWW	;YES, SET ^V^V FLAG & CLR OTHERS
	TRO	F2,CTLVV
	POPJ	P,

;SET ^W FLAGS

C.W:	TRON	F2,CTLW		;SET ^W FLAG -- WAS IT ON BEFORE?
	POPJ	P,		;NO
	TRZ	F2,CTLW+CTLVV	;YES, SET ^W^W FLAG & CLR OTHERS
	TRO	F2,CTLWW
	POPJ	P,

;CONVERT ALPHABETIC CH TO UPPER OR LOWER CASE ACCORDING TO CASE CONTROL FLAGS

CASE:	CAIL	CH,"A"		;IS CHAR IN UPPER CASE RANGE?
	CAILE	CH,"Z"
	CAIL	CH,"A"+40	;IS IT IN LOWER CASE RANGE?
	CAILE	CH,"Z"+40
	JRST	CASE3		;NO
CASE2:	TRNE	F2,LCASE	;PREVAILING LOWER CASE?
	TRO	CH,40		;YES, CONVERT TO LOWER
	TRNE	F2,UCASE	;PREVAILING UPPER CASE?
	TRZ	CH,40		;YES, CONVERT TO UPPER
	TRNE	F2,CTLVV	;DOUBLE ^V ON?
	TRO	CH,40		;YES, CONVERT TO LC
	TRNE	F2,CTLWW	;DOUBLE ^W ON?
	TRZ	CH,40		;YES, CONVERT TO UC
	TRZE	F2,CTLV		;SINGLE ^V ON?
	TRO	CH,40		;YES, CONVERT TO LC
	TRZE	F2,CTLW		;SINGLE ^W ON?
	TRZ	CH,40		;YES, CONVERT TO UC
CASE3:	TRZ	F2,CTLV+CTLW	;CLR IN CASE NO CONVERSION
	POPJ	P,

;CONVERT @, [, \, ], ^, AND _ TO THE EQUIVALENT LC CHARACTER

CVTSPC:	CAIL	CH,"["
	CAILE	CH,"_"
	CAIN	CH,"@"
	TRO	CH,40		;CONVERT TO LOWER CASE RANGE
	POPJ	P,
;CHECK FOR NON-CONTROL CHARACTERS
;IF CH<10, OR 15<CH<33, OR 33<CH<40, CH IS AN ILLEGAL CTRL-CHAR

CKNCC:	CAIGE	CH,40
	CAIG	CH,15
	CAIGE	CH,10
	CAIN	CH,33
	POPJ	P,		;IT IS 10-15 OR 33 OR 40+
	MOVEI	B,(CH)		;SAVE CHAR FOR ERROR MSG ROUTINE
	ERROR	E.ICT
;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:	CHKEO	EO21,INS1X	;IF EO=1 SKIP NEXT STUFF
	PUSHJ	P,SKRCH		;GET CHAR AFTER I
	ERROR	E.NAI
	CAIE	CH,ALT		;IT HAD BETTER BE AN ALTMODE
	ERROR	E.NAI
INS1X:	MOVE	CH,NUM		;CH:=NUM

;INSERT CH IN DATA BUFFER AT PT

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

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

BAKSL1:	MOVE	T,[XWD 700,STAB-1]
	MOVEI	C,0		;COUNT # DIGITS IN C.
	MOVEI	A,BAKSL4	;SET DPT TO RETURN TO BAKSL4
	PUSHJ	P,DPT		;CONVERT C(B) TO ASCII AND STORE STRING IN STAB.
	MOVE	B,[XWD 700,STAB-1]
	PUSHJ	P,NROOMC	;MOVE FROM PT THROUGH Z UP C POSITIONS.
BAKSL5:	MOVE	OU,PT		;POSITION TO PUT CHAR IN
	ILDB	CH,B		;GET NEXT CHAR OF THE #
	PUSHJ	P,PUT		;STORE THE CHAR
	AOS	PT		;MOVE THE POINTER
	SOJG	C,BAKSL5	;DECREMENT THE CHAR CTR
	JRST	RET

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

;@ COMMAND MODIFIER

ATSIGN:	TROA	FF,SLSL		;SET @ SEEN FLAG

;COLON COMMAND MODIFIER

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

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

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

TYPE1:	PUSHJ	P,CHK1		;C:=MAX(C(C),BEG), B:=MIN(C(B),Z)
	MOVE	I,C		;START GETTING CHARACTERS AT C.
TYPE3:	CAML	I,B		;DONE?
	JRST	TYPE5		;YES.
	MOVE	TT,I		;NO. GET NEXT CHAR
	IDIVI	TT,5		;THIS IS A COPY OF GETINC
	HLL	TT,BTAB(TT1)	;..
	LDB	CH,TT		;COPIED TO SPEED IT UP
	ADDI	I,1		;..
	PUSHJ	P,(D)		;OUTPUT IT
	JRST	TYPE3		;LOOP
TYPE5:	MOVEI	A,PPA		;IF TYPING OR I,JP DON'T APPEND FF.
	MOVEI	CH,14		;IF PUNCHING, APPEND FF.
	CAIE	A,(D)		;D=PPA?
	POPJ	P,		;NO
	TRNN	FF,PCHFLG	;IS THIS AN "N" SEARCH?
CPPA:	JRST	PPA		;NO, APPEND A FORM FEED
	TRNN	FF,FORM		;DID LAST Y,A TERMINATE ON A FORM FEED?
	POPJ	P,		;NO,DO NOT APPEND ONE
				;YES, FALL INTO PPA: TO APPEND FF
PPA:	TLNN	FF,UWRITE	;ERROR IF NO OUTPUT FILE
	ERROR	E.NFO
PPA05:	SOSLE	OBF+2		;YES. IS OUTPUT BUFFER FULL?
	JRST	PPA11		;NO.
	OUTPUT	OUTCHN,0	;YES. WRITE IT
	STATZ	OUTCHN,740000	;ERROR?
	JRST	OUTERR		;YES.
	MOVE	A,OUCHR		;[175]
	TXNE	A,DV.MTA	;[175]
	STATO	OUTCHN,IOEOT	;A MAG TAPE AND AFTER EOT?
	SKIPA			;NO
	JRST	OUTERR
PPA11:	MOVE	A,OUTSWT	;GET OUTPUT SWITCHES
	TRNE	FF,SEQF		;SEQUENCED FILE?
	JRST	PPA02		;YES
	TLNE	A,GENLSN	;NO, OUTPUT GENLSN ON?
	JRST	PPA02		;YES, GENERATE LSN
	TRZ	FF,SEQUIN	;CLR SO AS NOT TO SCREW YANK
PPA01:	IDPB	CH,OBF+1	;CH TO OUTPUT BUFFER.
	POPJ	P,		;RETURN


OUTERR:	GETSTS	OUTCHN,B	;SAVE ERROR FLAGS
	RELEAS	OUTCHN,0	;CLOSE FILE AND RELEASE OUTPUT DEVICE.
	TLZ	FF,UWRITE+UBAK	;CLEAR OUTPUT FILE OPEN INDICATOR.
	EE2+ERROR E.OUT
PPA02:	TRNN	FF,SEQUIN	;WAS LAST CHAR AN EOL OR BEG OF BUFR?
	JRST	PPA03		;NO
	MOVE	AA,OUTSWT	;[176] GET OUTPUT SWITCHES
	TLNE	AA,SUPLSN	;[176] SUPPRES SEQ # ?
	JRST	PPA06		;[176] YES
	MOVE	A,OBF+2		;ROOM FOR SEQ# IN OUTPUT BUFR?
	CAIG	A,12
	JRST	PPA05		;NO, OUTPUT & COME BACK
PPA07:	LDB	A,[POINT 6,OBF+1,5]	;GET CURRENT BYTE POSITION IN OUT BUFR
	CAIG	A,1		;AT END OF WORD?
	JRST	PPA06		;YES
	IBP	OBF+1		;NO, PAD OUT WORD WITH NULLS
	SOS	OBF+2
	JRST	PPA07		;TRY AGAIN
PPA06:	TRZ	FF,SEQUIN	;[176] MOVED DOWN FROM PPA07-1
	TRNE	FF,SEQF		;[176] REMOVE PPA06 LABEL
				;[176] GENERATE NEW LSN OR OUTPUT EXISTING LSN?
	JRST	PPA04		;OUTPUT EXISTING LSN
	MOVE	A,LSNCTR	;GET LAST CREATED LSN WITH BIT 35 ON
	ADD	A,[BYTE (7)106,106,106,107]	;& ADD ASCII 10 TO IT
	MOVE	T,A
	AND	T,[BYTE (7)60,60,60,60]
	LSH	T,-3
	MOVE	TT,A
	AND	TT,[BYTE (7)160,160,160,160]
	IOR	T,TT
	SUB	A,T
	ADD	A,[BYTE (7)60,60,60,60]
	MOVEM	A,LSNCTR	;STORE NEW LSN
PPA06A:	AOS	OBF+1		;& OUTPUT THE 5 DIGITS + BIT 35
	MOVEM	A,@OBF+1
	MOVEI	A,11		;FOLLOWED BY TAB
	IDPB	A,OBF+1
	MOVE	A,OBF+2		;ADJUST BUFR CTR
	SUBI	A,6
	MOVEM	A,OBF+2
PPA03:	PUSHJ	P,CKEOL		;IS THIS CHAR AN EOL?
	JRST	PPA01		;NO
	TRO	FF,SEQUIN	;YES, SET EOL FLAG
	JRST	PPA01
;OUTPUT EXISTING LSN WITH LEADING ZEROS

PPA04:	MOVEI	A,4		;INIT 5 DIGIT CTR
	MOVEM	A,LSNCTR
	MOVE	A,[<"00000">B34]	;INIT LSN ACCUMULATOR
	CAIL	CH,"0"		;IS CURRENT CHAR A DIGIT?
	CAILE	CH,"9"
	JRST	PPA08		;NO, FILL IN 5 SPACES
	JRST	PPA12
PPA10:	SOSGE	LSNCTR		;DONE 5 DIGITS YET?
	JRST	PPA09		;YES
PPA12:	LSH	A,7		;PUT DIGIT INTO ACCUMULATOR
	DPB	CH,[POINT 7,A,34]
	CAML	I,B
	JRST	PPA09
	PUSHJ	P,GETINC	;[141]GET NEXT BUFFER CHAR
	CAIL	CH,"0"		;IS IT A DIGIT?
	CAILE	CH,"9"
	JRST	PPA09		;NO
	JRST	PPA10		;YES, STORE IT

PPA08:	MOVE	A,[<"     ">B34]	;[150] GET 5 SPACES
PPA08X:	CAIE	CH," "		;[150] SPACE?			
	JRST	PPA08B		;NO, INSERT 5 SPACES	[115]
	SOSGE	LSNCTR		;HAVE WE SEEN 5 SPACES	[115]
	JRST	PPA08C		;IF SO CHECK FOR TAB	[115]
	PUSHJ	P,GETINC	;[141]GET NEXT CHARACTER	
	JRST	PPA08X		;[150] TRY AGAIN		

;	HERE IF WE'VE SEEN 5 SPACES MAY BE TECO BLANK SEQUENCE NUMBER,
;	SOS PAGE MARK, OR SPACES THE USER HAS INSERTED.
PPA08C:	PUSHJ	P,GETINC	;[150] PICK IT UP AND		
	CAIE	CH,15		;[150] TEST FOR CR (FOR SOS) OR
	CAIN	CH,11		;[150] TAB TO BE OUTPUT WITH SPACES
	JRST	PPA09		;[150] OUTPUT 5 SPACES + CHAR IN CH
;	JRST	PPA08B		;[150] MUST BE USER'S SPACES!

;	HERE IF NOT 5 SPACES FOLLOWED BY TAB OR CR.  THIS IMPLIES
;	THAT ANY SPACES SEEN WERE USER'S TEXT.
PPA08B:	SUBI	I,5		;[150] BACK UP TO FIRST CHARACTER
	ADD	I,LSNCTR	;[150] AND OUTPUT IT WITH BLANK LSN
	PUSHJ	P,GETINC	;[141] GET PROPER CHARACTER
	MOVE	AA,OUTSWT	;GET SWITCHES		[115]
	TLNE	AA,SUPLSN	;SUPPRESS SEQ#		[115]
	JRST	PPA01		;[141] YES
	TRO	A,1		;NO, SET BIT 35		[115]
	JRST	PPA06A		;OUTPUT SEQ# WITH A TAB	[115]
PPA09:	MOVE	AA,OUTSWT	;GET SWITCHES
	TLNE	AA,SUPLSN	;SUPPRESS SEQ#'S?
	JRST	PPA13		;YES
	TRO	A,1		;SET BIT 35
	AOS	OBF+1		;& OUTPUT SEQ #
	MOVEM	A,@OBF+1
	MOVE	A,OBF+2		;& ADJUST BUFR CTR
	SUBI	A,5
	MOVEM	A,OBF+2
	JRST	PPA03		; CONTINUE

PPA13:	CAIE	CH,15		;[150] ELIMINATE CR (FOR SOS)
	CAIN	CH,11		;IS TERMINATOR A TAB?
	AOSA	OBF+2		;[176] YES, FIX POINTER AND
	JRST	PPA01		;NO, OUTPUT IT
	POPJ	P,		;[176] OMIT IT
;PW	OUTPUT THE ENTIRE BUFFER, FOLLOWED BY A FORM FEED CHARACTER.
;	TO THE SELECTED OUTPUT DEVICE.  BUFFER IS UNCHANGED AND POINTER
;	IS UNMOVED.
;P	IS IDENTICAL TO PWY.
;NP	IS IDENTICAL TO PP...P (P PERFORMED N TIMES).
;I,JP	OUTPUTS (I+1)TH THROUGH JTH CHARACTERS OF BUFFER.  NO FORM
;	FEED IS PUT AT THE END.  BUFFER UNCHANGED; POINTER UNMOVED.

PUNCHA:	MOVEI	D,CPPA		;SELECT PPA FOR OUTPUT INDIRECTLY IN CASE I,JP.
	TRNE	FF,ARG2		;I,JP?
	JRST	TYPE0		;YES. GET STRING ARGUMENTS AND OUTPUT.
	MOVE	E,B		;NO. E:=N
	MOVE	B,CPTR
	ILDB	T,B		;T:=COMMAND CHARACTER FOLLOWING P.
	TRZ	T,40		;FILTER L.C.
	JUMPL	E,CPOPJ		;IF N<0, IGNORE P.
	CHKEO	EO21,PUN1	;OLD STYLE P ALWAYS GIVES FORM FEED
	CAIE	T,"W"		;PW ALWAYS GIVES FORM FEED
	TRO	FF,PCHFLG	;OTHERWISE, FORM GOES OUT ONLY IF FORM CAME IN
PUN1:	PUSHJ	P,PUNCHR	;PUNCH OUT BUFFER
	SKIPE	COMCNT		;IF NO COMMANDS LEFT
	CAIE	T,"W"		;OR COMMAND IS NOT W
	JRST	PUN3		;READ NEXT PAGE
	CAIG	E,1		;ARG DOWN TO 1 YET?
	PUSHJ	P,RCH		;YES, THROW AWAY THE W
PUN4:	MOVE	C,Z
	CAMN	C,BEG		;EMPTY BUFFER?
	TLNN	FF,FINF		;NO. QUIT ON EOF
	SOJG	E,PUN1		;YES. E:=E-1. DONE?
CPOPJ:	POPJ	P,		;YES

PUN2:	MOVE	OU,BEG		;IF NOTHING READ IN, CLEAR THE BUFFER
	MOVEM	OU,PT
	TRZ	FF,FORM		;AND THE FORM FEED FLAG
	JRST	YANK51		;SET Z=BEG & POPJ

PUNCHR:	MOVE	C,BEG		;OUTPUT DATA BUFFER.
	MOVE	B,Z
	MOVEI	D,PPA
	CAME	B,C		;IS PAGE BUFFER EMPTY?
	JRST	TYPE1		;[173]	NO; IF SEQUENCED FILE, START PAGE WITH SEQ#
				;[173]	EDIT 173 OBSOLECES PUNCH1

	TRNE	FF,FORM		;YES, IS THERE A FORM-FEED ON THIS BLANK PAGE?
	JRST	TYPE5		;YES, OUTPUT IT
	POPJ	P,		;NO, DON'T OUTPUT ANYTHING

PUN3:	TLNE	FF,UREAD	;ANY INPUT FILE?
	TLNE	FF,FINF		;DONT TRY TO READ IF NO DATA LEFT
	JRST	PUN2
	PUSHJ	P,YANK1		;RENEW BUFFER
	JRST	PUN4		;CONTINUE
;NJ	MOVE THE POINTER TO THE RIGHT OF THE NTH CHARACTER IN THE
;	BUFFER. (I.E., GIVE "." THE VALUE N.)
;J	SAME AS 0J.

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



;NR	SAME AS .-NJ.

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

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

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

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

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

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

LINE:	TRNE	FF,ARG2		;ERROR IF THERE ARE 2 ARGS
	ERROR	E.TAL
	PUSHJ	P,GETARG	;NO. C:=FIRST STRING ARGUMENT ADDRESS,
				;B:=SECOND STRING ARGUMENT ADDRESS.
	XOR	B,C
	XORM	B,PT
	JRST	RET
;ROUTINE TO RETURN CURRENT ARGUMENT IN B
;ASSUMES A VALUE OF 1 WITH SIGN OF LAST OPERATOR IF THERE IS NO CURRENT ARGUMENT
;CALL	PUSHJ P,CHK2
;	RETURN WITH B:=CURRENT ARG.,+1 OR -1

CHK2:	TROE	FF,ARG		;IS THERE AN ARGUMENT?
	POPJ	P,		;YES. IT'S ALREADY IN B.
CHK22:	LDB	B,[XWD 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:	PUSHJ	P,GETARG	;C:=FIRST STRING ARG. ADDRESS
				;B:=SECOND STRING ARG. ADDRESS
	PUSHJ	P,CHK1		;C:=MAX(C(C),BEG), B:=MIN(C(B),Z)
	MOVEM	C,PT		;PT:=C(C)
	SUB	B,C		;B:=NO. OF CHARACTERS TO KILL.
	JUMPE	B,RET		;IF NONE, RETURN. OTHERWISE, FALL INTO DELETE
;ND	DELETE N CHARACTERS FROM THE BUFFER: IF N IS POSITIVE, DELETE
;	THEM JUST TO THE RIGHT OF THE POINTER; IF N IS NEGATIVE, DELETE
;	THEM JUST TO ITS LEFT.
;D	SAME AS 1D

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



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

CHK:	CAMG	B,Z
	CAMGE	B,BEG
	ERROR	E.POP
	POPJ	P,

;ROUTINE TO PUT STRING ARGUMENT ADDRESSES WITHIN DATA BUFFER
;BOUNDS AND CHECK ORDER RELATION.
;CALL	MOVE C,FIRST STRING ARGUMENT ADDRESS
;	MOVE B,SECOND STRING ARGUMENT ADDRESS
;	PUSHJ P,CHK1
;	RETURN

CHK1:	CAMLE	C,B		;[172]	C>B?	(CHECK FIRST!)
	ERROR	E.SAL
	CAMGE	C,BEG		;[172] C:=MAX(C(C),BEG)
	MOVE	C,BEG		;[172]
	CAMLE	C,Z		;[172] C:=MIN(C(C),Z)
	MOVE	C,Z		;[172]
	CAMGE	B,BEG		;[172] B:=MAX(C(B),BEG)
	MOVE	B,BEG		;[172]
	CAMLE	B,Z		;[172] B:=MIN(C(B),Z)
	MOVE	B,Z		;[172]
	CAMN	C,BEG		;[173]	YES; BEG OF BUFFER?
	JRST	CHK1.5		;[173]	YES
	MOVE	TT,C		;[173]	NO; BEG OF LINE?
	SUBI	TT,1		;[173]	GET PREV CHAR
	IDIVI	TT,5		;[173]	RIGHT HALF OF PTR
	HLL	TT,BTAB(TT1)	;[173]	LEFT HALF OF PTR
	LDB	CH,TT		;[173]	
	PUSHJ	P,CKEOL		;[173]	PREV CHAR = EOL?
	POPJ	P,		;[173]	NO; RETURN
CHK1.5:	TRO	FF,SEQUIN	;[173]	YES; SET FLAG
	POPJ	P,		;[172]	RETURN	(CHANGE COMMENT)
;_ SEARCH

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

;N SEARCH

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

;S SEARCH

SERCH:	SKIPLE	E,B		;E=SEARCH COUNT
	JRST	SERCHA		;POSITIVE ARGUMENT
	TRNE	FF,ARG		;ILLEGAL 0 OR - SRH ARG
	ERROR	E.ISA
SERCHA:	MOVEI	CH,ALT		;USE ALT-MODE DELIMITER IF NO @ SEEN
	TRZN	FF,SLSL		;@ SEEN?
	JRST	SERCHB		;NO, TERMINATOR = ALTMODE
	PUSHJ	P,SKRCH		;YES. CH:=USER SPECIFIED DELIMITER.
	ERROR	E.USR
SERCHB:	MOVEM	CH,B		;B:=SEARCH STRING DELIMITER
	MOVEM	CH,ARGTRM	;SAVE TERMINATOR FOR FS INSERTION
	SETZM	STAB		;CLEAR SEARCH MATRIX
	MOVE	A,[XWD STAB,STAB+1]
	BLT	A,STAB+STABLN-1
	PUSHJ	P,SKRCH		;LOOK AHEAD 1 CHAR
	ERROR	E.USR
	CAIE	CH,(B)		;IS IT THE DELIMITER?
	JRST	SERCHT		;NO, AN ARGUMENT IS GIVEN
	SKIPN	SRHCTR		;YES, USE PREVIOUS SEARCH STRING
	ERROR	E.SNA
	JRST	SERCH0

U ARGTRM,1			;FS, FN 2ND ARG TERMINATOR
;MOVE NEW STRING TO STORAGE

SERCHT:	SETZM	SRHCTR		;CLR STRING CTR
	MOVE	AA,[POINT 7,SRHARG]	;INIT STORAGE PTR
	JRST	SERCHD		;1ST CHAR ALREADY IN
SERCHC:	PUSHJ	P,SKRCH		;GET NEXT CHAR OF CMD STRING
	ERROR	E.USR
SERCHD:	CHKEO	EO21,SERCHE	;IF EO=1, ^R IS JUST TEXT
	CAIE	CH,22		;^R?
SERCHE:	CAIN	CH,21		;^Q?
	JRST	SERCHG		;YES, NEXT CHAR IS TEXT
	CAIN	CH,(B)		;THE DELIMITER?
	JRST	SERCH0		;YES
	CAIN	CH,24		;^T?
	JRST	SERCHU		;YES
	TRNE	F2,TXTCTL	;^T FLAG ON?
	JRST	SERCHF		;YES, ^V AND ^W ARE JUST TEXT
	CAIE	CH,26		;^V?
	CAIN	CH,27		;^W?
	TRO	F2,XMATCH	;YES, SET EXACT MATCH FLAG
SERCHF:	AOS	A,SRHCTR	;BUMP STRING CTR
	CAILE	A,^D80		;STILL FIT IN STORE?
	ERROR	E.STC
	IDPB	CH,AA		;STORE CHARACTER
	JRST	SERCHC		;& GO BACK FOR MORE

SERCHG:	AOS	SRHCTR		;COUNT THE ^R (^Q)
	IDPB	CH,AA		;& STORE IT
	PUSHJ	P,SKRCH		;GET NEXT CHAR
	ERROR	E.USR
	JRST	SERCHF		;STORE IT AS TEXT

SERCHU:	TRC	F2,TXTCTL	;COMPLEMENT CONTROL CMD DISABLING SWITCH
	JRST	SERCHF
;SET UP SEARCH MATRIX

SERCH0:	TRZ	F2,TXTCTL	;REFRESH ^T FLAG
	SETZM	SCESQB		;CLR ^E[...] NEST CTR
	MOVE	B,SRHCTR	;INIT STRING CTR
	MOVE	AA,[POINT 7,SRHARG]	;& POINTER
	MOVSI	D,400000	;INIT MATRIX BIT PTR

SERCH2:	ILDB	CH,AA		;CH:=NEXT SEARCH STRING CHARACTER.
	SKIPN	SCESQB		;GATHERING DATA FOR ^E[...]?
	JRST	.+3		;NO
	SOJL	B,CNTREE	;YES, ERRORS GO TO ?ICE
	JRST	.+2
	SOJL	B,SERCHI	;END OF STRING?
	MOVEI	T,S2TABL	;CK FOR CTL CHAR IN STRING
	TRNE	F2,TXTCTL	;^T FLAG ON?
	MOVEI	T,S3TABL	;YES, USE RESTRICTED TABLE
	PUSHJ	P,DISP1
	CHKEO	EO21,SRCH2B	;IF EO=1, FORCE EXACT MODE
	TRNN	F2,TXTCTL	;IF ^T FLAG ON, ALL ^CHARS ARE LEGAL
	PUSHJ	P,CKNCC		;CK FOR OTHER CTRL-CHARS (THEY ARE ILLEGAL)
SRCH2E:	TRNE	F2,EMATCH	;IGNORE XMATCH FLAG?
	JRST	SRCH2F		;YES, FORCE ACCEPT-EITHER SEARCH
	TRNN	F2,XMATCH	;NO, XMATCH ON?
	TLNE	FF,PMATCH	;NO, PREVAILING EXACT MATCH FLAG ON?
	JRST	SRCH2B		;EMATCH=0 & XMATCH OR PMATCH =1 IMPLIES EXACT MODE
SRCH2F:	CAIL	CH,141		;ACCEPT-EITHER SEARCH MODE
	CAILE	CH,172		;IS IT LOWER CASE ALPHA?
	SKIPA			;NO
	TRZ	CH,40		;YES, MAKE IT UPPER CASE
	CAIL	CH,"A"		;IS IT UPPER CASE ALPHA?
	CAILE	CH,"Z"
	JRST	SERCH4		;NO
	XORM	D,STAB+40(CH)	;ENABLE MATCH ON CORRESP. LC CHAR.
	JRST	SERCH4

SRCH2B:	PUSHJ	P,CASE		;EXACT MODE SEARCH -- ADJUST CASE
SERCH4:	XORM	D,STAB(CH)	;MARK CHARACTER TO MATCH
SERCH5:	SKIPE	SCESQB		;GATHERING DATA FOR A ^E[...]?
	POPJ	P,		;YES
	TLZN	F2,CTLN		;DOES ^N PRECEDE THIS CHAR POSITION?
	JRST	SERCH6		;NO
	ANDCAM	D,STAB+BEGPAG	;YES, CLEAR ALL FAKE BITS
	ANDCAM	D,STAB+ENDPAG
	ANDCAM	D,STAB+SPCTAB
SERCH6:	LSH	D,-1		;MOVE TO NEXT CHAR. POSITION IN MATRIX
	SETZM	SCESQB		;(BASE IS 0)
	JUMPN	D,SERCH2	;36 CHARS SEEN YET? IF NOT CONTINUE.
	JUMPE	B,SERCHI	;TOO MUCH IF STILL ANOTHER CHAR WAITING
	ERROR	E.STL
;SCAN INSERT ARGUMENT IF F-SEARCH

SERCHI:	TRNN	FF,FSRCH	;F-SEARCHING?
	JRST	SERCH1		;NO
	TRZ	F2,TXTCTL	;REFRESH ^T FLAG
	MOVE	CH,ARGTRM	;GET TERMINATOR TO WATCH FOR
	JRST	INSERA		;SCAN INSERT ARGUMENT

SERCHJ:	POP	P,COMBAK	;SAVE COMCNT & CPTR FOR THE INSERTION
	POP	P,CPTBAK
				;THEN FALL INTO SERCH1

;START SEARCHING

SERCH1:	MOVE	AA,D		;END OF SEARCH MARKER
	MOVE	I,PT		;START SEARCHING AT PT
S1:	TRNE	FF,ARG		;IS THERE AN ARGUMENT?
	JUMPLE	E,FND		;YES. SEEN STRING N TIMES?
	MOVE	TT,I		;NO, FORM BYTE PTR WHICH WILL BE
	SUBI	TT,1		;INCREMENTED BEFORE USE
	IDIVI	TT,5
	HLL	TT,BTAB(TT1)
	CAMG	I,BEG		;AT BEG OF BUFR?
	SKIPL	STAB+BEGPAG	;& 1ST SERCH CHAR = BEG OF BUFR CHAR?
	JRST	S3		;NO
	MOVSI	D,200000	;YES, START SEARCH AT 2ND SEARCH CHAR
	MOVE	TT1,TT		;SET DYNAMIC PTR = STATIC PTR
	SETOM	BCOUNT		;FLAG 1ST IS BEGPAG		[117]
	JRST	S4B		;ENTER SEARCH LOOP

S3:	CAML	I,Z		;NO. REACHED TOP OF BUFFER?
	JRST	NOFND		;YES.
	MOVSI	D,400000	;START SEEKING MATCH FOR 1ST CHAR
	MOVE	TT1,TT		;SET DYNAMIC PTR=STATIC PTR
	JRST	S4A
S4:	TDNE	D,STAB+SPCTAB	;IS SPACE/TAB STRING BIT SET?
	JRST	SPTB		;YES
	ADDI	I,1		;LOOK AT NEXT LOC, XCEPT 1ST TIME THRU
S4C:	LSH	D,-1		;ADVANCE TO NEXT CHAR POSITION
S4B:	CAMN	D,AA		;END OF SEARCH TABLE?
	JRST	FND		;YES.
S4A:	ILDB	CH,TT1		;NO, GET NEXT CHAR
	TDNE	D,STAB(CH)	;IS IT A MATCH?
	JRST	S4		;YES, GO TO NEXT TABLE ENTRY.
	AOSN	BCOUNT		;IF WE FAILED WITH BEGPAG	[117]
	JRST	S3		; THEN TRY AGAIN WITH 1ST CHAR	[117]
	AOS	I,PT		;NO MATCH. PT:=PT+1
	IBP	TT		;MOVE STATIC BYTE PTR
	JRST	S3		;KEEP LOOKING
FND:	CAMLE	I,Z		;REACH TOP OF BUFFER?
	JRST	NOFND		;YES. SEARCH FAILED.
	SETOM	SFINDF		;NO. SFINDF:=-1
	MOVE	A,I
	SUB	A,PT		;COMPUTE LENGTH OF SEARCH ARG
	MOVEM	I,PT		;MOVE PT PAST THE STRING
	SOJG	E,S1		;FIND IT N TIMES?
	TRNN	FF,FSRCH	;F-SEARCH?
	JRST	FND3		;NO
	MOVE	C,VVAL		;YES, GET INSERT SIZE
	SUBI	C,(A)		;INSERT MINUS DELETE
	MOVNS	A		;SET PT TO BEGINNING OF STRING FOUND
	ADDM	A,PT
	CAIE	C,0		;[201] SKIP FOR SAME LENGTH STRINGS
	PUSHJ	P,NROOM		;STRETCH OR SCRUNCH THE HOLE
	MOVE	B,ARGTRM	;GET TERMINATOR TO LOOK FOR
	MOVE	A,COMBAK	;RESET COMCNT & CPTR TO BEGINNING
	MOVEM	A,COMCNT	;  OF INSERT ARGUMENT
	MOVE	A,CPTBAK
	MOVEM	A,CPTR
	PUSHJ	P,INS1B		;INSERT THE 2ND ARG
	PUSHJ	P,ZEROTT	;DO AUTO-TYPE IF REQUIRED
	MOVE	CH,ARGTRM
	SKIPN	VVAL		;IS THERE A NON-NULL INSERT?
	CAIE	CH,ALT		;ALTMODE TERMINATOR?
	JRST	FND2		;NO
	TLO	F2,NALTFS	;[174] SET NULL REPLACEMENT ALTMODE
				;[174]  DELIMITED F SEARCH FLAG
	JRST	ALTM1		;YES, FS<STRING>$$ TERMINATES EXECUTION
FND3:
IFN VC,<MOVEM	A,VVAL>		;SAVE LENGTH OF STRING
	PUSHJ	P,ZEROTT	;AUTOTYPE
FND2:	TRZN	FF,COLONF	;COLON MODIFIER?
	JRST	RET		;NO

FFOK:	MOVNI	A,1		;YES. RETURN VALUE OF -1
	JRST	VALRET

U COMBAK,1			;STORE FOR COMCNT DURING FS, FN
U CPTBAK,1			;DITTO CPTR
;AUTOTYPE AFTER SUCCESSFUL SEARCHES
;  IF AUTOF IS NON-ZERO
;  INCLUDE POINTER MARKER = ASCII CHAR IN AUTOF IF AUTOF > 0

ZEROTT:	TRNE	FF,COLONF	;NO AUTOTYPE ON COLON SEARCHES
	POPJ	P,
	SKIPL	-1(P)		;IN AN ITERATION?
	SKIPN	AUTOF		;AUTOTYPE WANTED?
	POPJ	P,
	TRO	FF,ARG		;DO 0T
	SETZ	B,
	PUSHJ	P,TYPE
	HRRZ	CH,AUTOF
	SKIPL	AUTOF		;PTR MARKER WANTED?
	PUSHJ	P,TYOM		;YES
	MOVEI	B,1		;DO 1T
	PUSHJ	P,TYPE
	TRZ	FF,ARG
	POPJ	P,
NOFND:	TDNN	D,STAB+ENDPAG	;ENDPAG GOOD FOR A MATCH HERE?
	JRST	NOFND3		;NO
	LSH	D,-1		;YES, BUT ONLY IF THIS IS LAST SRH CHAR
	CAMN	D,AA
	JRST	FND		;ENDPAG MATCHES!
NOFND3:	MOVE	I,BEG		;SEARCH FAILED
	MOVEM	I,PT		;PT=BEG
	SETZM	SFINDF		;SFINDF=0
	TRNE	FF,PCHFLG+FINDR	;S SEARCH?
	JRST	NOFND1		;NO.


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


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



NOFND1:	MOVEM	E,SRHCNT	;YES. SAVE SEARCH COUNT
	MOVEM	AA,SRHAA	;& SAVE END OF MATRIX MARKER
	MOVEI	B,1		;PUNCH 1 PAGE ONLY
	TRNE	FF,PCHFLG	;N SEARCH?
	PUSHJ	P,PUNCHA	;YES. PUNCH THIS BUFFER AND REFILL IT.
	TLNN	FF,UREAD	;ANY INPUT FILE?
	JRST	BEGIN1		;NO
	TLNE	FF,FINF		;MORE DATA?
	TRNE	FF,FORM
	JRST	NOFND4		;YES
	MOVE	E,BEG		;EOF & NO FORM SEEN
	CAMN	E,Z		;CHECK BUFFER CONTENTS
	JRST	BEGIN1		;NO MORE DATA
NOFND4:	TRNE	FF,FINDR	;LEFT ARROW SEARCH?
	PUSHJ	P,YANK1		;YES. FILL BUFFER.
	MOVE	E,SRHCNT	;RESTORE SEARCH COUNT.
	MOVE	D,SRHAA		;RESTORE END OF STRING MARKER
	JRST	SERCH1		;RESUME SEARCH


NOFND2:	SKIPGE	(P)		;IN AN ITERATION?
	JRST	BEGIN2		;YES. RETURN VALUE OF 0
	ERROR	E.SRH

U SRHCNT,1			;SEARCH COUNT STORE
U SRHAA,1			;END OF SEARCH MATRIX MARKER

SRHMOD:	EXP	SRCHSW		;DEFAULT SEARCH MODE
;CNTR S MATCHES ANY SEPARATOR CHARACTER (I.E., ANY CHARACTER NOT
;A LETTER, NUMBER, PERIOD, DOLLAR SIGN OR PER CENT SYMBOL)

CNTRS:	MOVE	T,[-STABLN+3,,1] ;SET ALL CURRENT BITS EXCEPT NULL & SPCTAB
	PUSHJ	P,SETSTB	;  & ENDPAG, BUT DO INCLUDE BEGPAG
	XORM	D,STAB+"."	;NOW, SCRATCH ALL SYMBOL CHARS
	XORM	D,STAB+"%"
	XORM	D,STAB+"$"
	MOVE	T,[-^D10,,"0"]	;DIGITS
	PUSHJ	P,SETSTB
CNTLEA:	MOVE	T,[-^D26,,"A"]	;UC CHARS (ENTRY FOR ^EA)
	PUSHJ	P,SETSTB
CNTLEV:	MOVE	T,[-^D26,,141]	;LC CHARS (ENTRY FOR ^EV)
	JRST	CNTRXX

;CNTR X MATCHES ANY ARBITRARY CHARACTER

CNTRX:	MOVE	T,[-STABLN+4,,1] ;WANT TO ACCEPT ANYTHING AS A MATCH
CNTRXX:	PUSHJ	P,SETSTB	;  EXCEPT NULL & SPCTAB & BEGPAG & ENDPAG
	JRST	SERCH5

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

CNTRN:	MOVE	T,[-STABLN+4,,1]	;STAB CTR & PTR
	PUSHJ	P,SETSTB	;SET CURRENT POSITION BIT FOR ALL CHARS
	TLO	F2,CTLN		;SET ^N FLAG
	JRST	SERCH2

;SET STAB BITS AS INDICATED BY T & D

SETSTB:	XORM	D,STAB(T)
	AOBJN	T,.-1
	POPJ	P,

;DISPATCH TABLE FOR 2ND SCAN OF SEARCH STRING

S2TABL:	XWD	CNTRE,05	;^E
	XWD	CNTRX,30	;^X
	XWD	CNTRN,16	;^N
	XWD	CNTRS,23	;^S
	XWD	CNTRV,26	;^V
	XWD	CNTRW,27	;^W
	XWD	CNTRL,34	;^\
	XWD	CNTRU,36	;^^
S3TABL:	XWD	CNTRT,24	;^T
	XWD	CNTRQ,21	;^Q
	XWD	CNTRR,22	;^R
	XWD	CNTR33,ALT	;ALTMODE
	XWD	0,0		;END OF LIST
;^E COMMANDS

CNTRE:	CHKEO	EO21,SERCH4	;IF EO=1, ^E IS JUST TEXT
	ILDB	CH,AA		;GET CHAR. AFTER ^E
	SOJL	B,CNTREE	;NONE THERE
	MOVEI	T,S4TABL	;GO TO PROPER ^E COMMAND
	PUSHJ	P,DISPAT	;  TO SET SPECIFIED CHARACTER BITS
CNTREE:	ERROR	E.ICE

;DISPATCH TABLE FOR ^E COMMANDS

S4TABL:	XWD	CNTLEA,"A"	;^EA	ACCEPT ANY ALPHA
	XWD	CNTLEV,"V"	;^EV	ACCEPT ANY L.C. ALPHA
	XWD	CNTLEW,"W"	;^EW	ACCEPT ANY U.C. ALPHA
	XWD	CNTLED,"D"	;^ED	ACCEPT ANY DIGIT
	XWD	CNTLEL,"L"	;^EL	ACCEPT ANY E-O-L CHAR.
	XWD	CNTLES,"S"	;^ES	ACCEPT A STRING OF SPACES OR TABS
	XWD	CNTLEN,74	;^E<NNN>	ACCEPT ASCII <NNN>
	XWD	CNTLEB,133	;^E[A,B,C]	ACCEPT A OR B OR C
	XWD	0,0		;END OF LIST

U SCESQB,1			;SEARCH FOR ^E[...] NESTING COUNTER
;^EW

CNTLEW:	MOVE	T,[-^D26,,"A"]	;UPPER CASE ALPHABETIC CHARS.
	JRST	CNTRXX

;^ED

CNTLED:	MOVE	T,[-^D10,,"0"]	;DIGITS
	JRST	CNTRXX

;^EL

CNTLEL:	MOVE	I,Z		;IS LAST CHAR IN BUFR AN EOL?
	CAMG	I,BEG
	JRST	CNTLE3		;NO
	SUBI	I,1
	PUSHJ	P,GET
	CAIL	CH,12
	CAILE	CH,14
CNTLE3:	XORM	D,STAB+ENDPAG	;NO, ENDPAG IS GOOD FOR A MATCH
	MOVE	T,[-3,,12]	;LF, VT, FF
	JRST	CNTRXX

;^ES

CNTLES:	XORM	D,STAB+40	;SPACE
	XORM	D,STAB+11	;TAB
	XORM	D,STAB+SPCTAB	;& SPACE/TAB STRING BIT
	JRST	SERCH5

;SKIP OVER A STRING OF SPACES AND/OR TABS WHILE SEARCHING

SPTB:	ADDI	I,1		;ADVANCE TO NEXT BUFFER LOCATION
	CAML	I,Z		;END-OF BUFFER?
	JRST	S4C		;YES, NO MORE SPACE/TABS
	MOVEM	TT1,ERR1	;SAVE CURRENT BYTE PTR (USING ERR1 AS TMP)
	ILDB	CH,TT1		;LOOK AT NEXT CHAR
	CAIE	CH,40		;IS IT A SPACE?
	CAIN	CH,11		;OR TAB?
	JRST	SPTB		;YES, KEEP SKIPPING
	MOVE	TT1,ERR1	;NO, END OF SPACE/TAB STRING
	JRST	S4C		;  RESTORE BYTE-POINTER & CONTINUE SEARCH
;^E[A,B,C,...]

CNTLEB:	AOS	SCESQB		;BUMP ^E[...] NEST CTR
CNTLE0:	PUSHJ	P,SERCH2	;GET CHAR FROM OR-STRING
	ILDB	CH,AA		;GET SEPARATOR
	SOJL	B,CNTREE
	CAIN	CH,","		;MORE TO GO?
	JRST	CNTLE0		;COMMA IMPLIES YES
	CAIE	CH,"]"		;END OF OR-STRING?
	ERROR	E.ICE
	SOS	SCESQB		;DECREMENT ^E[...] NEST CTR
	JRST	SERCH5		;YES

;^E<NNN>	(NNN IS OCTAL FOR A SINGLE ASCII CHAR)

CNTLEN:	MOVEI	A,0		;CLR NUMBER ACCUMULATOR
CNTLE1:	ILDB	CH,AA		;GET A DIGIT
	SOJL	B,CNTREE	;SHOULDN'T RUN OUT
	CAIN	CH,76		;RIGHT ANGLE-BRACKET?
	JRST	CNTLE2		;YES, END OF NUMBER
	CAIL	CH,"0"		;IS IT A DIGIT?
	CAILE	CH,"7"
	ERROR	E.ICE
	LSH	A,3		;YES, SCALE UP THE PREVIOUS VALUE
	ADDI	A,-60(CH)	;AND ADD IN THE NEW DIGIT
	JRST	CNTLE1		;TRY FOR MORE
CNTLE2:	ANDI	A,177		;EXTRACT AN ASCII CHAR.
	XORM	D,STAB(A)	;AND SET THE CORRESP. BIT
	JRST	SERCH5
;^R IS SAME AS ^Q (PROVIDED EO NOT = 1)
;EXCEPT IT DOESN'T CAUSE RUBOUT PROBLEMS

CNTRR:	CHKEO	EO21,SERCH4	;IF EO=1, ^R IS JUST TEXT

;^Q CAUSES NEXT CHAR TO BE TAKEN AS TEXT EVEN IF IT IS
;A CTRL CHAR. OR THE TERMINATOR

CNTRQ:	ILDB	CH,AA		;GET NEXT CHAR
	SOJA	B,SRCH2E	;& PROCESS AS ORDINARY TEXT

;^V CAUSES NEXT CHAR TO BE TAKEN AS LOWER CASE
;^V^V SETS LOWER CASE MODE UNTIL FURTHER NOTICE

CNTRV:	CHKEO	EO21,SERCH4	;IF EO=1, ^V IS JUST TEXT
	PUSHJ	P,C.V		;SET ^V FLAGS
	JRST	SERCH2

;^W CAUSES NEXT CHAR TO BE TAKEN WITHOUT CONVERSION
;^W^W SETS STANDARD CASE MODE UNTIL FURTHER NOTICE

CNTRW:	CHKEO	EO21,SERCH4	;IF EO=1, ^W IS JUST TEXT
	PUSHJ	P,C.W		;SET ^W FLAGS
	JRST	SERCH2

;FIRST ^\ CHANGES MATCH MODE TO ACCEPT EITHER UC OR LC
;SECOND ONE TURNS ACCEPT EITHER FLAG OFF

CNTRL:	CHKEO	EO21,SERCH4	;IF EO=1, ^\ IS JUST TEXT
	TRC	F2,EMATCH	;COMPLEMENT ACCEPT EITHER FLAG
	JRST	SERCH2

;IF SEARCHING FOR ALTMODE, AND IF EO=1, 033 & 175 ARE MATCHES

CNTR33:	CHKEO	EO21,.+2	;EO=1?
	JRST	SERCH4		;NO, ACCEPT 033 ONLY
	XORM	D,STAB+175	;YES, MARK 175 AS ACCEPTABLE MATCH
	JRST	SERCH4		;& 033

;^^ CAUSES IMMEDIATELY FOLLOWING @,[,\,],^,_ TO BE CONVERTED TO LC RANGE

CNTRU:	CHKEO	EO21,SERCH4	;IF EO=1, ^^ IS TEXT
	ILDB	CH,AA		;GET NEXT CHAR
	PUSHJ	P,CVTSPC	;CONVERT TO LC IF @, ETC
	SOJA	B,SRCH2E

;^T DISABLES ALL CNTRL COMMANDS EXCEPT ^Q,^R,^T AND ALLOWS ALL OTHER
;CNTRL CHARS AS TEXT.  THE NEXT ^T TURNS THE ^T SWITCH BACK OFF.

CNTRT:	CHKEO	EO21,SERCH4	;IF EO=1, ^T IS TEXT
	TRC	F2,TXTCTL
	JRST	SERCH2
;F SEARCHES

FCMD:	PUSHJ	P,SKRCH		;GET CHAR AFTER F
	ERROR	E.MEF
	TRO	FF,FSRCH	;SET F-SEARCH FLAG
	TRZ	CH,40		;UPPER OR LOWER CASE		[114]
	CAIN	CH,"S"		;FS?
	JRST	SERCH		;YES
	CAIN	CH,"N"		;FN?
	JRST	SERCHP		;YES
	ERROR	E.IFC
;<>	ITERATION BRACKETS.  COMMAND INTERPRETATION IS SENT
;	BACK TO THE < WHEN THE > IS ENCOUNTERED.

LSSTH:	PUSH	P,ITERCT	;SAVE ITERATION COUNT
	PUSH	P,COMAX		;[161] KEEP MAX. FOR GARBAGE COLLECTION
	PUSH	P,CPTR		;SAVE COMMAND STATE
	PUSH	P,COMCNT
	SETOM	ITERCT		;ITERCT:=-1
	PUSH	P,ITERCT	;-1 FLAGS ITERATION ON PDL
	TRZN	FF,ARG		;IS THERE AN ARGUMENT?
	JRST	RET		;NO
	JUMPLE	B,INCMA1	;IF ARG NOT > 0, SKIP OVER <>
	MOVEM	B,ITERCT	;YES. ITERCT:=ARGUMENT
	JRST	RET


GRTH:	SKIPGE	A,(P)		;IS THERE A LEFT ANGLE BRACKET?
	JRST	GRTH2		;YES. OTHERWISE ITS A MISSING < OR
	SOJE	A,GRTH9		;SOMETHING LIKE <...(...>
	ERROR	E.MLA
GRTH2:	SOSN	ITERCT		;ITERCT:=ITERCT-1. DONE?
	JRST	INCMA2		;YES
	MOVE	A,-2(P)		;NO. RESTORE COMMAND STATE TO START OF ITERATION.
	MOVEM	A,CPTR
	MOVE	A,-1(P)
	MOVEM	A,COMCNT
	TRNE	FF,TRACEF	;TRACING?
	PUSHJ	P,CRR		;YES. OUTPUT CRLF
	JRST	RET

GRTH9:	ERROR E.MRP

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

SEMICL:	SKIPL	(P)		;ERROR IF NOT IN <...>
	ERROR	E.SNI
	TRNN	FF,ARG		;YES. IF NO ARG,
	MOVE	B,SFINDF	;USE LAST SEARCH SWITCH (0 OR -1).
	JUMPL	B,CD		;IF ARG <0, JUST RET + EXECUTE LOOP
INCMA1:	MOVEI	TT,">"		;SKAN FOR >
	MOVEI	TT1,"<"		;IGNORE <...> STRINGS
	PUSHJ	P,SKAN

	ERROR	E.MRA
INCMA2:	SUB	P,[XWD 3,3]	;[161] POP OUT A LEVEL
	POP	P,COMAX		;[161]
	POP	P,ITERCT
	JRST	RET



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

EXCLAM:	PUSHJ	P,SKRCH		;LOOK FOR NEXT !
	ERROR	E.UTG
	CAIE	CH,"!"
	JRST	EXCLAM
	JRST	RET
;OTAG$	GO TO THE TAG NAMED TAG.  THE TAG MUST APPEAR IN THE 
;	CURRENT MACRO OR COMMAND STRING.

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

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

OGNF:	PUSH	P,CPTR
	PUSH	P,B
	MOVEI	D,STAB
OGW:	CAIG	D,STAB+STABLN-2	;[156] IS THE TAG TOO LONG?
	JRST	OG1		;[156] NO, CONTINUE
	ERROR	E.TTL
OG1:	PUSHJ	P,SKRCH		;GET NEXT COMMAND CHAR

	ERROR	E.MEO
	MOVEM	CH,(D)		;STAB ... _ TAG
	CAIE	CH,ALT
	AOJA	D,OGW
	MOVEI	A,"!"		;TAG TERMINATOR
	MOVEM	A,(D)
	SETZM	1(D)
	MOVE	B,COMCNT	;MAKE PTR TO START OF THIS COMMAND LEVEL
	SUB	B,COMAX
	IDIVI	B,5
	ADD	B,CPTR
	JUMPE	E,OG7		;NO REMAINDER
	SOS	B
	MOVMS	E
	JRST	.(E)
	IBP	B
	IBP	B
	IBP	B
	IBP	B
OG7:	MOVEM	B,CPTR
	MOVE	B,COMAX		;GET # OF CMD CHARS AT THIS LEVEL
	MOVEM	B,COMCNT
OG2:	MOVEI	TT,"!"		;SKAN FOR !
	MOVEI	TT1,-1		;NO SECONDARY CHAR.
	PUSHJ	P,SKAN
	ERROR	E.TAG
	TRO	F2,NOTRAC	;DON'T TYPE EVERY TAG WHILE TRACING
	MOVEI	E,STAB		;INIT SEARCH STRING TO 1ST CHAR AFTER !
OG5:	SKIPN	(E)		;OVER STRING?
	JRST	OG3		;YES
	PUSHJ	P,SKRCH		;NO. GET A CHAR
	ERROR	E.TAG
	CAMN	CH,(E)		;MATCH ?
	AOJA	E,OG5		;YES. MOVE ON.
	CAIN	CH,"!"		;NO, ARE WE AT END OF A TAG?
	JRST	OG2		;YES, LOOK FOR ANOTHER
	MOVEI	E,"!"		;NO, SKIP TO NEXT !
OG6:	PUSHJ	P,SKRCH		;GET NEXT CHAR OF TAG
	ERROR	E.UTG
	CAIE	CH,(E)		;!?
	JRST	OG6		;NO, KEEP GOING
	JRST	OG2		;YES, LOOK FOR ANOTHER TAG

OG3:	TRZ	F2,NOTRAC	;RE-ENABLE TRACING
	POP	P,A		;GET INDEX TO SYMBOL TABLE
	POP	P,SYMS(A)	;SAVE POSITION OF THIS O COMMAND
	MOVE	B,COMCNT	;SAVE COMCNT FOR THIS TAG
	MOVEM	B,CNTS(A)
	MOVE	B,CPTR		;SAVE TAG POSITION IN COMMAND STRING
	MOVEM	B,VALS(A)
	JRST	RET


OGFND:	MOVE	A,VALS(B)
	MOVEM	A,CPTR
	MOVE	A,CNTS(B)
	MOVEM	A,COMCNT
	JRST	RET
;N"G	HAS NO EFFECT IF N IS GREATER THAT 0.  OTHERWISE,
;	SEND COMMAND INTERPRETATION TO NEXT MATCHING '.
;	THE " AND ' MATCH SIMILAR TO ( AND ).
;N"L	SEND COMMAND TO MATCHING ' UNLESS N<0.
;N"N	SEND COMMAND TO MATCHING ' UNLESS N NOT = 0.
;N"E	SEND COMMAND TO MATCHING ' UNLESS N=0.
;N"F	SEND COMMAND TO MATCHING ' UNLESS N=0.
;N"U	SEND COMMAND TO MATCHING ' UNLESS N=0.
;N"T	SEND COMMAND TO MATCHING ' UNLESS N<0.
;N"S	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 (%).
;N"A	SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
;	CHARACTER IS ALPHABETIC.
;N"D	SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
;	CHARACTER IS A DIGIT.
;N"V	SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
;	CHARACTER IS LOWER CASE ALPHABETIC.
;N"W	SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
;	CHARACTER IS UPPER CASE ALPHABETIC.

DQUOTE:	TRNN	FF,ARG		;ERROR IF NO ARG BEFORE "
	ERROR	E.NAQ
	PUSHJ	P,SKRCH		;GET CHAR AFTER "
	ERROR	E.MEQ
	MOVEI	T,DQTABL	;INDEX DISPATCH TABLE
	PUSHJ	P,DISPAT	;DISPATCH FOR CHAR. AFTER "
	ERROR	E.IQC

;" COMMAND DISPATCH TABLE

DQTABL:	XWD	DQ.G,"G"
	XWD	DQ.L,"L"
	XWD	DQ.N,"N"
	XWD	DQ.E,"E"
	XWD	DQ.C,"C"
	XWD	DQ.L,"T"
	XWD	DQ.E,"F"
	XWD	DQ.L,"S"
	XWD	DQ.E,"U"
	XWD	DQ.A,"A"
	XWD	DQ.D,"D"
	XWD	DQ.V,"V"
	XWD	DQ.W,"W"
	XWD	0,0		;END OF LIST
;EXECUTE INDIVIDUAL " COMMANDS

DQ.V:	TRZN	B,40		;EXECUTE "V
	JRST	NOGO		;IF BIT 30 NOT ON IT CAN'T BE L.C.
DQ.A:	TRZ	B,40		;EXECUTE "A -- TREAT UC & LC ALIKE
DQ.W:	CAIL	B,"A"		;EXECUTE "W
	CAILE	B,"Z"
	JRST	NOGO		;IT IS NOT A LETTER
	JRST	RET		;IT IS A LETTER
DQ.D:	CAIL	B,"0"		;EXECUTE "D
	CAILE	B,"9"
	JRST	NOGO		;IT IS NOT A DIGIT
	JRST	RET		;IT IS A DIGIT
DQ.C:	PUSHJ	P,CKSYM1	;EXECUTE "C
	JRST	RET		;IT IS A SYMBOL CHAR
	JRST	NOGO		;IT'S NOT A SYMBOL CHAR
DQ.G:	MOVNS	B		;EXECUTE "G
DQ.L:	JUMPL	B,RET		;EXECUTE "L
	JRST	NOGO		;TEST FAILED
DQ.N:	JUMPN	B,RET		;EXECUTE "N
	JRST	NOGO		;TEST FAILED
DQ.E:	JUMPE	B,RET		;EXECUTE "E, "F, "U
NOGO:	MOVEI	TT,47		;SKAN FOR '
	MOVEI	TT1,42		;IGNORE "...' STRINGS
	PUSHJ	P,SKAN
	ERROR	E.MAP
	JRST	RET
;ROUTINE TO TEST CHARACTER FOR $,%,.,0-9,A-Z
;CALL	PUSHJ P,CKSYM
;	RETURN IF $,%,.,0-9,A-Z
;	RETURN ON ALL OTHER CHARACTERS

CKSYM:	MOVEI	B,(CH)		;ENTER AT CKSYM1 IF CHAR ALREADY IN B
CKSYM1:	CAIE	B,"$"		;$ OR %?
	CAIN	B,"%"
	POPJ	P,		;YES
	CAIN	B,"."		;NO. POINT?
	POPJ	P,		;YES.
	CAIGE	B,"0"		;NO. DIGIT OR LETTER?
	JRST	CPOPJ1		;NO
	CAIG	B,"9"		;MAYBE. DIGIT?
	POPJ	P,		;YES.
CKSYM2:	TRZ	B,40		;LC TO UC
	CAIL	B,"A"		;LETTER?
	CAILE	B,"Z"
	JRST	CPOPJ1		;NO.
	POPJ	P,		;YES
;ERROR MESSAGE PRINTOUT

ERRP:	TRO	FF,QMFLG	;ERROR PROCEDURE IN PROGRESS
;ERRP+1/2  [164]
	MOVE	B,.JBREL	;[164] SAVE CURRENT CORE
	MOVEM	B,RELSAV	;[164]
	HRLZ	B,.JBUUO	;GET ERROR CODE
	CLRBFI			;CLEAR TTY
	PUSHJ	P,TTOPEN
	MOVEI	CH,"?"		;TYPE ?
	PUSHJ	P,TYOM
	HLLZ	TT,B		;PRINT  CODE
	PUSHJ	P,SIXBMS
	LDB	D,[POINT 4,.JBUUO,12]	;GET SPECIAL TYPEOUT FLAG
	JUMPE	D,ERRP04	;NO SPECIAL ERROR EXTENSION
	CAIN	D,3		;FLAG=EE3?
	JRST	ERRP05		;YES
	MOVEI	CH,"-"		;NO, TYPE EXTENSION (MONITOR ERROR CODE)
	PUSHJ	P,TYOM
	LDB	B,[POINT 15,XEXT,35]	;[175] GET UUO ERROR FLAG
	SOJLE	D,ERRP03	;1 IMPLIES IT IS A UUO ERROR
	HRRZI	B,740000	;GET I-O ERROR FLAGS
	AND	B,ARGSTO
ERRP03:	PUSHJ	P,OCTMS		;TYPE ERROR CODE IN OCTAL
ERRP04:	MOVE	B,ERRLEN	;HOW MUCH MESSAGE WANTED?
	JUMPGE	B,ERRP02	;AT LEAST 1ST FULL LINE
	PUSHJ	P,CRR		;HE WANTS ONLY ?XXX, SO END LINE
	JRST	ERRP5		;BETTER SEE IF HE WANTS MORE
ERRP02:	MOVEI	CH,11		;1ST LINE OF MESSAGE AUTOMATIC
	PUSHJ	P,TYOM		;TYPE TAB
ERRP0:	INIT	ERRCHN,0	;INIT INPUT FROM SYS:
	SIXBIT	/SYS/
	XWD	0,ERRHDR
	JRST	NOERRS		;CAN'T
	MOVE	B,RELSAV	;[177] SETUP FOR GRABJR CALL BELOW
	MOVE	TT,Z		;GET ACTUAL FIRST FREE LOC
	IDIVI	TT,5
	ADDI	TT,2
	MOVEI	T,<BUFSIZ+3>*2(TT)	;ROOM FOR 2 DISK BUFFERS?
	CAML	T,.JBFF
	PUSHJ	P,GRABJR	;NO, GET 1K CORE
	EXCH	TT,.JBFF	;GET INPUT BUFFER
	INBUF	ERRCHN,2
	MOVEM	TT,.JBFF
	MOVSI	A,(SIXBIT /ERR/)
	MOVEM	A,TECERR+1	;SET UP FILE EXTENSION
	SETZM	TECERR+2
	SETZM	TECERR+3
	HRL	A,JOBN		;GET JOBNUMBER
	HRRI	A,JBTPRG	;& JOBNAME TABLE ADDRESS
	GETTAB	A,		;GET JOBNAME
	JRST	ERRP01		;CAN'T
	MOVEM	A,TECERR	;SET FILE NAME
	LOOKUP	ERRCHN,TECERR	;LOOKUP JOBNAME.ERR
	JRST	ERRP01		;NOT THERE, SO USE TECO.ERR
	JRST	ERRP1		;FOUND
ERRP01:	MOVE	A,[SIXBIT /TECO/]
	MOVEM	A,TECERR
	LOOKUP	ERRCHN,TECERR	;FIND TECO.ERR
	JRST	NOERRS		;NOT ON SYS:
ERRP1:	PUSHJ	P,ERRCHR	;GET A CHAR. FROM TECO.ERR
	CAIE	CH,"?"		;LOOK FOR START OF A MESSAGE
	JRST	ERRP1		;NO, TRY NEXT
	SETZ	T,		;YES, INIT RESULT ACCUMULATOR
	HRRZ	D,.JBUUO	;GET ERROR CODE AGAIN
ERRP2:	PUSHJ	P,ERRCHR	;GET NEXT CHAR
	CAIN	CH,11		;TAB?
	JRST	ERRP3		;YES
	LSH	T,6		;SCALE PREV. RESULT UP ONE CHAR
	ADDI	T,-40(CH)	;ADD NEW SIXBIT CHAR TO PREVIOUS RESULT
	JRST	ERRP2
ERRP3:	CAME	D,T		;IS THIS CODE EQUAL TO THE ERROR CODE?
	JRST	ERRP1		;NO, KEEP GOING
	PUSHJ	P,ERRPRN	;YES, PRINT EVERYTHING UP TO THE LF
	TRO	FF,EMFLAG	;NOTE THAT THE 1ST LINE HAS BEEN TYPED
	JRST	ERRP5
NOERRS:	TRO	FF,XPLNFL+EMFLAG	;CANT DO /
	JSP	A,CONMES	;PRINT BAD NEWS
	ASCIZ	/
?EEE	Unable to Read Error Message File
/
ERRP5:	MOVE	A,COMAX
	SUB	A,COMCNT
	MOVEM	A,ERR1		;ERR1:=COMAX-COMCNT
	MOVE	A,CPTR
	MOVEM	A,ERR2		;ERR2:=CPTR
	MOVE	A,ERRLEN	;DOES HE WANT THE WHOLE THING AUTOMATICALLY?
	TRNN	FF,XPLNFL	;[162] IF SO, CAN WE GIVE IT TO HIM?
	JUMPG	A,XPLAIN	;YES

ERRP6:	TLZN	FF,CCLFLG	;GET HERE FROM A "TECO" COMMAND?
	JRST	ERRP6A		;NO
	LDB	CH,[POINT 15,XEXT,35]	;[175] CHECK FOR ?FNF-00
	JUMPN	CH,ERRP6A	;IT'S NOT
	HRRZ	CH,.JBUUO	;MAYBE
	CAIN	CH,(SIXBIT /FNF/)
	JRST	DECDMP		;YES, POP UP TO MONITOR
ERRP6A:	MOVEI	CH,"*"		;TYPE * FOR NEXT COMMAND
	PUSHJ	P,TYOM
	TRO	FF,DDTMF
	PUSHJ	P,TYI		;GET A CHARACTER NOW
	CAIN	CH,"?"		;QUESTION MARK?
	JRST	ERRTYP		;YES, TYPE BAD COMMAND
	TRNE	FF,XPLNFL	;EXPLANATION TYPED YET?
	JRST	ERRP7		;YES, CAN'T DO THAT AGAIN
	CAIE	CH,"/"		;NO, IS IT A SLASH?
	JRST	ERRP7		;NO
	TRNN	FF,EMFLAG	;YES, 1ST LINE DONE YET?
	JRST	ERRP0		;NO
	JRST	XPLAIN		;OK, TYPE MORE EXPLANATION OF ERROR

ERRP7:	RELEAS	ERRCHN,
	TRNN	FF,XPLNFL+EMFLAG	;MED OR LONG MSG TYPED?	[125]
	JRST	GOE			;NO, SKIP CORE CONTRACTN[125]
	MOVE	B,RELSAV	;GO BACK TO CORE WE HAD BEFORE
	CORE	B,
	JFCL			;REDUCTION WON'T FAIL
	JRST	GOE		;GET REST OF COMMAND

U TECERR,4			;LOOKUP SPECS FOR TECO.ERR
U ERRHDR,3			;RING HEADER FOR TECO.ERR
U RELSAV,1			;STORE FOR .JBREL
U ARGSTO,1			;STORE FOR ARGUMENT (IF ANY)
ERRPRN:	PUSHJ	P,ERRCHR	;GET A CHAR FROM ERR. FILE
ERRPR2:	CAIE	CH,16		;^N?
	JRST	ERRPR3		;NO, SKIP
	PUSHJ	P,ERRCHR	;GET 1ST DIGIT AFTER ^N
	MOVEI	T,-60(CH)
	IMULI	T,^D10		;PUT IT IN TEN'S PLACE
	PUSHJ	P,ERRCHR	;GET 2ND DIGIT
	ADDI	T,-60(CH)
	ROT	T,-1		;DIVIDE TOTAL BY 2 & SAVE BIT 35
	HLRZ	CH,ETABL(T)	;GET LEFT SIDE ADDR IN CASE EVEN
	TLNE	T,400000	;EVEN OR ODD?
	HRRZ	CH,ETABL(T)	;ODD, GET ADDR FROM RIGHT SIDE
	JRST	(CH)		;TYPE SPECIAL INFORMATION

ERRPR3:	PUSHJ	P,TYOM		;PRINT NORMAL CHARS.
	CAIE	CH,12		;LF?
	JRST	ERRPRN		;NO
	POPJ	P,

;GET A CHARACTER FROM SYS:TECO.ERR

ERRCHR:	SOSG	ERRHDR+2	;ANY CHARS. IN BUFFER?
	JRST	ERRCH2		;NO
ERRCH1:	ILDB	CH,ERRHDR+1	;YES, GET NEXT
	JUMPE	CH,ERRCHR	;IGNORE NULLS
	POPJ	P,
ERRCH2:	IN	ERRCHN,0	;GET NEXT BUFFER
	JRST	ERRCH1		;OK, NOW GET A CHAR.
ERRCH3:	POP	P,A		;UNABLE TO READ TECO.ERR
	JRST	NOERRS

;GET 1K CORE FOR ERROR MESSAGE FILE READ-IN

GRABJR:	ADDI	B,^D1024	;ADD 1K
	CORE	B,
	JRST	ERRCH3		;CAN'T GET IT
	POPJ	P,

;CAN'T PRINT ERROR FILE BECAUSE OF NO CORE

ERRP05:	TRO	FF,XPLNFL+EMFLAG
	JSP	A,CONMES
	ASCIZ	/	Storage Capacity Exceeded
/
	JRST	ERRP5
;ROUTINE TO TYPE C(TT) IN SIXBIT
;CALL	MOVE TT,[SIXBIT /MESSAGE/]
;	PUSHJ P,SIXBMS
;	RETURN


SIXBMS:	SKIPN	CH,TT		;ALL SPACES?
	JRST	SIXBM2		;YES
	MOVNI	B,6
	MOVE	E,[POINT 6,TT]
	ILDB	CH,E
	JUMPE	CH,CPOPJ
SIXBM2:	ADDI	CH,40
	PUSHJ	P,TYOM
	AOJL	B,.-4
	POPJ	P,
ERRTYP:	TLNN	F2,GOING	;[166] ANY COMMAND SEEN YET?
	JRST	ERRTY1		;[166] NO, SKIP THE FOLLOWING
	MOVE	AA,ERR2		;VALUE OF CPTR WHEN LAST ERROR OCCURRED.
	MOVEI	B,12
	SUBI	AA,2		;BACK POINTER UP 10 CHARACTERS.
	ILDB	CH,AA		;GET CHARACTER
	CAMG	B,ERR1		;WAS IT IN THE COMMAND BUFFER?
	PUSHJ	P,TYOM		;YES. TYPE IT.
	CAME	AA,ERR2		;HAVE WE REACHED THE BAD COMMAND?
	SOJA	B,.-4		;NO. DO IT AGAIN.
;ERRTYP+10 [166] SR#17205
ERRTY1:	JSP	A,CONMES	;PRINT A ? TO MARK END
	ASCIZ	/?
/
	JRST	ERRP6A

XPLA2:	PUSHJ	P,ERRPR2	;PRINT UP TO LF
XPLAIN:	PUSHJ	P,ERRCHR	;IS NEXT CHAR A "?" OR ^A,^B, ... ^H?
	CAIN	CH,"?"
	JRST	XPLA1		;YES
	CAILE	CH,10
	JRST	XPLA2		;NO, KEEP GOING
XPLA1:	TRO	FF,XPLNFL	;SET FLAG THAT XPLANATION IS TYPED
	JRST	ERRP6		;YES, STOP HERE

U ERR1,1			;
U ERR2,1			;
U COMLEN,1			;LENGTH OF BASIC COMMAND STRING
;DISPATCH TABLE FOR SPECIAL INFORMATION TYPEOUT
;BASED ON CHARACTER AFTER CONTROL-N

ETABL:	XWD	ECOMCH,EOUTFL	;00  01
	XWD	EFILEN,EERNUM	;02  03
	XWD	EDEVNM,EPROJN	;04  05
	XWD	EARG1,EPROTC	;06  07
	XWD	EEBFN,EINFIL	;08  09
	XWD	EEBFIL,EIOFLG	;10  11
	XWD	ESTAB,ESKIP	;12  13
	XWD	EISKIP,EFILSP	;14  15
	XWD	EEOVAL,EESRCH	;16  17
	XWD	EECTRL,EESWIT	;18  19
	XWD	EEBPTH,EINFSP	;20  21
	XWD	EOUFSP,EPATH	;22  23
;SPECIAL INFORMATION TYPEOUT ROUTINES


EECTRL:	SKIPA	CH,ARGSTO	;GET BAD CHAR FROM TEXT STRING
ECOMCH:	LDB	CH,CPTR		;GET LAST COMMAND STRING CHAR.
	PUSHJ	P,TYOS
	JRST	ERRPRN

EOUTFL:	MOVEI	TT1,OUNAM	;[175] AIM AT OUTPUT FILENAME
EOUTF2:	PUSHJ	P,EFILE		;[175] TYPE THE FILE
	JRST	ERRPRN		;[175] CONTINUE WITH MESSAGE

;HERE TO TYPE A FILENAME.EXTENSION
EFILE:	MOVE	TT,(TT1)	;[175] PICK UP FILE NAME
	PUSHJ	P,SIXBMS	;PRINT FILENAME
	HLLZ	TT,1(TT1)
	JUMPE	TT,CPOPJ	;[175] SKIP REST IF NO EXTENSION
	MOVEI	CH,"."
	PUSHJ	P,TYOM
	PUSHJ	P,SIXBMS	;PRINT EXTENSION
	POPJ	P,		;[175]

EFILEN:	MOVEI	TT1,XNAM	;[175] GET FILENAME REF'D BY UUO
	JRST	EOUTF2

EERNUM:	LDB	B,[POINT 15,XEXT,35]	;[175] GET 2-DIGIT ERROR CODE
EERNU1:	PUSHJ	P,OCTMS		;TYPE IT
	JRST	ERRPRN

EDEVNM:	MOVE	TT,OPNDEV	;[175] GET DEVICE NAME
EDEVN1:	PUSHJ	P,SIXBMS	;[175] PRINT THE DEVICE NAME
	JRST	ERRPRN		;[175] BACK FOR MORE OF MESSAGE

EPROJN:	SKIPE	PTHPPN		;[175] LOOKUP/ENTER ON DEFAULT PATH?
	SKIPA	C,[PTHBLK]	;[175] NO, GET PATH WE USED
	MOVEI	C,DEFPTH	;[175] YES, POINT TO DEFAULT PATH
	PUSHJ	P,TYPATH	;[175] TYPE THE PATH
	JRST	ERRPRN		;[175] AND CONTINUE WITH TYPEOUT

EESWIT:	MOVE	TT,SWITHL	;GET I/O SWITCH NAME
	JRST	EDEVN1		;[175] TYPE IT & RETURN

EARG1:	MOVE	B,ARGSTO	;GET ARG BACK
EARG1A:	PUSHJ	P,DECMS		;PRINT IT
	JRST	ERRPRN
EPROTC:	LDB	B,[POINT 9,XPRV,8]	;[175] GET FILE PROTECTION
	JRST	EERNU1

EEBFN:	MOVE	TT,EBNAM	;[175] EB FILENAME
	JRST	EDEVN1		;[175] PRINT IT WITHOUT EXTENSION

EINFIL:	MOVEI	TT1,INNAM	;[175] AIM AT INPUT FILENAME
	JRST	EOUTF2

EEBFIL:	MOVEI	TT1,EBNAM	;[175] AIM AT EB ORIGINAL FILENAME
	JRST	EOUTF2
EIOFLG:	HRRZI	B,740000	;RETRIEVE I/O ERROR FLAGS
	AND	B,ARGSTO
	JRST	EERNU1

ESTAB:	MOVEI	TT,STAB		;INDEX STAB WHERE TAG RESIDES
ESTAB1:	MOVE	CH,(TT)
	JUMPE	CH,ERRPRN	;THAT'S ALL
	PUSHJ	P,TYOS
	AOJA	TT,ESTAB1

EISKIP:	LDB	TT,[POINT 4,ARGSTO,21]	;GET I/O ERROR FLAGS
	SKIPA
ESKIP:	LDB	TT,[POINT 15,XEXT,35]	;[175]
ESKIP2:	PUSHJ	P,ERRCHR	;LOOK FOR ^A
	CAIN	CH,2		;^B ENCOUNTERED?
	JRST	ERRPRN		;YES, PRINT DEFAULT MESSAGE
	CAIE	CH,1
	JRST	ESKIP2		;NOT ^A
	PUSHJ	P,ERRCHR	;GET 1ST DIGIT AFTER ^A
	MOVEI	T,-60(CH)
	LSH	T,3		;MULT BY 8
	PUSHJ	P,ERRCHR	;GET NEXT DIGIT
	ADDI	T,-60(CH)
	CAME	TT,T		;THIS THE NUMBER WE WANT?
	JRST	ESKIP2		;NO
	JRST	ERRPRN		;YES, NOW START PRINTING

EEOVAL:	MOVEI	B,EOVAL		;GET MAXIMUM EOFLAG FOR THIS VERSION
	JRST	EARG1A

EESRCH:	MOVE	TT,[POINT 7,SRHARG]	;GET PTR TO SEARCH STRING
	MOVE	B,SRHCTR	;& STRING CTR
EESRH2:	ILDB	CH,TT		;GET STRING CHAR
	PUSHJ	P,TYOS		;TYPE IT
	SOJE	B,ERRPRN	;WATCH STRING CTR
	JRST	EESRH2		;NOT FINISHED YET
EFILSP:	MOVEI	TT1,XNAM	;[175] POINT TO FILE NAME
	MOVEI	C,PTHBLK	;[175] AND DEVICE, CHR'S, PATH
	JRST	EFLSUB		;[175] JOIN COMMON ROUTINE

EPATH:	SKIPA	C,[PTHBLK]	;[200] POINT TO PTHBLK
EEBPTH:	MOVEI	C,EBPTH		;[175] POINT TO EB PATH
	JRST	EDSPTH		;[175] GO DISPLAY IT

EINFSP:	MOVEI	TT1,INNAM	;[175] SETUP INPUT FILE NAME
	MOVEI	C,INPTH		;[175] AND INPUT PATH
	JRST	EFLSUB		;[175] MERGE WITH COMMON CODE

EOUFSP:	MOVEI	TT1,OUNAM	;[175] OUTPUT FILE NAME
	MOVEI	C,OUPTH		;[175] OUTPUT PATH
;	JRST	EFLSUB		;[175] COMMON CODE

;HERE TO PRINT DEV:FILE.EXT[PATH]
EFLSUB:	MOVE	TT,-3(C)	;[175] GET DEVICE NAME
	PUSHJ	P,SIXBMS	;[175] TYPE IT
	MOVEI	CH,":"		;[175] SEPERATOR
	PUSHJ	P,TYOM		;[175] TYPE IT
	PUSHJ	P,EFILE		;[175] TYPE THE FILE.EXT

;HERE TO TYPE PATH C POINTS TO IF FROM A DISK.
EDSPTH:	MOVE	E,-1(C)		;[175] GET DEVCHR WORD
	TXNN	E,DV.DSK	;[175] A DISK?
	JRST	ERRPRN		;[175] NO, DONE
	SKIPE	2(C)		;[175] THIS PATH BLOCK SET UP?
	JRST	EDSPT1		;[175] YES, PROCEED
	MOVE	E,-3(C)		;[175] NO, PICKUP DEVICE
	MOVEM	E,0(C)		;[175] STORE IN PATH BLOCK
	MOVSI	E,10		;[200] ASSUME 10 WORDS LONG
	HRRI	E,0(C)		;[175] NOW SET UP FOR PATH UUO
	PATH.	E,		;[175] FIND OUT DEVICE'S PATH
	  JRST	ERRPRN		;[175] NOT A DISK, FORGET IT
EDSPT1:	MOVEI	CH,"["		;[175] ANNOUNCE THE PATH
	PUSHJ	P,TYOM		;[175] OUT IT GOES
	PUSHJ	P,TYPATH	;[175] TYPE IT
	MOVEI	CH,"]"		;[175] ANNOUNCE END OF PATH
	PUSHJ	P,TYOM		;[175] TYPE IT
	JRST	ERRPRN		;[175] LOOP BACK FOR MORE OF THE MESSAGE

;UUO HANDLER

UUOH:
IFN PDP6,<0>			;PDP-6 JSR ENTRY
	MOVEM	B,ARGSTO	;SAVE POSSIBLE ARG
	LDB	B,[POINT 9,.JBUUO,8]	;GET UUO TYPE
	CAIL	B,20		;CHKEO?
	JRST	CEO		;YES
	CAIN	B,1		;ERROR UUO?
	JRST	ERRP		;YES
UUOERR:	MOVEM	B,PTHPPN		;[175]
	HRRZ	B,(P)		;ADDRESS OF ILLEGAL UUO
	SUBI	B,1
	ERROR	E.UUO

U LISTF5,1			;OUTPUT DISPATCH

;CHKEO EO#,ADDR
;IF EOFLAG > EO#, RETURN AT CALL+1 (FEATURE IS LEFT ON)
;OTHERWISE GO TO ADDR (FEATURE IS TURNED OFF)

CEO:	PUSH	P,A		;SAVE AC
	LDB	B,[POINT 8,.JBUUO,12]	;GET EO TEST VALUE
	MOVE	A,EOFLAG	;GET LAST SETTING OF EOFLAG
	CAIG	A,(B)		;EOFLAG > TEST VALUE?
	JRST	CEO1		;NO
CEO2:	POP	P,A		;RESTORE AC A
	MOVE	B,ARGSTO	;RESTORE AC B
IFE PDP6,<POPJ	P,>		;RETURN
IFN PDP6,<JRST	@UUOH>

CEO1:	HRRZ	A,.JBUUO	;GET DISPATCH ADDR
	HRRM	A,-1(P)		;PUT ON PDL AS RET. ADDR.
	JRST	CEO2
;COMMAND TO COMPLEMENT TRACE MODE. "?" AS A COMMAND

QUESTN:	TRCN	FF,TRACEF	;COMPLEMENT TRACE FLAG
	JRST	RET
	PUSHJ	P,CRR		;TYPE CR/LF AFTER TRACE MODE EXIT
	JRST	RET

COMMEN:	PUSHJ	P,SKRCH		;GET A COMMENT CHAR
	ERROR	E.UCA
	CAIN	CH,1		;^A
	JRST	RET		;DONE
	TRNN	FF,TRACEF	;OMIT DOUBLE TYPE-OUT WHEN TRACING
	PUSHJ	P,TYOM		;TYPE IT
	JRST	COMMEN

;OLD ^G EXIT COMMAND AND ILLEGAL COMMANDS

BELDMP:	CHKEO	EO21,DECDMP	;IF EO=1, DO ^Z, OTHERWISE ^G IS ILLEGAL

ERRA:	ERROR	E.ILL
;ROUTINE TO RETURN STRING OPERATION STRING ARGUMENTS.
;ARGUMENTS ARE CHARACTER ADDRESSES IN THE DATA BUFFER.
;TRANSFORMS M,N OR N, WHERE THE LATTER SPECIFIES A NUMBER OF LINES,
;TO ARGUMENTS.
;CALL	PUSHJ P,GETARG
;	RETURN WITH FIRST ARGUMENT ADDRESS IN C, SECOND IN B.
;IF THE EO VALUE HAS BEEN SET TO 1, THE ONLY EOL CHAR IS LINE FEED.
;IF EO > 1, THE EOL CHARS ARE LF, VT, AND FF (& END OF BUFFER IF
;LAST CHAR IN BUFR IS NOT AN EOL)

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

;N	SIGN INDICATES DIRECTION RELATIVE TO PT.
GETNAG:	PUSHJ	P,CHK2		;NO, GET 1ST ARG (+ OR - 1 IF NONE THERE)
	MOVE	I,PT		;IN:=PT
GETAG4:	JUMPLE	B,GETAG2	;WAS LAST ARGUMENT FUNCTION -?
	CAMN	I,Z		;NO. ARGUMENT IS LOCATION OF NTH EOL FORWARD FROM PT.
				;IS PT AT END OF BUFFER?
	JRST	GETAG1		;YES.
	PUSHJ	P,GETINC	;NO. CH:=NEXT DATA BUFFER CHARACTER, IN:=IN+1
	PUSHJ	P,CKEOL		;IS IT AN EOL?
	JRST	GETAG4		;NO. TRY AGAIN.
	SOJG	B,GETAG4	;YES. NTH EOL?

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

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

GETAG2:	SOS	I		;SET I FOR CHAR BEFORE PT
	CAMGE	I,BEG		;PASSED BEGINNING OF BUFFER?
	JRST	GETAG3		;YES. IN:=BEG
	PUSHJ	P,GETINC	;NO. CH:=NEXT DATA BUFFER CHARACTER. IN:=IN+1
	PUSHJ	P,CKEOL		;IS IT AN EOL?
	SOJA	I,GETAG2	;NO. BACK UP ONE POSITION AND TRY AGAIN.
	AOJLE	B,.-1		;YES. NTH EOL?

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

GETINC:	PUSHJ	P,GET
	AOJA	I,CPOPJ

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

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

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

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

;CHECK IF CH = EOL CHARACTER
;CALL:	PUSHJ	P,CKEOL
;	RETURN IF CH NOT = EOL
;	RETURN IF CH IS EOL CHAR

CKEOL:	CAIN	CH,12		;LINE FEED?
	JRST	CPOPJ1		;YES, IT IS AN EOL!
	CHKEO	EO21,CPOPJ	;IF EO=1, LF IS ONLY POSSIBLE EOL
	CAIE	CH,13		;VERTICAL TAB?
	CAIN	CH,14		;FORM FEED?
	AOS	(P)		;YES, SKIP RETURN
	POPJ	P,		;NO
NROOMC:
IFN VC,<MOVEM	C,VVAL>		;SAVE LENGTH OF STRING
NROOM:	MOVEM	17,AC2+15	;SAVE 17
	MOVEI	17,NROOM9	;ANTICIPATE GARBAGE COLLECTION
	MOVEM	17,GCRET	;THIS THE EXIT DISPATCH
	SETZM	CRREL
	SETZM	RREL
	MOVE	17,PT
	CAMN	17,Z		;PT=Z? I.E., DATA BUFFER EXPANSION?
	JRST	NROOM1		;YES.
NROOM0:	MOVE	17,[XWD 2,AC2]	;NO. SAVE ACS 2 THROUGH 16.
	BLT	17,AC2+14
	JUMPL	C,NROOM6	;DELETION?
	SETOM	GCFLG		;NO.

;MOVE STRING STORAGE UP C CHARACTERS STARTING AT PT.

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


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

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


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

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

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

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

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

U NROOM4,1			;PARTIAL WORD POINTER FOR DOWNWARD MOVE
GC:	AOSE	GCFLG		;FIRST ATTEMPT?
	JRST	PRENR9		;TRY TO EXPAND MEMORY
	SETOM	GCPTR		;YES. GCPTR:=-1
	SETZM	SYMS		;CLEAR SYMS,VALS AND CNTS TABLES
	MOVE	T,[XWD SYMS,SYMS+1]
	BLT	T,SYMEND-1
	MOVEI	T,CPTR		;COMMAND BUFFER
	PUSHJ	P,GCMA
	MOVEI	T,(P)
	PUSHJ	P,GCMA		;NO. GARBAGE COLLECT ALL BYTE POINTERS ON IT.
	CAILE	T,PDL+1
	SOJA	T,.-2
	HRRZ	T,AC2+PF-2	;GARBAGE COLLECT Q-REG PUSHDOWN LIST.
	CAIL	T,PFL
	PUSHJ	P,GCM
	CAILE	T,PFL
	SOJA	T,.-2
	MOVE	T,[XWD -44,QTAB]	;GARBAGE COLLECT Q-REGISTERS.
	PUSHJ	P,GCM
	AOBJN	T,.-1
	MOVE	I,BEG		;MAKE SURE STUFF BEFORE BEG
	SUB	I,QRBUF		;IS COLLECTED
	MOVEI	T,0		;MARK THIS AS LAST COLLECTION
	PUSHJ	P,GCM3		;STORE IT ON TH GC LIST
	MOVE	I,QRBUF
GCS1A:	MOVSI	TT,200000	;TT>MAX. NO. CHARACTERS IN WORLD
	MOVE	OU,GCPTR	;GO BACKWARDS THROUGH GCTAB
GCS1:	HRRZ	A,GCTAB(OU)	;RELOCATE
	ADD	A,QRBUF
	CAMGE	A,I
	JRST	GCS2
	CAMGE	A,TT		;SET TT TO HIGHEST CHARACTER POSITION
	MOVE	TT,A
GCS2:	SOJGE	OU,GCS1
	CAMN	TT,[1B1]	;ANYTHING IN GCTAB?	[116]
	JRST	GCS4A		;NO, DON'T SAVE INFINITY[116]
	MOVE	F2,TT		;HIGHEST CHARACTER.
	IDIVI	I,5		;C(QRBUF)/5
	IDIVI	F2,5		;HIGH CHAR/5
	AOS	I		;C(QRBUF)/5+1
	MOVS	OU,F2
	MOVE	T,F2
	SUB	T,I		;HIGH CHAR/5-C(QRBUF)/5+1
	JUMPLE	T,GCS4A		;ANYTHING TO GET?
	HRR	OU,I		;XWD HIGH CH/5,C(QRBUF)/5+1=NREG
	MOVE	B,Z		;GET TOP OF BUFR FOR BLT
	HRRZ	F2,(P)		;SEE WHO CALLED NROOM
	CAIN	F2,YANK6	;WAS IT APPEND?
	MOVE	B,AC2+OU-2	;YES, MUST USE THE REAL Z FOR THE BLT
	IDIVI	B,5
	SUB	B,T		;Z/5-NREG
	BLT	OU,(B)		;MOVE STUFF DOWN
	MOVNS	OU,T
	IMULI	OU,5		;OUT:=-5*NREG
	ADDM	OU,BEG		;BEG:=C(BEG)-5*NREG
	ADDM	OU,PT		;PT:=C(PT)-5*NREG
	ADDM	OU,Z		;Z:=C(Z)-5*NREG
	ADDM	OU,RREL		;RREL:=C(RREL)-5*NREG
	MOVE	CH,GCPTR	;UPDATE INSERTER
GCS3:	HRRZI	TT1,GCTAB(CH)
	HRRZ	A,(TT1)
	ADD	A,QRBUF
	CAMGE	A,TT
	JRST	GCS4
	ADDM	OU,(TT1)
	HLRZ	A,(TT1)
	JUMPE	A,GCS4		;NO PTR TO BEG
	CAIN	A,CPTR		;IN COMMAND BUFFER?
	ADDM	T,CRREL		;YES. UPDATE COMMAND POINTER RELOCATION
	SKIPL	(A)		;Q-REG?
	ADDM	T,(A)		;NO
	SKIPGE	(A)		;Q-REG?
	ADDM	OU,(A)		;YES. RELOCATE BASE POINTER.

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

GCS4A:	CAML	TT,BEG		;LAST COLLECTION?
	JRST	@GCRET		;YES, RETURN
	MOVE	I,TT
	PUSH	P,C
	PUSHJ	P,GTQCNT
	ADD	I,C
	POP	P,C
	JRST	GCS1A
GCM:	MOVE	I,(T)
	TLZE	I,400000	;DOES Q-REG CONTAIN TEXT?
	TLZE	I,377777
	POPJ	P,		;NO
	ADD	I,QRBUF		;YES. ENTER POINTER IN GCTAB

GCM2:	CAML	I,BEG		;REGION BEFORE TEXT BUFFER?
	POPJ	P,		;NO. FORGET IT.
	SUB	I,QRBUF		;YES. IN:=# CHARACTERS TO RETREIVE.
				; IN Q-REG BUFFER AREA?
	JUMPL	I,CPOPJ		;NO. FORGET IT.
GCM3:	AOS	TT,GCPTR	;YES. TO BE GRABBED.
	CAIL	TT,GCTBL	;AM I WINNING?
	ERROR	E.GCE
	HRL	I,T		;XWD ADDRESS OF BYTE POINTER,NO. CHARACTERS
	MOVEM	I,GCTAB(TT)	;SAVE DATA
	POPJ	P,		;DONE THIS POINTER

;IF T POINTS TO AN ASCII BYTE POINTER, IN:=CHARACTER ADDRESS OF TOP
;OF STRING - NO. OF CHARACTERS.
GCMA:	HLRZ	TT,(T)		;LEFT HALF OF PTR
	TRC	TT,700		;DOES T POINT TO A TEXT BYTE POINTER?
	TRNE	TT,7700
	POPJ	P,		;NO
	MOVE	I,-1(T)		;MAYBE. GET WORD BEFORE POINTER. (MAX)
	SUB	I,1(T)		;MAX-CT
	LSH	TT,-14		;BYTE POSITION
	IDIVI	TT,7		;NO. OF CHARACTERS
	MOVEI	TT1,4-3+1	;2
	SUB	TT1,TT		;2-NO. OF CHARACTERS
	HRRZ	TT,(T)		;POINTER WORD ADDRESS (UNRELOCATED)
	IMULI	TT,5		;5*ADDRESS
	ADD	TT,TT1
	SUBM	TT,I		;5*ADDRESS-NO. CHARS+2+CT-MAX
	JRST	GCM2
;**********AUTOMATIC MEMORY EXPANSION*********

;MEMORY WILL BE EXPANDED UNDER ONE OF THESE CONDITIONS.

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

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


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


;SAVE THE ACCUMULATORS


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

;COUNT THE NUMBER OF BLOCKS NEEDED TO FILL THE REQUEST

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

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

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

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

;NO CORE AVAILABLE (OR NOT ENOUGH)

NOTANY:	HLRZ	A,.JBSA		;GET LAST FIGURE OF CORE BOUND
	MOVEM	A,.JBFF		;AND STORE IT
	PUSHJ	P,CRE23		;COMPUTE THE MEMSIZE VALUES AGAIN
	MOVSI	CH,SAVE		;RESTORE THE ACCUMULATORS
	BLT	CH,CH		;& INFORM THE OUTSIDE WORLD THAT THEY LOSE
	EE3+ERROR E.COR

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

PRENR9:	PUSHJ	P,GRABAK	;GET THE REQUIRED CORE
	JRST	NROOM9		;GO TRY THE INSERT AGAIN
U BEG,1				;
U PT,1				;
U Z,1				;
U QRBUF,1			;
;*** DO NOT SEPARATE ***
U COMAX,1			;TOTAL # OF CHARS AT CUR. CMD. LEVEL
U CPTR,1			;EXECUTION-TIME CMD STRING PTR
U COMCNT,1			;# OF CHARS REMAINING TO BE EXECUTED AT THIS LEVEL
;*** DO NOT SEPARATE ***
U CBUFH,1			;
U CBUF,1			;
U MEMSIZ,1			;
IFN CCL,<U CCLSW,1>
U GCPTR,1			;
U CRREL,1			;
U GCFLG,1			;
U RREL,1			;


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

U M23,1				;
U M23PL,1			;
;COMMAND DISPATCH TABLE

DEFINE	DSP (C1,A1,C2,A2)<
	XWD <<C1>B20+A1>,<<C2>B20+A2>>

;CODES INDICATE TYPE OF DISPATCH
JR==0	;FOR SIMPLE JRST DISPATCH
HR==1	;FOR DISPATCH TO A COMMAND PERFORMED BY A SUBROUTINE
MV==2	;FOR JRST DISPATCH AFTER PROCESSING PRECEDING NUMERIC ARGUMENTS

DTB:	DSP(JR,ERRA,JR,COMMEN)		;^@	^A
	DSP(JR,ERRA,JR,ERRA)		;^B	^C
	DSP(JR,ERRA,JR,FFEED)		;^D	^E
	DSP(JR,LAT,JR,BELDMP)		;^F	^G
	DSP(JR,GTIME,HR,TAB)		;^H	TAB
	DSP(JR,CD5,JR,ERRA)		;LF	VT	[142]
	DSP(HR,TYO,JR,CD5)		;FF	CR	[142]
	DSP(JR,EOF,JR,OCTIN)		;^N	^O
	DSP(JR,ERRA,JR,ERRA)		;^P	^Q
	DSP(JR,ERRA,JR,ERRA)		;^R	^S
	DSP(JR,SPTYI,JR,ERRA)		;^T	^U
	DSP(MV,LOWCAS,MV,STDCAS)	;^V	^W
	DSP(MV,SETMCH,JR,ERRA)		;^X	^Y
	DSP(JR,DECDMP,JR,ALTMOD)	;^Z	^[
	DSP(JR,ERRA,JR,ERRA)		;^BKSLH	^]
	DSP(JR,CNTRUP,JR,ERRA)		;^^	^LFTARR
	DSP(MV,PLUS,JR,EXCLAM)		;SPACE	!
	DSP(MV,DQUOTE,MV,COR)		;"	#
	DSP(JR,ERRA,JR,PCNT)		;$	%
	DSP(MV,CAND,JR,CD)		;&	'
	DSP(JR,OPENP,MV,CLOSEP)		;(	)
	DSP(MV,TIMES,MV,PLUS)		;*	+
	DSP(MV,COMMA,MV,MINUS)		;,	-
	DSP(JR,PNT,MV,SLASH)		;.	/
	DSP(JR,CDNUM,JR,CDNUM)		;0	1
	DSP(JR,CDNUM,JR,CDNUM)		;2	3
	DSP(JR,CDNUM,JR,CDNUM)		;4	5
	DSP(JR,CDNUM,JR,CDNUM)		;6	7
	DSP(JR,CDNUM,JR,CDNUM)		;8	9
	DSP(MV,COLON,MV,SEMICL)		;:	;
	DSP(MV,LSSTH,HR,PRNT)		;<	=
	DSP(JR,GRTH,JR,QUESTN)		;>	?
	DSP(MV,ATSIGN,JR,ACMD)		;@	A
	DSP(JR,BEGIN,MV,CHARAC)		;B	C
	DSP(MV,DELETE,HR,ECMD)		;D	E
	DSP(MV,FCMD,JR,QGET)		;F	G
	DSP(JR,HOLE,HR,INSERT)		;H	I
	DSP(MV,JMP,MV,KILL)		;J	K
	DSP(MV,LINE,JR,MAC)		;L	M
	DSP(MV,SERCHP,JR,OG)		;N	O
	DSP(HR,PUNCHA,JR,QREG)		;P	Q
	DSP(MV,REVERS,MV,SERCH)		;R	S
	DSP(HR,TYPE,MV,USE)		;T	U
	DSP(JR,ERRA,JR,ERRA)		;V	W
	DSP(MV,X,HR,YANK)		;X	Y
	DSP(JR,END1,MV,OPENB)		;Z	[
	DSP(MV,BAKSL,MV,CLOSEB)		;BKSLH	]
	DSP(JR,UAR,MV,LARR)		;^	LFTARR
U ERRLEN,1			;TYPE OF ERROR MESSAGES WANTED BY DEFAULT
U AC2,16			;SAVE AC2-AC17 IN NROOM ROUTINE
U STAB,STABLN			;SEARCH MATRIX
COMZR==STAB			;[175] BEGINNING OF AREA TO ZERO
				;[175] WHEN ENTERING COMMAND SCANNER
COMDEV=STAB			;[175] DEVICE USER TYPED
COMNAM=COMDEV+1			;[175] FILENAME  "    "
COMEXT=COMNAM+1			;[175] EXTENSION "    "
COMPPN=COMEXT+1			;[175] PPN       "    "
COMSFD=COMPPN+1			;[175] SFD'S     "    "
SWITC=COMSFD+5			;[175] SWITCHES  "    "
SWITHL=SWITC+1			;[175] LAST SWITCH TYPED, IN SIXBIT

OPNBLK==<OPNSTS=SWITHL+1>	;[175] STATUS TO DO OPEN WITH
OPNDEV=OPNSTS+1			;[175] DEVICE TO OPEN
OPNBUF=OPNDEV+1			;[175] BUFFER ADDRESS

OPNCHR=OPNBUF+1			;[175] DEVCHR OF DEVICE IN OPNDEV

PTHBLK=OPNCHR+1			;[175] 1ST WORD OF PATH BLOCK
PTHFLG=PTHBLK+1			;[175] SCAN SWITCH & OTHER FLAGS
PTHPPN=PTHFLG+1			;[175] PROJ-PROG PAIR
PTHSFD=PTHPPN+1			;[175] FIRST SFD
PTHLEN=PTHSFD+5-PTHBLK+1	;[175] LENGTH OF PATH BLOCK

XFILNM==PTHBLK+PTHLEN		;[175] EXTENDED OPEN BLOCK
XCNT=XFILNM+.RBCNT		;[175] COUNT OF ARGS FOLLOWING
XPPN=XFILNM+.RBPPN		;[175] POINTER TO PATH BLOCK
XNAM=XFILNM+.RBNAM		;[175] FILE NAME
XEXT=XFILNM+.RBEXT		;[175] EXTENSION
XPRV=XFILNM+.RBPRV		;[175] PROT. & DATES
XSIZ=XFILNM+.RBSIZ		;[175] FILE SIZE (WORDS)
XVER=XFILNM+.RBVER		;[175] VERSION
XSPL=XFILNM+.RBSPL		;[175] SPOOLING NAME
XEST=XFILNM+.RBEST		;[175] ESTIMATED SIZE
XALC=XFILNM+.RBALC		;[175] BLOCKS ALLOCATED TO FILE
XPOS=XFILNM+.RBPOS		;[175] POSITION OF FILE ON DISK
XNCA=XFILNM+.RBNCA		;[175] NON-PRIVED CUST. ARG.
XDEV=XFILNM+.RBDEV		;[175] UNIT OF STR THAT FILE CAME FROM
XFILEN=XDEV-XFILNM+1		;[175] LENGTH OF LOOKUP BLOCK

SFILNM==XNAM			;[175] ALTERNATE NAME FOR DTA LOOKUPS
CPATH=XFILNM+XFILEN		;[175] SECOND PATH BLOCK FOR CHKPTH
CFLG=CPATH+1			;[175] SCAN SWITCH
CPPN=CFLG+1			;[175] PPN
CSFD=CPPN+1			;[175] 1ST SFD
CPTLEN=CSFD+5-CPATH+1		;[175] LENGTH OF PATH BLOCK

DCBLK=CPATH+CPTLEN		;[175] DSKCHR BLOCK FOR EB OPEN
DCSNM=DCBLK+.DCSNM		;[175] STRUCTURE NAME FILE IS ON
DCLEN==DCSNM-DCBLK+1		;[175] LENGTH OF DSKCHR BLOCK

COMEZR==DCBLK+DCLEN-1		;[175] LAST LOCATION TO ZERO IN SCANNER
IFL <STABLN-<COMEZR-COMZR+1>>,<PRINTX ? MOVE X??? BLOCKS TO BIGGER AREA>

U BCOUNT,1			;BEGPAG MATCH FLAG FOR SERCH1	[ED#117]
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 EQM,1				;LEVEL OF MACRO NESTING		[ED#114]
U SRHCTR,1			;# OF CHARS IN SEARCH ARGUMENT (MUST PRECEDE SRHARG)
U SRHARG,^D16			;STORE FOR SEARCH ARGUMENT
U PFL,LPF			;
U GCTAB,GCTBL			;GCS3+4,GCM2+13
U QTAB,44			;Q-REGISTER TABLE
				;USEA+1,PCNT+1
U PDL,LPDL			;
U SAVE,16			;AC STORAGE FOR GC
U SAV16,1			;

IFE BUGSW,<U CMDBFR,0>			;COMMAND BUFFER
IFN BUGSW, <U CMDBFR,1
	U LOWEND,0>

	LIT			;SO PATCH SPACE IS AT TOP OF HI-SEG
PATCH:	END	TECO